#!/usr/bin/perl
use strict;
use warnings;
use Benchmark 'cmpthese';
use Data::Dumper;

sub comb {
    my @items = @{ $_[0] };
    my $group = $_[1];
    my @list  = @{ $_[2] };
    my $ret   = $_[3]||[];

    unless ($group) {
        push @$ret,\@list;
    } else {
        my (@newitems,@newlist,$i);
        foreach $i (0 .. $#items) {
                @newlist = @list;
                push (@newlist, shift (@items));
                @newitems = @items;
                comb([@newitems], $group - 1, [@newlist],$ret);
        }
    }
    return $ret;
}


sub comb_demq {
    my ($items,$group,$list)=@_;
    return _comb_demerphq([@{$items||[]}],$group,[@{$list||[]}]);
}

sub _comb_demerphq {
    my ($items,$group,$list,$ret) = @_;
    $ret||=[];
    unless ($group) {
        push @$ret,[@$list];
    } else {
        my @newlist = (@$list,undef);
        while (@$items) {
                $newlist[-1]=shift (@$items);
                _comb_demerphq([@$items], $group - 1, \@newlist,$ret);
        }
    }
    return $ret
}

sub comb_integral_np {
  my ($items, $group, $list, $next,$ret) = @_;
  $list ||= [];
  $next ||= 0;
  $ret||=[];

  if ($group == 1) {
    push @$ret,[@$list,$_] for @$items[$next..$#$items];
  } else {
    for my $i ($next..$#$items) {
      comb_integral_np($items, $group - 1, [@$list, $$items[$i]], $i + 1,$ret);
    }
  }
  return $ret
}

sub comb_integral_pp {
  my ($items, $group, $list, $next,$ret) = @_;
  $list ||= [];
  $next ||= 0;
  $ret||=[];

  if ($group == 1) {
    push @$ret,[@$list,$_] for @$items[$next..$#$items];
  } else {
    for my $i ($next..$#$items) {
      push @$list, $items->[$i];
      comb_integral_pp($items, $group - 1, $list, $i + 1,$ret);
      pop @$list;
    }
  }
  return $ret
}

sub comb_integral_ni {
  my ($items, $group, $next) = @_;
  $next ||= 0;

  if ($group == 1) {
    return map [$_], @$items[$next..$#$items];
  } else {
    my @returns;
    for my $i ($next..$#$items) {
      push @returns, map [$$items[$i], @$_], comb_integral_ni($items, $group - 1, $i + 1);
    }
    return @returns;
  }
}


sub comb_integral_ni2 {
  my ($items, $group, $next) = @_;
  $next ||= 0;

  if ($group == 1) {
    return map [$_], @$items[$next..$#$items];
  } else {
    my @returns;
    for my $i ($next..$#$items) {
        push @returns, my @combs = comb_integral_ni2($items, $group - 1, $i + 1);
        unshift @$_, $$items[$i] for @combs;
    }
    return @returns;
  }
}

my $Tests={
             Sparky => 'comb([1..5],2,[])',
             demphq => 'comb_demq([1..5],2,[])',
             iterat => 'comb_iter([1..5],2)',
             int_np => 'comb_integral_np([1..5],2)',
             int_pp => 'comb_integral_pp([1..5],2)',
             int_ni => '[comb_integral_ni([1..5],2)]',
             int_i2 => '[comb_integral_ni2([1..5],2)]',
           };

# First run them all on groups of 2 through 5
# and print the output 
foreach my $count (2..5) {
    foreach my $name (keys %$Tests) {
        (my $eval=$Tests->{$name})=~s/,2/,$count/;
        print "$name: $eval\n";
        my $ret=eval($eval);
        die "Error!" unless $ret;
        printf "%2d -> @{$ret->[$_-1]}\n",$_ for 1..@$ret;
        print "---\n";
    }
}

# Benchmark for at least 1 second each
cmpthese -1,$Tests;





##</code><code>##

sub comb_iter {
    my $items = shift || [];             # Think 1,2,3,4,5
    my $group = shift || 2;              # Think 2

    @$items>=$group or
       die "Insufficient elements ".scalar(@$items).
          " to make groups of $group\n";

    my @index=(0..$group-1);             # Think 0,1
    my @last=(@$items-$group..$#$items); # Think 3,4
    my @ret;

    while ($index[0]<=$last[0]) {        # Think first pass: 0 < 3
        push @ret,[@$items[@index]];

        # increment the last digit, and if we rollover carry it left
        unless (++$index[-1]<=$last[-1]) {

            # we've rolled over, we need to go left until
            # until the result after adding 1 is below the
            # respective last.
            my $pos=$#index;
            --$pos while ($pos and $index[$pos]+1>$last[$pos]);

            # increment the apropriate index, if we increment
            # $index[0] too high the loop exits because of the
            # while condition.
            my $v=++$index[$pos];

            # and then move right assigning the values in sequential order
            $index[++$pos]=++$v while $pos<$#index;
        }
    }
    return \@ret;
}

##</code><code>##

<edited tofit="your screen, for your viewing pleasure">

Benchmark: running Sparky, demphq, int_i2, int_ni, int_np, int_pp, iterat,
each for at least 1 CPU seconds...

    Sparky:  1 w-secs ( 1.07 usr +  0.00 sys =  1.07 CPU) @ 8358.21/s (n=8960)
    demphq:  1 w-secs ( 1.12 usr +  0.00 sys =  1.12 CPU) @ 11914.36/s (n=13356)
    int_i2:  1 w-secs ( 1.04 usr +  0.00 sys =  1.04 CPU) @ 15889.53/s (n=16541)
    int_ni:  1 w-secs ( 1.05 usr +  0.00 sys =  1.05 CPU) @ 18582.70/s (n=19549)
    int_np:  1 w-secs ( 1.06 usr +  0.00 sys =  1.06 CPU) @ 18407.72/s (n=19549)
    int_pp:  1 w-secs ( 1.04 usr +  0.00 sys =  1.04 CPU) @ 18761.04/s (n=19549)
    iterat:  1 w-secs ( 1.06 usr +  0.00 sys =  1.06 CPU) @ 22394.91/s (n=23761)

          Rate Sparky demphq int_i2 int_np int_ni int_pp iterat
Sparky  8358/s     --   -30%   -47%   -55%   -55%   -55%   -63%
demphq 11914/s    43%     --   -25%   -35%   -36%   -36%   -47%
int_i2 15890/s    90%    33%     --   -14%   -14%   -15%   -29%
int_np 18408/s   120%    55%    16%     --    -1%    -2%   -18%
int_ni 18583/s   122%    56%    17%     1%     --    -1%   -17%
int_pp 18761/s   124%    57%    18%     2%     1%     --   -16%
iterat 22395/s   168%    88%    41%    22%    21%    19%     --

</edited>