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";

打印

基数：10 15 6 2（总数：33） 副：2 4 6 2 2 5 7 2（共：30） @base 元素 #1 已清空。结转：2。留在@sub：2 2 5 7 2 @base 元素 #2 已清空。结转：3。留在@sub：2 @base 元素 #3 已清空。结转：3. 保留 0 个 @subt 元素 留在基地：0 0 1 2 停在@base 元素索引 2（元素编号 3），值为 1 剩余总数：3

（没有诊断打印的版本见结尾）

还有其他可能的情况，由注释掉的不同@subt 输入表示

• @base 在仍有非零 @subt 元素时用完。可以使用下一个（注释掉的）@subt 输入行来测试最简单的这种情况；它的附加元素不断蚕食@base 的值并完全耗尽它，还剩下一些@subt

• 所有@base 都被驱动为零并且 @subt 完全耗尽！这个阴谋可以通过输入来实现，这样@base 和@subt 加起来相同（最后注释掉的@subt 输入）

• 有些@subt 元素大到足以使@base 元素变得如此消极以至于有足够的结转来耗尽下一个元素，等等。这在第一个if 测试中处理，我们在其中如果还有多余的负数（要结转），直接跳到下一个@base元素，以便可以在上面使用，等等

一个注释。 @subt 元素总是首先从其前面移除（通过shift），然后从@base 元素中减去。如果这使 @base 元素为负数，则负值将用于结转并应用于下一个 @base 元素。

但是，如果这最终导致最后一个 @base 元素变为负数，则额外的（负数）量被认为保留在该 @subt 的元素中；它被放回@subt的前面（unshift-ed）。

示例：我们在@base 的最后一个元素中留下了5（让我们想象一下），而从中减去@subt 的元素是7。然后将@base 的元素设为零，而@subt 的元素保持在2。

代码也适用于空@subt。

---

循环中没有额外的打印，以便于查看

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";

Answer 2

我不确定在用尽@subtr 之前用尽@base 时的预期值应该是多少。不过，对于您提供的输入，它似乎有效：

#!/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";

但我发现使用数组的副本并删除它们的元素更容易理解：

#!/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";
}