Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Round robin processing

by llarochelle (Beadle)
on Sep 09, 2019 at 15:47 UTC ( [id://11105885]=perlquestion: print w/replies, xml ) 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 -- boustrophedon
by Discipulus (Canon) 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 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
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 (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! :)

    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 (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;
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 (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' ] };
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 ];

Log In?
Username:
Password:

What's my password?
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?Last hourOther CB clients
Other Users?
Others studying the Monastery: (6)
As of 2024-03-28 23:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found