Perl：使用引用有其他散列

Question

我第一次不知道要搜索什麼，因爲我知道如何在Excel中做到這一點，但無法找到一個簡單的方法（用我有限的知識）在Perl中做到這一點。我需要對譜系文件重新編號（超過140萬條記錄），但不幸的是，由於PC功能和excel電子表格功能，excel vlookup不足以滿足要求。

的文件需要被重新編號，所以個人沒有比他們的父母一個較低的數字，所以我的測試文件看起來是這樣的：

Ani | Sire | Dam 
---------------- 
15 | 1 | 2 
12 | 1 | 2 
30 | 15 | 12 
18 | 15 | 2 
26 | 15 | 30 
48 | 18 | 30 
32 | 26 | 48 
50 | 26 | 30 

1和2表示未知的父（我會讓他們爲1/2），並重新編號從10開始，使「新的ID」如下：

Old_ID | New_ID 
--------------- 
15 | 10 
12 | 11 
30 | 12 
18 | 13 
26 | 14 
48 | 15 
32 | 16 
50 | 17 

所以，我想看到的輸出將被

new_ani | new_sire | new_dam 
---------------------------- 
    10 | 1  | 2 
    11 | 1  | 2 
    12 | 10  | 11 
    13 | 10  | 2 
    14 | 10  | 12 
    15 | 13  | 30 
    16 | 14  | 15 
    17 | 14  | 12 

使用兩個散列函數，我嘗試（不成功）首先將第一列鏈接到新ID（我可以這樣做），然後是陛下和dam列（我不能這樣做）。

爲了減少代碼量，我忽略了計算新壩標的塊，因爲它將是父系的複製品。我在我的代碼迄今如下：

use strict; 
use warnings; 

my $input_file = .../pedigree.csv; 
open (INPUT, "<", $input_file) or die "Cant open $input_file: $!"; 

my new_id = 0; 

my %old_ped =(); 
my %new_id =(); 

while (<INPUT>){ 

     my $line = $_; 
      $line =~ s/\s*$//g; 

     my ($ani,$sire,$dam) = split('\,',$line); 

     next if $ani eq 'db_animal' or !$ani or $ani eq 'ani'; 

     $old_ped{$ani}[0] = $ani; 
     $old_ped{$ani}[1] = $sire; 
     $old_ped{$ani}[2] = $dam; 

     $new_id++; 

     $new_id{$ani}[0] = $ani; 
     $new_id{$ani}[1] = $new_id; 

} 
close INPUT; 

foreach my $tt (sort keys %old_ped){ 

     #animal 
     if ($old_ped{$tt}[0] == $new_id{$tt}[0]){ 
       print "$new_id{$tt}[1],"; 

       #sires 
       if ($old_ped{$tt}[1] == 1){ 
         print " 1,"; 
       } 
       else{ 
         foreach my $tt (sort keys %new_id) { 
           if ($old_ped{$tt}[1] == $nuwe_id{$tt}[0]){ 
             print "$new_id{$tt}[1],";           
           } 
         } 
       } 
     } 

# AND REPEAT SIRE BLOCK FOR DAM 

print "\n"; 
} 

但是...我顯然得到錯誤的輸出作爲引用未連接，所以沒有對公畜（或水壩）匹配。

我試圖而不是創建2個額外的散列，一個用於父親和母親，使用父親和母親ID作爲參考：

$sire{$sire}[0] = $sire; 
$sire{$sire}[1] = $dierid; 

$dam{$dam}[0] = $dam; 
$dam{$dam}[1] = $dierid; 

和在foreach使用它們如下：

foreach my $tt (sort keys %old_ped){ 

     #animal 
     if ($old_ped{$tt}[0] == $new_id{$tt}[0]){ 
       print "$new_id{$tt}[1],"; 

       #sires 
       if ($old_ped{$tt}[1] == 1){ 
         print " 1,"; 
       } 
       else{ 
         foreach my $tt (sort keys %sire) { 
           if ($sire{$tt}[0] == $nuwe_id{$tt}[0]){ 
             print "$new_id{$tt}[1],";           
           } 

         } 
       } 
     } 

# AND REPEAT SIRE BLOCK FOR DAM 

print "\n"; 
} 

我猜我沒有正確使用我的散列，或者我可能需要使用不同的循環？然而，我的知識仍然非常基礎和缺乏。

任何幫助將非常感謝！

Answer 1

您的方法很複雜。我將首先關注一種不同的方法，我會解釋一下。

您需要對數據進行兩次傳遞。在第一遍中，您會生成舊ID和新ID的地圖。創建新ID的算法只是從10開始並增量，所以這很簡單。我們可以使用舊ID作爲關鍵字，並使用新ID作爲值。

在我的方法中，我們還將第一遍中的行數據保存到數組引用的數組中。這樣我可以在第二遍中重複使用它。如果你有很多記錄，那可能不是很聰明，因爲它需要很多內存。在這種情況下，您將重新讀取數據和print，而不是像我那樣更改值。

在第二遍中，我們遍歷行並簡單地將它們全部從查找哈希中替換掉。

• 該值爲ani很容易。獲取當前值並查找它。
• 父系的值應該只能被替換，如果它不是1或2。在Perl中，它可以翻譯成unless它比3小。在這種情況下查看它，否則什麼都不做。
• dam的值的工作方式相同。

use strict; 
use warnings; 
use Data::Printer; 

my $new_id = 10; 

my %new_ids; 
my @rows; 
while (my $line = <DATA>) { 
    $line =~ s/\s*$//g; 

    my ($ani, $sire, $dam) = split('\,', $line); 

    # map old -> new 
    $new_ids{$ani} = $new_id; 

    # save row 
    push @rows, [$ani, $sire, $dam]; 

    ++$new_id; 
} 

# iterate all rows and replace the ids 
foreach my $row (@rows) { 
    $row->[0] = $new_ids{$row->[0]}; 
    $row->[1] = $new_ids{$row->[1]} unless $row->[1] < 3; 
    $row->[2] = $new_ids{$row->[2]} unless $row->[2] < 3; 
} 

p @rows; 
__DATA__ 
15,1,2 
12,1,2 
30,15,12 
18,15,2 
26,15,30 
48,18,30 
32,26,48 
50,26,30 

我的程序將打印Data::Printer的結果。

[ 
    [0] [ 
     [0] 10, 
     [1] 1, 
     [2] 2 
    ], 
    [1] [ 
     [0] 11, 
     [1] 1, 
     [2] 2 
    ], 
    [2] [ 
     [0] 12, 
     [1] 10, 
     [2] 11 
    ], 
    [3] [ 
     [0] 13, 
     [1] 10, 
     [2] 2 
    ], 
    [4] [ 
     [0] 14, 
     [1] 10, 
     [2] 12 
    ], 
    [5] [ 
     [0] 15, 
     [1] 13, 
     [2] 12 
    ], 
    [6] [ 
     [0] 16, 
     [1] 14, 
     [2] 15 
    ], 
    [7] [ 
     [0] 17, 
     [1] 14, 
     [2] 12 
    ] 
] 

---

在執行時間方面，我創建了一個文件，用1.5M這個節目實錄隨機。

$ perl -E 'say join ",", int rand 10000, int rand 10000, int rand 10000 for 1 .. 1_500_000' > animals.csv 

通過我的代碼（改爲open文件）運行這個歷時約上我的酷睿i7四核筆記本電腦和Perl 5.20.1 787-8。

$ time perl scratch.pl 
real 0m7.863s 
user 0m7.260s 
sys  0m0.436s