|
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'
]
};
|
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
]
];
| [reply]
[d/l]
[select] |
|
|
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.
| [reply] |
|
|
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.
| [reply] |
|
|
| [reply] |
|
|
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. | [reply]
[d/l]
[select] |
Re: Round robin processing -- boustrophedon
by Discipulus (Canon) on Sep 09, 2019 at 17:06 UTC
|
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.
| [reply]
[d/l] |
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]}
| [reply]
[d/l] |
Re: Round robin processing
by trwww (Priest) on Sep 09, 2019 at 16:42 UTC
|
$ 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'
]
];
| [reply]
[d/l]
[select] |
Re: Round robin processing
by LanX (Saint) 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! :)
| [reply]
[d/l] |
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
| [reply]
[d/l] |
Re: Round robin processing
by 1nickt (Canon) on Sep 09, 2019 at 22:09 UTC
|
$ 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.
| [reply]
[d/l] |
Re: Round robin processing
by siberia-man (Friar) 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;
| [reply]
[d/l] |
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 ! | [reply] |
|
|
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
]
};
| [reply]
[d/l] |
|
|
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."
| [reply] |
Re: Round robin processing
by dbuckhal (Chaplain) 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'
]
};
| [reply]
[d/l] |
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
];
| [reply]
[d/l]
[select] |
|
|
