Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

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

by kcott (Canon)
on May 02, 2013 at 10:35 UTC ( #1031726=note: print w/ replies, xml ) Need Help??


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

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.

-- Ken


Comment on Re: Divide an array into 2 subsets to verify their sum is equal or not.
Select or Download Code
Replies are listed 'Best First'.
Re^2: Divide an array into 2 subsets to verify their sum is equal or not.
by hdb (Prior) on May 02, 2013 at 11:08 UTC
      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

        8 + 4 + 4 = 16 = 7 + 6 + 3

      > 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)

        There are some very talented people in this community, so perhaps if we post the one or other unsolved problem, some monk might find a solution...

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

      -- Ken

        Sorry, but your algorithm must still be wrong if this test passes
        my @test_unequal_subsets = ( ... [8, 4, 4, 7, 6, 3], ... );

        8+4+4=16

        Cheers Rolf

        ( addicted to the Perl Programming Language)

Re^2: Divide an array into 2 subsets to verify their sum is equal or not.
by roboticus (Chancellor) on May 02, 2013 at 11:00 UTC

    kcott:

    [ 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

Re^2: Divide an array into 2 subsets to verify their sum is equal or not.
by BrowserUk (Pope) on May 02, 2013 at 11:10 UTC

    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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1031726]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (11)
As of 2015-09-03 18:17 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred temperature scale is:










    Results (123 votes), past polls