Question

我首先甚至不确定要搜索什么，因为我知道如何在excel中执行此操作，但无法找到一种简单的方法（用我有限的知识）在perl中执行此操作。我需要重新编号一个谱系文件（超过140万条记录），不幸的是excel vlookup还不够，这都归功于PC功能和excel电子表格功能。

该文件需要重新编号，以便个人的编号不比父编号低，所以我的测试文件看起来像这样：

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开始，以便＆＃34;新的ID＆＃34;如下：

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（我可以做），然后是sire和dam列（我不能这样做）。

为了减少代码，我省略了计算新的大坝ID的块，因为它将是父亲的复制品。我到目前为止我的代码如下：

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

然而......由于引用没有连接，我显然得错了输出，因此没有匹配的公牛（或水坝）。

我尝试使用父亲和大坝ID作为参考来创建2个额外的哈希，一个用于父亲和大坝：

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

我猜我没有正确使用哈希，或者我需要使用不同的循环？但是，我的perl知识仍然非常基础和缺乏。

非常感谢任何帮助!!

Answer 1

你的方法很复杂。我将首先关注一种不同的方法，我将对此进行解释。

您需要对数据进行两次传递。在第一遍中，您将生成旧ID和新ID的映射。创建新id的算法只是从10开始并递增，因此这很简单。我们可以使用带有旧id的常规哈希作为键，将新id作为值。

在我的方法中，我们还将第一遍中的行数据保存到数组引用数组中。这样我就可以在第二遍中重复使用它。如果你有很多记录，那可能不是很聪明，因为它需要大量的内存。在这种情况下，您将重新读取数据和print，而不是像我一样更改值。

在第二遍中，我们迭代行并简单地从查找散列中替换所有行。

ani 的值很简单。取当前值并查找。
sire 的值只有在不是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文件）在我的Core i7 quadcore笔记本电脑和Perl 5.20.1上耗费了大约8秒。

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

Perl：使用引用用于其他哈希

1 个答案: