たつをの ChangeLog : 2012-01-13

複数のTSVファイルを第一カラムをキーにマージするタスクについて。プログラム言語はPerlを使う。

サンプルとして使うのは下記の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 をマージするときにも書いたしなあ。

いくらハードが進歩したとはいえ、それにつれて扱うデータが巨大になっていくので、結局は貧乏プログラミング（ケチケチプログラミング、エコプログラミング）になっちゃうんだよね。いつまでたっても必要となる処理。

参考

• 富豪的プログラミング
  http://www.pitecan.com/fugo.html
• エコプログラミング
  http://ta2o.net/doc/zb/0017.html
• その場しのぎプログラミング[2003-12-09-3]

今週の平日のランチの記録。



■1/5（木） お弁当

社内売り弁当。580円。

■1/6（金） しゃぶしゃぶ

豚組しゃぶ庵でランチ豚しゃぶお年玉セット！ 1200円。


■1/10（火） ラーメン

めんや 参◯伍[2010-03-26-2]で参◯伍郎らーめん。

■1/11（水） お弁当

社内売り弁当。ロコモコ丼。

■1/12（木） ハンバーガー

バーガーキングでワッパー！

■1/13（金） うどん

宮武讃岐製麺所[2010-02-02-5]でぶっかけうどん。