Perl:比较2个哈希的键和打印最近的键之间的差异

时间:2013-01-14 08:50:58

标签: perl hash bioinformatics

UPDATE(16/1/13)

鲍罗丁指出了另一种我完全忽略的可能性 在实际文件中(我手动坐着并开始查看46个文件,每个文件大约10MB),有些情况下 File1 中的特定值,没有 File2 中存在较小的值(但更大的值)。

同样存在 File1 中的特定值, File2 中不存在更大值的情况(但较小< / em>值确实)

我在这里更新示例文件和所需的输出以反映此更新。

更新(15/1/13)

我已更新了所需的输出,以说明 File1 中的值与 File2 中的值匹配的情况。感谢Borodin指出这样的情景。


我有2个文件,如下所示:

File1中

 chr1   10227  
 chr1   447989  
 chr1   535362
 chr1   856788
chr1    249240496

文件2

chr1    11017
chr1    11068
chr1    23525
chr1    439583
chr1    454089
chr1    460017
chr1    544711
chr1    546239
chr1    856788
chr1    249213429
chr1    249214499
chr1    249239072

我需要做的是 file1 中的foreach值,例如。 10227,从 file2 中找到最接近的两个值。其中一个值会更大,另一个更小。 因此,在 file1 中取10227 file2 中最接近的值为925011017。现在需要计算差异,9250 - 10227 = -97711017 - 10227 = 790,以提供如下输出(制表符分隔):

所需输出

chr1   10227   No   790   No Match
chr1   447989  No   6100  -8406
chr1   535362  No   9349  -75345
chr1   856788  Yes  
chr1   249240496 No No Match -25997

我认为最快的方法是使用哈希来读取2个文件,将数字设为keys并将1指定为值。

到目前为止,我编写的代码给出了10227 file2 中所有值的差异。与447989535682类似。 如何停止此操作并找到最接近的数字的区别,一个是&gt; 10227,另一个是&lt; 10227

代码

use 5.014;
use warnings;

#code to enter lsdpeak and pg4 data into hash with KEYS as the numerical values, VALUE as 1

#Assign filename
my $file1 = 'lsdpeakmid.txt';
my $file2 = 'pg4mid.txt';

#Open file
open my $fh1, '<', $file1 or die $!;
open my $fh2, '<', $file2 or die $!;

#Read in file linewise
my %hash1;
while(<$fh1>){

    my $key1 = (split)[1];
    $hash1{$key1} = 1;

}


    my %hash2;
    while(<$fh2>){
        my $key2 = (split)[1];

    }


foreach my $key1 (sort keys %hash1){

    foreach my $key2 (sort keys %hash2){

    say $key2-$key1;

    }

}

#Exit
exit;

感谢您抽出宝贵时间解决问题。我会很感激任何评论/答案。

3 个答案:

答案 0 :(得分:2)

哈希在这里不是一个好选择,因为从file2中找到正确边界的唯一方法是搜索值列表,并且哈希不利于此。

此程序的工作原理是将file2的所有边界放入数组@boundaries,然后在此数组中搜索从file1读取的每个值,以找到第一个边界值更大。然后,这个和前面的边界是必需的,并且算术在print语句中完成。

请注意,如果file2包含匹配的边界,或者没有大于或小于给定值的边界,则此代码会出现问题。

use strict;
use warnings;

use Data::Dump;

my $file1 = 'lsdpeakmid.txt';
my $file2 = 'pg4mid.txt';

my @boundaries = do {
  open my $fh, '<', $file2 or die $!;
  map { (split)[1] } <$fh>;
};

open my $fh, '<', $file1 or die $!;

while (my $line = <$fh>) {
  chomp $line;
  my @vals = split ' ', $line;
  my $val = $vals[-1];
  for my $i (1 .. $#boundaries) {
    if ($boundaries[$i] > $val) {
      print join(' ', @vals, $boundaries[$i] - $val, $boundaries[$i-1] - $val), "\n";
      last;
    }
  }
}

<强>输出

chr1 10227 790 -977
chr1 447989 6100 -8406
chr1 535362 9349 -75345

答案 1 :(得分:1)

一种方式:

#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw(first);

open my $fh1,'<','file1' or die $!;
open my $fh2,'<','file2' or die $!;
my %h1;

while(<$fh2>){
        chomp;
        my ($k,$v)=split(/\s+/);
        push @{$h1{$k}}, $v;
}
close $fh2;

while (<$fh1>){
        chomp;
        my ($k, $v)=split(/\s+/);
        my $bef=first{$_ >= $v}@{$h1{$k}};
        $bef=defined $bef?$bef-$v:"No match";
        my $aft=first{$_ <= $v}reverse @{$h1{$k}};
        $aft=defined $aft?$aft-$v:"No match";
        my $str=sprintf("%-8s %-10d %-5s %-8s %-8s",$k, $v,$bef?"No":"Yes",$bef?$bef:"",$aft?$aft:"");
        print $str, "\n";
}
close $fh1;

第一个while循环读取第二个文件并创建一个散列,其中键为chr1,值为包含chr1所有值的数组引用。

foreach块按数字顺序对所有键进行排序。   第二个while循环处理file1的记录,并使用first List::Util函数来获取结果。

first函数使用两次:一次,获取第一个最大值而不是当前值,第二个:获取最后一个最小值,而不是使用first获得的当前值在reverse sort ed数组上。

第一个功能: 第一个函数返回满足条件的数组中的第一个数字。

first{$_ > $v}@{$h1{$k}} =&gt;这将获得数组中第一个大于当前数字的数字。比如说10227,首先会返回11017。

接下来需要的是10227之前的最后一个最小数。为此,第一个函数应用于反向数组。

first{$_ < $v}reverse @{$h1{$k}} =&gt;这将返回第一个小于10227的数字,并且由于数组反转,我们得到的实际上是10227之前的最后一个最小数字,即9250。

在运行时:

chr1     10227      No    790      No match
chr1     447989     No    6100     -8406
chr1     535362     No    9349     -75345
chr1     856788     Yes
chr1     249240496  No    No match -1424

答案 2 :(得分:1)

首先,我们读入第二个文件并将值放入数组。我进一步假设这个chr1是常量,可以安全地丢弃:

#!/usr/bin/perl
use strict; use warnings;
my @file2;
open my $fh2, "<", "file2" or die $!;
while (<$fh2>) {
  my (undef, $num) = split;
  die "the number contains illegal characters" if $num =~ /\D/;
  push @file2, $num;
}
@file2 = sort {$a <=> $b} @file2; # sort ascending
# remove previous line if sorting is already guaranteed.

然后,我们定义一个sub来在我们的数组中找到两个值。它只是基本算法的一种变体,用于在排序列表中找到某个值(在 O(log n)中),并且应该比在每个值上迭代更好,至少在大集合上。此外,它不需要为每个值反转整个列表。

sub find {
  my ($num, $arrayref) = @_;

  # exit if array is too small
  return unless @$arrayref >= 2;
  # exit if $num is outside the values of this array (-1 is last element)
  return if $num <= $arrayref->[0] or $arrayref->[-1] < $num;

   my ($lo, $hi) = (1, $#$arrayref);
  my $i = int(($lo+$hi)/2); # start in the middle

  # iterate until
  #   a) the previous index contains a number that is smaller than $num and
  #   b) the current index contains a number that is greater or equal to $num.
  until($arrayref->[$i-1] < $num and $num <= $arrayref->[$i]) {
    # make $i the next lower or upper bound.
    # instead of going into an infinite loop (which would happen if we
    # assign $i to a variable that already holds the same value), we discard
    # the value and move on towards the middle.
          # $i is too small
    if    ($num >  $arrayref->[$i]  ) { $lo = ($lo == $i ? $i+1 : $i) }
          # $i is too large
    elsif ($num <= $arrayref->[$i-1]) { $hi = ($hi == $i ? $i-1 : $i) }
          # in case I made an error:
    else                              { die "illegal state" }
    # calculate the next index
    $i  = int(($lo+$hi)/2);
  }
  return @{$arrayref}[$i-1, $i];
}

其余的都是微不足道的:

open my $fh1, "<", "file1" or die $!;
while (<$fh1>) {
  my ($chr, $num) = split;
  die "the number contains illegal characters" if $num =~ /\D/;
  if (my ($lo, $hi) = find($num, \@file2)) {
    if ($hi == $num) {
      print join("\t", $chr, $num, "Yes"), "\n";
    } else {
      print join("\t", $chr, $num, "No", $hi-$num, $lo-$num), "\n";
    }
  } else {
    # no matching numbers were found in file 2
    print join("\t", $chr, $num, "No-match"), "\n";
  }
}

输出:

chr1    10227   No      790     -977                                                            
chr1    447989  No      6100    -8406                                                           
chr1    535362  No      9349    -75345                                                          
chr1    856788  Yes