コンコーダンサーを作る


今整形したテキストから、語をサーチし、その文を表示する仕組みを考えます。

データの読み込み
まず、ファイルから配列へデータを格納します。

--
#!/usr/local/bin/perl

$directory="data"; 	#目的のファイルがあるフォルダの名称
$file="wowcat\.txt"; 	#ファイルの名称。「\.」としてありますが\はなくてもほぼOK
$separator="\\"; 	#パスをつなぐ記号で、機種固有値(UNIX... /  Mac... :)
$in=$directory.$separator.$file; 	#相対パスでファイルを指定

open (FILE, $in) || die "$in\n$!\n"; 	#ファイルオープン
while (<FILE>) { 				#ファイル内のデータ分繰り返し
	push (@array, $_); 		#配列@arrayに格納
}
close FILE;	#ファイルのクローズ
--

入力インターフェイス
キーボードからの入力を受け付ける場合、STDINというハンドルから受けます。この文字を変更することはできません。

--
print "Input: "; #入力を促すコマンド。後ろにSTDINがあるので、入力待ちになる。
$word = <STDIN>; #入力文字列を$wordに格納
chop $word; #最後の改行を削除

#確認
print "target = $word\n";
--

キーボードから文字列を入力後は、必ずエンター(リターン)キーを押します。そのため、入力文字列の最後は必ず"\n"になっています。chop関数は、文字列の最後の1文字を切り落とす関数です。このchopを使って"\n"を切り落とします。他にchompという関数もあり、これは文字列の最後が"\n"の場合にのみそれを切り落とします。

$wordの検索
$wordを検索する方法はいくつかありますが、ここではまずgrepで$wordを含む文だけからなる新たな配列を作ります。

--
@hit = grep(/\b$word\b/i, @array); 		#iオプションで大文字小文字の区別をなくしてみました
print "sentence ... ", $#hit+1,"\n";		#ヒット数。語の数ではなく文の数が表示されることに注意

#確認
foreach $yoso (@hit) {
  print $yoso;
}
--

次に、検索語が1行に複数ある場合の処理をしなければいけません。ここで注意することは、正規表現は常に最初にマッチした文字列にヒットします。ある文に「the」が2回使われていた時、何度検索しても1番目の「the」に常にマッチするということです。つまり、何度同じ検索をかけても2番目の「the」に到達してくれない、ということです。これに対処する方法もいろいろ考えられますが、ここでは以下のようにしてみます。

--
$total=0;
foreach $yoso (@hit) {
  while (1) {
    if ($yoso =~ /\b($word)\b/i) {
      $total++;
      $ephe = $total."_".$1;
      $yoso =~ s/\b$1\b/$ephe/;
    } else {
      last;
    }
  }>
}
print "word ... ", $total, "\n";
--

$totalというスカラー変数は、語のカウンターとして働きます。
while(1)というように、( )に1(=真)を記述すると、このループは無限ループになります。
if ($yoso =~ /\b($word)\b/i) --($word)とカッコで囲むことで、その値を$1に保持します。
$epheの代入及びその次の行の置換で行うのは、$wordの頭に「数字_」をつけることです。「the」なら「12_the」となります。perlはアンダーバーを語の区切りとして扱いませんので、この時点で「the」とはマッチしなくなります。
同様にしてすべての$wordを書き換えてしまいます。
elseの処理で、無限ループを抜けるlast文を書きます。
この処理が終わった時点で、語の出現数は$totalに格納されています。

次に実際に検索結果を(ちゃんとした形で)表示させていきます。なお、マッチした語をbaldやitalicで表示する処理というのはシステムに依存しますので、ここでは扱いません。その代わりにマッチした語の前後をタブではさんでファイルに出力させてみます。

--
$out = "concres\.txt";
$counter = 1;

open (FILE, "> $out") || die "Can't create $out\n$!\n";
foreach $yoso (@hit) {
  while (1) {
    $pre = $counter."_";
    $ephe = $pre."\(".$word."\)";
    if ($yoso =~ /\b($ephe)\b/i) {
      $fst = $`; $ephe = $1; $lst = $';
      $yoso =~ s/$pre//;
      $ephe =~ s/$pre//;
      $lst =~ s/\d+_//g;
      print FILE "$fst\t$ephe\t$lst";
      $counter++;
    } else {
      last;
    }
  }
}
close FILE;
print "end\n";
--

ソート
後は、検索語、その直前・直後の語でソートができれば一応の機能が備わることになります。では、このソートの方法について考えてみます。
perlにはsort関数があり、デフォルトでASCII順でソートするので、これをそのまま利用した方法を考えます。これにもいろいろな方法が考えられますが、基本的には、先ほど語数のトータルを出したのと同じ理屈でやってみます。

その前に、「1語」を表す正規表現は例えば以下のように書けます。
/[\w'-]+/ ... \w(word構成文字)か'か-の内の1文字の連続(+)
(他にも語を構成する文字はありますが、ここではこれでとどめます。)

では、この表現を使って$`(マッチした直前の文字列)の最後の1語を取り出してみます。
--
$fst = $`;
$fst =~ s/\s+$//; #文字列末の空白文字削除
if ($fst =~ /([\w'-]+)$/) { #最後の1語にマッチさせ、$1に格納する条件文
  $mae = $1;
} else {
  $mae = substr($fst, length($fst)-1, 1); #語でない場合、直前の1文字を代入
}
print "match ... $ephe\n";
print "mae ... $mae\n";
--

次は$'(マッチした直後の文字列)の最初の1語の取り出しです。

--
$lst = $';
$lst =~ s/^\s+//; #文字列最初の空白文字削除
if ($lst =~ /^([\w'-]+)/) {  #最初の1語にマッチさせ、$1に格納する条件文
  $ato = $1;
} else {
  $ato = substr($lst, 0, 1); #語でない場合、直後の1文字を代入
}
print "ato ... $ato\n\n";
--

ここまでで、マッチした語と、その前後1語ずつのデータが得られました。後は、どこを基準にソートさせるかを指定するスイッチを用意すれば、結果が得られます。ここでは単純にいかのいずれかの設定でソートできるスイッチを作ります。
0...何もしない
1...検索語でソート
2...検索語の直前の語でソート
3...検索語の直後の語でソート
以下の例は、キーボードからの入力でこのスイッチの値を受け取ります。

--
$switch = 0; #初期値設定。インプットエラーの際は「0」で処理するために0を代入。
#インプットを促すプロンプト
print "sort by: 0. no sort 1.target itself 2.before target 3.after target (0, 1, 2, or 3): ";
$ss = <STDIN>;
chop $ss;
#スイッチを1,2,3いずれかに設定する分岐。条件に合わないと初期値0が保持される。
if ($ss == 1) {$switch = 1;} elsif ($ss == 2) {$switch = 2;} elsif ($ss == 3) {$switch = 3;}
print "$switch\n";
--

後は、スイッチの値によって処理を変化させます。以上の処理ができるように先ほどのルーチンを書き換えてみます。

--

$switch = 0;
print "sort by: 0. no sort  1.target itself  2.before target  3.after target (0, 1, 2, or 3): ";
$ss = <STDIN>;
chop $ss;
if ($ss == 1) {$switch = 1;} elsif ($ss == 2) {$switch = 2;} elsif ($ss == 3) {$switch = 3;}
print "sort $switch\n";

$out = "concres\.txt";
$counter = 1;

foreach $yoso (@hit) {
  while (1) {
    $pre = $counter."_";
    $ephe = $pre.$word;
    if ($yoso =~ /\b($ephe)\b/i) {
      $fst = $`; $ephe = $1; $lst = $';

      $yoso =~ s/$pre//;
      $ephe =~ s/$pre//;
      $lst =~ s/\d+_//;

      $fst =~ s/\s+$//; #文字列末の空白文字削除
      if ($fst =~ /([\w'-]+)$/) {
        $mae = $1;
      } else {
        $mae = substr($fst, length($fst)-1, 1);
      }

      $lst =~ s/^\s+//; #文字列最初の空白文字削除
      if ($lst =~ /^([\w'-]+)/) { #最初の1語にマッチさせ、$1に格納する条件文
        $ato = $1;
      } else {
        $ato = substr($lst, 0, 1); #語でない場合、直後の1文字を代入
      }

#ここがソート種類別の処理
#ソートしたい語を元データの頭にくっつけ、元データとの間を3つのアンダーバー「___」で区切る
#elseの分岐ではこの処理を行わない
      if ($switch == 1) {
          $new_yoso = $ephe."___".$fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      } elsif ($switch == 2) {
          $new_yoso = $mae."___".$fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      } elsif ($switch == 3) {
          $new_yoso = $ato."___".$fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      } else {
          $new_yoso = $fst."\t".$ephe."\t".$lst;
          push (@new_hit, $new_yoso);
      }
      
      $counter++;
    } else {
      last;
    }
  }
}

#$switchが1より大きいときのみソートする
if ($switch > 0) {@new_hit = sort @new_hit;}

#ここがファイル書き出し処理
open (FILE, "> $out") || die "Can't create $out\n$!\n";
foreach $new_yoso (@new_hit) {
  if ($switch > 0) {$new_yoso =~ s/^.+___//;} #頭につけた余分なデータを削除して元に戻す
  print FILE $new_yoso; #書き出し
}
close FILE;
print "end\n";

補足:
純粋にN番目のマッチを見つけるには、以下のようにします。
以下の例では3番目のcatとその前の単語を出力
--


$txt="white cat blue cat red cat yellow cat gray cat";
$n=2;
$counter=0;

while ($txt =~ /([\w'-]+\s+cat)\b/gi) {
	if ($counter++ == $n) {
		print $1,"\n";
		#in this case 'last;' is prohibited
	}
}
出力:red cat

--
スクリプト全体...conc.pl