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的sp n / A n 组合。这是一个简单代码的演示，它将执行相同的操作。我在代码中添加了注释来解释 - 显然你的生产代码中不需要它们，所以随意删除它们！

#!/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的$specie数据归零。理想情况下，您应该检查$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

将哈希值打印为矩阵

2 个答案: