1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
|
#!/usr/bin/perl
use warnings;
use strict;
use List::Util qw{ sum };
# Adapted from PWC 114/2.
sub next_same_number_of_ones {
my ($binary) = @_;
if (-1 != (my $pos = rindex $binary, '01')) {
substr $binary, $pos, 2, '10';
my $suffix = substr $binary, $pos + 2, length $binary, "";
my $ones = $suffix =~ tr/1//d;
$suffix .= 1 x $ones;
return "$binary$suffix";
}
my $pos = rindex $binary, '1';
my $zeros = substr $binary, $pos + 1, length $binary, "";
substr $binary, 1, 0, "0$zeros";
return $binary
}
sub tug_of_war {
my @ints = @_;
my $length = @ints;
my $size = $length / 2;
my $mask = "%0${length}b";
my $bin = sprintf $mask, 2 ** (int $size) - 1;
my ($diff, $best1, $best2) = sum(@ints);
while ($bin !~ /^1+0+$/) {
my ($s1, $s2) = ([], []);
for my $i (0 .. $length - 1) {
push @{ ($s1, $s2)[ substr $bin, $i, 1 ] }, $ints[$i];
}
if (abs(sum(0, @$s1) - sum(0, @$s2)) < $diff) {
$diff = abs(sum(0, @$s1) - sum(0, @$s2));
($best1, $best2) = ([@$s1], [@$s2]);
last if 0 == $diff
}
$bin = next_same_number_of_ones($bin);
}
return $best1, $best2
}
use Test2::V0;
plan 2;
sub Check {
my ($input, $arr1, $arr2, $name) = @_;
is [tug_of_war(@$input)],
bag { item bag { item $_ for @$arr1; end };
item bag { item $_ for @$arr2; end };
}, $name;
}
Check([10, 20, 30, 40, 50, 60, 70, 80, 90, 100],
[30, 40, 60, 70, 80],
[10, 20, 50, 90, 100],
'Example 1');
Check([10, -15, 20, 30, -25, 0, 5, 40, -5],
[30, 0, 5, -5],
[10, -15, 20, -25, 40],
'Example 2');
|
