Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

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

by kcott (Abbot)
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
Re^2: Divide an array into 2 subsets to verify their sum is equal or not.
by roboticus (Canon) 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 hdb (Parson) on May 02, 2013 at 11:08 UTC
      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

      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.

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

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

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 cooling their heels in the Monastery: (5)
As of 2014-07-29 02:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (211 votes), past polls