[を]CHALOW Search: Suffix Array

たつをの ChangeLog

26 件見つかりました。

1 2 3 4 5 6 [ 次へ ]

テキストから辞書にある文字列をすべて取り出す簡単なプログラム (Perl + SUFARY.pm(suffix arrays))

https://chalow.net/2014-05-12-1.html
テキストから辞書にある文字列をすべて取り出す簡単なプログラム (Perl + SUFARY.pm(suffix arrays))[Programming][NLP] 「テキストから辞書にある文字列をすべて取り出す簡単なプログラム (Pure Perl)」[2014-05-09-1]の話の続きです。事情により Pure Perl で書きましたが、今回は SUFARY.pm (suffix arrays) を使ったバージョン。suffix arrays による擬似 TRIE です。結論から言うと、手元の実験環境においては Pure Perl 版よりも 3.5 倍も時間がかかっています。実装がアレなのかもしれませんが、まあたいていの場合は Pure Perl 版で OK ということで。■実験：- 辞書とテキスト-- 辞書：2万3千エントリ（平均文字列長4）-- テキスト：2500行（平均文字列長71）- 実行速度（3回平均）-- Pure Perl 版：2.3秒-- SUFARY.pm 版：8.2秒■コード (fesa.pl)：#!/usr/bin/perluse strict;use warnings;use Encode;use utf8;use open ':utf8';binmode STDIN, ':utf8';binmode STDOUT, ':utf8';use SUFARY;use Getopt::Long;my $answer_mode = 0; # input with answer?my $debug_mode = 0;GetOptions ( "answer" => \$answer_mode, 'debug' => \$debug_mode, );my $wordset_fn = shift;my $sa = SUFARY->new($wordset_fn);while (<>) { print "[INPUT] $_" if $debug_mode; chomp; $_ = Encode::decode_utf8($_) if not utf8::is_utf8($_); my $ans = ($_ =~ s/^((.+?)\t)//) ? $2 : "" if $answer_mode; my @c = split(//, $_); my %m; for (my $i = 0; $i < @c; $i++) { my $key;my ($left, $right) = (0, $sa->{'arraysize'}-1); for (my $j = $i; $j < @c; $j++) { $key .= $c[$j]; my $ekey = Encode::encode('utf8', $key); ($left, $right) = $sa->range_search($ekey, $left, $right); last if not defined $left and not defined $right; my ($l, $r) = $sa->range_search($ekey."\t", $left, $right); next if not defined $left and not defined $right; if ($r - $l >= 0) { my $li = $sa->get_position($l); my $s = Encode::decode_utf8($sa->get_line($li)); my ($k, $v) = $s =~ /^(.+)\t(.+)$/; print "[MATCH] $k ($v)\n" if $debug_mode; $m{$v}++; } } } print "$ans "if $answer_mode; print join(" ", map {"$_:$m{$_}"} sort {$a <=> $b} keys %m)."\n";# print join(" ", map {"$_:1"} sort {$a <=> $b} keys %m)."\n";}■実行例：辞書とテキストは前回[2014-05-09-1]と同じ。% mkary -l -q fepp-dic.txt% ./fesa.pl -a fepp-dic.txt < fepp-test.txt1 1:1 2:1 3:10 2:1 3:1 4:11 5:1 6:1 7:1 8:10 7:1 9:1

Perlで複数のTSVファイルを第一カラムをキーにマージする

https://chalow.net/2012-01-13-1.html
Perlで複数のTSVファイルを第一カラムをキーにマージする[Programming] 複数のTSVファイルを第一カラムをキーにマージするタスクについて。プログラム言語はPerlを使う。サンプルとして使うのは下記の3ファイル（スペース連続はタブ）。==> a1.txt <==a b cd ef a==> a2.txt <==a eb c dd af b==> a3.txt <==b cc ae f一番簡単なのはハッシュに全部投げ込んで最後にまとめて出力する方法。ワンライナーでも書ける。■コード(merge-tsv.pl)：#!/usr/bin/env perluse 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 eb c dc ad a ee ff a bしかし、ファイルがとてつもなく大きいとメモリ不足(Out of memory)になる場合がある。そこで、メモリ不足にならないように、各ファイルはソート済み前提で、それぞれを頭から少しずつ読み込んでその場でマージして出力するという方法をとる。■コード(merge-large-tsv.pl)：#!/usr/bin/env perluse 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.txta b c eb c dc ad a ee ff a bしかし今までに何度も同じような処理書いてるよなあ。巨大なテキストに対して分割で作った Suffix Arrays をマージするときにも書いたしなあ。いくらハードが進歩したとはいえ、それにつれて扱うデータが巨大になっていくので、結局は貧乏プログラミング（ケチケチプログラミング、エコプログラミング）になっちゃうんだよね。いつまでたっても必要となる処理。参考富豪的プログラミングhttp://www.pitecan.com/fugo.htmlエコプログラミングhttp://ta2o.net/doc/zb/0017.htmlその場しのぎプログラミング[2003-12-09-3]

sang.pl - Suffix Array を用いて N-gram 統計をとるプログラム

https://chalow.net/2010-06-21-1.html
sang.pl - Suffix Array を用いて N-gram 統計をとるプログラム[Programming] SUFARY に付属している sang というプログラムの Perl 版「sang.pl」を作りました。オリジナルCコード(sang.c)に書いてある説明を改変して載せておきます。使い方は同じです。sang.pl --- Suffix Array を用いて N-gram 統計をとるプログラムUSAGE sang.pl -n NUM -t NUM FILENAMEOPTION-n NUM : NUM で n-gram の n を指定する。-t NUM : threshold: NUM以下の頻度のものは表示しないn-gram には改行は含まれない。[実行例]% cat testABCBACABBAACABCABCACABACABBACBACACAAABACCAB% makeary -q test ● arrayファイルの作成% sang -n 6 -t 1 test ● 6-gram で頻度が 1 より大きいものを表示2 ACABBA2 BACABB% ./sang.pl -n 3 -t 4 test ● trigram で頻度が 4 より大きいものを表示6 ACA5 BAC6 CAB■コード(sang.pl)：#!/usr/bin/perluse strict;use warnings;use SUFARY;use Encode;use Getopt::Std;use utf8;use open ':utf8';binmode STDOUT, ":utf8";my %opts = ();getopts("n:t:", \%opts);my $ng = $opts{n} || 4;my $threshold = $opts{t} || 3;my $fn = shift @ARGV;my $sa = SUFARY->new($fn);my $n_ctr = 0;my @ktoks = ();for (my $i = 0; $i < $sa->{arraysize}; $i++) { my $pos = $sa->get_position($i); my ($from, $len) = $sa->get_line_info($pos); my $s = $sa->get_string($pos, $from + $len - $pos); $s =~ s/^([^\n]+)\n.*$/$1/; my @ttoks = map {Encode::decode_utf8($_)} ($s =~ m{([\x00-\x7f]|[\xC0-\xDF][\x80-\xBF]| [\xE0-\xEF][\x80-\xBF]{2}|[\xF0-\xF7][\x80-\xBF]{3})}gsx); if (cmp_tok(\@ktoks, \@ttoks) >= $ng) { $n_ctr++; } else { output(); $n_ctr = 1; } @ktoks = @ttoks;}output() if $n_ctr >= 1;sub output { return if $n_ctr <= $threshold; print "$n_ctr ".join("", @ktoks[0..($ng-1)])."\n";}sub cmp_tok { my ($k_ref, $t_ref) = @_; my $i; for ($i = 0; $i < @$k_ref and $i < @$t_ref; $i++) { last if $k_ref->[$i] ne $t_ref->[$i]; } return $i;}■実行例：インデックス作成。対象ファイルは utf-8。mkipu8.pl[2007-06-10-3]を使う。% ./mkipu8.pl a.txt > a.txt.ary% mkary -so a.txtN-gram カウント。4-gram で頻度は3よりも大きいものを出力。% ./sang.pl -n 4 -t 3 a.txt 4 100円5 「ぬんな10 ぬんなり4 ました。4 まったり5 んなり」ref.- SUFARY 臨時復旧ページ http://ta2o.net/tools/sufary/（SUFARYの入手はここから。）- [を] SUFARY用インデクサのPerl版の雛形[2007-06-10-3]（mkipu8.pl のソースはここに。）- [を] 自分マイニング！ - Blogでよく使うフレーズは？[2005-01-18-3]（sang を使ったデータマイニング例。）

SUFARY.pm で variable-gram 類似文字列検索

https://chalow.net/2010-03-12-4.html
SUFARY.pm で variable-gram 類似文字列検索[Programming][Algorithm] sufary の Perl モジュールである SUFARY.pm を使って v-gram による類似文字列検索を実現するサンプル。コードvgram.pl#!/usr/bin/perluse strict;use warnings;use SUFARY;use Encode;use open ':utf8';binmode STDIN, ":utf8";binmode STDOUT, ":utf8";my $min_ngram = 1;my $wordset_fn = shift @ARGV;my $suf = SUFARY->new($wordset_fn);while (<>) { chomp; next if /^\s*$/; my @chars = split(//, $_); my %phrases; my %scores; my %seen; for (my $i = 0; $i < @chars; $i++) { for (my $j = $i + $min_ngram - 1; $j < @chars; $j++) { my $key = join("", @chars[$i..$j]); next if $seen{$key}; $seen{$key} = 1; my ($left, $right) = $suf->range_search($key); last if not defined $left and not defined $right; for (my $k = $left; $k <= $right; $k++) { my $pos = $suf->get_position($k); my @lis = $suf->get_line_info($pos); next if $phrases{$lis[0]}{$key}; $phrases{$lis[0]}{$key} = 1; $scores{$lis[0]}++; } } } foreach my $li (sort {$scores{$b} <=> $scores{$a}} keys %scores) { my $line = $suf->get_line($li); print "$scores{$li} "; print decode('utf-8', $line); print " vgram:".join(",", sort keys %{$phrases{$li}})."\n"; }}データの準備辞書ファイル (a.txt)。各行のフォーマットは「^検索対象文字列\t付加情報$」。これはゆで卵卵あれはカレー米カレーな釜玉卵焼き鳥はカレー鶏ゆで卵は豚カツ豚豚カツと豚汁豚mkipu8.pl で文字単位でインデックスポイントを出力。mkary (SUFARYに付属) でインデックスポイントをソートし、suffix arrays を完成させる。./mkipu8.pl a.txt > a.txt.arymkary -so a.txt実行例% echo "これはカレー" | ./vgram.pl a.txt15 あれはカレー米 vgram:は,はカ,はカレ,はカレー,れ,れは,れはカ,れはカレ,れはカレー,カ,カレ,カレー,レ,レー,ー10 焼き鳥はカレー鶏 vgram:は,はカ,はカレ,はカレー,カ,カレ,カレー,レ,レー,ー6 カレーな釜玉卵 vgram:カ,カレ,カレー,レ,レー,ー6 これはゆで卵卵 vgram:こ,これ,これは,は,れ,れは2 ゆで卵は豚カツ豚 vgram:は,カ1 豚カツと豚汁豚 vgram:カ解説連続一致する部分文字列に高スコアを与えるように検索する手法。（あとで書く）参考- SUFARY.pm で Longest Common Prefix Search[2007-05-15-5]- SUFARY用インデクサのPerl版の雛形[2007-06-10-3]- D論 (http://ta2o.net/doc/pub/)- 富士通研究所時代の学会発表 (http://ta2o.net/doc/pub/)

Suffix Arrays の構築がいつまでたっても終わらない問題

https://chalow.net/2009-10-20-4.html
Suffix Arrays の構築がいつまでたっても終わらない問題[Algorithm] よくあるトラブルなのでまとめておく。suffix を文字列比較でソートするという単純な方法で Suffix Arrays を作るSUFARYでのトラブルについて。- SUFARY 臨時復旧ページhttp://ta2o.net/tools/sufary/ちなみに Suffix Array の作成ロジック（もっとも簡単なやつ）はこんな感じ(C言語です)：#include <fcntl.h> #include <malloc.h> #include <stdio.h> #include <sys/mman.h> #include <sys/stat.h> #include <sys/types.h> /* usage: sufsort1 text > text.suf */ char *text; suffix_compare(int *a, int *b) { return strcmp(text + *a, text + *b); } main(int ac, char **av) { struct stat stat_buf; int N, i, *suf; FILE *fd = fopen(av[1], "r"); fstat(fileno(fd), &stat_buf); N = stat_buf.st_size; text = (char *)malloc(N+1); fread(text, sizeof(char), N, fd); text[N] = 0; /* pad with null */ suf = (int *)malloc(N * sizeof(int)); for(i=0;i<N;i++) suf[i] = i; qsort(suf, N, sizeof(int), suffix_compare); fwrite(suf, N, sizeof(int), stdout); } (http://ta2o.net/doc/pub/dron-sa.pdf)ここでは、原因と解決方法について述べる。例えば000001-100000までの5桁IDを持つ10万件のデータ（10万行のテキスト）があるとする。000001 六本木000002 呼吸...099999 鰻100000 札幌改行文字も含めた各行の平均バイト数が15だとすると全体で150万バイト(1.5M)のテキストデータとなる。もし何かの間違いでこのデータを二回コピペしたテキストファイルを作ってしまったとする。000001 六本木000002 呼吸...099999 鰻100000 札幌000001 六本木000002 呼吸...099999 鰻100000 札幌このテキストに対してsuffix arrayを作るとなると、先頭からの suffix と、1,500,001バイト目からの suffix の文字列比較が行われる可能性が高い。それはつまり、先頭から150万バイト同じで最後だけ異なる文字列の比較である。常識的に考えて(JK)、これはやたらめったらと時間がかかる。それがやっとこさ終わったとしても、先頭から2番目からの suffix と 1,500,002バイト目からの…（以下略）。そして、先頭から3番目からの suffix と 1,500,003バイト目からの…（以下略）。というわけで、これが「いつまでたっても終わらないよー！」の原因。この場合の解決法は簡単で、事前にテキストファイルをソートするだけ。sort original.txt > new.txtまたは、ついでに重複除去して、sort -u original.txt > new.txtをコマンドラインで実行して、new.txt に対して suffix array を作成する。

1 2 3 4 5 6 [ 次へ ]

たつをの ChangeLog