#!/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;