Perl 将哈希值打印为矩阵

我试图将散列作为矩阵填充。我的数据中有5个ID；每一行都以一个IDsm开始，IDsm是我解析的行中的第一个字段。这些ID将是我要构建的矩阵的列名。为了填充矩阵，我计算了这些ID与其他记录的关联数（在解析行的最后一个字段中，物种名称用

；

分隔）。我的代码如下。你能告诉我这个代码出了什么问题吗

获得的结果是错误的（结果为

%hashOrganization

）；我通过检查输入文件或附加哈希检查来验证（下面代码中的

%check

）

我的输入示例如下（请忽略COL234和5，它们并不重要）：

预期矩阵如下所示：

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

#/usr/bin/perl
使用警告；
严格使用；
使用整数；
使用Text：：Table；
打开（MAP），您可以将程序简化一点，并在打印阶段处理spn/An组合为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";
}

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

我假设您正在尝试为打印填充缺少的0，但是您正在为所有其他ID将该
$specie
的数据归零。理想情况下，您应该检查
$hashorganism{$specie}{$e}{/code>是否已经存在（
如果（！defined$hashorganism{$specie}{$e}）…
），这样您就不会冒删除现有数据的风险。不过，在打印时填补缺失的空白要容易得多。
这与昨天的问题非常接近：

主要区别在于，您的输出是使用csv而不是csv输出到表中

我还添加了在不只是一位数的列或行的情况下使用的，即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

非常感谢！我在打印前尝试填充缺失的0。我现在很清楚，在打印时填充缺失的空白会更好。这对我帮助很大，感谢你找到了错误的代码。我很感激！最后一个问题可能很基本。你为我的$sp（@multiorg）工作与foreach不同的是，它是一样的？我习惯了'for'，对（$I=0；$Ifor
和
foreach
是一样的，是的。
foreach my $e (@IDS) {
    if ($e ne $la) {
        # print $e, "\n";
        $hashorganism{ $specie }{ $e } = 0;
    }
}

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