[buug] substring of integers problem

[Michael Paoli]

Not quite a "perfect" solution (e.g. it can hit some  
overflow/underflow/conversion errors in some cases - including not  
detecting them in some cases), but ...
I also realized later I could've coded it to solve from left to right,
rather than right to left ... and could thus possibly not process/parse
the arguments (input integers) until they're needed, and thus also not
need to store them all.  Most of the "real work" happens within about
21 lines of body of loop.  The rest is mostly just initialization and
final output.  It needs more comments :-) ... I had a bunch, but stripped
most of them out ... they'd not kept up to how the code had "evolved".

In any case:

$ ./maxsumsubset 1 2 3 -8 5
1, 2, 3
$ ./maxsumsubset 1 2 3 -8 5 8
5, 8
$ ./maxsumsubset 1 2 3 -6 5 8
1, 2, 3, -6, 5, 8
5, 8
$ perl -e '@_=(); for(my  
$n=15;$n>0;--$n){push(@_,int(rand(19))-9);};print(join('\''  
'\'', at _),"\n");'
6 4 6 -5 8 -5 3 -8 1 4 2 -6 2 -5 8
$ ./maxsumsubset 6 4 6 -5 8 -5 3 -8 1 4 2 -6 2 -5 8
6, 4, 6, -5, 8
$ perl -e '@_=(); for(my  
$n=15;$n>0;--$n){push(@_,int(rand(19))-9);};print(join('\''  
'\'', at _),"\n");'
7 -7 2 -3 -8 -9 -5 -4 -2 -1 -8 -6 5 0 8
$ ./maxsumsubset 7 -7 2 -3 -8 -9 -5 -4 -2 -1 -8 -6 5 0 8
5, 0, 8
$ perl -e '@_=(); for(my  
$n=15;$n>0;--$n){push(@_,int(rand(19))-9);};print(join('\''  
'\'', at _),"\n");'
2 1 -8 8 -2 -7 1 5 6 6 -3 -4 1 -8 -3
$ ./maxsumsubset 2 1 -8 8 -2 -7 1 5 6 6 -3 -4 1 -8 -3
1, 5, 6, 6
$ perl -e '@_=(); for(my  
$n=15;$n>0;--$n){push(@_,int(rand(19))-9);};print(join('\''  
'\'', at _),"\n");'
8 -8 -3 -5 -9 -7 8 -3 -5 3 -4 1 1 -7 8
$ ./maxsumsubset 8 -8 -3 -5 -9 -7 8 -3 -5 3 -4 1 1 -7 8
8
$ perl -e '@_=(); for(my  
$n=15;$n>0;--$n){push(@_,int(rand(19))-9);};print(join('\''  
'\'', at _),"\n");'
-4 9 6 2 2 9 3 -9 -3 -6 0 0 2 0 0
$ ./maxsumsubset -4 9 6 2 2 9 3 -9 -3 -6 0 0 2 0 0
9, 6, 2, 2, 9, 3
$ expand -t 4 < maxsumsubset
#!/usr/bin/perl

$^W=1;
use strict;

# vi(1) :se tabstop=4

# given list of integers, find subset(s) of consecutive integer(s) in
# list having the maximum sum
# we'll take our list from argument(s)

# initialize list
my @list=();

# check arguments and populate list, abort on invalid argument
for (@ARGV) {
     if(
         !
         /^
             [-+]?
             (?:
                 \d+
                 (?:\.0*)?
                 |
                 \d*\.0+
             )
             $
         /ox
     ){
         die (
                 "$0: $_ not integer in expected format:\n",
                 '/^[-+]?(?:\d+(?:\.0*)?|\d*\.0+)$/)',
                 ", aborting",
             )
         ;
     };
     # sanity check for precision loss
     if($_>0){
         $_ - 1 != $_ or die("$0: precision loss? - failed test: $_ -  
1 != $_, aborting");
     }else{
         $_ + 1 != $_ or die("$0: precision loss? - failed test: $_ +  
1 != $_, aborting");
     };
     # sanity check for possible underflow, overflow or bad conversion
     {
         my $original=$_;
         #'/^[-+]?(?:\d+(?:\.0*)?|\d*\.0+)$/)',
         # normalize form
         s/^\+//o; # strip any leading +
         s/^(?!0$)-?(?:0+\.?|0*\.0+)$/0/o; # nominalize zero to 0
         s/\.0*$//o; # strip zero decimal portion
         s/^(-?)0+(?=[1-9])/\1/o; # strip unneded leading 0s
         ($_ + 0) . '' eq $_ or die ("$0: convesion problem? $original  
--> $_, failed test: ($_ + 0) . '' eq $_, aborting");
     }
     push (@list,$_+0);
};

# trivial solutions first:
if ($#list <= 0){
     if ($#list == -1){
         # empty input list
         print "null\n";
         exit(0);
     }elsif($#list == 0){
         # single element input list
         print "$list[0]\n";
         exit(0);
     };
     # should be unreachable, but if we're here:
     die("$0: \$#list(==$#list) <=0 but not -1 or 0, aborting");
};

# additional pre-loop initialization
my $sum=$list[$#list];
my %solution=($sum => [$sum]); #(setkey => [set], ...)
my $sum_to_right=$sum;
my %solution_to_right=($sum => [$sum]); #(setkey => [set], ...)

# concatenation string for setkey (must not contain digit or -)
my $c='.';

# iterate over our list, right to left, start at next to rightmost
# position
for (
         my $index=$#list-1; # index position in list, work right to left
         $index>=0;
         --$index
){
     my $here=$list[$index];
     if($sum_to_right >= 0){
         $sum_to_right+=$here;
         for (keys %solution_to_right){
             $solution_to_right{$here . $c . $_}=
                 [$here,@{$solution_to_right{$_}}];
             delete $solution_to_right{$_};
         };
     }else{ # $sum_to_right < 0
         $sum_to_right=$here;
         %solution_to_right=($here => [$here]);
     };
     if($sum_to_right >= $sum){
         if($sum_to_right > $sum){
             $sum=$sum_to_right;
             %solution=();
         };
         for (keys %solution_to_right){
             $solution{$_}=[@{$solution_to_right{$_}}];
         };
     #}else{ # $sum_to_right < $sum # nothing to do in this case
     };
};

for(keys %solution){
     print(join(', ',@{$solution{$_}}),"\n");
};

> From: "Ian Zimmerman" <itz at buug.org>
> Subject: Re: [buug] substring of integers problem
> Date: Fri, 04 Feb 2011 22:04:20 -0800

>
> Karen> You may find this helpful:
> Karen> http://en.wikipedia.org/wiki/Longest_common_substring_problem
>
> That's an interesting problem too, but I don't think it is relevant to
> mine :-P  I must have not explained it clearly, so I'll do it again
> here.  Apologies to those who have already seen this.
>
> The problem is:  given a list (array, finite sequence, vector - whatever
> you want to call it) of integers, positive and negative, find a slice
> (contiguous subsequence) which maximizes the *sum* of the integers in
> the slice.
>
> Examples: if the input list is [1, 2, 3, -8, 5], then there's exactly one
> solution, namely [1, 2, 3].  If the input list is [1, 2, 3, -8, 5, 8]
> there's again a unique solution, [5, 8].  If I change the -8 to a -6,
> there are now 2 solutions: [5, 8] and the full input list.  Only one
> solution is required if there are multiple ones.