G'day bimleshsharma,
Update:
Update2:
Original solution substantially rewritten! It had various problems:
-
Failed with data like [ 7, 5, 3, 3] (see ++roboticus' response) and [ 8, 4, 4, 7, 6, 3 ] (see ++hdb's explanation).
-
Contained some fairly crappy code (see ++BrowserUk's questions).
-
Didn't test edge/corner cases such as empty array, single element array, arrays containing only zeros.
Here's the original code I posted:
Here's my take on a solution. I added some additional test data (one copied from choroba's solution).
#!/usr/bin/env perl -l
use strict;
use warnings;
use List::Util qw{sum};
my @test_arrays = (
[1, 3, 8, 4],
[1, 6, 2],
[1, 3, 5, 7],
[4, 3, 2, 2, 1],
[4, 3, 2, 2, 2, 2, 1],
[5, 5, 4, 6, 2, 8, 1, 9],
);
check_arrays($_) for @test_arrays;
sub check_arrays {
my @full_array = @{shift()};
print "Checking: (", join(", " => @full_array), ")";
my $sum = sum @full_array;
if ($sum % 2) {
print "\tSubsets not equal";
return;
}
my $half = $sum / 2;
my (@a1, @a2);
for (sort { $b <=> $a } @full_array) {
push @{(sum(@a1) || 0) + $_ <= $half ? \@a1 : \@a2} => $_;
}
print "\tSubsets: (", join(", " => sort { $a <=> $b } @a1),
") and (", join(", " => sort { $a <=> $b } @a2), ")";
print "\tSubset sum = $half";
}
Output:
$ pm_split_equal_sums.pl
Checking: (1, 3, 8, 4)
Subsets: (8) and (1, 3, 4)
Subset sum = 8
Checking: (1, 6, 2)
Subsets not equal
Checking: (1, 3, 5, 7)
Subsets: (1, 7) and (3, 5)
Subset sum = 8
Checking: (4, 3, 2, 2, 1)
Subsets: (2, 4) and (1, 2, 3)
Subset sum = 6
Checking: (4, 3, 2, 2, 2, 2, 1)
Subsets: (1, 3, 4) and (2, 2, 2, 2)
Subset sum = 8
Checking: (5, 5, 4, 6, 2, 8, 1, 9)
Subsets: (1, 2, 8, 9) and (4, 5, 5, 6)
Subset sum = 20
Here's the rewrite:
#!/usr/bin/env perl -l
use strict;
use warnings;
use List::Util qw{sum};
use Test::More;
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],
[1, 1],
[2, 2],
[],
[0],
[0, 0],
[0, 0, 0],
[0, 0, 0, 0],
);
my @test_unequal_subsets = (
[1, 6, 2],
[7, 5, 3, 3],
[8, 4, 4, 7, 6, 3],
[0, 1],
[1, 2],
[1],
[2],
);
plan tests => scalar @test_equal_subsets + scalar @test_unequal_subset
+s;
for (@test_equal_subsets) {
is(check_arrays($_), 1, 'Expecting equal subsets.');
}
for (@test_unequal_subsets) {
is(check_arrays($_), 0, 'Not expecting equal subsets.');
}
sub check_arrays {
my $full_array = shift;
print "Checking: (", join(", " => @$full_array), ")";
if (! grep { $_ } @$full_array) {
print "\tSubsets: (", join(", " => @$full_array), ') and ()';
print "\tSubset sum = 0";
return 1;
}
my $full_sum = sum @$full_array;
if ($full_sum % 2) {
print "\tSubsets not equal.";
return 0;
}
my $half_sum = $full_sum / 2;
my (@a1, @a2);
my $a1_total = 0;
for (sort { $b <=> $a } @$full_array) {
if ($a1_total + $_ <= $half_sum) {
push @a1, $_;
$a1_total += $_;
}
else {
push @a2, $_;
}
}
if ($a1_total == $half_sum) {
print "\tSubsets: (", join(", " => sort { $a <=> $b } @a1),
") and (", join(", " => sort { $a <=> $b } @a2), ")";
print "\tSubset sum = $half_sum";
return 1;
}
else {
print "\tSubsets not equal.";
return 0
}
}
Here's prove output:
$ prove pm_split_equal_sums.pl
pm_split_equal_sums.pl .. ok
All tests successful.
Files=1, Tests=19, 0 wallclock secs ( 0.03 usr 0.01 sys + 0.02 cusr
+ 0.00 csys = 0.06 CPU)
Result: PASS
Here's the full output:
$ pm_split_equal_sums.pl
1..19
Checking: (1, 3, 8, 4)
Subsets: (8) and (1, 3, 4)
Subset sum = 8
ok 1 - Expecting equal subsets.
Checking: (1, 3, 5, 7)
Subsets: (1, 7) and (3, 5)
Subset sum = 8
ok 2 - Expecting equal subsets.
Checking: (4, 3, 2, 2, 1)
Subsets: (2, 4) and (1, 2, 3)
Subset sum = 6
ok 3 - Expecting equal subsets.
Checking: (4, 3, 2, 2, 2, 2, 1)
Subsets: (1, 3, 4) and (2, 2, 2, 2)
Subset sum = 8
ok 4 - Expecting equal subsets.
Checking: (5, 5, 4, 6, 2, 8, 1, 9)
Subsets: (1, 2, 8, 9) and (4, 5, 5, 6)
Subset sum = 20
ok 5 - Expecting equal subsets.
Checking: (1, 1)
Subsets: (1) and (1)
Subset sum = 1
ok 6 - Expecting equal subsets.
Checking: (2, 2)
Subsets: (2) and (2)
Subset sum = 2
ok 7 - Expecting equal subsets.
Checking: ()
Subsets: () and ()
Subset sum = 0
ok 8 - Expecting equal subsets.
Checking: (0)
Subsets: (0) and ()
Subset sum = 0
ok 9 - Expecting equal subsets.
Checking: (0, 0)
Subsets: (0, 0) and ()
Subset sum = 0
ok 10 - Expecting equal subsets.
Checking: (0, 0, 0)
Subsets: (0, 0, 0) and ()
Subset sum = 0
ok 11 - Expecting equal subsets.
Checking: (0, 0, 0, 0)
Subsets: (0, 0, 0, 0) and ()
Subset sum = 0
ok 12 - Expecting equal subsets.
Checking: (1, 6, 2)
Subsets not equal.
ok 13 - Not expecting equal subsets.
Checking: (7, 5, 3, 3)
Subsets not equal.
ok 14 - Not expecting equal subsets.
Checking: (8, 4, 4, 7, 6, 3)
Subsets not equal.
ok 15 - Not expecting equal subsets.
Checking: (0, 1)
Subsets not equal.
ok 16 - Not expecting equal subsets.
Checking: (1, 2)
Subsets not equal.
ok 17 - Not expecting equal subsets.
Checking: (1)
Subsets not equal.
ok 18 - Not expecting equal subsets.
Checking: (2)
Subsets not equal.
ok 19 - Not expecting equal subsets.
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.
| [reply]
[d/l]
[select] |
