免费注册 查看新帖 |

Chinaunix

  平台 论坛 博客 文库
123下一页
最近访问板块 发新帖
查看: 7811 | 回复: 22

请教perl高手 [复制链接]

论坛徽章:
0
发表于 2014-06-16 21:42 |显示全部楼层
请教perl高手一个较为复杂的列合并

总体目标:合并file1.txt file1.rar (232 Bytes, 下载次数: 160)

论坛徽章:
8
技术图书徽章
日期:2013-08-22 11:21:28未羊
日期:2015-01-19 22:22:25巳蛇
日期:2014-08-11 16:53:08子鼠
日期:2014-05-29 09:04:44摩羯座
日期:2014-04-11 14:15:07丑牛
日期:2014-01-24 12:41:28金牛座
日期:2013-11-21 17:38:28射手座
日期:2015-01-21 08:50:32
发表于 2014-06-16 23:49 |显示全部楼层
本帖最后由 huang6894 于 2014-06-17 10:50 编辑

求并集?
建议楼主搜一搜吧,挺简单的。。。


占楼~

24k菜鸟的方法{:3_195:} 弄了四个hash去做,不好意思了~:
  1. my (%hash,%h1,%h2,%h2_1);

  2. $file1 =  $ARGV[0];
  3. $file2 =  $ARGV[1];

  4. while (<>) {
  5.         chomp;
  6.         my @h = split(/\t/);
  7.         my ($k1,$k2,$k3,$k4,@v) = @h[0,1,2,3,4 .. $#h];
  8.         map{$hash{"$k1\t$k2\t$k3\t$k4"} .= "$_\t"}@v;
  9. }
  10. my @merge = keys (%hash);
  11. open F1, "< $file1" or die "$!";
  12. open F2, "< $file2" or die "$!";
  13. while(<F1>){
  14.         chomp;
  15.         my @h = split(/\t/);
  16.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
  17.         my $t = "0\t" x ($#h-3);
  18.         $t =~  s/\t$//;
  19.         $h1{"$k1\t$k2\t$k3\t$k4"} = 1;
  20.         $h2_1{"not_exit_file1"} = $t;
  21. }
  22. close F1;
  23. while(<F2>){
  24.         chomp;
  25.         my @h = split(/\t/);
  26.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
  27.         my $t = "0\t" x ($#h-3);
  28.         $t =~  s/\t$//;
  29.         $h2{"$k1\t$k2\t$k3\t$k4"} = 1;
  30.         $h2_1{"not_exit_file2"} = $t;
  31. }
  32. close F2;
  33. my @f1 = keys (%h1);
  34. my @f2 = keys (%h2);
  35. for $i (grep {!$h1{$_}} @merge){
  36.         print "$i\t$hash{$i}$h2_1{not_exit_file1}\n";
  37. }
  38. for $i (grep {!$h2{$_}} @merge){
  39.         chop $hash{$i};
  40.         print "$i\t$h2_1{not_exit_file2}\t$hash{$i}\n";
  41. }
  42. for $i (grep {$h1{$_}} @f2){
  43.         chop $hash{$i};
  44.         print "$i\t$hash{$i}\n";
  45. }
复制代码

论坛徽章:
6
丑牛
日期:2014-03-21 15:42:04子鼠
日期:2014-04-12 11:50:17处女座
日期:2014-09-01 09:25:1115-16赛季CBA联赛之吉林
日期:2015-12-22 14:01:5215-16赛季CBA联赛之广东
日期:2016-03-08 18:49:422016科比退役纪念章
日期:2016-07-06 12:19:55
发表于 2014-06-17 00:15 |显示全部楼层
本帖最后由 stanley_tam 于 2014-06-17 00:20 编辑

偶试试,貌似把所有空的都弄成0了。不知道行不行。。。{:3_193:}
  1. #!perl
  2. use Modern::Perl;

  3. sub _get_fh;

  4. my $data_in_txt_href = +{};
  5. my @headers = ();

  6. # get the data
  7. for my $file ('file1.txt', 'file2.txt'){
  8.     my $fh = _get_fh({file => $file, mode => '<'});

  9.     my $header = readline $fh;
  10.     chomp $header;
  11.     my @header_parts = split /\t/, $header;

  12.     push @headers, @header_parts[4 .. $#header_parts];

  13.     while (my $line = readline $fh) {
  14.         chomp $line;
  15.         my @parts     = split /\t/, $line;
  16.         my $first4col = join "\t", @parts[0 .. 3];

  17.         for my $item (4 .. $#header_parts){
  18.             $data_in_txt_href->{$first4col}->{ $header_parts[$item] } = $parts[$item] || 0;
  19.         }
  20.     }
  21.     close $fh;
  22. }

  23. # output the data
  24. my $out_fh = _get_fh({file => 'file_out.txt', mode => '>'});
  25. say {$out_fh} join "\t", ('chrom', 'start', 'end', 'strand', @headers);

  26. for my $first4col ( sort keys %{$data_in_txt_href} ){
  27.     my $out_line = $first4col;

  28.     for my $head_item (@headers){
  29.         my $item_value = $data_in_txt_href->{$first4col}->{$head_item} || 0;
  30.         $out_line .= "\t$item_value";
  31.     }

  32.     say {$out_fh} $out_line;
  33. }

  34. close $out_fh;
  35. say "Done, cost @{[time - $^T]} seconds, press <ENTER> to exit.";
  36. <STDIN>;


  37. sub _get_fh {
  38.     my $param = shift;
  39.     my $file = $param->{file};
  40.     my $mode = $param->{mode};
  41.     open my $fh, $mode, $file or
  42.         die "Fail to open file $file:$!\n";
  43.     return $fh;
  44. }

  45. __END__
复制代码

论坛徽章:
0
发表于 2014-06-17 07:36 |显示全部楼层
回复 3# stanley_tam

谢谢stanley兄弟,能实现。Modern Perl !   

论坛徽章:
0
发表于 2014-06-17 12:17 |显示全部楼层
回复 2# huang6894
非常感谢兄弟!我去测试下。

stanley兄的代码如果file2.txt中的header名称与file1.txt的header名称有重复的话会有点问题。




   

论坛徽章:
0
发表于 2014-06-17 12:30 |显示全部楼层
回复 2# huang6894

谢谢黄兄,经测试发现代码处理标题行有点问题,标题行会移到文件中去,另外,没有匹配1-4列时,插入0的位置不对。呵呵,多谢多谢!
   

论坛徽章:
8
技术图书徽章
日期:2013-08-22 11:21:28未羊
日期:2015-01-19 22:22:25巳蛇
日期:2014-08-11 16:53:08子鼠
日期:2014-05-29 09:04:44摩羯座
日期:2014-04-11 14:15:07丑牛
日期:2014-01-24 12:41:28金牛座
日期:2013-11-21 17:38:28射手座
日期:2015-01-21 08:50:32
发表于 2014-06-17 12:37 |显示全部楼层
回复 6# owwa


    well~这只是一个思路,关于标题行。。你把44-47行和37-39行换个位置就好了

论坛徽章:
0
发表于 2014-06-17 12:49 |显示全部楼层
回复 7# huang6894

多谢多谢,换行后还是没在header的位置,一时没看明白。
   

论坛徽章:
8
技术图书徽章
日期:2013-08-22 11:21:28未羊
日期:2015-01-19 22:22:25巳蛇
日期:2014-08-11 16:53:08子鼠
日期:2014-05-29 09:04:44摩羯座
日期:2014-04-11 14:15:07丑牛
日期:2014-01-24 12:41:28金牛座
日期:2013-11-21 17:38:28射手座
日期:2015-01-21 08:50:32
发表于 2014-06-17 12:59 |显示全部楼层
本帖最后由 huang6894 于 2014-06-17 12:59 编辑

回复 8# owwa

  1. ===》 perl map5.pl file1.txt file2.txt
  2. chrom   chromstart      chromend        strand  a1      a2      b1      b2      c1      c2      d1      d2      e1      e2      f1      f2      o1      o2  p1       p2      q1      q2
  3. chr1    363     364     -       0       10      0       7       0       8       0       3       0.1     10      0       27      0       21      0       11  08
  4. chr1    33      34      +       0       3       0       20      0       4               0       0.11    9               0       0       1       0       1   017
  5. chr1    231     232     +       0       3       0       21      0       4               0       0.11    9               0       0       1       0       2   020
  6. chr1    210     211     +       0       3       0       21      0       4               0       0.11    9               0       0       1       0       2   020
  7. chr1    13      14      +       0       3       0.06    18      0.33    3               0       0.11    9               0       0       1       0       2   0.05     19
  8. chr1    217     218     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   023
  9. chr1    211     212     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   0.09     23
  10. chr1    232     233     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   024
  11. chr1    34      35      -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   024
  12. chr1    253     254     -       0       0       0       0       0       0       0       0       0       0       0       0               0       0       1   023
  13. chr1    216     217     +       0       3       0       21      0       4               0       0.11    9               0       0       0       0       0   00
  14. chr1    212     213     +       0       3       0       21      0       4               0       0.11    9               0       0       0       0       0   00

  15. ===》cat map5.pl
  16. #########################################################################
  17. #! /usr/bin/perl -w
  18. # File Name: map5.pl
  19. # Created Time: 2014年06月17日 星期二 10时46分35秒
  20. ##    ┏┓        ┏┓
  21. ##    ┏┛┻━━━━━━━━━┛┻┓
  22. ##    ┃          ┃
  23. ##    ┃    ━   ┃
  24. ##    ┃  ┳┛  ┗┳   ┃
  25. ##    ┃       ┃
  26. ##    ┃ **  ┻  ** ┃
  27. ##    ┃       ┃
  28. ##    ┗━┓       ┏━┛
  29. ##    ┃      ┃
  30. ##     ┃      ┃
  31. ##    ┃      ┗━━━┓
  32. ##    ┃       ┣┓
  33. ##     ┃       ┏┛
  34. ##     ┗┓┓┏━━━━━━━┳┓┏┛
  35. ##     ┃┫┫      ┃┫┫
  36. ##     ┗┻┛      ┗┻┛
  37. ## ━━━━━━神兽保佑,代码无bug━━━━━━
  38. ## Code is far away from bug with the animal protecting.
  39. #########################################################################
  40. my (%hash,%h1,%h2,%h2_1);

  41. $file1 =  $ARGV[0];
  42. $file2 =  $ARGV[1];

  43. while (<>) {
  44.         chomp;
  45.         my @h = split(/\t/);
  46.         my ($k1,$k2,$k3,$k4,@v) = @h[0,1,2,3,4 .. $#h];
  47.         map{$hash{"$k1\t$k2\t$k3\t$k4"} .= "$_\t"}@v;
  48. #       print "$k1\t$k2\t$k3\t$k4\t".$hash{"$k1\t$k2\t$k3\t$k4"}."\n";
  49. }
  50. my @merge = keys (%hash);
  51. open F1, "< $file1" or die "$!";
  52. open F2, "< $file2" or die "$!";
  53. while(<F1>){
  54.         chomp;
  55.         my @h = split(/\t/);
  56.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
  57.         my $t = "0\t" x ($#h-3);
  58.         $t =~  s/\t$//;
  59.         $h1{"$k1\t$k2\t$k3\t$k4"} = 1;
  60.         $h2_1{"not_exit_file1"} = $t;
  61. }
  62. close F1;
  63. while(<F2>){
  64.         chomp;
  65.         my @h = split(/\t/);
  66.         my ($k1,$k2,$k3,$k4) = @h[0,1,2,3];
  67.         my $t = "0\t" x ($#h-3);
  68.         $t =~  s/\t$//;
  69.         $h2{"$k1\t$k2\t$k3\t$k4"} = 1;
  70.         $h2_1{"not_exit_file2"} = $t;
  71. }
  72. close F2;
  73. my @f1 = keys (%h1);
  74. my @f2 = keys (%h2);
  75. for $i (grep {$h1{$_}} @f2){
  76.         chop $hash{$i};
  77.         print "$i\t$hash{$i}\n";
  78. }

  79. for $i (grep {!$h1{$_}} @merge){
  80.         chop $hash{$i};
  81.         print "$i\t$h2_1{not_exit_file1}\t$hash{$i}\n";
  82. }
  83. for $i (grep {!$h2{$_}} @merge){
  84.         chop $hash{$i};
  85.         print "$i\t$hash{$i}\t$h2_1{not_exit_file2}\n";
  86. }

复制代码

论坛徽章:
0
发表于 2014-06-17 13:15 |显示全部楼层
回复 9# huang6894

非常感谢黄兄!奇怪的是我这里标题行总是在第二行。


   
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年举报专区
中国互联网协会会员  联系我们:huangweiwei@itpub.net
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP