Perlで複数のTSVファイルを第一カラムをキーにマージする
2012-01-13-1
[Programming]
複数のTSVファイルを第一カラムをキーにマージするタスクについて。プログラム言語はPerlを使う。
サンプルとして使うのは下記の3ファイル(スペース連続はタブ)。
一番簡単なのはハッシュに全部投げ込んで最後にまとめて出力する方法。ワンライナーでも書ける。
■コード(merge-tsv.pl):
■ワンライナー:
■実行結果:
しかし、ファイルがとてつもなく大きいとメモリ不足(Out of memory)になる場合がある。
そこで、メモリ不足にならないように、各ファイルはソート済み前提で、それぞれを頭から少しずつ読み込んでその場でマージして出力するという方法をとる。
■コード(merge-large-tsv.pl):
実行結果:
しかし今までに何度も同じような処理書いてるよなあ。巨大なテキストに対して分割で作った Suffix Arrays をマージするときにも書いたしなあ。
いくらハードが進歩したとはいえ、それにつれて扱うデータが巨大になっていくので、結局は貧乏プログラミング(ケチケチプログラミング、エコプログラミング)になっちゃうんだよね。いつまでたっても必要となる処理。
サンプルとして使うのは下記の3ファイル(スペース連続はタブ)。
==> a1.txt <== a b c d e f a ==> a2.txt <== a e b c d d a f b ==> a3.txt <== b c c a e f
一番簡単なのはハッシュに全部投げ込んで最後にまとめて出力する方法。ワンライナーでも書ける。
■コード(merge-tsv.pl):
#!/usr/bin/env perl use strict; use warnings; my %link; while (<>) { chomp; my ($key, @c) = split(/\t/, $_); foreach my $i (@c) { $link{$key}{$i} = 1; } } foreach my $key (sort keys %link) { print join("\t", $key, sort keys %{$link{$key}}), "\n"; }
■ワンライナー:
perl -nle '($k,@c)=split/\t/;for(@c){$h{$k}{$_}=1}; END{for(sort keys%h){print join("\t",$_,sort keys%{$h{$_}})}} ' a1.txt a2.txt a3.txt
■実行結果:
a b c e b c d c a d a e e f f a b
しかし、ファイルがとてつもなく大きいとメモリ不足(Out of memory)になる場合がある。
そこで、メモリ不足にならないように、各ファイルはソート済み前提で、それぞれを頭から少しずつ読み込んでその場でマージして出力するという方法をとる。
■コード(merge-large-tsv.pl):
#!/usr/bin/env perl use strict; use warnings; my @fns = @ARGV; my @fhs; my @lis; for (my $i = 0; $i < @fns; $i++) { open($fhs[$i], "<", $fns[$i]) or die; $lis[$i] = read_oneline($fhs[$i]); } while (1) { my @ixs = sort {$lis[$a]{key} cmp $lis[$b]{key}} 0..$#lis; my $ci = 0; for ($ci = 0; $ci < @ixs; $ci++) { last if $lis[$ixs[$ci]]{key} ne ""; } last if $ci == @lis; if (($ci == $#lis) or ($lis[$ixs[$ci]]{key} ne $lis[$ixs[$ci+1]]{key})) { print join("\t", $lis[$ixs[$ci]]{key}, @{$lis[$ixs[$ci]]{cont}})."\n"; } else { my %h; foreach my $i (@{$lis[$ixs[$ci]]{cont}}, @{$lis[$ixs[$ci+1]]{cont}}) { $h{$i} = 1; } $lis[$ixs[$ci+1]]{cont} = [sort keys %h]; } $lis[$ixs[$ci]] = read_oneline($fhs[$ixs[$ci]]); } for (my $i = 0; $i < @fhs; $i++) { close($fhs[$i]); } sub read_oneline { my ($fh) = @_; return {key => ""} if eof($fh); my $line = <$fh>; chomp $line; my ($key, @c) = split(/\t/, $line); return {key => $key, cont => \@c}; }
実行結果:
% ./merge-large-tsv.pl a1.txt a2.txt a3.txt a b c e b c d c a d a e e f f a b
しかし今までに何度も同じような処理書いてるよなあ。巨大なテキストに対して分割で作った Suffix Arrays をマージするときにも書いたしなあ。
いくらハードが進歩したとはいえ、それにつれて扱うデータが巨大になっていくので、結局は貧乏プログラミング(ケチケチプログラミング、エコプログラミング)になっちゃうんだよね。いつまでたっても必要となる処理。
参考
この記事に言及しているこのブログ内の記事