Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
After mulling on this one for a while, in particular thinking about how to track when a letter was due to get output again and how to maintain a distribution, I think I have something good. Compute a rolling score for each element, where it accumulates based upon probability of output and gets dinged when its element gets selected; maximum score always gets chosen.
use strict; use warnings; use List::Util 'sum'; use Data::Dump qw[ pp ]; sub gen { my $href = shift; my %score = %$href; my $norm = sum values %score; my @series; for (1 .. $norm) { my ($max, $elem) = 0; for (keys %score) { ($max, $elem) = ($score{$_}, $_) if $score{$_} >= $max; $score{$_} += $href->{$_}; } push @series, $elem; $score{$elem} -= $norm; } return \@series; } pp gen( { A => 4, B => 2, C => 3, D => 1 } ); pp gen( { A => 5, B => 4, C => 3, D => 2, E => 1 } );
["A", "C", "B", "A", "D", "C", "A", "B", "C", "A"] ["A" .. "D", "A", "B", "E", "A", "C", "B", "A", "D", "C", "B", "A"]

It also naturally extends to infinite series and non-integer element counts. The infinite series case is why it's necessary to have a >= in the score comparison; you could alternatively initialize $max to something negative since the sum of all scores is necessarily zero at all times. N*M complexity, where N is the length of desired series and M is number of distinct elements.

This approach also lends itself to designing a metric for how smooth a series is:

use strict; use warnings; use List::Util 'sum'; sub measure { my @series = @_; my %count; $count{$_}++ for @series; my $norm = sum values %count; $_ /= $norm for values %count; my %score = %count; my $metric = 0; for my $elem (@series) { $score{$elem} -= 1; for (keys %score) { $metric += $score{$_}**2; $score{$_} += $count{$_}; } } return $metric/@series; } print measure("A", "C", "B", "A", "D", "C", "A", "B", "C", "A"), "\n"; print measure("A", "C", "B", "A", "C", "D", "A", "B", "C", "A"), "\n"; print measure("A", "A", "A", "A", "B", "B", "C", "C", "C", "D"), "\n";
0.37 0.37 3.45

#11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

In reply to Re: Bag uniform distribution algorithms by kennethk
in thread Bag uniform distribution algorithms by davido

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, 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, 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.
  • Log In?

    What's my password?
    Create A New User
    LanX wonders, do we have a rule against systematic down voting?
    [erix]: we frown :)
    [marto]: Does the command line arg --product-version@ help?
    [LanX]: xD
    [erix]: 'systematic' is going to be hard to define I think
    [marto]: Err no @
    LanX Much enemy much ore
    [Corion]: marto: Naah, my module doesn't care, but the users of my module might expect some things to work in Chrome that only work in later builds (or, as seems to be the case, don't work there either ;) )

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (11)
    As of 2017-12-12 20:19 GMT
    Find Nodes?
      Voting Booth?
      What programming language do you hate the most?

      Results (335 votes). Check out past polls.