arrays - Perl 简单的 FIFO 计算

Question

我似乎无法让这个 FIFO 计算工作:

@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;
}

一旦 subt 元素的总和超过 @base 数组的第一个元素，我需要它从第一个数组 @base 中减去 @subtr 中的数字，以便它使用超出的金额并从第二个元素中减去@base等，直到完成。完成后，我需要它告诉我它完成了 @base 中的哪个数组，以及该数组元素还剩下多少(应该是 1)，然后总共还剩下多少(应该是 3)。 先感谢您! 保罗

Answer 1

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 @subt = (2,4,6,2,2,5,7,2);  # SUBTract from @base in a particular way ("FIFO")

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

say "base: @base (total: ", sum(@base), ")";
say "sub:  @subt (total: ", sum (@subt), ")\n" if @subt;

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 @subt elements until they're all gone or $base[$bi] < 0
    1 while @subt and ($base[$bi] -= shift @subt) > 0;

    # Either @base element got negative, or we ran out of @subt elements
    if ($base[$bi] <= 0) {
        $carryover = abs($base[$bi]);
        say "\@base element #", $bi+1, " emptied. carry-over: $carryover. ",
            "Stayed with \@sub: @subt";
        $base[$bi] = 0;
    }
    elsif (not @subt) {  # we're done
        $base_idx = $bi;
        say "\@base element #", $bi+1, " emptied. carry-over: $carryover. ",
            "Stayed with ", scalar @subt, " \@subt 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, "), with value $base[$base_idx]";
}
else {
    if ($carryover) {
        say "Last carry-over: $carryover. Put it back at front of \@subt";
        unshift @subt, $carryover;
    }
    if (@subt) { say "Remained with \@subt elements: @subt" }
    else       { say "Used all \@subt to deplete all \@base" }
}

say "Total remaining: $total_base_value";

打印

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 @sub: 2 2 5 7 2
@base element #2 emptied. carry-over: 3. Stayed with @sub: 2
@base element #3 emptied. carry-over: 3. Stayed with 0 @subt elements

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

(See end for version without diagnostic prints)

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

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

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

• that some @subt elements are large enough 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 extra negative (to be carry-over), so that it can get used on it, etc

A note. A @subt 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 @subt's element; it is put back at @subt's front (unshift-ed).

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

The code works with empty @subt as well.

---

Without extra prints in the loop, for easier reviewing

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 @subt = (2,4,6,2,2,5,7,2);
# For testing other cases:
#my @subt = (2,4,6,2,2,5,7,2,5,5);  # @base runs out
#my @subt = (2,4,36,20);            # large @subt values, @base runs out
#my @subt = (2,4,21,2);             # large @subt values, @base remains
#my @subt = (2,4,6,2,2,5,7,2,3);    # @base runs out, @subt runs out
say "base: @base (total: ", sum(@base), ")";
say "sub:  @subt (total: ", sum (@subt), ")\n" if @subt;

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 @subt elements until they're all gone or $base[$bi] < 0
    1 while @subt and ($base[$bi] -= shift @subt) > 0;

    # Either @base element got negative, or we ran out of @subt elements
    if ($base[$bi] <= 0) {
        $carryover = abs($base[$bi]);
        $base[$bi] = 0;
    }
    elsif (not @subt) {  # 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, "), with value $base[$base_idx]";
}
else {
    unshift @subt, $carryover  if $carryover;

    if (@subt) { say "Remained with \@subt elements: @subt" }
    else      { say "Used all \@subt to deplete all \@base" }
}

say "Total remaining: $total_base_value";