将散列的散列打印为矩阵

Question

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

得到的结果有误（%hashorganism的结果）；我通过检查输入文件或额外的哈希检查来验证这一点（下面代码中的%check）

我的输入示例在这里（请忽略列 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 的 spn/An 组合。这是一个可以做同样事情的更简单代码的演示。我已将 cmets 放入代码中进行解释——显然您在生产代码中不需要它们，因此请随意删除它们！

#!/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 以进行打印，但您正在将 $specie 的所有其他 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