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

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

标签： arraysperlfifo

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元素总是首先从它的前面移除（by shift），然后从一个@base元素中减去。如果这使该@base元素为负，则负值用于结转并应用于下一个@base元素。

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

示例：我们5（假设有一些钱）留在@base' 的最后一个元素中，而@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";