Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

Seek one liner for distributing an integer

by johnnywang (Priest)
on Sep 22, 2004 at 05:01 UTC ( #392839=perlquestion: print w/replies, xml ) Need Help??
johnnywang has asked for the wisdom of the Perl Monks concerning the following question:

Is there an one liner to do the following, which is not hard to do in more than a few lines: Given an array, and an integer, want to distribute this integer roughly evenly among this array elements, result should be a hash:
my @array=qw(a b c d e); my $num = 13; # so every element should get 2 = int(13/5), with the # remaining 3 given to the first three (or randomly). # Desired result: my %result = (a=>3, b=>3,c=>3,d=>2,e=>2);

My current version is something like:

my $averge = int($num/@array); my %result = map{$_=>$average} @array; for my $i(1..($num - $average*@array)){ ++$result{$array[$i-1]}; }

Replies are listed 'Best First'.
Re: Seek one liner for distributing an integer
by ikegami (Pope) on Sep 22, 2004 at 05:15 UTC
    $result{$array[$num%@array]}++ while ($num--);

      or if you want something ugly:

      %result = map{pop@array,length}('1'x$num)=~/^@{['(.*)'.'(\1.?)'x$#array]}$/;

      Apparently, map + regexps can do anything! ☺


      %result = map{$array[$i++],length}('1'x$num)=~/^@{['(.*)'.'(\1.?)'x$#array]}$/;
        Apparently, map + regexps can do anything!
        I'm pretty sure perl's flavor of regular expressions are turing complete, so you could do it all without the map. (I guess that would make them trans-regular expressions. Anyone got a better name?)

        -- All code is 100% tested and functional unless otherwise noted.
Re: Seek one liner for distributing an integer
by Zaxo (Archbishop) on Sep 22, 2004 at 05:19 UTC

    Here goes,

    $ perl -e'my ($n,$s) = @ARGV; my @foo = map { int($s/$n) + ($_ < $s % +$n) }0..$n-1; print "@foo"' 5 13 3 3 3 2 2$
    Purely arithmetic, with a pun on the logical value of '<'.

    Or more like the original problem,

    @result{@array} = map { int($num/@array) + ($_ < $num % @array) } 0 .. $#array;

    After Compline,

Re: Seek one liner for distributing an integer
by ysth (Canon) on Sep 22, 2004 at 05:46 UTC
    Recommended reading which deals with variations on this problem at length: Calendrical Calculations section 1.12, "Cycles of Years".

    Distributing m (here, $num) "evenly" into n (here, scalar(@array)) elements, some will be int(m/n), and m%n will be 1 more than that. So, putting all the extras at the front gives:

    my %result; my $num = 13; my @array = qw(a b c d e); @result{@array} = map int($num/@array) + $_ < $num%@array, 0..$#array;
    To do it randomly, use @result{shuffle @array} instead.

    Spreading them out as evenly as possible gives:

    @result{@array} = map int($num/@array) + ($_ * ($num%@array) % @array < $num%@array), 0..$#array;
    (See formula 1.57 in the book.)
•Re: Seek one liner for distributing an integer
by merlyn (Sage) on Sep 22, 2004 at 10:24 UTC
    To distribute this evenly and quickly, you could use the Bresenham Algorithm. Unfortunately, I didn't see any Perl implementations on a quick scan of the results. I became aware of the Bresenham technique some 20 years ago when I saw how to draw a diagonal line with the right amount of dots without using any division. It was quite amazing.

    -- Randal L. Schwartz, Perl hacker
    Be sure to read my standard disclaimer if this is a reply.

      While still not in Perl, the best work that I know of on implementing Bresenham's Algorithm is to be found in books by Michael Abrash. Two come to mind that belong on any programmers shelf; "Zen of Graphics Programming" Coriolis Group Books, ISBN 188357708X and "Zen of Code Optimization", Coriolis Group Books, ISBN 1883577039. Since Coriolis is sadly no longer among the living, you might try Powel's Technical in Portland.


      "Never try to teach a pig to wastes your time and it annoys the pig."
Re: Seek one liner for distributing an integer
by davido (Archbishop) on Sep 22, 2004 at 07:20 UTC

    Yet another way...

    use strict; use warnings; use Data::Dumper; my @array=qw(a b c d e); my $num = 13; my %result; $result{do{my$v=shift@array;push@array,$v;$v}}++while$num--; print Dumper \%result;


Re: Seek one liner for distributing an integer
by ikegami (Pope) on Sep 22, 2004 at 06:10 UTC


    Rate davido ike3 pela jw ted ike1b zaxo ike1 davido 22603/s -- -50% -54% -66% -69% -70% -73% -73% ike3 45636/s 102% -- -8% -31% -37% -40% -45% -45% pela 49364/s 118% 8% -- -25% -32% -35% -40% -40% jw 65704/s 191% 44% 33% -- -9% -13% -20% -21% ted 72090/s 219% 58% 46% 10% -- -5% -12% -13% ike1b 75516/s 234% 65% 53% 15% 5% -- -8% -9% zaxo 82287/s 264% 80% 67% 25% 14% 9% -- -1% ike1 82719/s 266% 81% 68% 26% 15% 10% 1% --
Re: Seek one liner for distributing an integer
by TedPride (Priest) on Sep 22, 2004 at 07:32 UTC
    $result{$array[$n++]} = int($num / ($#array + 1)) + ($num % ($#array + 1) > $n) while ($n <= $#array + 1);

    This produces the results you want in one run through @array - 5 steps - rather than $num steps. One of the other examples given above also attempts to do this, but I can't get the code to work, so here's mine.

    NOTE: $n is created global here, overwriting any other global or local $n in use. I couldn't do a my statement without using a second line.

      Found a small bug when doing benchmarks. Remove the "+ 1" from while ($n <= $#array + 1);.
Re: Seek one liner for distributing an integer
by pelagic (Priest) on Sep 22, 2004 at 12:50 UTC
    YAP (yet another possibility) making it pretty roughly evenly distributed:
    use strict; use Data::Dumper; $Data::Dumper::Indent = 1; my @array=qw(a b c d e); my $num = 13; my %result; for (1..$num){ $result{$array[int(rand(scalar(@array)))]}++; } foreach (@array) { print $_, ' => ', $result{$_} ? $result{$_} : 0, "\n"; } ___OUTPUT___ (maybe) a => 2 b => 3 c => 4 d => 2 e => 2

Re: Seek one liner for distributing an integer
by TilRMan (Friar) on Sep 23, 2004 at 04:04 UTC
    A little late to the game, but here goes:
    my %result = map { $_ => ( int($num / @array) + ($num % @array ? ($num--, 1) : 0) ) } @array;

    One statement, strict and warnings clean, and if you take out the whitespace, it'll fit on one line. Doesn't work on negative $num though.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://392839]
Approved by ysth
Front-paged by grinder
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others studying the Monastery: (3)
As of 2017-08-23 16:16 GMT
Find Nodes?
    Voting Booth?
    Who is your favorite scientist and why?

    Results (354 votes). Check out past polls.