お手軽PerlでSuffixArrayに挑戦

Mon Apr 14 23:57:39 JST 2003

はじめに

[UP]

試しにPERLでSuffixArrayついでにソートの勉強

下記のページを参考にしている

http://www.namazu.org/~satoru/unimag/9/

ここに記述されているコードは、実験のために書かれているので、

へんなところはご容赦を...

インデックスを作ってみる

[UP]

Cで書かれたサンプルをperlでかいてみた。

PERLでもquicksortの関数はあるが、一応PERLでかいてみた。

バイナリー形式でインデックスファイルを書き出している。

テストのためのサンプルプログラムなので、書き出したあとよみだして表示している。

pushを使って配列を拡大しているが、これってスピード的にいいのだろうか？

pack,unpack関数はいろいろ使いでありそう！！

1: #!/usr/bin/perl
2: 
3: #2003/03/14
4: #UNIXマガジン2002 10月号 横着プログラミングのsample3.cをPerlにしてみた
5: $text = "abracadabra";
6: print "$text\n";
7: print length($text)."\n";
8: $text_len = length($text);
9: my @index;
10: 
11: for(my $i=0;$i<$text_len;$i++){
12:     $sa[$i] = substr($text, $i, 1);
13:     $index[$i] = $i;
14: }
15: 
16: #ソート処理
17: #選択ソートを使用している
18: #選択ソートの計算量 O(n2)
19: #$upper = $text_len -1;
20: #for(my $i=$upper; $i; $i--){
21: #    $max = $i;
22: #    for($j = 0; $j < $i; $j++){
23: #        $max = $j if suffixcmp($index[$j], $index[$max]) > 0;
24: #        
25: #    }
26: #    ($index[$i], $index[$max]) = ($index[$max], $index[$i]);
27: #}
28: 
29: #ソート処理
30: #QUICKソートを使用している
31: #QUICKソートの計算量 O(n log n)
32: $upper = $text_len - 1;
33: myquicksort(0, $upper);
34: 
35: sub myquicksort{
36:     my($p, $q) = @_;
37:     $i = $p;
38:     $j = $q;
39:     my $x;
40:     $x = $index[$p];
41:     while(true){
42:         while(suffixcmp($index[$i], $x) < 0){
43:             $i = $i + 1
44:         }
45:         while(suffixcmp($x,  $index[$j]) < 0){
46:             $j = $j - 1;
47:         }
48: 
49:         if( $i >= $j ){
50:             last;
51:         }
52: 
53:         ($index[$i], $index[$j]) = ($index[$j], $index[$i]);
54:         $i = $i + 1;
55:         $j = $j - 1;
56:     }
57: 
58:     if ($p < $i -1 ) {
59:         myquicksort($p, $i - 1);
60:     }
61: 
62:     if($j + 1 < $q ){
63:         myquicksort($j + 1, $q);
64:     }
65: }
66: 
67: #結果を表示
68: foreach $loop_var (@index){
69:     print "$loop_var ";
70: }
71: 
72: #suffix比較
73: sub suffixcmp{
74:     my($p1, $p2)=@_;
75:     my $s1 = substr($text, $p1, $text_len - $p1);
76:     my $s2 = substr($text, $p2, $text_len - $p2);
77:     print $s1."   ".$s2."\n";
78:     return ($s1 cmp $s2);
79: }
80: 
81: #2003/03/25 出来上がったインデックスをファイルにおとしてみる
82: #下記のサイトにpackなどの説明がある
83: #http://www.geocities.co.jp/SiliconValley-Oakland/1680/xperl/perl12.html
84: $filename = "arry_index.bin";
85: open( OUT, ">$filename" ) or die "Can't open $filename\n";
86:     binmode( OUT );
87:     print OUT pack("L*", @index);
88: close( OUT );
89: 
90: print "-----------------\n";
91: 
92: open( IN, "$filename" ) or die "Can't open $filename\n";
93:     binmode( IN ); 
94:     while( read( IN, $buffer, 16) ){
95: 
96:         push @index2, unpack( "L*", $buffer)
97:         
98:     }
99:     #@index2 = unpack("L*", IN);
100: close( IN );
101: 
102: #ファイルに書き出したものを読んでみる
103: foreach $loop_var (@index2){
104:     print "$loop_var ";
105: }
106: 
107: 
108:

検索をおこなってみる

[UP]

実はよくわかっていない...

PERLは数値の型、整数、浮動小数点ひっくるめているので、

割り算して、小数点がでてくるので、intで整数にする

バグありです2003/04/05

1: #!/usr/bin/perl
2: 
3: #2003/04/01 - 2003/04/02
4: #とりあえず、いろいろきめうちじょじょに、機能的にする予定
5: 
6: $text = "abracadabra";
7: $text_len = length($text);
8: $key = "ra";
9: 
10: #インデックスファイル名固定
11: $filename = "arry_index.bin";
12: 
13: 
14: open( IN, "$filename" ) or die "Can't open $filename\n";
15:     binmode( IN ); 
16:     while( read( IN, $buffer, 16) ){
17: 
18:         push @index, unpack( "L*", $buffer)
19:         
20:     }
21: close( IN );
22: 
23: print "-----------------\n";
24: 
25: 
26: #ファイルに書き出したものを読んでみる
27: foreach $loop_var (@index){
28:     print "$loop_var ";
29: }
30: 
31: $index_pos = bsearch_first($key, 0, $text_len, 1);
32: if($index_pos == -1){
33:     exit;
34: }
35: print "index position: $index_pos\n";
36: 
37: $cursor = $index_pos;
38:       while (($key cmp substr($text, $index[$cursor], length($key))) == 0) {
39:           #printf("text + %d = %s\n", *cursor, text + *cursor);
40:           printf("text + $index[$cursor] = \n");
41:           $cursor++;
42:       }
43: 
44: sub bsearch_first {
45:     
46:     my ($key, $base, $nmemb, $size)= @_;
47: 
48:       $low  = 0;
49:       $high = 0;
50:       $mid  = 0;
51:         
52:       #assert(key != NULL && base != NULL && compar !=NULL);
53:   
54:       $low = -1;
55:       $high = $nmemb;
56:       #assert(low < high);
57:         
58:       while (($low+1) != $high) {
59:           #欲しいのは整数の値
60:           $mid = int(($low + $high) / 2);
61:           
62:           print "low = $low; mid = $mid; high= $high\n";
63:           
64:           if (searchcmp($key, $index[$mid])> 0) {
65:               $low = $mid;
66:           } else {
67:               $high = $mid;
68:           }
69:    
70:       }
71:       if ($high >= $nmemb || searchcmp($key, $index[$mid]) != 0) {
72:           return -1;
73:       }
74:       return $index[$mid];
75: }
76: 
77: 
78: sub searchcmp {
79:   my ($p1, $p2) = @_;
80:       $key    = $p1;
81:       $suffix = substr($text, $p2, $text_len - $p2); #text + *((int *)p2);
82:       
83:       $ret = ($key cmp $suffix);
84:       print "key= $key; suffix=$suffix; ret=$ret \n";
85:       return $ret;
86: }
87: 
88: 
89:

ファイルを読み込みインデックスを作成してみる

[UP]

ファイルからShift_JISでかかれた文章を読み込み、インデックスを作成してみる。

結果、非常におそすぎて使い物にならない

TIPS: Windowsで動かせるPerlにはppmコマンドというものが使えて登録されているモジュール

ならネットワークからインストールできるようである。

1: #!/usr/bin/perl
2: 
3: #2003/04/02 - 2003/04/03
4: #このコードのチェックは
5: #  Cygwin上のPerlでおこなう
6: #ほんとはActivePerlでもおこないたいのだが、モジュールのインストール
7: #の仕方がわからないため
8: #PerlでのShift_JIS操作は下記のサイトが詳しい
9: #   http://homepage1.nifty.com/nomenclator/perl/shiftjis.htm
10: #Shift_JISを扱うモジュールを利用させていただく
11: #   http://homepage1.nifty.com/nomenclator/perl/ShiftJIS-String.html
12: #モジュールのインストール方法
13: #   http://member.nifty.ne.jp/hippo2000/perltips/
14: #################################################################################
15: use ShiftJIS::String;
16: 
17: 
18: #ファイルから読み取り※ファイル名固定
19: $in_file_name = "test2.txt";
20: 
21: open(IN,"$in_file_name")||die "OPEN ERROR";
22:     #一気にファイルを読むのこれでよいのか？
23:     $text = join('', <IN>);
24: close(IN);
25: 
26: print "$text\n";
27: print ShiftJIS::String::length($text)."\n";
28: $text_len = ShiftJIS::String::length($text);
29: my @index;
30: 
31: for(my $i=0;$i<$text_len;$i++){
32:     $sa[$i] = ShiftJIS::String::substr($text, $i, 1);
33:     $index[$i] = $i;
34: }
35: 
36: #ソート処理
37: #QUICKソートを使用している
38: #QUICKソートの計算量 O(n log n)
39: $upper = $text_len - 1;
40: myquicksort(0, $upper);
41: 
42: sub myquicksort{
43:     my($p, $q) = @_;
44:     $i = $p;
45:     $j = $q;
46:     my $x;
47:     $x = $index[$p];
48:     while(true){
49:         while(suffixcmp($index[$i], $x) < 0){
50:             $i = $i + 1
51:         }
52:         while(suffixcmp($x,  $index[$j]) < 0){
53:             $j = $j - 1;
54:         }
55: 
56:         if( $i >= $j ){
57:             last;
58:         }
59: 
60:         ($index[$i], $index[$j]) = ($index[$j], $index[$i]);
61:         $i = $i + 1;
62:         $j = $j - 1;
63:     }
64: 
65:     if ($p < $i -1 ) {
66:         myquicksort($p, $i - 1);
67:     }
68: 
69:     if($j + 1 < $q ){
70:         myquicksort($j + 1, $q);
71:     }
72: }
73: 
74: #結果を表示
75: foreach $loop_var (@index){
76:     print "$loop_var ";
77: }
78: 
79: #suffix比較
80: sub suffixcmp{
81:     my($p1, $p2)=@_;
82:     my $s1 = ShiftJIS::String::substr($text, $p1, $text_len - $p1);
83:     my $s2 = ShiftJIS::String::substr($text, $p2, $text_len - $p2);
84:     #print $s1."   ".$s2."\n";
85:     return ($s1 cmp $s2);
86: }
87: #
88: ###############################################################################
89: 
90: #2003/03/25 出来上がったインデックスをファイルにおとしてみる
91: #下記のサイトにpackなどの説明がある
92: #http://www.geocities.co.jp/SiliconValley-Oakland/1680/xperl/perl12.html
93: $filename = "arry_index.bin";
94: open( OUT, ">$filename" ) or die "Can't open $filename\n";
95:     binmode( OUT );
96:     print OUT pack("L*", @index);
97: close( OUT );
98: 
99:

はやくなった！！ファイルを読み込みインデックスを作成してみるその２

[UP]

おそかった原因として、substr関数をバカ正直に使用していたことがあげられる。

横着プログラミングに２バイト文字扱いINDEXをつくる方法があったので

参考にさせていただく。

http://www.namazu.org/~satoru/unimag/9/

Shift_JISの操作は、

http://homepage1.nifty.com/nomenclator/perl/shiftjis.htmが詳しい

みそは2バイト文字の１バイト目で判断させること

2003/04/14

.......60Kのファイルでためしたら、処理がもどってこなかった.......

1: #!/usr/bin/perl
2: 
3: #2003/04/04 - 2003/04/05
4: #このコードのチェックは
5: #  Cygwin上のPerlでおこなう
6: #ほんとはActivePerlでもおこないたいのだが、モジュールのインストール
7: #の仕方がわからないため
8: #PerlでのShift_JIS操作は下記のサイトが詳しい
9: #   http://homepage1.nifty.com/nomenclator/perl/shiftjis.htm
10: #Shift_JISを扱うモジュールを利用させていただく
11: #   http://homepage1.nifty.com/nomenclator/perl/ShiftJIS-String.html
12: #モジュールのインストール方法
13: #   http://member.nifty.ne.jp/hippo2000/perltips/
14: #
15: #
16: # a.インデックス作成速度をあげるための実験
17: #   ファイルを直接操作している(seek, read)
18: #
19: # 
20: #
21: #################################################################################
22: use ShiftJIS::String;
23: 
24: 
25: #ファイルから読み取り※ファイル名固定
26: $in_file_name = "test2.txt";
27: 
28: open(IN,"$in_file_name")||die "OPEN ERROR";
29:     #一気にファイルを読むのこれでよいのか？
30:     $text = join('', <IN>);
31: close(IN);
32: 
33: 
34: print "$text\n";
35: print length($text)."\n";
36: print ShiftJIS::String::length($text)."\n";
37: $text_len = length($text);
38: $text_sjis_len = ShiftJIS::String::length($text);
39: my @index;
40: 
41: # 1バイト目がShift_JISの１バイト目かどうか判断し、1バイト目なら次のバイトを
42: # スキップして、カウントする
43: # 1バイト目がASCIIの領域であれば、カウントする
44: # 
45: #################################################################################
46: 
47: open(IN,"$in_file_name")||die "OPEN ERROR";
48: open(IN_FOR_CMP1,"$in_file_name")||die "OPEN ERROR";
49: open(IN_FOR_CMP2,"$in_file_name")||die "OPEN ERROR";
50: 
51: $cnt = 0;
52: $shis_1byte = '(?:[\x81-\x9F\xE0-\xFC])';
53: $ascii = '[\x00-\x7F]';
54: TEST1:for(my $i=0;$i<$text_len;$i++){
55:     #$index[$i] = $i;
56:     #$tmp = substr($text, $i, 1);
57:     #ファイルポインタを移動
58:     seek(IN, $i, 0);
59:     read(IN, $tmp, 1);
60:     $_ = $tmp;
61:     
62:     if(m/$shis_1byte/o){
63:         #print "BINGO\n";
64:         $index[$cnt] = $i;
65:         $cnt++;
66:         #一文字スキップ
67:         $i++;
68:         next TEST1;
69:     } 
70:     
71:     if(m/$ascii/o){
72:         #print "ASCII $tmp \n";
73:         $index[$cnt] = $i;
74:         $cnt++;
75:     }
76:     
77: }
78: 
79: close(IN);
80: 
81: #foreach $loop_var (@index){
82: #    print "$loop_var ";
83: #}
84: #print "COUNT $cnt\n";
85: 
86: $index_size = @index;
87: print "index size: $index_size\n";
88: 
89: #ソート処理
90: #QUICKソートを使用している
91: #QUICKソートの計算量 O(n log n)
92: $upper = $index_size - 1;
93: myquicksort(0, $upper);
94: 
95: #開いたファイルを閉じる
96: close(IN_FOR_CMP1);
97: close(IN_FOR_CMP2);
98: 
99: 
100: #結果を表示
101: foreach $loop_var (@index){
102:     print "$loop_var ";
103: }
104: 
105: #
106: ###############################################################################
107: 
108: #2003/03/25 出来上がったインデックスをファイルにおとしてみる
109: #下記のサイトにpackなどの説明がある
110: #http://www.geocities.co.jp/SiliconValley-Oakland/1680/xperl/perl12.html
111: $filename = "arry_index.bin";
112: open( OUT, ">$filename" ) or die "Can't open $filename\n";
113:     binmode( OUT );
114:     print OUT pack("L*", @index);
115: close( OUT );
116: 
117: print "-----------------\n";
118: 
119: # ユーザー定義関数
120: #
121: #
122: ###############################################################################
123: sub myquicksort{
124:     my($p, $q) = @_;
125:     $i = $p;
126:     $j = $q;
127:     my $x;
128:     $x = $index[$p];
129:     while(true){
130:         while(suffixcmp($index[$i], $x) < 0){
131:             $i = $i + 1
132:         }
133:         while(suffixcmp($x,  $index[$j]) < 0){
134:             $j = $j - 1;
135:         }
136: 
137:         if( $i >= $j ){
138:             last;
139:         }
140: 
141:         ($index[$i], $index[$j]) = ($index[$j], $index[$i]);
142:         $i = $i + 1;
143:         $j = $j - 1;
144:     }
145: 
146:     if ($p < $i -1 ) {
147:         myquicksort($p, $i - 1);
148:     }
149: 
150:     if($j + 1 < $q ){
151:         myquicksort($j + 1, $q);
152:     }
153: }
154: 
155: #suffix比較
156: # ファイルポインタを直接動かして、文字列取得している
157: #############################################################################
158: sub suffixcmp{
159:     my($p1, $p2)=@_;
160:     #my $s1 = ShiftJIS::String::substr($text, $p1, $text_len - $p1);
161:     #my $s2 = ShiftJIS::String::substr($text, $p2, $text_len - $p2);
162:     my $s1, $s2;
163:     seek(IN_FOR_CMP1, $p1, 0);
164:     seek(IN_FOR_CMP2, $p2, 0);
165:     read(IN_FOR_CMP1, $s1, $text_len - $p1);
166:     read(IN_FOR_CMP2, $s2, $text_len - $p2);
167:     #print $s1."   ".$s2."\n";
168:     return ($s1 cmp $s2);
169: }
170: 
171: 
172: 
173:

検索をこなってみるその２

[UP]

単純に、検索語がいくつあるかカウントするだけ

まあ、うまくいってると思う...

1: #!/usr/bin/perl
2: 
3: #2003/04/05 - 2003/04/05
4: #
5: #
6: #ファイルを直接開いて検索するバージョン
7: #
8: #
9: #
10: #参考にさせてもらったページ
11: #
12: #ファイルサイズの取得,配列のサイズ,文字ばけ等:
13: # http://www2u.biglobe.ne.jp/~MAS/perl/waza/menu.html#file
14: ################################################################################
15: #検索語・文章
16: #$search_phrase = "検索語・文章";
17: 
18: #引数を検索語にする
19: $search_phrase = shift(@ARGV);
20: 
21: #検索結果
22: $bingo_cnt = 0;
23: 
24: #検索対象ファイル
25: $target_file = "test2.txt";
26: 
27: #検索対象ファイルのサイズを取得
28: $target_file_size = -s $target_file;
29: 
30: #インデックスファイル名固定
31: $filename = "arry_index.bin";
32: 
33: 
34: #インデックスを読み取る
35: open( IN, "$filename" ) or die "Can't open $filename\n";
36:     binmode( IN ); 
37:     while( read( IN, $buffer, 1024) ){
38:         push @index, unpack( "L*", $buffer)
39:     }
40: close( IN );
41: 
42: #インデックスサイズを取得
43: $index_size = @index;
44: print "index size: $index_size\n";
45: 
46: #文字列比較用にファイルを開く
47: open( IN_FOR_CMP1, "$target_file" ) or die "Can't open $filename\n";
48: open( IN_FOR_CMP2, "$target_file" ) or die "Can't open $filename\n";
49: 
50: print "-----------------\n";
51: 
52: 
53: $index_pos = bsearch_first($search_phrase, 0, $index_size, 1);
54: if($index_pos == -1){
55:     print "no phrase\n";
56:     exit;
57: }
58: print "index position: $index_pos\n";
59: #ひとつみつかった
60: $bingo_cnt = $bingo_cnt + 1;
61: 
62: $cursor = $index_pos;
63: 
64: #
65: #
66: while (true){
67:     #printf("text + %d = %s\n", *cursor, text + *cursor);
68:     #printf "text ".getStrFormTargetFile($cursor, length($key))."\n";
69:     #みつかった分カウントしていく
70:     #こんなんでいいのかな....
71:     if(($search_phrase cmp getStrFormTargetFile($cursor, length($search_phrase) ))== 0)
72:     {
73:         $bingo_cnt = $bingo_cnt + 1;
74:     }
75:     $cursor++;
76:     #検索対象ファイルの大きさをこえたら終了
77:     if($cursor > $target_file_size){
78:         last;
79:     }
80: }
81: 
82: #開けたら閉じる
83: close(IN_FOR_CMP1);
84: close(IN_FOR_CMP2);
85: 
86: print "search result: $bingo_cnt\n";
87: #プログラムエンド
88: exit;
89: 
90: ##############################################################################
91: 
92: #
93: # ユーザー定義関数
94: #
95: #
96: ################################################################################
97: 
98: #
99: # 横着プログラミングそのまんま
100: # 
101: #
102: ################################################################################
103: sub bsearch_first {
104:     
105:     my ($key, $base, $nmemb, $size)= @_;
106: 
107:       $low  = 0;
108:       $high = 0;
109:       $mid  = 0;
110:         
111:       #assert(key != NULL && base != NULL && compar !=NULL);
112:   
113:       $low = -1;
114:       $high = $nmemb;
115:       #assert(low < high);
116:         
117:       while (($low+1) != $high) {
118:           #欲しいのは整数の値
119:           $mid = int(($low + $high) / 2);
120:           
121:           print "low = $low; mid = $mid; high= $high\n";
122:           
123:           if (searchcmp($key, $index[$mid])> 0) {
124:               $low = $mid;
125:           } else {
126:               $high = $mid;
127:           }
128:    
129:       }
130:       if ($high >= $nmemb || searchcmp($key, $index[$high]) != 0) {
131:           return -1;
132:       }
133:       return $index[$high];
134: }
135: 
136: #
137: #ファイルハンドル直接使っていることに注意
138: #
139: ###############################################################################
140: sub searchcmp {
141:   my ($p1, $p2) = @_;
142:   my $key, $suffix;
143:   $key    = $p1;
144:   print "p2: $p2\n";
145:   seek(IN_FOR_CMP1, $p2, 0);
146:   read(IN_FOR_CMP1, $suffix, length($key));
147: 
148:   #$suffix = substr($text, $p2, $text_len - $p2); #text + *((int *)p2);
149:       
150:   $ret = ($key cmp $suffix);
151:   print "key= $key; suffix=$suffix; ret=$ret \n";
152:   return $ret;
153: }
154: 
155: #
156: # 安易な名前....
157: #
158: ###############################################################################
159: sub getStrFormTargetFile {
160:     my($pos, $len) = @_;
161:     my $retStr;
162:     seek(IN_FOR_CMP1, $pos, 0);
163:     read(IN_FOR_CMP1, $retStr, $len);
164:     #print "retStr: $retStr\n";
165:     return $retStr;
166: }
167: 
168: 
169: