Perl簡單的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 
"。
            if ($result > 0) {
                print "Still1 POS $result
"。
                $count = 1;
            } else {
                print "NEG1 now $result
"。
                $count = 1;
                next;
            }
        } else {
            $prev = $result;
            $result = $result - $subt;
            print "$prev - $subt = $result 
"。
            if ($result > 0) {
                print "Still2 POS $result
"。
                next;
            } else {
                print "NEG2 now $result
"。
                $count = 1;
                next;
            }
        }
    }
    $count = 0;
}

我需要它從第一個陣列@base中減去@subtr中的數字，一旦sub元素的總和超過了@base陣列的第一個元素，它就會使用超過的數量并從@base的第二個元素中減去，等等，直到它完成。一旦完成，我需要它告訴我它在@base的哪個陣列上完成，該陣列元素還剩多少（應該是1），然后總共還剩多少（應該是3）。 謝謝你的幫助。 保羅

uj5u.com熱心網友回復：

use警告。
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）。) 
# 用于測驗其他情況：。
#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用完，@sub用完。

say "base: @base (total: ", sum(@base), " )"。
say "sub:  @sub (total: ", sum (@sub), ")
" 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 "	@base元素#", $bi 1, " value $base[$bi] (-> 0); " ,
            "結轉$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. "。
            "留有", scalar @sub, " @子元素"。
        $base[$bi] = 0;
    }
    elsif (not @sub) { # 我們完成了。
        $base_idx = $bi;
        say "@base element #", $bi 1, " Emptied. carry-over: $carryover. "。
            "留有", scalar @sub, " @子元素"。
        最后 BASE_ELEM。
    }
}
my $total_base_value = sum @base;

say "
留在了基地。@base"。
if (any { $_ > 0 } @base) { # some base elements remained
    say "Stopped at @base element index $base_idx ( element number ",
        $base_idx 1, "），其值為$base[$base_idx]"。
}
elsif (@sub) { say "殘留的@sub元素。@sub" }
else { say "使用所有@sub來耗盡所有@base" }

say "Total remaining: $total_base_value"/span>;

印刷品

基數。10 15 6 2 (總計: 33)
子：2 4 6 2 2 5 7 2 (總數：30)

@base元素#1清空了。結轉：2。保留了5個@sub元素
@基數元素#2清空了。3. 保留了1個@子元素
@基礎元素#3清空了。3. 留有0個@子元素

留在了基數上。0 0 1 2
停在了@基數元素索引2（元素編號3），它有1
剩余總數：3

（沒有診斷性列印的版本見結尾）

還有其他可能的情況，由注釋出來的不同@sub輸入表示

• 當@base仍有非零的@sub元素時，@base耗盡。 最簡單的這種情況可以通過使用下一個(注釋過的)@sub輸入行來測驗；它的附加元素不斷蠶食基數值，并完全耗盡它，還剩下一些@sub

  。

• 所有的@base被驅動到零和@sub正好耗盡! 這個陰謀可以通過輸入使@base和@sub加起來是一樣的（最后注釋的@sub輸入）

• 有些@sub元素是如此之大，以至于使一個@base元素如此之負，以至于有足夠的結余來消耗下一個元素，等等。 這在第一個if測驗中得到了處理，如果還有一些額外的負數（要結轉），我們就直接跳到下一個@base元素，這樣它就可以被用在它上面，等等

  。

一個注意。一個@sub元素總是首先從它的前面被移除（通過shift），然后從一個@base元素中減去。 如果這使得該@base元素變成了負值，那么該負值將被用于結轉并應用于下一個@base元素。

但是，如果這最終使最后一個@base元素變成了負數，那么額外的（負數）被認為是留在了那個@sub的元素中；它被放回到@sub的前面（unshift-ed）。

例子：我們在@base的最后一個元素中剩下5（一些錢，讓我們想象一下），而@sub的元素中減去的是7。然后那個@base的元素就變成了0，而那個@sub的元素則保持在2。

這段代碼對空的@sub;也有效，列印索引0和值10.

uj5u.com熱心網友回復：

我不確定當你在用完@subtr之前用完@base時，預期的值應該是什么。對于你給的輸入，它似乎可以作業，雖然：

#!/usr/bin/perl。
use strict;
使用警告。
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 "在$subtr_index進行減法。$subtr[$subtr_index]"。
        $subtracted  = $subtr[$subtr_index  ]。
        say "Remains: ", $base[$base_index] - $subtracted;
    }
    最后 if $subtr_index > $#subtr;

    say "$base[$base_index] <=$subtracted"。
    $subtracted -= $base[$base_index  ]。
    if ($base_index > $#base) {
        --$base_index。
        最后一次。
    }
    say "攜帶$subtracted到索引$base_index（$base[$base_index]）"。
}
say "在基礎索引$base_index（$base[$base_index]）完成"。
say "剩余的值。", $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 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: "/span>, $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沒有被減去" if $remain。 } else { say "Subtr exhausted"/span>; }

標籤：

上一篇：在python中根據嵌套的多個條件過濾Json陣列（沒有根節點名稱）。

下一篇：為什么我對numpy元素使用id()注釋時，會顯示不同的結果？