#/usr/bin/perl -w

use strict;

my @array = qw(a b c d e f g h i j k l m n o p q r s t u v w x y z);

my $nbuckets = 3;  # number of buckets to divide @array into
my %bucket;        # @{$bucket{0 .. $nbuckets - 1}} are the buckets

foreach my $n( 0 .. $nbuckets - 1) {
    foreach my $size (1 .. int(0.9999 + @array /($nbuckets - $n))) {
        push @{$bucket{$n}}, shift @array;
    }
}

foreach my $n (0 .. $nbuckets - 1) {
    print "bucket $n: ",
          join(' ', @{$bucket{$n}}), "\n";
}
[download]

bucket 0: a b c d e f g h i
bucket 1: j k l m n o p q r
bucket 2: s t u v w x y z
[download]

Yet another n-buckets routine:

#!/usr/bin/perl -w
use strict;
my @array = ('a' .. 'z');
my @buckets = n_buckets(3, @array);

foreach my $aref (@buckets) {
    print scalar @$aref, ":@$aref\n";
}

# n_buckets(n, list)
sub n_buckets {
    my @buckets = ([]) x shift;
    my @list    = @_;
    my $mod     = @list % @buckets;
    my $inc     = int(@list / @buckets);
    map{ [splice @list, 0, $inc + (--$mod >= 0)] } 0 .. $#buckets;
}
__END__
[download]

Sexy code there... that is better than what I came up with. =)

--
$you = new YOU;
honk() if $you->love(perl)

Splitting an array into two or three are special cases where you can simply use stack operations.

print map { @$_, "\n" } split_into_three( 'a'..($ARGV[0] || 'z') );

sub split_into_three {
        my @a = @_;
        my (@b, @c);
        while (@b < @a) {
                push(@b, shift(@a));
                unshift(@c, pop(@a));
        }
        push(@a, shift(@c)) if (@a < @c);
        return \@b, \@a, \@c;
}
[download]

sub split_to_n {
  my $n = shift;
  my @p = map {(@_)*$_/$n} 0..$n;
  map {[@_[$p[$_-1]..($p[$_]-1)]]} 1..$n;
}
[download]

use Data::Dumper;
$Data::Dumper::Indent = 1;
print Dumper split_to_n(3, 'a'..'z');
[download]

sub split_to_n {
  my $n = shift;
  my @p = map {(@_)*$_/$n} 0..$n;
  @_ = reverse @_;
  map {[reverse @_[$p[$_-1]..($p[$_]-1)]]} reverse 1..$n;
}
[download]

PS This is the kind of code which could benefit from an explanatory comment about the interface. :-)

#another twist
sub split_to_n {
   my $n = shift;
   my @p = map {(@_)*$_/$n} -$n..0;
   map {[@_[$p[$_-1]..($p[$_]-1)]]} 1..$n;
}
[download]

io,

While I am greatly enjoying your terse and good solutions (Even attempting to emulate your approach to answering questions to some extent), I find I do have a request. If possible, please use slightly more verbosity in your variables. It improves the readability of the code for us less fluent, and allows less expirienced monks like myself to focus on your construction more closely.

coreolyn -- Working to have perl code flying off his fingers instead of spelling mistakes.

           Rate 2501 tilly2 merlyn dominus  dws tilly   eg   io repson
+ fastsp1 danger2 fast fast_c
2501     5263/s   --   -30%   -36%    -39% -46%  -46% -60% -64%   -66%
+    -68%    -70% -73%   -89%
tilly2   7491/s  42%     --   -10%    -13% -23%  -23% -43% -49%   -52%
+    -55%    -57% -61%   -84%
merlyn   8278/s  57%    11%     --     -3% -15%  -15% -37% -43%   -47%
+    -50%    -52% -57%   -83%
dominus  8569/s  63%    14%     4%      -- -12%  -12% -35% -41%   -45%
+    -49%    -50% -55%   -82%
dws      9709/s  84%    30%    17%     13%   --   -0% -26% -33%   -38%
+    -42%    -44% -49%   -80%
tilly    9737/s  85%    30%    18%     14%   0%    -- -26% -33%   -37%
+    -42%    -44% -49%   -80%
eg      13089/s 149%    75%    58%     53%  35%   34%   -- -10%   -16%
+    -22%    -24% -32%   -73%
io      14599/s 177%    95%    76%     70%  50%   50%  12%   --    -6%
+    -13%    -15% -24%   -69%
repson  15552/s 195%   108%    88%     81%  60%   60%  19%   7%     --
+     -7%    -10% -19%   -67%
fastsp1 16694/s 217%   123%   102%     95%  72%   71%  28%  14%     7%
+      --     -3% -13%   -65%
danger2 17271/s 228%   131%   109%    102%  78%   77%  32%  18%    11%
+      3%      -- -10%   -64%
fast    19194/s 265%   156%   132%    124%  98%   97%  47%  31%    23%
+     15%     11%   --   -60%
fast_c  47847/s 809%   539%   478%    458% 393%  391% 266% 228%   208%
+    187%    177% 149%     --
[download]

Good data, Fastolfe! It's fun to look back at the fragments and guess how well they compare against one another, and then have hard data to check your guesses against.

In this particular case, though, I'll bet a round of virtual drinks that performance isn't an issue, and that the split-into-three-lists routine gets called no more than a handful of times per CGI invocation.

Yeah I'd say performance probably doesn't really matter.

If it really isn't an issue then it would be better to rate the solutions on efficiency, maintainability, flexibility and coolness.

eg's solution may be the fastest in this set of benchmarks, but it doesn't include a variable number of buckets (which may be useful later in a project) and it isn't one the one that I personally (not begin a perl god) can understand and alter the fastest.

Maybe someone else can come up with a better, and overall rating....

Fastolfe, could you post your benchmark code? Perhaps I am not using Benchmark.pm correctly, but I do not obtain similar standings.
thanks.

It's rather long, but here it is. By all means let me know if I've done something wrong.

I've removed the code because this node was really long and annoying. It's in the source code of the page if you want it, but it's out of date since others have been added since then.

sub split_into_three {
   my $first = @_;
   my $last = int($first / 3);
   $first -= $last;
   $first -= int($first / 2);

   return [ @_[0..$first-1] ],
          [ @_[$first..$#_-$last] ],
          [ @_[$#_-$last+1..$#_] ];
}

my ($first, $second, $third) = split_into_three(@everything);

my @buckets = split_into_three('a'..'z');
print join("\n", map { join(" ", @{$_}) } @buckets), "\n";

# a b c d e f g h i
# j k l m n o p q r
# s t u v w x y z
[download]

Here's a nicer solution (IMO) using splice:

sub split_into {
   my $howmany = shift;
   my @from = reverse @_;

   my @buckets;
   unshift(@buckets, [ reverse splice(@from, 0, @from / $howmany--) ])
+ while $howmany;
   @buckets;
}
[download]

Or, dropping @buckets at the expense of readability (and perhaps efficiency):

sub split_into {
   my $howmany = shift;
   my @from = reverse @_;

   reverse 
      map 
      { [ reverse splice(@from, 0, @from / $_) ] } 
      reverse 1 .. $howmany;
}
[download]

...but that second example just looks good...

use Data::Dumper;

my @array = 'a' .. 'w';
my $num = 3;                    # buckets

my $cnt = @array;               # total items
my $base = int($cnt/$num);      #  }
my $left = $cnt % $num;         #  } $cnt = ($base * $num) + $left

my @buckets;
for (1..$num) {
        push @buckets, [ splice(@array,0,$base + ($left-- > 0 && 1) ) 
+];
}

print Dumper(\@buckets);
[download]

So deal.

sub split_to_n {
  my @buckets = map {[]} 1..shift;
  while (@_) {
    my $b = shift @buckets;
    push @$b, shift;
    push @buckets, $b;
  }
  @buckets;
}
[download]

or for that matter then:

sub split_to_n {
  my @return = map [], 1..shift;
  { for(@return) { return @return unless @_; push @$_, shift } redo }
}
[download]

-- Randal L. Schwartz, Perl hacker

    sub split_into {
      my ($n, @from, @to) = @_;
      while (@from) {    
        push @{$to[$i++]}, shift @from;
        i %= $n;
      }
      @to;
    }

    @results = split_into(3, 'a' .. 'z');
[download]

Update: It's a lot like Tilly's last one. But it doesn't have the bad memory behavior. (Ben's has an array that marches downward indefinitely in memory, which is bad.) Mine also has the benefit of not requiring the explicit initialization of the destination array.

use Inline C => <<'EoF';

void fast_c (int num, ...) {
    Inline_Stack_Vars;

    int rnum = num;
    SV** buckets;
    int stack_ptr = Inline_Stack_Items - 1;

    buckets = (SV**)malloc(sizeof(SV*) * num);

    while (rnum) {
        int this = stack_ptr / rnum--;
        AV* bucket = newAV();
        while (this--) {
            av_unshift(bucket, 1);
            av_store(bucket, 0, Inline_Stack_Item(stack_ptr--));
        }
        buckets[rnum] = newRV_inc((SV*)bucket);
    }

    Inline_Stack_Reset;

    while (rnum < num) {
        Inline_Stack_Push(sv_2mortal(buckets[rnum++]));
    }

    free(buckets);

    Inline_Stack_Done;
    Inline_Stack_Return(num);
}

EoF
[download]

sub foo{

my @list = @_;
my $toggle = 0;
my (@list0,@list1);
my $element;

while($#list > $#list0 && $#list > $#list1 ){
if($toggle == 2){
           $toggle = 0;
           next;
}else{
      $element = pop(@list);
      if($toggle ==1){
                 push(@list1,$element);
      }else{
                 push(@list0,$element);
      } # end of else toggle == 1
      $toggle++;
} #end of else toggle == 2

} #end of while

return \@list, \@list0, \@list1;
} # end of sub;
[download]