 Think about Loose Coupling PerlMonks

### Round robin processing

 on Sep 09, 2019 at 15:47 UTC Need Help??

llarochelle has asked for the wisdom of the Perl Monks concerning the following question:

Hi, I need to split an array into 4 even arrays (lists). I wrote this little piece of code I called "poor man's round robin algorithm". I wonder if there is a better approach to this ?

Here's the code

```
#!/bin/perl
my @array = qw(1 2 3 4 5 6 7 8 9 10 11 12);

my \$counter = 1;
my \$data;

for my \$pos (0 .. \$#array) {

print \$array[\$pos],"\n";
push @{\$data->{\$counter}}, \$array[\$pos];
if (\$counter == 4) {
\$counter = 1;
} else {
\$counter++;
}

};

use Data::Dumper;
print Dumper(\$data);

Here's the output

```
1
2
3
4
5
6
7
8
9
10
11
12
\$VAR1 = {
'4' => [
'4',
'8',
'12'
],
'1' => [
'1',
'5',
'9'
],
'3' => [
'3',
'7',
'11'
],
'2' => [
'2',
'6',
'10'
]
};

Replies are listed 'Best First'.
Re: Round robin processing
by jcb (Parson) on Sep 09, 2019 at 16:18 UTC

Well, at least writing these was enjoyable. Here are two solutions, both slightly adjusted to have data that does not evenly fit the number of bins.

modulo.pl:

```#!/usr/bin/perl

use strict;
use warnings;

my @array = 1 .. 14;

use constant BINS => 4;
my @bins = ();

for my \$i (0 .. \$#array) {
print "i = \$i:\t\$array[\$i]\n";
push @{\$bins[\$i % BINS]}, \$array[\$i];
}

use Data::Dumper;
print Dumper \@bins;

sample output:

```i = 0:  1
i = 1:  2
i = 2:  3
i = 3:  4
i = 4:  5
i = 5:  6
i = 6:  7
i = 7:  8
i = 8:  9
i = 9:  10
i = 10: 11
i = 11: 12
i = 12: 13
i = 13: 14
\$VAR1 = [
[
1,
5,
9,
13
],
[
2,
6,
10,
14
],
[
3,
7,
11
],
[
4,
8,
12
]
];

slice.pl

```#!/usr/bin/perl

use strict;
use warnings;

my @array = 1 .. 14;

use constant BINS => 4;
my @bins = ();

for my \$i (0 .. (BINS - 1)) {
push @bins, [@array[grep {defined \$array[\$_]}
map {BINS * \$_ + \$i} 0 .. (@array / BINS)]];
}

use Data::Dumper;
print Dumper \@bins;

sample output:

```\$VAR1 = [
[
1,
5,
9,
13
],
[
2,
6,
10,
14
],
[
3,
7,
11
],
[
4,
8,
12
]
];

Thanks for those ideas. That's interesting, I thought about modulo but wasn't sure how to use it , because remainder is often 0 : e.g. : 8%1 , 8%2, 8%4 all have a remainder of 0.

The remainder being 0 is not really a problem and is needed for the solutions presented thus far, because all of them are using arrays to store the bins instead of using a hash. Arrays in Perl are indexed using numbers starting at 0, so it "just fits" and also mean that the bins are always in a known order instead of the random order that your initial code produces.

those with a remainder of 0 will go to bin 0, i.e. the first slot in the bins array.

I tried a bit similar to 'slice.pl':

```perl -wle 'use Data::Dumper; my @buckets; my \$buckets = 4; @a = 1 .. 1
+4; push @buckets, [ grep defined, @a[ map { \$_ * \$buckets } 0 .. @a /
+ \$buckets ] ] xor shift @a for 1 .. 1 + @a / \$buckets; print Dumper(
+@buckets )'
output:
```Useless use of logical xor in void context at -e line 1.
\$VAR1 = [
1,
5,
9,
13
];
\$VAR2 = [
2,
6,
10,
14
];
\$VAR3 = [
3,
7,
11
];
\$VAR4 = [
4,
8,
12
];
upd.Slightly changed a name of variable \$bucket to \$buckets.
Re: Round robin processing -- boustrophedon
by Discipulus (Abbot) on Sep 09, 2019 at 17:06 UTC
Hello llarochelle

you can also use a boustrophedon distribution:

```use Data::Dump

my @A = (1..12);
my \$data;
my \$i = 0;
while (@A){
push @{\$data->[\$i]},shift @A;
\$i == 3 ? \$i = -1 : \$i == -4 ? \$i = 0 :  \$i < 0 ? \$i-- : \$i
+++;
}

dd \$data;

__DATA__

[
[1, 8, 9],
[2, 7, 10],
[3, 6, 11],
[4, 5, 12]
]

See also How to get this not the usual round robin looping for more examples about such distribution

L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
Re: Round robin processing
by daxim (Curate) on Sep 09, 2019 at 16:48 UTC
```use v5;
use List::AllUtils qw(partition_by);
my %h = partition_by { (\$_ - 1) % 4 } 1..14
# (0 => [1, 5, 9, 13], 1 => [2, 6, 10, 14], 2 => [3, 7, 11], 3 => [4,
+8, 12])

use v6;
my %h = roundrobin((1..14).rotor(4, :partial)).kv
# {0 => [1, 5, 9, 13], 1 => [2, 6, 10, 14], 2 => [3, 7, 11], 3 => [4,
+8, 12]}
Re: Round robin processing
by trwww (Priest) on Sep 09, 2019 at 16:42 UTC

Your solution is fine. Heres how I'd probably write it:

```\$ cat 11105885.pl
use warnings;
use strict;
use Data::Dumper;

my \$bucket_count = 4;

my @array = qw(1 2 3 4 5 6 7 8 9 10 11 12);
my \$buckets = [];

for ( my \$counter = 0; \$counter < @array; \$counter++ ) {
my \$element = \$array[ \$counter ];
my \$bucket  = \$buckets->[ \$counter % \$bucket_count ] ||= [];
push @\$bucket, \$element;
}

print Data::Dumper->Dump([\$buckets], [qw(buckets)]);
```

The result:

```\$ perl 11105885.pl
\$buckets = [
[
'1',
'5',
'9'
],
[
'2',
'6',
'10'
],
[
'3',
'7',
'11'
],
[
'4',
'8',
'12'
]
];
```
Re: Round robin processing
by LanX (Sage) on Sep 09, 2019 at 16:47 UTC
You description doesn't tell that the elements are shuffled the way your example code says.

if consecutive elements and destroying the original array are OK, try splice

```  DB<32> use Data::Dump qw/dd/

DB<33> @a=1..12; dd { map { \$_ => [splice @a,0,3] } 1..4  }
{ 1 => [1, 2, 3], 2 => [4, 5, 6], 3 => [7, 8, 9], 4 => [10, 11, 12] }
+...

NB: the case where @a/4 is not an integer is more complicated.

HTH! :)

Cheers Rolf
(addicted to the Perl Programming Language :)
Wikisyntax for the Monastery FootballPerl is like chess, only without the dice

Re: Round robin processing
by BillKSmith (Monsignor) on Sep 09, 2019 at 18:30 UTC
There seems to be some confusion between hash and array.
```>type llarochelle.pm
use strict;
use warnings;
use Test::More tests=>1;
my \$VAR1 = {
'4' => [
'4',
'8',
'12'
],
'1' => [
'1',
'5',
'9'
],
'3' => [
'3',
'7',
'11'
],
'2' => [
'2',
'6',
'10'
]
};

my @array = qw(1 2 3 4 5 6 7 8 9 10 11 12);

my \$counter = 1;
my \$data;

for my \$pos (0 .. \$#array) {

\$data->{ \$pos%4 + 1 }[ int(\$pos / 4)] = \$array[\$pos];
}

is_deeply(\$data, \$VAR1);

>perl llarochelle.pm
1..1
ok 1
Bill
Re: Round robin processing
by 1nickt (Canon) on Sep 09, 2019 at 22:09 UTC

Hi, see Tie::Cycle.

```\$ perl -MTie::Cycle -E 'tie \$i, Tie::Cycle, [0..3]; push @{ \$h{\$i} },
+\$_ for 1..12'
\$VAR1 = {
'2' => [
3,
7,
11
],
'1' => [
2,
6,
10
],
'0' => [
1,
5,
9
],
'3' => [
4,
8,
12
]
};

Hope this helps!

The way forward always starts with a minimal test.
Re: Round robin processing
by siberia-man (Pilgrim) on Sep 09, 2019 at 20:20 UTC
This solution is almost similar to other ones supplied by other monks:
```#!/bin/perl

my @array = qw(1 2 3 4 5 6 7 8 9 10 11 12);

my \$data;

my \$div = 4;

for my \$i ( @array ) {
my \$j = \$i % \$div;
push @{ \$data->{\$j || \$div} }, \$i;
}

use Data::Dumper;
print Dumper \@array;
print Dumper \$data;
Re: Round robin processing
by llarochelle (Beadle) on Sep 09, 2019 at 17:21 UTC
Thanks everyone for your replies ! You've shown alternatives and upgrades to what I did, I realized my algorithm wasn't so bad after all :) I'll make some modifications to enhance it's clarity. Cheers !
Your code looks better. Here is one liner. Two ways, filling first bucket first and filling bucket one after another.
```\$ perl -MData::Dumper -le '\$bucket={}; @a=(1..12); \$max=scalar @a/4; f
+or my \$x(1..4) { for my \$y(0..\$max-1){ push @{\$bucket->{\$x}},shift(@a
+); } } print Dumper \$bucket'
\$VAR1 = {
'4' => [
10,
11,
12
],
'1' => [
1,
2,
3
],
'3' => [
7,
8,
9
],
'2' => [
4,
5,
6
]
};

\$ perl -MData::Dumper -le '\$how_many=4; \$bucket={}; \$count=1;for (1..1
+2) { push @{\$bucket->{\$count++}},\$_; \$count=1 if \$_%\$how_many == 0; }
+; print Dumper \$bucket'
\$VAR1 = {
'2' => [
2,
6,
10
],
'3' => [
3,
7,
11
],
'4' => [
4,
8,
12
],
'1' => [
1,
5,
9
]
};
Your algorithm was, indeed, pretty clean as it was. (The only thing I would seriously change is to use the "%" (modulo) operator when advancing the cursor.) Face it: at this glorious and long-awaited point in computing history, "saving milliseconds no longer matters." Today, "clarity rules."
Re: Round robin processing
by dbuckhal (Hermit) on Sep 10, 2019 at 02:33 UTC

very nice solutions, All!

Me? late to the party as usual, but my contribution:

```#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my @array = qw(1 2 3 4 5 6 7 8 9 10 11 12);
my \$size = @array;
my \$count = int(\$size / 4);
my \$counter = 1;
my \$result = {};

for (0..2) {
push @{\$result->{\$counter++}}, @array[0 ..\$count-1];
@array = @array[\$count .. \$#array];
}
push @{\$result->{\$counter}}, @array[0 ..\$#array] if @array;
print Dumper(\$result);

__output__
\$VAR1 = {
'1' => [
'1',
'2',
'3'
],
'3' => [
'7',
'8',
'9'
],
'4' => [
'10',
'11',
'12'
],
'2' => [
'4',
'5',
'6'
]
};
Re: Round robin processing
by rsFalse (Chaplain) on Sep 10, 2019 at 10:21 UTC
Tried this for fun. But it becomes slower as bucket count increases:
```#!/usr/bin/perl -l

# https://www.perlmonks.org/?node_id=11105885

use strict;
use warnings;
use Data::Dumper;

my @a = 1 .. 14;

my \$buckets = 4;

my @buckets;

my \$place = ',';

\$_ = \$place x ( @a + \$buckets - 1 );

my \$space = \$buckets - 1;

my @bucket;

/
(?(?{ \$buckets <= pos }) (*ACCEPT) )
(?{ @bucket = (); })
(?: .{\$space} \$place
(?{ push @bucket, ( pos ) - \$buckets })
)++
(?{ push @buckets, [ @a[ @bucket ] ] })
(*FAIL)
/x;

print Dumper( @buckets );
OUTPUT:
```\$VAR1 = [
1,
5,
9,
13
];
\$VAR2 = [
2,
6,
10,
14
];
\$VAR3 = [
3,
7,
11
];
\$VAR4 = [
4,
8,
12
];

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11105885]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (2)
As of 2022-05-21 18:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Do you prefer to work remotely?

Results (77 votes). Check out past polls.

Notices?