We don't bite newbies here... much PerlMonks

### Seek one liner for distributing an integer

by johnnywang (Priest)
 on Sep 22, 2004 at 05:01 UTC 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);
Thanks.

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! ☺

Non-destructive:

```%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,
Zaxo

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.

--hsm

"Never try to teach a pig to sing...it 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;

Dave

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

Benchmarks

```          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

pelagic
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.

Create A New User
Node Status?
node history
Node Type: perlquestion [id://392839]
Approved by ysth
Front-paged by grinder
help
Chatterbox?
 [1nickt]: ... choice, the threaded-perl user *probably* wants to use threads, therefore only require threads and leave MCE out, allowing the user to manually install if desired? [choroba]: just require any of MCE and threads. Not sure if that's possible in the cpanfile, but should be possible early in the Makefile [1nickt]: The app expects threads as default anyway, right? [choroba]: that's true [1nickt]: expects threads *to be* the default [1nickt]: I think cpanfile can handle the logic. testing now.

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (14)
As of 2017-10-18 13:26 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My fridge is mostly full of:

Results (244 votes). Check out past polls.

Notices?