打印哈希散列作为矩阵

Question

我想填充散列哈希作为矩阵。我的数据中有5个ID;每行都以我分析过的行中第一个字段的IDsm开头。这些ID将是我想要构建的矩阵的列名称。为了填充矩阵，我计算这些ID与其他记录（在解析线的最后一个字段中由;分隔的物种名称）的关联数。我的代码如下。你能告诉我这段代码出了什么问题吗？

获得的结果是错误的（结果为%hashorganism）;我确认通过检查输入文件或与另外的哈希校验（%check在下面的代码）

我的输入的例子是在这里（请忽略COLS 2 3 4和5中，它们并不重要）：

A1 4 5 6 7 sp1;sp2;sp3;sp4 
A2 4 5 6 7 sp5 
A4 4 5 6 7 sp1;sp2;sp3 
A5 4 5 6 7 sp6 
A3 4 5 6 7 sp1;sp2 
A3 4 5 6 7 sp1 
A4 4 5 6 7 sp2;sp4 
A3 4 5 6 7 sp1;sp2;sp3;sp5 

预期矩阵是在这里：

A1 A2 A3 A4 A5 
sp1 1 0 3 1 0 
sp2 1 0 2 2 0 
sp3 1 0 1 1 0 
sp4 1 0 0 1 0 
sp5 1 1 0 0 0 
sp6 0 0 0 0 1 

我的代码是在这里：

#!/usr/bin/perl 
use warnings; 
use strict; 
use integer; 
use Text::Table; 

open(MAP, "<$ARGV[0]") || die "Problem in file opening : $ARGV[0]: $!\n"; 

my %hashorganism; 
my %check; 
my @IDS = ("A1", "A2", "A3", "A4", "A5"); 
my $j = 0; 
while (my $line = <MAP>) { 
    chomp($line); 

    if ($line ne "") { 

     my @tempo = split(/\t/, $line); 

     $tempo[$#tempo] =~ s/^\s//; 
     $tempo[$#tempo] =~ s/\s$//; 
     #print $tempo[$#tempo] , "\n" ; 

     if ($tempo[1] >= 4 and $tempo[2] >= 5 and $tempo[3] >= 6) 
     { ## && $tempo[$10] >= $evalue 
      $j++; 
      my $la = $tempo[0]; 

      #print $tempo[$#tempo], " **\n"; 

      if ($tempo[$#tempo] =~ /\;/) { 
       #print $line, "\n" ; 

       #print $line, "\n" ; 
       my @multiorg = split(/\;/, $tempo[$#tempo]); 

       foreach my $specie (@multiorg) { 
        $check{$specie}++; 
        $hashorganism{$specie}{$la}++; 
        ## $hashorganism{$la."|".$specie}++ ; 

        foreach my $e (@IDS) { 
         if ($e ne $la) { 
          # print $e, "\n"; 
          ## $hashorganism{$e."|".$specie}=0; 
          $hashorganism{$specie}{$e} = 0; 
         } 
         #else {print $la, "\n";} 
        } 
       } 
      } 

      elsif ($tempo[$#tempo] !~ /\;/) { 
       $check{ $tempo[$#tempo] }++; 
       $hashorganism{ $tempo[$#tempo] }{$la}++; 
       ##$hashorganism{$la."|".$tempo[$#tempo]}++; 
       foreach my $l (@IDS) { 
        if ($l ne $la) { 
         #print $l, "\n"; 
         $hashorganism{ $tempo[$#tempo] }{$l} = 0; 
         #$hashorganism{$l."|".$tempo[$#tempo]}=0; 
        } 
        #else {print $lake, "\n";} 
       } 
      } else { 
       print $line, "something going wrong in your data\n"; 
      } 
     } 
    } 
} 

print "The number of parsed lines : $j \n"; 

# print the whole hash of hashes 
print "\tA1\t", "A2\t", "A3\t", "A4\t", "A5\n"; 

my $count = 0; 
foreach my $org (sort keys %hashorganism) { 
    print $org, "\t"; 

    foreach $_ (sort keys %{ $hashorganism{$org} }) { 
     print "$hashorganism{$org}{$_}\t"; 
    } 
    print "\n"; 
} 

foreach my $sp (sort keys %check) { 
    print $sp, "\t $check{$sp}\n"; 
} 

Answer 1

你可以简化你的程序一点点，并处理在打印阶段为0的组合。这是一个简单代码的演示，它可以做同样的事情。我在代码中加入了一些注释来解释 - 显然，您的生产代码中不需要它们，所以请随时删除它们！

#!/usr/bin/perl 
use warnings ; 
use strict ; 
open (MAP,"<$ARGV[0]") || die "Problem in file opening : $ARGV[0]: $!\n"; 
my %org_h; 
my @IDS = ("A1", "A2", "A3", "A4", "A5"); 
my $j = 0; 
while(my $line = <MAP>) 
{ # skip the line unless it contains alphanumeric characters 
    next unless $line =~ /\w/; 
    chomp($line); 

    my @tempo = split(/\t/, $line); 

    $tempo[$#tempo] =~ s/^\s// ; 
    $tempo[$#tempo] =~ s/\s$// ; 

    if ($tempo[1] >= 4 and $tempo[2] >= 5 and $tempo[3] >= 6) { 
     $j++; 
     my $la = $tempo[0]; 
     # it is safe to split every $tempo[$#tempo] -- it makes the code simpler 
     # if $tempo[$#tempo] only contains one sp, you'll get an array of size 1 
     my @multiorg = split ';', $tempo[$#tempo]; 
     for my $sp (@multiorg) { 
      $org_h{$sp}{$la}++; 
     } 
    } 
} 

print "The number of valid parsed lines : $j \n"; 

# print the header line 
# join prints an array of items, separated by the first argument - "\t" here 
print join("\t", '', @IDS) . "\n"; 

for my $org (sort keys %org_h) { 
    # the 'join' prints a tab-separated array containing $org and a mapped array 
    # 'map' applies an expression to every member of an array -- it's like using 
    # a 'for' loop. In this case, for every member of @IDS, print $org_h{$org}{$_} 
    # if it exists or (if it doesn't exist or is false) print 0. 
    print join("\t", $org, map { $org_h{$org}{$_} || "0" } @IDS) . "\n"; 
} 

你不需要%check - 它被复制%org_h散列的第一级。

你的代码是走错了，由于这些行：

foreach my $e (@IDS) { 
    if ($e ne $la) { 
     # print $e, "\n"; 
     $hashorganism{ $specie }{ $e } = 0; 
    } 
} 

（其中$la是在该行的第一列的ID，并$specie是种）

我相信你试图填写丢失的0进行打印，而是将所有其他ID的数据清零。理想情况下，你会检查$hashorganism{$specie}{$e}是否已经存在或不存在（if (! defined $hashorganism{$specie}{$e}) ...），所以你不会冒着删除现有数据的风险。尽管如此，在打印时填补缺失的空白要容易得多。

Answer 2

这是非常接近的一个问题，从昨天：rearrange data from one column to a row

的主要区别是，你是输出到使用Text::Table与一个CSV表。

我还增加了使用Sort::Key::Natural qw(natsort)的情况下，有不止一个数字列或行，即。 sp10在sp9之后。

use strict; 
use warnings; 
use autodie; 

use Sort::Key::Natural qw(natsort); 
use Text::Table; 

my %row; 
my %cols; 

while (<DATA>) { 
    chomp; 

    my ($col, $species) = (split ' ', $_, 6)[ 0, -1 ]; 

    $cols{$col}++; 
    $row{$_}{$col}++ for split ';', $species; 
} 

my @cols = natsort keys %cols; 

# Header: 
my $tb = Text::Table->new('', @cols); 

$tb->load(
    map { 
     [ $_, map { $_ // 0 } @{ $row{$_} }{@cols} ] 
    } natsort keys %row 
); 

print $tb; 

__DATA__ 
A1 4 5 6 7 sp1;sp2;sp3;sp4 
A2 4 5 6 7 sp5 
A4 4 5 6 7 sp1;sp2;sp3 
A5 4 5 6 7 sp6 
A3 4 5 6 7 sp1;sp2 
A3 4 5 6 7 sp1 
A4 4 5 6 7 sp2;sp4 
A3 4 5 6 7 sp1;sp2;sp3;sp5 

输出：

A1 A2 A3 A4 A5 
sp1 1 0 3 1 0 
sp2 1 0 2 2 0 
sp3 1 0 1 1 0 
sp4 1 0 0 1 0 
sp5 0 1 1 0 0 
sp6 0 0 0 0 1