I can not seem to get this FIFO calculation to work:

@base = (10,15,6,2);
@subtr = (2,4,6,2,2,5,7,2);

my $count = 0;
my $result;
my $prev;
foreach my $base1 (@base) {
    foreach my $subt (@subtr) {
        if ($count == 0) {
            $result = $base1 - $subt;
            print "$base1 - $subt = $result \n";
            if ($result > 0) {
                print "Still1 POS $result\n";
                $count = 1;
            } else {
                print "NEG1 now $result\n";
                $count = 1;
                next;
            }
        } else {
            $prev = $result;
            $result = $result - $subt;
            print "$prev - $subt = $result \n";
            if ($result > 0) {
                print "Still2 POS $result\n";
                next;
            } else {
                print "NEG2 now $result\n";
                $count = 1;
                next;
            }
        }
    }
    $count = 0;
}

I need it to subtract the numbers in @subtr from the 1st array @base, once the sum of the subt elements exceeds the 1st element of the @base array, for it to use the amount exceeded and subtract from second element of @base, etc until it is done. Once done, I need it to tell me which array from @base it finished on and how much is left from that array element( should be 1) and then how much is left total (should be 3). Thank you in advance! Paul

CodePudding user response：

use warnings;
use strict;
use feature 'say';
use List::Util 1.33 qw(sum any);  # 'any' was in List::MoreUtils pre-1.33

my @base = (10,15,6,2); 
my @sub = (2,4,6,2,2,5,7,2); 
# For testing other cases:
#my @sub = (2,4,6,2,2,5,7,2,5,5);  # @base runs out
#my @sub = (2,4,36,20);            # large @sub values, @base runs out
#my @sub = (2,4,21,2);             # large @sub values, @base remains
#my @sub = (2,4,6,2,2,5,7,2,3);    # @base runs out, @sub runs out

say "base: @base (total: ", sum(@base), ")"; 
say "sub:  @sub (total: ", sum (@sub), ")\n" if @sub;
    
my ($base_idx, $carryover) = (0, 0);
BASE_ELEM:
for my $bi (0..$#base) { 
    $base[$bi] -= $carryover; 
  
    # If still negative move to next @base element, to use carry-over on it
    if ($base[$bi] < 0) {
        $carryover = abs($base[$bi]);
        say "\t\@base element #", $bi 1, " value $base[$bi] (-> 0); ",
            "carry over $carryover.";
        $base[$bi] = 0;
        next BASE_ELEM;
    }

    # Subtract @sub elements until they're all gone or $base[$bi] < 0
    1 while @sub and ($base[$bi] -= shift @sub) > 0;  

    # Either @base element got negative, or we ran out of @sub elements
    if ($base[$bi] < 0) {
        $carryover = abs($base[$bi]);
        say "\@base element #", $bi 1, " emptied. carry-over: $carryover. ",
            "Stayed with ", scalar @sub, " \@sub elements";
        $base[$bi] = 0;
    }
    elsif (not @sub) {  # we're done
        $base_idx = $bi;
        say "\@base element #", $bi 1, " emptied. carry-over: $carryover. ",
            "Stayed with ", scalar @sub, " \@sub elements";
        last BASE_ELEM;
    }
}
my $total_base_value = sum @base;

say "\nStayed with base: @base";
if (any { $_ > 0 } @base) {  # some base elements remained
    say "Stopped at \@base element index $base_idx (element number ",
        $base_idx 1, "), which has value $base[$base_idx]";
}
elsif (@sub) { say "Remained \@sub elements: @sub" }
else         { say "Used all \@sub to deplete all \@base" }

say "Total remaining: $total_base_value";

Prints

base: 10 15 6 2 (total: 33)
sub:  2 4 6 2 2 5 7 2 (total: 30)

@base element #1 emptied. carry-over: 2. Stayed with 5 @sub elements
@base element #2 emptied. carry-over: 3. Stayed with 1 @sub elements
@base element #3 emptied. carry-over: 3. Stayed with 0 @sub elements

Stayed with base: 0 0 1 2
Stopped at @base element index 2 (element number 3), which has 1
Total remaining: 3

(See end for version without diagnostic prints)

There are other possible cases, indicated by commented-out different @sub inputs

• that @base runs out while there are still non-zero @sub elements. The simplest such case can be tested by using the next (commented-out) @sub input line; its additional elements keep nibbling away at base value and deplete it altogether, with some @sub remaining

• that all @base is driven to zero and @sub exactly runs out! This conspiracy can be effected with input such that @base and @sub add up to same (last commented-out @sub input)

• that some @sub elements are so large so to make a @base element so negative that there is enough of carry-over to deplete the next one, etc. This is handled in the first if test, where we skip directly to the next @base element if there is still some extra negative (to be carry-over), so that it can get used on it, etc

A note. A @sub element is always first removed from its front (by shift) and then subtracted from a @base element. If that made that @base element negative, the negative value is used for carry-over and applied to the next @base element.

But, if that finally drove the last @base element into negative, the extra (negative) amount is considered to have stayed in that @sub's element; it is put back at @sub's front (unshift-ed).

Example: we had 5 (of some moneys, let's imagine) left in @base's last element, and @sub's element subtracted from it was 7. Then that @base's element is made into zero and that @sub's element stays at 2.

The code works with empty @sub; as well, printing index 0 and value 10.

Without extra prints in the loop, for easier review

use warnings;
use strict;
use feature 'say';
use List::Util 1.33 qw(sum any);  # 'any' was in List::MoreUtils pre-1.33

my @base = (10,15,6,2); 
my @sub = (2,4,6,2,2,5,7,2); 
# For testing other cases:
#my @sub = (2,4,6,2,2,5,7,2,5,5);  # @base runs out
#my @sub = (2,4,36,20);            # large @sub values, @base runs out
#my @sub = (2,4,21,2);             # large @sub values, @base remains
#my @sub = (2,4,6,2,2,5,7,2,3);    # @base runs out, @sub runs out

say "base: @base (total: ", sum(@base), ")"; 
say "sub:  @sub (total: ", sum (@sub), ")\n" if @sub;
    
my ($base_idx, $carryover) = (0, 0);

for my $bi (0..$#base) { 
    $base[$bi] -= $carryover; 

    # If still negative move to next @base element, to use carry-over on it
    if ($base[$bi] < 0) {
        $carryover = abs($base[$bi]);
        $base[$bi] = 0;
        next;
    }

    # Subtract @sub elements until they're all gone or $base[$bi] < 0
    1 while @sub and ($base[$bi] -= shift @sub) > 0;  

    # Either @base element got negative, or we ran out of @sub elements
    if ($base[$bi] < 0) {
        $carryover = abs($base[$bi]);
        $base[$bi] = 0;
    }
    elsif (not @sub) {  # we're done
        $base_idx = $bi;
        last;
    }
}
my $total_base_value = sum @base;

say "Stayed with base: @base";
if (any { $_ > 0 } @base) {  # some base elements remained
    say "Stopped at \@base element index $base_idx (element number ",
        $base_idx 1, "), which has value $base[$base_idx]";
}
elsif (@sub) { say "Remained \@sub elements: @sub" }
else         { say "Used all \@sub to deplete all \@base" }

say "Total remaining: $total_base_value";

CodePudding user response：

I'm not sure what the expected values should be when you exhaust @base before exhausting @subtr. For the input you gave, it seems to work, though:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw{ say };

my @base = (10, 15, 6, 2);
my @subtr = (2, 4, 6, 2, 2, 5, 7, 2);

my ($base_index, $subtr_index) = (0, 0);
my $subtracted = 0;

while ($base_index <= $#base) {
    while ($base[$base_index] - $subtracted > 0 && $subtr_index <= $#subtr) {
        say "Subtract at $subtr_index: $subtr[$subtr_index]";
        $subtracted  = $subtr[$subtr_index  ];
        say "Remains: ", $base[$base_index] - $subtracted;
    }
    last if $subtr_index > $#subtr;

    say "$base[$base_index] <= $subtracted";
    $subtracted -= $base[$base_index  ];
    if ($base_index > $#base) {
        --$base_index;
        last
    }
    say "Carrying $subtracted to index $base_index ($base[$base_index])";
}
say "Finished at base index $base_index ($base[$base_index])";
say "Remaining value: ", $base[$base_index] - $subtracted;
my $remaining = $base[$base_index] - $subtracted;
$remaining  = $_ for @base[$base_index   1 .. $#base];
say "Remaining total: $remaining";

But I find working with copies of the arrays and removing their elements easier to understand:

#!/usr/bin/perl
use strict;
use warnings;
use feature qw{ say };

my @base = (10, 15, 6, 2);
my @subtr = (2, 4, 6, 2, 2, 5, 7, 2);

my @copy_base = @base;
my @copy_subtr = @subtr;

while (@copy_base && @copy_subtr) {
    if ($copy_base[0] > $copy_subtr[0]) {
        $copy_base[0] -= shift @copy_subtr;
    } else {
        my $first = shift @copy_base;
        $copy_base[0]  = $first;
        if (1 == @copy_base && $copy_base[0] <= $copy_subtr[0]) {
            $copy_subtr[0] -= $copy_base[0];
            @copy_base = ();
        }
    }
    # say "b:@copy_base";
    # say "s:@copy_subtr";
    # say "";
}

if (@copy_base) {
    say "Ended at base index ", @base - @copy_base;
    say "Value left: ", $copy_base[0];

    my $total = 0;
    $total  = $_ for @copy_base;
    say "Total: ", $total;
} else {
    say "Base exhausted";
}
if (@copy_subtr) {
    say "Ended at subtr index ", @subtr - @copy_subtr;
    my $remain = 0;
    $remain  = $_ for @copy_subtr;
    say "$remain wasn't subtracted" if $remain;
} else {
    say "Subtr exhausted";
}