Perl：比较 2 个哈希的键并打印最接近的键之间的差异

Question

更新（2013 年 16 月 1 日）

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

同样，对于 File1 中的特定值，File2 中不存在 更大 值（但 更小 值）

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

更新（2013 年 15 月 1 日）

我已经更新了所需的输出，以解决 File1 中的值匹配 File2 中的值的情况。感谢 Borodin 指出这种情况。

---

我有 2 个文件，如下所示：

文件1

 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中最接近的值是9250和11017。现在需要计算差异，即 9250 - 10227 = -977 和 11017 - 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 中所有值的差异。与447989 和535682 类似。 如何阻止这种情况并仅找到最接近的数字之间的差异，一个是 >10227，另一个是 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;

感谢您抽出宝贵时间解决问题。我将不胜感激任何评论/回答。

Answer 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的记录，使用List::Util的first函数得到结果。

first函数被使用了两次：一次，获取当前值的第一个最大值，第二次：获取当前值的最后一个最小值，这是通过在@987654330上使用first获得的@sorted 数组。

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

first{$_ > $v}@{$h1{$k}} => 这将获取数组中大于当前数字的第一个数字。说为 10227，先返回 11017。

接下来需要的是 10227 之前的最后一个最小数字。为了得到这个，第一个函数应用于反向数组。

first{$_ < $v}reverse @{$h1{$k}} => 这将返回小于 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

Answer 2

首先，我们读入第二个文件并将值放入一个数组。我进一步假设这个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

Answer 3

在这里散列不是一个好的选择，因为从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