==== Correctness tests ====

Probabilities are: {6 => 27.000, 19 => 23.000, 21 => 33.000, 43 => 17.000}
origCode yielded {6 => 26.955, 19 => 22.825, 21 => 33.142, 43 => 17.078}
duff yielded {6 => 27.111, 19 => 22.956, 21 => 33.008, 43 => 16.925}
fizbin yielded {6 => 27.117, 19 => 23.057, 21 => 32.862, 43 => 16.964}
L~R yielded {6 => 26.929, 19 => 22.946, 21 => 33.151, 43 => 16.974}
QM yielded {6 => 59.902, 19 => 0.000, 21 => 17.062, 43 => 23.036}
QM failed
ccn yielded {6 => 26.991, 19 => 22.882, 21 => 33.064, 43 => 17.063}

==== Speed tests ====

            Rate origCode     duff       QM      L~R      ccn   fizbin
origCode  4101/s       --     -34%     -78%     -83%     -87%     -89%
duff      6191/s      51%       --     -66%     -75%     -81%     -83%
QM       18348/s     347%     196%       --     -26%     -43%     -50%
L~R      24743/s     503%     300%      35%       --     -24%     -32%
ccn      32411/s     690%     424%      77%      31%       --     -11%
fizbin   36567/s     792%     491%      99%      48%      13%       --

##</code><code>##

#!perl

use strict;

my $str = "17:43:33:21:23:19:27:6";

my $codehash = {
    origCode => sub {
        my @ary;
        my %hash = split /:/, $str;
        foreach my $k ( keys %hash ) {
            push( @ary, map { $hash{$k} } ( 1 .. $k ) );
        }
        my $adId = $ary[ int( rand(100) ) ];
    },

    ccn => sub {
        my %hash = split /:/, $str;

        my $adno;

        my $rand = rand 100;

        my $sum = 0;
        for ( keys %hash ) {    # there is no need of sorted keys
            $adno = $hash{$_};
            last if ( $sum += $_ ) > $rand;
        }
        $adno;
    },

    QM => sub {
        my %hash = reverse split /:/, $str;
        my $count;
        my %ad_lookup;
        foreach my $k ( keys %hash ) {
            $count += $hash{$k};
            $ad_lookup{$count} = $k;
        }
        my $rand = rand(100);
        my $adid;
        foreach ( sort { $a <=> $b } keys %ad_lookup ) {
            $adid = $ad_lookup{$_} unless defined($adid);
            if ( $_ <= $rand ) {
                $adid = $ad_lookup{$_};
            }
            else {
                last;
            }
        }
        $adid;
    },

    "L~R" => sub {
        my $lookup;
        my %hash = reverse split /:/, $str;
        while ( my ( $key, $val ) = each %hash ) {
            $lookup .= pack( "C*", ($key) x $val );
        }
        my $addid = unpack( "C", substr( $lookup, rand 100, 1 ) );
    },

    duff => sub {
        my @ary;
        my @a = split /:/, $str;
        @a % 2 && die;    # not an even number of items
        while ( my ( $p, $ad ) = splice @a, 0, 2 ) {
            push @ary, ($ad) x $p;
        }
        my $adId = $ary[ int( rand(100) ) ];
    },

    fizbin => sub {
        my @a = split /:/, $str;
        @a % 2 && die;    # not an even number of items
        my $r = int( rand(100) );
        my ( $adId, $p );
        while ( ( $p, $adId ) = splice @a, 0, 2 ) {
            if ( $r < $p ) { last; }
            $r -= $p;
        }
        $adId;
    }
};

sub phash (%) {
    my %h = @_;
    return "{"
      . join( ", ",
        map { sprintf( '%s => %3.3f', $_, $h{$_} ); }
          sort { $a <=> $b } keys(%h) )
      . "}";
}

print "==== Correctness tests ==== \n\n";
my %strhash = reverse split( /:/, $str );

print "Probabilities are: ", phash(%strhash), "\n";

foreach my $subname ( keys %$codehash ) {
    my %resultshash = map { $_ => 0 } keys %strhash;
    do { $resultshash{ $codehash->{$subname}->() } += 0.001; }
      for ( 1 .. 100000 );

    print "$subname yielded ", phash(%resultshash), "\n";
    do {
        print "$subname failed\n" and last
          if ( abs( $resultshash{$_} - $strhash{$_} ) > 0.5 );
      }
      for keys(%strhash);
}

print "\n==== Speed tests ====\n\n";

use Benchmark qw(cmpthese);

cmpthese( -5, $codehash );