1

更新（16/1/13）

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

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

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

更新（13 年 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中 找到最接近的两个值。其中一个值会更大，而另一个值会更小。因此，考虑file110227 ，在file2中最接近的值是和。现在需要计算差异，即=和=给出如下输出（制表符分隔）：9250110179250 - 10227-97711017 - 10227790

期望的输出

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。

到目前为止，我编写的代码给出了file210227中所有值的差异。与和类似。我该如何阻止这种情况并仅找到最接近的数字之间的差异，一个是 > ，一个是 <4479895356821022710227

代码

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;

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

4

3 回答 3

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
于 2013-01-14T11:50:01.223 回答
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函数使用了两次：一次，获取当前值的第一个最大值，第二次：获取当前值的最后一个最小值，该值是通过使用firstedreverse sort数组获得的。

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

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
于 2013-01-14T09:15:02.373 回答
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
于 2013-01-14T11:08:02.723 回答