G'day bimleshsharma,
Update:
Update2:
Original solution substantially rewritten! It had various problems:
Update3:
Fixed a bug and added some features:
Update4:
Fixed some bugs and changed volume testing.
-
Display issue with subset output. Duplicate data due to "@a2 ... @a2" not being "@a1 ... @a2". - FIXED.
-
while loop in check_arrays() had flaws. This has been pretty much rewritten. - FIXED.
-
Volume testing was decimal-based, now it's octal-based. Previously, --volume_power_max=3 [or --vpm=3] created arrays of up to 10**3 (1,000) elements; now, the value is 8**3 (512) elements. Decimal-based was a bad choice as neither 1 .. 10 nor 1 .. 100 can be split into two equal portions.
-
Added a few more tests.
Here's Update4's version of pm_split_equal_sums.pl:
#!/usr/bin/env perl -l
use strict;
use warnings;
use List::Util qw{first sum};
use Test::More;
use Time::HiRes qw{time};
use Getopt::Long;
my %opt = (
test_more => 1,
time_hires => 1,
volume_tests => 0,
volume_power_max => 3,
array_limit => 3,
);
GetOptions(map {
join('|' => @{[join '' => /(?>^|_)([a-z])/gi]}, $_) . ':i' => \$op
+t{$_}
} keys %opt);
my $test_equal_subsets = [
[1, 3, 8, 4],
[1, 3, 5, 7],
[4, 3, 2, 2, 1],
[4, 3, 2, 2, 2, 2, 1],
[5, 5, 4, 6, 2, 8, 1, 9],
[8, 4, 4, 7, 6, 3],
[1, 1],
[2, 2],
[],
[0],
[0, 0],
[0, 0, 0],
[0, 0, 0, 0],
[ (1) x 100 ],
[ 1 .. 1000 ],
];
my $test_unequal_subsets = [
[1, 6, 2],
[7, 5, 3, 3],
[1, 2 ,3, 7],
[0, 1],
[1, 2],
[1],
[2],
[8, 1, 2, 3],
[ 1 .. 10 ],
[ 1 .. 100 ],
];
if ($opt{volume_tests}) {
for (1 .. $opt{volume_power_max}) {
my @volume = map { (($_), ($_)) } 1 .. 8**$_ / 2;
push @$test_equal_subsets, [@volume];
push @$test_unequal_subsets, [@volume, 8**(2 * $_)];
}
}
if ($opt{test_more}) {
plan tests => scalar @$test_equal_subsets + scalar @$test_unequal_
+subsets;
}
my @expectations = ('Not expecting equal subsets.', 'Expecting equal s
+ubsets.');
my @subsets_data = ([$test_unequal_subsets, 0, 0], [$test_equal_subset
+s, 1, 1]);
for (@subsets_data) {
my ($subsets, $expect_code, $expect_name_index) = @$_;
my $expect_name = $expectations[$expect_name_index];
for (@$subsets) {
my $start = time if $opt{time_hires};
if ($opt{test_more}) {
is(check_arrays($_), $expect_code, $expect_name);
}
else {
check_arrays($_);
}
printf "Took %f seconds\n", time() - $start if $opt{time_hires
+};
}
}
sub check_arrays {
my $full_array = shift;
print 'Checking: (', array_string($full_array), ')';
if (! grep { $_ } @$full_array) {
print "\tSubsets: (", array_string($full_array), ') and ()';
print "\tSubset sum = 0";
return 1;
}
my $full_sum = sum @$full_array;
if ($full_sum % 2) {
print "\tSubsets not equal: sum of starting array is odd ($ful
+l_sum).";
return 0;
}
my $half_sum = $full_sum / 2;
my @sorted_array = sort { $b % 2 <=> $a % 2 || $b <=> $a } @$full_
+array;
if (my $big = first { $_ > $half_sum } @sorted_array) {
print "\tSubsets not equal: element ($big) larger than sum of
+rest.";
return 0;
}
my (@a1, @a2);
my $total = 0;
while (@sorted_array) {
push @a1, shift @sorted_array;
$total += $a1[$#a1];
@sorted_array = map { $total + $_ <= $half_sum
? do { push @a1, $_; $total += $_; () } : $_
} @sorted_array;
if ($total == $half_sum) {
(@a2, @sorted_array) = (@a2, @sorted_array);
}
else {
push @a2, pop @a1 if @a1;
}
}
if ($total == $half_sum) {
print "\tSubsets: (", array_string([sort { $a <=> $b } @a1]),
+')';
print "\t and (", array_string([sort { $a <=> $b } @a2]),
+')';
print "\tSubset sum = $half_sum";
return 1;
}
else {
print "\tSubsets not equal: no solution found.";
return 0
}
}
sub array_string {
my $array = shift;
return join(', ' => @$array > 3 * $opt{array_limit}
? ( @$array[0 .. $opt{array_limit} - 1],
" ... [snip: @{[@$array - 2 * $opt{array_limit}]} elements
+] ...",
@$array[@$array - $opt{array_limit} .. $#$array] )
: @$array);
}
Here's a test run. Note that this uses --vpm=8 and final volume test "Took 89.489836 seconds" — you might want to start with a lower value.
