宝刀未老 | 写了一个 Ugly 的可能用于单细胞数据分析的脚本？！

写在前面

昨天傍晚，突然有个朋友联系到我，让帮忙写个 perl 脚本。想想是几年前认识的，后面也就基本没联系过了。那会我似乎是刚接手QQ社群“Bioinformatics中国”的管理。时间过得是真快。尽管确实没啥时间，我还是答应了，毕竟写个脚本嘛。

需求描述

有文本内容如下

0 401 61 111 121 171 191 201 311 382 42 52 62 102 312 384 64 104 314 385 65 386 126 176 206 316 388 189 139 239 3012 2015 2617 1917 2017 2517 3819 2019 2519 3119 38

其中每个数字按理是对应一个cluster，cluster和cluster有关联？或者overlap？就是一行，所以每行是两个数字。要求是把所有有之间关联或者间接关联的汇聚成一行。
Emmm，说的是perl脚本，但实际上我估计三年多来几乎没写过perl脚本。perl活在我的命令行one-liner世界。Anyway，我还是折腾折腾写了下。

脚本逻辑与具体实现

当时写了十来分钟，感觉快写完了，突然院楼就断电了。于是去打了会球，回来又折腾了大半个小时。原本是觉得挺简单的，不过还是花了一点时间。
整体实现逻辑简单

  1. 读取整个文件，每两个有直接联系的cluster，存储起来

  2. 遍历cluster，一旦发现可以合并的cluster，记录然后终止循环

  3. 合并cluster，回到第二步，直到无法发现还能继续合并的cluster

于是得到脚本如下

#!/usr/bin/perluse strict;my $usage = " perl $0 in.file out.file";my $in = shift;my $out = shift;die $usage unless $in and $out;open IN,'<',$in or die "Can't read input file $in\n";open OUT,'>',$out or die "Can't write into file $out\n";my @cluster;
while(<IN>){ s/[\r\n]+//; push @cluster,[split /\s+/,$_];}close IN;while(1){ my $mergeCluster_1; my $mergeCluster_2; LOOP:for my $out(@cluster){ my @out = @{$out}; for my $in(@cluster){ if($out == $in){ next; } my @in = @{$in}; for my $iter (@out){ if((grep {$iter == $_} @in)){ $mergeCluster_1 = $out; $mergeCluster_2 = $in; # print "Hit\n"; last LOOP; } } } } if($mergeCluster_1){ # and $mergeCluster_2 my @mergedCluster; my @updateCluster; for(@cluster){ if($_!=$mergeCluster_1 && $_!=$mergeCluster_2){ push @updateCluster,$_; }else{ push @mergedCluster,@{$_}; } } push @updateCluster,[@mergedCluster]; @cluster = @updateCluster; }else{ print "Finished...\n"; last; }}for(@cluster){ my %uniq; map {$uniq{$_}=1} @{$_}; print OUT join qq{\t},sort {$a<=>$b} keys %uniq; print OUT "\n";}

运行结果

0 408 1815 269 13 23 301 2 4 5 6 10 11 12 17 19 20 25 31 38

Emmm，我还是觉得我挺厉害的。

写在最后

啊，宝刀未老。不过整个实现跟perl没啥关系，基本是C-style。
想想，写这些脚本，真是没意思。

赞 (0)

相关推荐