After finding that oops above in my code, I thought I better put correctness tests in and publish the code I was using so that other people could tell me I was nuts if necessary.

So here again is the output of the benchmark code: 

==== 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.07
+8}
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%       --

[download]
And here's the code I used to make that determination. The formatting is from being run through perltidy, since it was even uglier before. 
#!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 );

[download]

In reply to Re^2: $str to %hash to @ary by fizbin
in thread $str to %hash to @ary by abaxaba

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.