Re: partition of an array

You could try something like this:

#! perl -slw
use strict;
use List::Util qw[ sum ];

our $N ||= 9;

#my @data = ( 9,1,1,1,1,1,1,1,1,1 );
my @data = map{ int rand( $N ) } 1 .. $N;

my @a = @data[ 0 .. $#data / 2 ];
my @b = @data[ $#data / 2 + 1 .. $#data ];

my $diff = abs( sum( @a ) - sum( @b ) );

print "$diff : [@a] [@b]";

OUTER: for my $ai ( 0 .. $#a ) {
    for my $bi ( 0 .. $#b ) {
        if( abs(
            sum( @a[ 0 .. $ai-1, $ai+1 .. $#a ], $b[ $bi ] )
          - sum( @b[ 0 .. $bi-1, $bi+1 .. $#b ], $a[ $ai ] )
          ) < $diff
        ) {
            my $temp = $a[ $ai ];
            $a[ $ai ] = $b[ $bi ];
            $b[ $bi ] = $temp;
            $diff = abs( sum( @a ) - sum( @b ) );
            print "$diff : [@a] [@b]";
            last OUTER if $diff == 0;
        }
    }
}
[download]

It could be coded more efficiently ~~and I haven't yet convinced myself that it will always find the optimum solution, but it seems to get pretty close~~ quite quickly even for quite large arrays:

C:\test>junk -N=25
13 : [6 8 12 19 12 16 19 2 14 2 12 18 2] [3 23 24 7 11 7 16 10 6 6 12 
+4]
7 : [3 8 12 19 12 16 19 2 14 2 12 18 2] [6 23 24 7 11 7 16 10 6 6 12 4
+]
3 : [3 6 12 19 12 16 19 2 14 2 12 18 2] [8 23 24 7 11 7 16 10 6 6 12 4
+]
1 : [3 4 12 19 12 16 19 2 14 2 12 18 2] [8 23 24 7 11 7 16 10 6 6 12 6
+]

C:\test>junk -N=25
64 : [11 11 22 2 19 17 17 10 6 20 17 5 20] [21 21 0 12 4 3 8 22 0 6 13
+ 3]
42 : [0 11 22 2 19 17 17 10 6 20 17 5 20] [21 21 11 12 4 3 8 22 0 6 13
+ 3]
28 : [0 4 22 2 19 17 17 10 6 20 17 5 20] [21 21 11 12 11 3 8 22 0 6 13
+ 3]
26 : [0 3 22 2 19 17 17 10 6 20 17 5 20] [21 21 11 12 11 4 8 22 0 6 13
+ 3]
20 : [0 0 22 2 19 17 17 10 6 20 17 5 20] [21 21 11 12 11 4 8 22 3 6 13
+ 3]
18 : [0 0 21 2 19 17 17 10 6 20 17 5 20] [22 21 11 12 11 4 8 22 3 6 13
+ 3]
2 : [0 0 11 2 19 17 17 10 6 20 17 5 20] [22 21 21 12 11 4 8 22 3 6 13 
+3]
0 : [0 0 12 2 19 17 17 10 6 20 17 5 20] [22 21 21 11 11 4 8 22 3 6 13 
+3]

C:\test>junk -N=25
80 : [10 9 23 4 14 22 0 17 19 9 16 24 24] [20 20 7 4 7 13 0 5 5 10 20 
+0]
74 : [7 9 23 4 14 22 0 17 19 9 16 24 24] [20 20 10 4 7 13 0 5 5 10 20 
+0]
68 : [4 9 23 4 14 22 0 17 19 9 16 24 24] [20 20 10 7 7 13 0 5 5 10 20 
+0]
60 : [0 9 23 4 14 22 0 17 19 9 16 24 24] [20 20 10 7 7 13 4 5 5 10 20 
+0]
56 : [0 7 23 4 14 22 0 17 19 9 16 24 24] [20 20 10 9 7 13 4 5 5 10 20 
+0]
50 : [0 4 23 4 14 22 0 17 19 9 16 24 24] [20 20 10 9 7 13 7 5 5 10 20 
+0]
42 : [0 0 23 4 14 22 0 17 19 9 16 24 24] [20 20 10 9 7 13 7 5 5 10 20 
+4]
36 : [0 0 20 4 14 22 0 17 19 9 16 24 24] [23 20 10 9 7 13 7 5 5 10 20 
+4]
16 : [0 0 10 4 14 22 0 17 19 9 16 24 24] [23 20 20 9 7 13 7 5 5 10 20 
+4]
14 : [0 0 9 4 14 22 0 17 19 9 16 24 24] [23 20 20 10 7 13 7 5 5 10 20 
+4]
10 : [0 0 7 4 14 22 0 17 19 9 16 24 24] [23 20 20 10 9 13 7 5 5 10 20 
+4]
6 : [0 0 5 4 14 22 0 17 19 9 16 24 24] [23 20 20 10 9 13 7 7 5 10 20 4
+]
4 : [0 0 4 4 14 22 0 17 19 9 16 24 24] [23 20 20 10 9 13 7 7 5 10 20 5
+]
2 : [0 0 4 4 13 22 0 17 19 9 16 24 24] [23 20 20 10 9 14 7 7 5 10 20 5
+]
0 : [0 0 4 4 13 22 0 17 19 9 16 23 24] [24 20 20 10 9 14 7 7 5 10 20 5
+]

C:\test>junk -N=25
43 : [22 10 14 1 2 1 16 8 19 20 17 24 21] [13 23 2 2 19 1 21 12 1 6 22
+ 10]
25 : [13 10 14 1 2 1 16 8 19 20 17 24 21] [22 23 2 2 19 1 21 12 1 6 22
+ 10]
3 : [2 10 14 1 2 1 16 8 19 20 17 24 21] [22 23 13 2 19 1 21 12 1 6 22 
+10]
1 : [1 10 14 1 2 1 16 8 19 20 17 24 21] [22 23 13 2 19 2 21 12 1 6 22 
+10]
[download]

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.

"Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."

Comment on Re: partition of an array Select or Download Code

Replies are listed 'Best First'.
Re^2: partition of an array by Limbic~Region (Chancellor) on Mar 09, 2009 at 19:06 UTC
BrowserUk, I really like this approach, but it is flawed. Consider the input: `7 7 7 1 0 0 0 -42 0 0 6 6 6` [download] There are 13 items so we will have one partition of 6 and one of 7. your code produces the following solution: `46 : [7 7 7 1 0 0 0] [-42 0 0 6 6 6] 32 : [0 7 7 1 0 0 0] [-42 7 0 6 6 6] 18 : [0 0 7 1 0 0 0] [-42 7 7 6 6 6] 16 : [0 0 6 1 0 0 0] [-42 7 7 7 6 6]` [download] The first partition sums to 7 and the second to -9 with a difference of 16. You could move (not swap) the 6 in the first partion to the second partition and you would end up with: `4 : [0 0 1 0 0 0] [-42 7 7 7 6 6 6]` [download] The first partition now sums to 1 and the second to -3 for a difference of 4. I don't know the difficulty in accounting for this situation but the problem is assuming the only balancing operation is swapping. Cheers - L~R	[reply] [d/l] [select]
Re^3: partition of an array by BrowserUk (Patriarch) on Mar 09, 2009 at 19:34 UTC
Thanks for the edge case. A couple of possible fixes spring to mind: Shuffling the input--not a guarentee. Sorting the input--is there an equivalent edge case that would give non-optimum results starting from sorted ordring? Splitting the input both ways--@a shorter than @b and vice versa--and finding the best solution from both datasets. Would that guarentee an optimum? Things to play with. Thanks. 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. "Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."	[reply]
Re^4: partition of an array by Limbic~Region (Chancellor) on Mar 09, 2009 at 19:55 UTC
BrowserUk, Regarding #2 (sorting the input), this is also a bust. You have to sort in descending order for my original edge case to work but if you sort in descending order for the following test case it doesn't produce optimal results `7 7 7 1 0 0 0 -42 36 0 0 6 6 6 -28 __DATA__ 146 : [36 7 7 7 6 6 6 1] [0 0 0 0 0 -28 -42] 74 : [0 7 7 7 6 6 6 1] [36 0 0 0 0 -28 -42] 18 : [-28 7 7 7 6 6 6 1] [36 0 0 0 0 0 -42] 10 : [-42 7 7 7 6 6 6 1] [36 0 0 0 0 0 -28]` [download] It can be shown that without sorting the data, the following solution is possible: `46 : [7 7 7 1 0 0 0 -42] [36 0 0 6 6 6 -28] 12 : [36 7 7 1 0 0 0 -42] [7 0 0 6 6 6 -28] 2 : [36 0 7 1 0 0 0 -42] [7 7 0 6 6 6 -28]` [download] This means #1 is also out. Possibly #3 (running it both ways) would produce optimum results but I am not ready to convince myself of it. Cheers - L~R	[reply] [d/l] [select]
Re^4: partition of an array by Limbic~Region (Chancellor) on Mar 09, 2009 at 20:09 UTC
BrowserUk, Update: I started this node indicating that I believed that I had proven that running it both ways was not guaranteed to produce an optimal solution. Then I updated it saying I had made a mistake. Now I am updating it again, quite confident that I have indeed proven that just running it both ways is not guaranteed to provide an optimum solution. Consider the input: `7 6 7 0 0 0 7 0 6 0 1 -42 6 __DATA__ 56 : [7 6 7 0 0 0 7] [0 6 0 1 -42 6] 42 : [0 6 7 0 0 0 7] [7 6 0 1 -42 6] 30 : [0 0 7 0 0 0 7] [7 6 6 1 -42 6] 28 : [0 0 6 0 0 0 7] [7 7 6 1 -42 6] 18 : [0 0 1 0 0 0 7] [7 7 6 6 -42 6] 16 : [0 0 1 0 0 0 6] [7 7 7 6 -42 6]` [download] I believe that to "run it both ways", I simply need to swap the assignments of @a and @b. If that's the case, then you can see that this too produces the same incorrect result: `56 : [0 6 0 1 -42 6] [7 6 7 0 0 0 7] 42 : [7 6 0 1 -42 6] [0 6 7 0 0 0 7] 40 : [7 7 0 1 -42 6] [0 6 6 0 0 0 7] 28 : [7 7 6 1 -42 6] [0 0 6 0 0 0 7] 26 : [7 7 7 1 -42 6] [0 0 6 0 0 0 6] 16 : [7 7 7 6 -42 6] [0 0 1 0 0 0 6]` [download] I haven't found an input that breaks if you sort the list and run it both ways but I am not inclined to think that makes a difference. Cheers - L~R	[reply] [d/l] [select]
Re^2: partition of an array by rir (Vicar) on Apr 22, 2009 at 04:19 UTC
For the universe of positive integers, I sensed a simple solution lurking. I found one but I didn't like how it coded up: It was just pushing the largest onto a half, if it was forced onto the currently smaller half, put it in a protest queue in that half. When ready to add a number to the other half in the presence of a protest, you would instead pop the top of the queue to the other half. This works and is fairly efficient but it is messy in the control code. Today, it just struck me that you don't have to keep the halves `abs( @left - @right) <= 1` as you create them; just make sure there is enough remaining to fill the other half. use List::Util qw{ sum }; sub L() { 0} # left sub R() { 1} # right sub remainder_halves { my $in = shift; my $ar ; @$ar = sort { $b <=> $a } @$in; die "bounds error" if @$ar && $$ar[-1] < 0; my @ans = ( [], [] ); # halves for answer no warnings 'uninitialized'; # summing empty arrays my ( $targ, $other ) = ( L, R ); my ( $halfsize) = int((@$ar+1)/2); while ( @$ar ) { while ( sum( @{$ans[$targ]}) <= sum( @{$ans[$other]}) && @{$ans[$targ]} < $halfsize ) { push @{$ans[$targ]}, shift @$ar; } ( $targ, $other ) = ( $other, $targ); push @{$ans[$targ]}, shift @$ar if @{$ans[$targ]} < $halfsize; } my $score = abs( sum( @{ $ans[L] } ) - sum( @{ $ans[R] } ) ); return $score, $ans[L], $ans[R]; } [download] Be well, rir	[reply] [d/l] [select]
Re^3: partition of an array by BrowserUk (Patriarch) on Apr 23, 2009 at 03:30 UTC
Sticking to positive integers certainly seems to make things easier. Maybe I should have applied that same caveat to mine as a defense against Limbic~Region's detective work :) 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. "Too many [] have been sedated by an oppressive environment of political correctness and risk aversion."	[reply]
Re^4: partition of an array by rir (Vicar) on Apr 23, 2009 at 20:25 UTC
No, neither of us should do that. :-) I should have just well enough alone with my brute force solution. I tested my "quick" version with every data set in this thread and more; and managed to miss sequences like: 550, 450, 360, 340, 300. Oh well, I'll be more perspicacious tomorrow. Ha! Be well, rir	[reply]


Perl-Sensitive Sunglasses
	PerlMonks