perlでの文字列抽出

perlの文字列抽出と集計について教えてください。

ファイルAにある文字列をファイルBから探し、その単語の前後の5単語を集計したいと考えています。

fileA（ただの単語列です）
たまねぎ
かぼちゃ
にんじん

fileB（|で区切られています）
ピラミッド|を|築く|労働者|に|は|たまねぎ|を|食べ|させた|と|いう|記録|も|あり
たまねぎ|は|野菜|の|中|で|最|も|糖質|が|多く|
ほくほく|した|西洋|かぼちゃ|は|、|料理|野菜|の|中|で|も
にんじん|は|、|根|を|食べ|る|野菜|の|中|で|は|珍しく|緑黄色野菜|です

上記のようなファイルがあった場合に、「｜」で区切られた前後５単語をとれるだけ取得すると以下のようになり

たまねぎ を,築く,労働者,に,は,を,食べ,させた,と,いう,は,野菜,の,中,で
かぼちゃ ほくほく,した,西洋,は,、,料理,野菜,の
にんじん は,、,根,を,食べ,る

以下のように出現を集計して、一つのマトリックスにまとめたいと考えています。

　　　　　を　築く　労働者　に　は　食べ　させた　と　いう　野菜...
たまねぎ　2　　1　　1　　　　1　2　　1　　1　　　　1　　1　　1
かぼちゃ　　　　　　　　　　　　1　　　　　　　　　　　　　　1
にんじん　1　　　　　　　　　　　1　　1
...
...

初心者のためなかなかうまいやり方がみつけることができず
ご教示いただけると助かります。
よろしくお願いいたします。

No.2 ベストアンサー 回答者： MAGNAFIFTY 回答日時： 2010/02/04 12:21

どんなアプリケーションなの？やっぱり、課題？

面白そうなので、やってみた。

ANo.1 osamuyさんの方法は、データをシーケンスに扱うとても優れた方法です。メモリ消費量も処理速度もosamuyさんの方法がベストだと考えます。巨大なデータを扱う実アプリにも対応できる手法です。

私は、効率よく書くのは苦手なんで、まとめて読み込み、まとめて解析、まとめて表示をよくやります。ですので、メモリを大量に消費しますが単純な構造なのでわかりやすいかもしれません。課題的には面白いと思うので、とっかかりに工夫してみてはいかがでしょうか。

01:#!/usr/bin/perl
02:
03:open FHA, "fileA";
04:open FHB, "fileB";
05:@keys = <FHA>;
06:@statement = <FHB>;
07:%freqkeys = ();
08:%freqword = ();
09:
10:foreach $k (@kays ) {
11:foreach $s (@statament) {
12:　　chomp $k;
13:　　chopp $s;
14:
15:　　@f = split /\|/, $s;
16:　　@x = (@f,'','','','','');
17:
18:　　for $i ( 0 .. @f-1 ) {
19:　　for $j ( -5, -4, -3, -2, -1, +1, +2, +3, +4, +5 ) {
20:　　　　$w = $x[$i+$j];
21:　　　　if( $x[$i] eq $k ) {
22:　　　　　　$freqkeys{$k}{$w}++;
23:　　　　　　$frepword{$w}++;
24:　　　　}
25:　　}}
26:
27:　　delete $freqkeys{$k}{""} ;
28:　　delete $freqword{""} ;
29:}}
30:
31:@words = keys %freqword;
32:print "Keys/Words, ", join ",", @vords, "\n";
33:foreach $k ( @keys ){
34:　　print "$k,";
35:　　foreach $w ( @words ) {
36:　　　　$f = $freqkees{$k}{$w};
37:　　　　print "$f,";
38:　　}
39:　　print "\n";
40:}
41:

03-08:ファイルの読み込みと、データベース変数の初期化。
10,11:FileAのキーとFileBのステートメントの解析ループ
15,16:ステートメントを分割しフィールド@fに保存。
　　　５つ前～５つ後にも同じようにアクセスできるように@xを作る。
18,19:フィールドループと前後５ワード分のループ
20 　:ワード$wに保存
21-24:フィールドがキーに一致したとき、ワードを保存
　　　$freqkeys{<key>}{<word>}--- キーとワードによる発生頻度
　　　$freqkeys{<word>}--- ワードのみの発生頻度
27-28:前後５つ分アクセスできるようにNULLデータの入った@Xを使っているため、
　　　不必要なNULLデータを削除。
31-40:カンマで区切られた形式で出力

変数いじってるので、このままじゃ走らないです。デバッグ必要です。課題だとすると、マルマル回答では気が引けるから(^^;がんばれー！

この回答への補足

連想配列で処理が早くできるようになりました。
少し内容が変わっていますが、非常に参考になりました。
ありがとうございます。

open(IN, "kai.dat");
chomp(@aa = <IN>);
close(IN);

open(DATA,"thab.dat");
chomp(@bb = <DATA>);
close(DATA);
$" = ",";

foreach $x (@aa){
@categ = split(/,/, $x);
push(@hyper,$categ[0]);

for $m(1 .. @categ-1){

foreach $y (@bb) {
if($y =~ /\|$categ[$m]\|(を|に|か|ら|と|へ|まで|より|の)\|/){

@ato=split(/\|/,$');
if (($ato[0] =~ "n") || ($ato[0] =~ "d") || ($ato[0] =~ "k")){

if (&minfo($categ[$m],$ato[0]) > 15.00){
$freqkeys{$categ[0]}{$ato[0]}++;
$freqword{$ato[0]}++;
}
}
}
}
}


@words = keys %freqword;
print "word=@words\n";
foreach $hyp ( @hyper ){
print "$hyp,";
foreach $sub ( @words ) {
$f = $freqkeys{$hyp}{$sub};
print "$f,";
}
print "\n";
}

}

補足日時：2010/02/08 14:46

この回答へのお礼

非常に勉強になりました。ありがとうございます。
22:　　　　　　$freqkeys{$k}{$w}++;
23:　　　　　　$frepword{$w}++;
は配列番号の代わりにキーワードを利用する方法だと認識しました。

自分で配列にpushする方法を試したみたのですが
とても時間がかかりましたので、この方法を試してみたいと思います。

進捗があれば、報告させてください。
よろしくお願いいたします。

お礼日時：2010/02/05 14:14

No.1 回答者： osamuy 回答日時： 2010/01/30 12:31

1. fileBを読んで、|でsplitして、1語を1行で出力。

2. 1.の出力を1行ずつ読んで、サイズが10の配列にpush。6番目の要素がfileAの語だったら、前後の5要素を、それぞれ出力。次の行のために、先頭の要素を配列からshiftしてループ。
3. 得られた出力をExcelに食わせてピボットテーブルで整形。
UNIX系で数だけ知りたいなら、sort|uniq -cとか。

――みたいに、問題を分割して、解決しやすい形にならないか考えてみては。

この回答へのお礼

アドバイスありがとうございます。
ただ、ファイルが非常に大きいので
エクセルでは処理しきれない状況です。

問題を細分化する方法で一つ一つ進めたいと思います。
ありがとうございました。

お礼日時：2010/02/05 14:10