Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

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


In reply to Re: Divide an array into 2 subsets to verify their sum is equal or not. by kcott
in thread Divide an array into 2 subsets to verify their sum is equal or not. by bimleshsharma

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (3)
    As of 2018-07-20 16:47 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















      Results (438 votes). Check out past polls.

      Notices?