Perl работает над двумя хеш-ссылками - PullRequest
Новая
       8

Perl работает над двумя хеш-ссылками

0 голосов
/ 13 сентября 2011

Я хотел бы сравнить значения двух ссылок на хеш.Дампер данных моего первого хэша таков: 

$VAR1 = {
          '42-MG-BA' => [
                          {
                            'chromosome' => '19',
                            'position' => '35770059',
                            'genotype' => 'TC'
                          },
                          {
                            'chromosome' => '2',
                            'position' => '68019584',
                            'genotype' => 'G'
                          },
                          {
                            'chromosome' => '16',
                            'position' => '9561557',
                            'genotype' => 'G'
                          },

И второй хэш похож на этот, но с большим количеством хэшей в массиве.Я хотел бы сравнить генотип моего первого и второго хэша, если позиция и хоромосома совпадают. 

map {print "$_= $cave_snp_list->{$_}->[0]->{chromosome}\n"}sort keys %$cave_snp_list;
map {print "$_= $geno_seq_list->{$_}->[0]->{chromosome}\n"}sort keys %$geno_seq_list;

Я мог бы сделать это для первого массива хэшей.Не могли бы вы помочь мне, как работать со всеми массивами?

Это мой настоящий код в полном объеме 

#!/software/bin/perl

use strict;

use warnings;
use Getopt::Long;
use Benchmark;
use Config::Config qw(Sequenom.ini);
useDatabase::Conn;
use Data::Dumper;

GetOptions("sam=s" => \my $sample);

my $geno_seq_list = getseqgenotypes($sample);
my $cave_snp_list = getcavemansnpfile($sample);
#print Dumper($geno_seq_list);
print scalar %$geno_seq_list, "\n";

foreach my $sam (keys %{$geno_seq_list}) {

    my $seq_used  = $geno_seq_list->{$sam};
    my $cave_used = $cave_snp_list->{$sam};
    print scalar(@$geno_seq_list->{$_}) if sort keys %$geno_seq_list, "\n";
    print scalar(@$cave_used), "\n";
    #foreach my $seq2com (@ {$seq_used } ){
    #    foreach my $cave2com( @ {$cave_used} ){
    #       print $seq2com->{chromosome},":" ,$cave2com->{chromosome},"\n";
    #    }
    #}

    map { print "$_= $cave_snp_list->{$_}->[0]->{chromosome}\n" } sort keys %$cave_snp_list;
    map { print "$_= $geno_seq_list->{$_}->[0]->{chromosome}\n" } sort keys %$geno_seq_list;
}

sub getseqgenotypes {

    my $snpconn;
    my $gen_list = {};
    $snpconn = Database::Conn->new('live');
    $snpconn->addConnection(DBI->connect('dbi:Oracle:pssd.world', 'sn', 'ss', { RaiseError => 1, AutoCommit => 0 }),
        'pssd');

#my $conn2 =Database::Conn->new('live');
#$conn2->addConnection(DBI->connect('dbi:Oracle:COSI.world','nst_owner','nst_owner', {RaiseError =>1 , AutoCommit=>0}),'nst');
    my $id_ind = $snpconn->execute('snp::Sequenom::getIdIndforExomeSample', $sample);
    my $genotype = $snpconn->executeArrRef('snp::Sequenom::getGenotypeCallsPosition', $id_ind);
    foreach my $geno (@{$genotype}) {

        push @{ $gen_list->{ $geno->[1] } }, {

            chromosome => $geno->[2],
            position   => $geno->[3],
            genotype   => $geno->[4],
        };

    }

    return ($gen_list);
}    #end of sub getseqgenotypes

sub getcavemansnpfile {

    my $nstconn;
    my $caveman_list = {};
    $nstconn = Database::Conn->new('live');
    $nstconn->addConnection(
        DBI->connect('dbi:Oracle:CANP.world', 'nst_owner', 'NST_OWNER', { RaiseError => 1, AutoCommit => 0 }), 'nst');

    my $id_sample = $nstconn->execute('nst::Caveman::getSampleid', $sample);
    #print "IDSample: $id_sample\n";
    my $file_location = $nstconn->execute('nst::Caveman::getCaveManSNPSFile', $id_sample);

    open(SNPFILE, "<$file_location") || die "Error: Cannot open the file $file_location:$!\n";

    while (<SNPFILE>) {

        chomp;
        next if /^>/;
        my @data = split;
        my ($nor_geno, $tumor_geno) = split /\//, $data[5];
        # array of hash
        push @{ $caveman_list->{$sample} }, {

            chromosome => $data[0],
            position   => $data[1],
            genotype   => $nor_geno,

        };

    }    #end of while loop
    close(SNPFILE);
    return ($caveman_list);
}

1 Ответ

0 голосов
/ 13 сентября 2011

Проблема, которую я вижу, состоит в том, что вы создаете дерево для общего хранения данных, когда вам нужен график, специфичный для задачи. Пока вы создаете запись, вы также можете создавать часть, которая группирует данные. Ниже приведен только один пример. 

my %genotype_for;
my $record
    = { chromosome => $data[0]
      , position   => $data[1]
      , genotype   => $nor_geno
    };
push @{ $gen_list->{ $geno->[1] } }, $record; 

# $genotype_for{ position }{ chromosome }{ name of array } = genotype code
$genotype_for{ $data[1] }{ $data[0] }{ $sample } = $nor_geno;

...
return ( $caveman_list, \%genotype_for );

В основной строке вы получаете их так: 

my ( $cave_snp_list, $geno_lookup ) = getcavemansnpfile( $sample );

Этот подход, по крайней мере, позволяет вам найти похожие позиции и значения хромосом. Если вы собираетесь сделать с этим многое, я мог бы предложить подход ОО.

Обновление

Предполагая, что вам не нужно хранить метку, мы можем изменить поиск на 

$genotype_for{ $data[1] }{ $data[0] } = $nor_geno;

И тогда сравнение можно записать: 

foreach my $pos ( keys %$small_lookup ) { 
    next unless _HASH( my $sh = $small_lookup->{ $pos } )
            and _HASH( my $lh = $large_lookup->{ $pos } )
            ;
    foreach my $chrom ( keys %$sh ) { 
        next unless my $sc = $sh->{ $chrom }
               and  my $lc = $lh->{ $chrom }
               ;
        print "$sc:$sc";
    }
}

Однако, если у вас было ограниченное использование для большого списка, вы могли бы построить конкретный случай и передать это как фильтр при создании более длинного списка.

Таким образом, в любом цикле, создающем более длинный список, вы можете просто пойти 

...
next unless $sample{ $position }{ $chromosome };
my $record
    = { chromosome => $chromosome
      , position   => $position
      , genotype   => $genotype
    };
...
...