### Divide an array into 2 subsets to verify their sum is equal or not.

 on May 02, 2013 at 07:09 UTC Need Help??
bimleshsharma has asked for the wisdom of the Perl Monks concerning the following question:

I have an array having some interger elements. I have to split into 2 subsets. Need to verify that sum of these 2 subsets are equal or not. Subset size is not matter, it can be element count of 3,2 or 1,4 or any but should be in 2 part. For example...

Ex 1: @a1 = qw(1, 3, 8, 4); This array can be divided into to subsets (1,3,4)=8 and (8)=8, so these two have equal sum.

Ex 2: @a1 = qw(1, 6, 2); This cant be divided into two subsets of equal sum.Because (1,6)!=2 or any combination of a subset is not matching to another subset.

I tried below code but it is working for one set of iteration, actually it should check all possible set of iteration to find possiblities.

```my @array= qw(1 3 5 7);
my @array= qw(1 3 5 7);
&test(\@array);

sub test
{
my (\$s1,\$s2);
my @a=@{\$_[0]};
for (my \$i=0;\$i<=\$#a ;\$i++) {
(\$s1,\$s2)=0;
for (my \$j=0;\$j<=\$#a ;\$j++) {
if (\$i == \$j) {
\$s1=\$s1+ \$a[\$j];
}
else{
\$s2+=\$a[\$j];
}
}

}
print "\n";
}
• Comment on Divide an array into 2 subsets to verify their sum is equal or not.

Replies are listed 'Best First'.
Re: Divide an array into 2 subsets to verify their sum is equal or not.
by choroba (Bishop) on May 02, 2013 at 07:50 UTC
To sum a list, I used the sum from List::Util. I made the following observation: if the array can be split, then the sum of each part is the half of the sum of the whole array. I used vec to generate binary vectors to be used as Indicator function. Checking a half of the possible vectors is enough, the rest is complementary (i.e. the two subsets are swapped).
```#!/usr/bin/perl
use warnings;
use strict;

use List::Util qw(sum);

sub is_divisible {
my \$array = shift;
my \$sum   = sum(@\$array) / 2;

for my \$bitmask (1 .. 2 ** \$#\$array - 1) {
return 1 if sum(map { \$array->[\$_] * vec \$bitmask, \$_, 1} 0 ..
+ \$#\$array) == \$sum;
}

return;
}

my @arrays = (
[qw(1 3 5 7)],
[qw(1 3 8 4)],
[qw(1 6 2)],
[qw(5 5 4 6 2 8 1 9)],
);

for my \$array (@arrays) {
print "@\$array: ", is_divisible(\$array) ? 'yes' : 'no', "\n";
}
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re: Divide an array into 2 subsets to verify their sum is equal or not.
by BrowserUk (Pope) on May 02, 2013 at 09:51 UTC

choroba's Explore-all-possible-combinations mechanism works okay for smallish sets (max:32 or 64 depending upon your Perl), but will get very slow for anything much larger than 20 or so.

This will very quickly (less than 0.001 of a second) find a solution, if one exists, for sets of 100s or 1000s of elements. :

```#! perl -slw
use strict;
use Time::HiRes qw[ time ];
use List::Util qw[ sum ];

sub partition {
my \$sum = sum @_;
return if \$sum & 1;
\$sum /= 2;
my @s = sort{ \$b <=> \$a } @_;
my @a;
my( \$t, \$n ) = ( 0, -1 );
\$t + \$s[\$n] <= \$sum and \$t+= \$s[\$n] and push @a, \$n while ++\$n < @
+s and \$t <= \$sum;
@a = delete @s[ @a ];
@s = grep defined, @s;
return unless sum( @a ) == sum( @s );
return \@a, \@s;
}

our \$N //= 64;

my( \$a, \$b ) = partition 1,3,5,7;
print "sum( @{ \$a } ) == sum( @{ \$b } )" if \$a;

my @set = map int( rand 100 ), 1 .. \$N;

my \$start = time;
( \$a, \$b ) = partition @set;
printf "Took %f seconds\n", time() - \$start;

if( \$a ) {
printf "(%u) == sum( @{ \$a } ) == sum( @{ \$b } )\n", sum @\$a;
}
else {
print "No solution existed for the \$N element set @set";
}

A few runs:

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
It gives a wrong answer for
```2, 12, 4
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Corrected. Thanks.

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Divide an array into 2 subsets to verify their sum is equal or not.
by kcott (Chancellor) on May 02, 2013 at 10:35 UTC

G'day bimleshsharma,

Update:

Update2: Original solution substantially rewritten! It had various problems:

Update3: Fixed a bug and added some features:

• Fixed problem reported by ++LanX.
• Added in the same timing metrics used by BrowserUk for comparison.
• Added options: --tm|test_more=0|1 switch Test::More tests off/on (def=1); --th|time_hires=0|1 switch Time::HiRes metrics off/on (def=1); --vt|volume_tests=0|1 switch volume tests off/on (def=0); --vpm|volume_power_max=1..N create arrays with 10**1 to 10**N elements for volume testing (def=3); --array_limit=0..N only show the first/last N elements of long arrays (def=3).

Here's pm_split_equal_sums.pl:

```#!/usr/bin/env perl -l

use strict;
use warnings;

use List::Util qw{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],
];

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],
];

if (\$opt{volume_tests}) {
for (1 .. \$opt{volume_power_max}) {
my @volume = (1 .. 10**\$_ / 2) x 2;
push @\$test_equal_subsets, [@volume];
push @volume, 10**(2 * \$_);
push @\$test_unequal_subsets, [@volume];
}
}

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.";
return 0;
}

my \$half_sum = \$full_sum / 2;
my @sorted_array = sort { \$b <=> \$a } @\$full_array;

if (\$sorted_array[0] > \$half_sum) {
print "\tSubsets not equal.";
return 0;
}

my (@a1, @a2);
my \$total = 0;

while (@sorted_array) {
\$total = 0;
for (@sorted_array) {
if (\$total + \$_ <= \$half_sum) {
push @a1, \$_;
\$total += \$_;
}
}

if (\$total == \$half_sum) {
push @a2, @sorted_array;
last;
}
else {
push @a2, shift @sorted_array or last;
\$total = 0;
}
}

if (\$total == \$half_sum) {
print "\tSubsets: (", array_string([sort { \$a <=> \$b } @a2]),
+')';
print "\t     and (", array_string([sort { \$a <=> \$b } @a2]),
+')';
print "\tSubset sum = \$half_sum";
return 1;
}
else {
print "\tSubsets not equal.";
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);
}

Sample run:

```\$ pm_split_equal_sums.pl --tm=1 --th=1 --vt=1 --vpm=5 --al=3
1..31
Checking: (1, 6, 2)
Subsets not equal.
ok 1 - Not expecting equal subsets.
Took 0.000307 seconds
Checking: (7, 5, 3, 3)
Subsets not equal.
ok 2 - Not expecting equal subsets.
Took 0.000197 seconds
Checking: (1, 2, 3, 7)
Subsets not equal.
ok 3 - Not expecting equal subsets.
Took 0.000180 seconds
Checking: (0, 1)
Subsets not equal.
ok 4 - Not expecting equal subsets.
Took 0.000166 seconds
Checking: (1, 2)
Subsets not equal.
ok 5 - Not expecting equal subsets.
Took 0.000165 seconds
Checking: (1)
Subsets not equal.
ok 6 - Not expecting equal subsets.
Took 0.000164 seconds
Checking: (2)
Subsets not equal.
ok 7 - Not expecting equal subsets.
Took 0.000168 seconds
Checking: (8, 1, 2, 3)
Subsets not equal.
ok 8 - Not expecting equal subsets.
Took 0.000170 seconds
Checking: (1, 2, 3,  ... [snip: 5 elements] ..., 4, 5, 100)
Subsets not equal.
ok 9 - Not expecting equal subsets.
Took 0.000183 seconds
Checking: (1, 2, 3,  ... [snip: 95 elements] ..., 49, 50, 10000)
Subsets not equal.
ok 10 - Not expecting equal subsets.
Took 0.000191 seconds
Checking: (1, 2, 3,  ... [snip: 995 elements] ..., 499, 500, 1000000)
Subsets not equal.
ok 11 - Not expecting equal subsets.
Took 0.000313 seconds
Checking: (1, 2, 3,  ... [snip: 9995 elements] ..., 4999, 5000, 100000
+000)
Subsets not equal.
ok 12 - Not expecting equal subsets.
Took 0.001494 seconds
Checking: (1, 2, 3,  ... [snip: 99995 elements] ..., 49999, 50000, 100
+00000000)
Subsets not equal.
ok 13 - Not expecting equal subsets.
Took 0.013494 seconds
Checking: (1, 3, 8, 4)
Subsets: (1, 3, 4, 8)
and (1, 3, 4, 8)
Subset sum = 8
ok 14 - Expecting equal subsets.
Took 0.000205 seconds
Checking: (1, 3, 5, 7)
Subsets: (1, 3, 5, 7)
and (1, 3, 5, 7)
Subset sum = 8
ok 15 - Expecting equal subsets.
Took 0.000195 seconds
Checking: (4, 3, 2, 2, 1)
Subsets: (1, 2, 2, 3, 4)
and (1, 2, 2, 3, 4)
Subset sum = 6
ok 16 - Expecting equal subsets.
Took 0.000205 seconds
Checking: (4, 3, 2, 2, 2, 2, 1)
Subsets: (1, 2, 2, 2, 2, 3, 4)
and (1, 2, 2, 2, 2, 3, 4)
Subset sum = 8
ok 17 - Expecting equal subsets.
Took 0.000201 seconds
Checking: (5, 5, 4, 6, 2, 8, 1, 9)
Subsets: (1, 2, 4, 5, 5, 6, 8, 9)
and (1, 2, 4, 5, 5, 6, 8, 9)
Subset sum = 20
ok 18 - Expecting equal subsets.
Took 0.000202 seconds
Checking: (8, 4, 4, 7, 6, 3)
Subsets: (3, 4, 4, 6, 7, 8)
and (3, 4, 4, 6, 7, 8)
Subset sum = 16
ok 19 - Expecting equal subsets.
Took 0.000199 seconds
Checking: (1, 1)
Subsets: (1, 1)
and (1, 1)
Subset sum = 1
ok 20 - Expecting equal subsets.
Took 0.000188 seconds
Checking: (2, 2)
Subsets: (2, 2)
and (2, 2)
Subset sum = 2
ok 21 - Expecting equal subsets.
Took 0.000186 seconds
Checking: ()
Subsets: () and ()
Subset sum = 0
ok 22 - Expecting equal subsets.
Took 0.000167 seconds
Checking: (0)
Subsets: (0) and ()
Subset sum = 0
ok 23 - Expecting equal subsets.
Took 0.000166 seconds
Checking: (0, 0)
Subsets: (0, 0) and ()
Subset sum = 0
ok 24 - Expecting equal subsets.
Took 0.000168 seconds
Checking: (0, 0, 0)
Subsets: (0, 0, 0) and ()
Subset sum = 0
ok 25 - Expecting equal subsets.
Took 0.000168 seconds
Checking: (0, 0, 0, 0)
Subsets: (0, 0, 0, 0) and ()
Subset sum = 0
ok 26 - Expecting equal subsets.
Took 0.000168 seconds
Checking: (1, 2, 3,  ... [snip: 4 elements] ..., 3, 4, 5)
Subsets: (1, 1, 2,  ... [snip: 4 elements] ..., 4, 5, 5)
and (1, 1, 2,  ... [snip: 4 elements] ..., 4, 5, 5)
Subset sum = 15
ok 27 - Expecting equal subsets.
Took 0.000211 seconds
Checking: (1, 2, 3,  ... [snip: 94 elements] ..., 48, 49, 50)
Subsets: (1, 1, 2,  ... [snip: 94 elements] ..., 49, 50, 50)
and (1, 1, 2,  ... [snip: 94 elements] ..., 49, 50, 50)
Subset sum = 1275
ok 28 - Expecting equal subsets.
Took 0.000269 seconds
Checking: (1, 2, 3,  ... [snip: 994 elements] ..., 498, 499, 500)
Subsets: (1, 1, 2,  ... [snip: 994 elements] ..., 499, 500, 500)
and (1, 1, 2,  ... [snip: 994 elements] ..., 499, 500, 500)
Subset sum = 125250
ok 29 - Expecting equal subsets.
Took 0.000762 seconds
Checking: (1, 2, 3,  ... [snip: 9994 elements] ..., 4998, 4999, 5000)
Subsets: (1, 1, 2,  ... [snip: 9994 elements] ..., 4999, 5000, 500
+0)
and (1, 1, 2,  ... [snip: 9994 elements] ..., 4999, 5000, 500
+0)
Subset sum = 12502500
ok 30 - Expecting equal subsets.
Took 0.005873 seconds
Checking: (1, 2, 3,  ... [snip: 99994 elements] ..., 49998, 49999, 500
+00)
Subsets: (1, 1, 2,  ... [snip: 99994 elements] ..., 49999, 50000,
+50000)
and (1, 1, 2,  ... [snip: 99994 elements] ..., 49999, 50000,
+50000)
Subset sum = 1250025000
ok 31 - Expecting equal subsets.
Took 0.060788 seconds

Timing metrics are probably best run without the overhead of Test::More:

```\$ pm_split_equal_sums.pl --tm=0 --th=1 --vt=1 --vpm=5 --al=3
Checking: (1, 6, 2)
Subsets not equal.
Took 0.000059 seconds
Checking: (7, 5, 3, 3)
Subsets not equal.
Took 0.000036 seconds
Checking: (1, 2, 3, 7)
Subsets not equal.
Took 0.000010 seconds
Checking: (0, 1)
Subsets not equal.
Took 0.000009 seconds
Checking: (1, 2)
Subsets not equal.
Took 0.000008 seconds
Checking: (1)
Subsets not equal.
Took 0.000008 seconds
Checking: (2)
Subsets not equal.
Took 0.000011 seconds
Checking: (8, 1, 2, 3)
Subsets not equal.
Took 0.000012 seconds
Checking: (1, 2, 3,  ... [snip: 5 elements] ..., 4, 5, 100)
Subsets not equal.
Took 0.000026 seconds
Checking: (1, 2, 3,  ... [snip: 95 elements] ..., 49, 50, 10000)
Subsets not equal.
Took 0.000031 seconds
Checking: (1, 2, 3,  ... [snip: 995 elements] ..., 499, 500, 1000000)
Subsets not equal.
Took 0.000150 seconds
Checking: (1, 2, 3,  ... [snip: 9995 elements] ..., 4999, 5000, 100000
+000)
Subsets not equal.
Took 0.001309 seconds
Checking: (1, 2, 3,  ... [snip: 99995 elements] ..., 49999, 50000, 100
+00000000)
Subsets not equal.
Took 0.012939 seconds
Checking: (1, 3, 8, 4)
Subsets: (1, 3, 4, 8)
and (1, 3, 4, 8)
Subset sum = 8
Took 0.000054 seconds
Checking: (1, 3, 5, 7)
Subsets: (1, 3, 5, 7)
and (1, 3, 5, 7)
Subset sum = 8
Took 0.000029 seconds
Checking: (4, 3, 2, 2, 1)
Subsets: (1, 2, 2, 3, 4)
and (1, 2, 2, 3, 4)
Subset sum = 6
Took 0.000032 seconds
Checking: (4, 3, 2, 2, 2, 2, 1)
Subsets: (1, 2, 2, 2, 2, 3, 4)
and (1, 2, 2, 2, 2, 3, 4)
Subset sum = 8
Took 0.000035 seconds
Checking: (5, 5, 4, 6, 2, 8, 1, 9)
Subsets: (1, 2, 4, 5, 5, 6, 8, 9)
and (1, 2, 4, 5, 5, 6, 8, 9)
Subset sum = 20
Took 0.000038 seconds
Checking: (8, 4, 4, 7, 6, 3)
Subsets: (3, 4, 4, 6, 7, 8)
and (3, 4, 4, 6, 7, 8)
Subset sum = 16
Took 0.000036 seconds
Checking: (1, 1)
Subsets: (1, 1)
and (1, 1)
Subset sum = 1
Took 0.000024 seconds
Checking: (2, 2)
Subsets: (2, 2)
and (2, 2)
Subset sum = 2
Took 0.000025 seconds
Checking: ()
Subsets: () and ()
Subset sum = 0
Took 0.000011 seconds
Checking: (0)
Subsets: (0) and ()
Subset sum = 0
Took 0.000011 seconds
Checking: (0, 0)
Subsets: (0, 0) and ()
Subset sum = 0
Took 0.000011 seconds
Checking: (0, 0, 0)
Subsets: (0, 0, 0) and ()
Subset sum = 0
Took 0.000011 seconds
Checking: (0, 0, 0, 0)
Subsets: (0, 0, 0, 0) and ()
Subset sum = 0
Took 0.000011 seconds
Checking: (1, 2, 3,  ... [snip: 4 elements] ..., 3, 4, 5)
Subsets: (1, 1, 2,  ... [snip: 4 elements] ..., 4, 5, 5)
and (1, 1, 2,  ... [snip: 4 elements] ..., 4, 5, 5)
Subset sum = 15
Took 0.000050 seconds
Checking: (1, 2, 3,  ... [snip: 94 elements] ..., 48, 49, 50)
Subsets: (1, 1, 2,  ... [snip: 94 elements] ..., 49, 50, 50)
and (1, 1, 2,  ... [snip: 94 elements] ..., 49, 50, 50)
Subset sum = 1275
Took 0.000111 seconds
Checking: (1, 2, 3,  ... [snip: 994 elements] ..., 498, 499, 500)
Subsets: (1, 1, 2,  ... [snip: 994 elements] ..., 499, 500, 500)
and (1, 1, 2,  ... [snip: 994 elements] ..., 499, 500, 500)
Subset sum = 125250
Took 0.000599 seconds
Checking: (1, 2, 3,  ... [snip: 9994 elements] ..., 4998, 4999, 5000)
Subsets: (1, 1, 2,  ... [snip: 9994 elements] ..., 4999, 5000, 500
+0)
and (1, 1, 2,  ... [snip: 9994 elements] ..., 4999, 5000, 500
+0)
Subset sum = 12502500
Took 0.005701 seconds
Checking: (1, 2, 3,  ... [snip: 99994 elements] ..., 49998, 49999, 500
+00)
Subsets: (1, 1, 2,  ... [snip: 99994 elements] ..., 49999, 50000,
+50000)
and (1, 1, 2,  ... [snip: 99994 elements] ..., 49999, 50000,
+50000)
Subset sum = 1250025000
Took 0.060971 seconds

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.

-- Ken

This is an NP-complete problem

Only true if the OP was looking for an optimum solution. He isn't:

Subset size is not matter,

Behooves you to read the actual question.

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
Applies to BrowserUK's solution as well.

Look again :)

```#! perl -slw
use strict;
use Time::HiRes qw[ time ];
use List::Util qw[ sum ];

sub partition {
my \$sum = sum @_;
return if \$sum & 1;
\$sum /= 2;
my @s = sort{ \$b <=> \$a } @_;
my @a;
my( \$t, \$n ) = ( 0, -1 );
\$t + \$s[\$n] <= \$sum and \$t+= \$s[\$n] and push @a, \$n while ++\$n < @
+s and \$t <= \$sum;
@a = delete @s[ @a ];
@s = grep defined, @s;
return unless sum( @a ) == sum( @s );
return \@a, \@s;
}

my \$start = time;
my( \$a, \$b ) = partition 8, 4, 4, 7, 6, 3;
my @set = map int( rand 100 ), 1 .. \$N;
printf "Took %f seconds\n", time() - \$start;
if( \$a ) {
printf "(%u) == sum( @{ \$a } ) == sum( @{ \$b } )\n", sum @\$a;
}
else {
print "No solution existed for 8, 4, 4, 7, 6, 3";
}
__END__
No solution existed for 8, 4, 4, 7, 6, 3
Took 0.000258 seconds

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
div
> This is an NP-complete problem http://en.wikipedia.org/wiki/Knapsack_problem

Yes, to be precise a sub class known as "Partition Problem".

See WP article for some efficient algorithms and further links.

I wonder who and why is posting well known scientific problems w/o references ...?

Cheers Rolf

( addicted to the Perl Programming Language)

++ Thanks. I've rewritten the solution to handle those sorts of cases.

-- Ken

[ 7, 5, 3, 3]

;^)

...roboticus

When your only tool is a hammer, all problems look like your thumb.

++ Thanks. That node was something of a minor disaster. I've rewritten the solution.

-- Ken

A couple of questions:

1. Why pass in a reference if the first thing you are going to do is copy the reference array to a local array?
```sub check_arrays {
my @full_array = @{shift()};
2. Why make a local copy of the array at all, when all the uses (join, sum, sort) of it require you to pass a list?

Ie. Why not my \$sum = sum @\$ref; etc.

3. Isn't re-summing your partial array over and over wildly inefficient?

With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

++ Thanks. All your points are perfectly valid. There were other issues as well. I've substantially rewritten the solution.

-- Ken

Re: Divide an array into 2 subsets to verify their sum is equal or not.
by hdb (Monsignor) on May 02, 2013 at 09:47 UTC

Using recursion:

```use strict;
use warnings;
use List::Util qw/sum/;

# finds one solution
sub findsum {
my (\$target, @array) = @_;
while( @array ) {
my \$cand = shift @array;
return () if \$cand > \$target;
return ( \$cand ) if \$cand==\$target;
my @sol = findsum( \$target-\$cand, @array );
return (\$cand, @sol) if @sol;
}
return ();
}

my @array = qw(1 3 5 7);
my \$total = sum(@array);

die "Odd total \$total cannot be split!\n" if \$total % 2;

my @sol = findsum( \$total/2, sort @array );
if( @sol ) {
print "Solution: ",join( ",", @sol), "\n";
} else {
print "No solution.";
}

Re: Divide an array into 2 subsets to verify their sum is equal or not.
by davido (Cardinal) on May 03, 2013 at 16:10 UTC

Here's my try, using Algorithm::Bucketizer:

```use strict;
use warnings;
use Algorithm::Bucketizer;
use List::Util qw( sum );
use POSIX qw( ceil );

my @arrays = (
[ qw( 1 3 8 4 ) ],
[ qw( 1 6 2   ) ],
[ qw( 1 3 5 7 ) ],
);

foreach my \$array ( @arrays ) {
print "( @{\$array} ) can ",
can_evenly_distribute( @{\$array} ) ? '' : 'not ',
"be evenly distributed.\n";
}

sub can_evenly_distribute {
my @elements = @_;
my \$b_size = ceil( sum( @elements ) / 2 );

my \$b = Algorithm::Bucketizer->new(
bucketsize => \$b_size,
algorithm  => 'retry'
);

\$b->add_item( \$_, \$_ ) foreach @elements;

\$b->optimize( algorithm => 'random', maxrounds => @elements * 10 );

my @buckets = \$b->buckets;

return    @buckets == 2
&& sum( \$buckets[0]->items ) == sum( \$buckets[1]->items );

}

I haven't found any cases where it fails to return the correct answer... but having just said that, someone will probably find one. ;)

Dave

Create A New User
Node Status?
node history
Node Type: perlquestion [id://1031699]
Approved by Corion
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2019-02-15 23:15 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
I use postfix dereferencing ...

Results (95 votes). Check out past polls.

Notices?