[交流] perl程序继续中，脸红贴上自写程序，求拍砖。已有2人参与

[code]、

#!/usr/bin/perl -w

unless (@ARGV) {
  die "Arguments not enough!";
}

$doc1 = $ARGV[0];
$doc2 = $ARGV[1];
undef %string;
open(DOC2,"$doc2") || die "Cannot open this file!$!";
while() {
  next if(/^\n/);
  chomp;
  
  @array = split /\t/;
  $string{$array[0],2} = $array[1];
  $string{$array[1],3} = $array[2];
  $string{$array[1],4} = $array[3];
}
close DOC2;


open(DOC1,"$doc1") || die "Cannot open this file!$!";
$out = "output";
open(OUT,">$out") || die "Cannot write to this file!$!";
while() {

  chomp;
  @array = split /\t/;
  print $array[2],"=>",&isPureDigit($array[2]),"\n";
  $mark = 0;
  foreach $i(1 .. 3) {
    if(&isPureDigit($array[$i]) && defined $string{$array[$i],2}) {
      if($i == 1) { $mark = 1; }
      $array[$i] = $string{$array[$i],2};
    }
  }
  foreach (@array) {
    print OUT "$_\t";
  }
  if($mark == 1) {
    print OUT "$string{$array[1],3}\t\t\t\t$string{$array[1],4}";
  }
  print OUT "\n";

}

close DOC1;
close OUT;

sub isPureDigit {
  $arg = shift;
  if($arg =~ /^NA/) {
    return 0;
  } else {
    return 1;
  }  
}

3楼: Originally posted by jackie1179 at 2012-07-10 10:42:40
给你写了个，希望能帮到你，另外你有一点说的不是很清楚，如果Doc1的第二列在Doc2中未匹配，而其他列有匹配，要在其后补充吗？本代码不进行补充。

#!/usr/bin/perl -w

unless (@ARGV) {
  die "Argumen ...