# chasen search tool searchChasen.pl
# first created 2004-01-20; last updated 2005-02-28
# 2004-2005 (c) CHIBA Shoju, Reitaku University
# e-mail: schiba@reitaku-u.ac.jp

use strict;
# use encoding "shiftjis"; # STDIN, STDOUT, script-internal string
# binmode(STDERR, ":shiftjis"); # STDERR
# use Encode qw/decode encode/;

my $version = '0.8';
my $instruction = "Usage: perl searchChasen.pl \-swW? \-mMy \"keyword\[_partofspeech\]\" \[\"keyword\[_partofspeech\]\" ... \] \< inputfilename\nFor more detailed information, try: perldoc searchChasen.pl (written in Japanese)";

# 使用法: perl searchChasen.pl -[メインオプション] -[検索モード] "検索キーワード_品詞" < 検索ファイル名
# 茶筌の標準的な解析結果を標準出力から読み込み，キーワードで検索し，EOSで区切られた文の単位で結果を出力するPerlスクリプト。
# Windows XPのコマンドプロンプト上から ActivePerl 5.8.6 を使い, chasen 2.3.3で解析したシフトJISテキストを用いて動作確認している

###### 利用方法 ######
# メインオプション(-s -w -W のいずれか)は必須
# 検索モードのオプションはメインオプションで -w -W を指定した場合のみ必要
# 検索キーワードは複数個指定可能
# 検索したいデータは必ず標準入力 (<) から読み込む。入力データは茶筌の標準的な解析結果を想定している。
# 出力結果をファイルに保存したい場合には，標準出力 (>) として出力ファイル名を指定する。例：
#     perl searchChasen.pl -w -M "^から$_助詞" "^(へ|に|まで)$_助詞" < input.txt > output.txt
#     (茶筌の解析結果であるファイル input.txt から助詞「から」と「へ，に，まで」のいずれかを含む文を output.txt に出力)
# 検索結果のリポートは標準出力として出力され，スクリプト名，バージョン，検索された文の数，検索作業をおこなった時間，使用したオプションが記録される。
# perldoc [パス]searchCasen.pl で Pod (plain old documentation) スタイルのヘルプを読むことができる。途中で perldoc を終了する場合は q キーを押す。

###### メインオプション: ######
# -s = 茶筌の解析結果から文章を再構築して検索。形態素の区切りは入らない
# -w = 指定したパターンを正規表現として検索
# -W = 完全一致するパターンのみを検索。正規表現は使えない。
# -? = 使用法の表示 ($instructionを表示する)
# オプションがない場合も使用法を表示する

###### 検索モード: #######
# -m = 出現形を単語として検索
# -y = 読み(カタカナ)を検索
# -M = 辞書形を単語として検索

###### 検索キーワードの書き方: ########
# シェルによってはキーワードはダブルクオート "" で囲まなくともＯＫ。
# キーワードの後に半角アンダーバー _ に続けて品詞の情報を指定できる。例：
#     perl searchChasen.pl -w -M "いる_動詞-非自立" < ... (非自立形の動詞「いる」の各種変化形を検索する)
# -w をしている場合は部分文字列もマッチするので，もし完全一致させたい場合には，正規表現を使う。例：
#     perl searchChasen.pl -w -m "^の$" < ... (「の」という出現形のみにマッチする)
# -w または -W を指定している場合，品詞が指定できる。指定したパターンは品詞の解析列のいずれかにマッチすればよい。
# -w を指定している場合は品詞にも正規表現が使える。
# 検索キーワードはいくつでも指定可能。
# 検索モードを変更する場合は，検索キーワードの前に再度モードを指定する。例：
#     perl searchChasen.pl -w -m "書い" -M "みる" < ... (「書いてみた」にもマッチする)
#     perl searchChasen.pl -w -m "書い" "みる" < ... (「書いてみる」などのみがマッチする)

###### TODO ######
# encodingで Shift JIS をうまく指定できていない... use encoding の行はコメントアウトしてある。したがって，現バージョンではコントロール文字と同じコードが含まれる一部のマルチバイトの文字をうまく処理できない。
# 現在は文中に現れたキーワードを全てマークしているが，例えばキーワードをその順番でマークする，
# さらには特定の範囲内 (○語以内) に出現するキーワードをマークする，など応用が考えられる。

####### variables ############

my $s_items; # データを入れるリファレンス
my $s_number = 0; # 文番号 (初期値0)
my $w_number = 0; # 単語番号 (初期値0)
my $option; # コマンドラインオプション
my @keywords = (); # 検索キーワードを入れる配列
my @columns = (); # 検索モードを入れる配列
# 茶筌の解析結果の列番号
my %columns = (
	wordform => 0, # 出現形
	yomi => 1, # 読み (カタカナ)
	baseform => 2, # 基本形
	pos1 => 3, # 品詞1
	pos2 => 4, # 品詞2
	pos3 => 5 # 品詞3
	);
# メインオプション
my %search = (
	sentence => 's',
	word => 'w',
	exact => 'W'
	);
my $column; # 検索する文字の列番号。0-5のいずれか。wモードで使用し，一度指定したら省略可。
my $mode; # 検索モード s, w, W のいずれか。
my $argNo = 0; # オプションの順序を示すカウンタ。
my $outnumber = 0; # 用例数

######### main routines ###################

# メインオプションの設定： -s 文単位 -w 単語単位(正規表現) -W 単語(完全一致)
$option = shift (@ARGV);
if ($option =~ /^-s$/) {
	$mode = $search{"sentence"};
} elsif ($option =~ /^-w$/) {
	$mode = $search{"word"};
} elsif ($option =~ /^-W$/) {
	$mode = $search{"exact"};
} elsif ($option =~ /^-\?/) {
	print $instruction . "\n";
	exit;
} else { # $option eq ""
	print "Specify correct option: $instruction\n";
	exit;
}

# 検索オプションの設定
foreach my $argValue (@ARGV) {
	if ($argValue =~ /^-m/) {
		$column = $columns{"wordform"};
	} elsif ($argValue =~ /^-M/) {
		$column = $columns{"baseform"};
	} elsif ($argValue =~ /^-y/) {
		$column = $columns{"yomi"};
	} elsif ($mode eq 's') {
		push @keywords, $argValue;
	}elsif ($argValue =~ /^-/) {
		print "The option you specify is incorrect: **$ARGV[$argNo]**\n$instruction\n";
		exit;
	} else {
		if ($column ne undef || $column ne "") {
			push @keywords, $argValue;
			push @columns, $column;
		} else {
			print "Specify correct option before keyword: $instruction\n";
			exit;
		}
	}
	$argNo++;
}

# my $keyNo = 0;

while (defined(my $line = <STDIN>)) {
	# my $line = decode("shiftjis", $_); # decode STDIN
	chomp ($line);
	# if ($line eq "EOS") { # もし文末を表すデータであれば
	if ($line =~ /EOS/) { # もし文末を表すデータであれば
		search_keyword($s_items, $s_number);
		$s_number++; # 文番号を1加算する
		$w_number = 0; # 単語番号を0に戻す
		undef $s_items; # 次のデータ用にリファレンスを初期化する
		next; # 次の処理へ
	} else {
		my @items = split ("\t", $line);
		$s_items->[$w_number] = [@items];
		$w_number++;
	}
}

# 結果をリポート
my $now = localtime();
print $0 . " version " . $version . " found " . $outnumber . " example(s) at $now.\nOptions specified are: $option " . join (' ', @ARGV) . "\n";

#### subroutines ####

sub search_keyword {
	my $s = shift; # データのリファレンス
	my $n = shift; # 文番号
	my @words;
	my $sentence;
	if ($mode eq 's') { # 文全体を再構築して検索
		my $hit = 0; # マッチのあるなしを判別する変数。0ならばマッチなし。
		foreach my $w (@{$s}) { # 登録されたデータ行ごとに処理
			push @words, $w->[0]; # 見出し語を配列に格納
		}
		$sentence = join ("", @words); # 配列を結合
		foreach my $keyword (@keywords) {
			if (eval{$sentence =~ /$keyword/}) { # キーワードで検索し，マッチしたら
				$sentence =~ s/($keyword)/<$1>/g; # 検索結果を加工
				$hit += 1; # マッチしていれば1加算
			}
		}
		if ($hit == scalar (@keywords)) {
			printf "%06d: $sentence\n", $n;# 出力
			$outnumber++;
		}
		undef $sentence;
		undef @words;
	} elsif ($mode eq 'w' || $mode eq 'W') { # 単語ごとに解析結果を検索
		my $hit = 0; # マッチのあるなしを判別する変数。0ならばマッチなし。
		# サブルーチン word_search で単語検索
		($hit, @words) = word_search($s); 
		# 検索結果の解釈
		if ($hit == 1) { # もしマッチしたら
			$sentence = join ("", @words); # 検索結果を文形式に加工
			printf "%06d: $sentence\n", $n; # 出力
			$outnumber++;
			$hit = 0; # マッチを示すビットをデフォルトに戻す
		} 
		undef $sentence; # 変数を再度初期化
		undef @words; # 配列を再度初期化
	} else { # もしおかしなオプションがあったら
		die "Set the option correctly:\n$instruction";
	}
}

sub word_search {
	my @hits = (); # キーワードごとのヒット数を入れる配列
	my ($s) = shift;
	my @words = ();
# 	my $hadPos = 0; # 検索文字列に品詞情報が含まれるかを示すビット
	foreach my $target (@{$s}) { # 登録されたデータ行ごとに処理
		my $match = 0;
		for (my $keyNo = 0; $keyNo < scalar(@keywords); $keyNo++) {
			# 品詞あり
			if ($keywords[$keyNo] =~ /_/) {
#				$hadPos = 1;
				my ($w, $p) = split (/_/, $keywords[$keyNo]);
				# 単語のパターンの指定あり
				if ($w ne "") { 
					my $wordHit = 0;
					my $posHit = 0;
					if ($mode eq 'w') {
						if (eval {$target->[$columns[$keyNo]] =~ /$w/}) { 
							$wordHit = 1; # マッチを記憶
						}
						for (my $PosNo = 1; $PosNo <= 3; $PosNo++) {
							if (eval {$target->[$columns{'pos' . $PosNo}] =~ /$p/}) {
								$posHit = 1; # マッチを記憶
							}
						}
					} elsif ($mode eq 'W') {
						if ($target->[$columns[$keyNo]] =~ /^$w$/) { # -W は eval {} なし
							$wordHit = 1; # マッチを記憶
						}
						for (my $PosNo = 1; $PosNo <= 3; $PosNo++) {
							if ($target->[$columns{'pos' . $PosNo}] =~ /$p/) {
								$posHit = 1; # マッチを記憶
							}
						}
					}
					if ($wordHit > 0 && $posHit > 0) {
						push @words, '<' . $target->[0] . '>'; # 検索結果を加工
						$match = 1; # マッチしたことを示すビットを立てる
						$hits[$keyNo] = 1; # 各キーワードのマッチを記憶
						next;
					}
				# $w eq "" 単語のパターンの指定がない場合
				} else { 
					my $posHit = 0;
					if ($mode eq 'w') {
						for (my $PosNo = 1; $PosNo <= 3; $PosNo++) {
							if (eval {$target->[$columns{'pos' . $PosNo}] =~ /$p/}) {
								$posHit = 1; # マッチを記憶
							}
						}
					} elsif ($mode eq 'W') {
						for (my $PosNo = 1; $PosNo <= 3; $PosNo++) {
							if ($target->[$columns{'pos' . $PosNo}] =~ /^$p$/) { # eval {} なし
								$posHit = 1; # マッチを記憶
							}
						}
					}
					if ($posHit > 0) {
						push @words, '<' . $target->[0] . '>'; # 検索結果を加工
						$match = 1; # マッチしたことを示すビットを立てる
						$hits[$keyNo] = 1; # 各キーワードのマッチを記憶
						next;
					}
				}
			# 品詞なし
			} else {
				if ($mode eq 'w') {
					if (eval {$target->[$columns[$keyNo]] =~ /$keywords[$keyNo]/}) { # マッチしたら
						push @words, '<' . $target->[0] . '>'; # 検索結果を加工
						$match = 1; # マッチしたことを示すビットを立てる
						$hits[$keyNo] = 1; # 各キーワードのマッチを記憶
						next;
					}
				} elsif ($mode eq 'W') {
					if ($target->[$columns[$keyNo]] =~ /^$keywords[$keyNo]$/) { # eval {} なし
						push @words, '<' . $target->[0] . '>'; # 検索結果を加工
						$match = 1;
						$hits[$keyNo] = 1; # 各キーワードのマッチを記憶
						next;
					}
				}
			}
		}
		if ($match == 0) {
		push @words, $target->[0]; # ヒットしなければそのまま
		}
	}
	my $hit = 0; # 検索キーワードのマッチ状況：キーワード全てがヒットしていなければ値はキーワードの数と同じ
	foreach my $hitparkey (@hits) {
		if (defined ($hitparkey)) {
			$hit++;
		}
	}
	if ($hit < scalar (@keywords)) {
		return (0, @words);
	} else { # 全てのキーワードが揃っている場合は1を返す
		return (1, @words);
	}
}


__END__

=head1 NAME
	
searchChasen.pl -- 茶筌解析結果の検索補助スクリプト

=head1 SYNOPSIS

=over 4

=item *

標準入力を利用して解析済みファイルを検索：

perl searchChasen.pl -[メインオプション] -[検索モード] "検索キーワード_品詞" < 検索ファイル名

=item *

データをchasenで解析し，パイプを利用してそのまま検索：

chasen 検索ファイル名 | perl searchChasen.pl -[メインオプション] -[検索モード] "検索キーワード_品詞"

=back

=head1 DESCRIPTION

茶筌の標準的な解析結果を標準出力から読み込み，キーワードで検索し，EOSで区切られた文の単位で結果を出力するPerlスクリプト。

Windows XPのコマンドプロンプト上から ActivePerl 5.8.6 を使い, chasen 2.3.3で解析したシフトJISテキストを用いて動作確認している。

=over 4

=item *

メインオプション(-s -w -W のいずれか)は必須

=item *

検索モードのオプションはメインオプションで -w -W を指定した場合のみ必要

=item *

検索キーワードは複数個指定可能

=item *

検索したいデータは必ず標準入力 ( < やパイプ | ) から読み込む。入力データは茶筌の標準的な解析結果を想定している。

=item *

出力結果をファイルに保存したい場合には，標準出力 (>) として出力ファイル名を指定する。茶筌の解析結果であるファイル input.txt から助詞「から」と「へ，に，まで」のいずれかを含む文を output.txt に出力する例：

perl searchChasen.pl -w -M "^から$_助詞" "^(へ|に|まで)$_助詞" < input.txt > output.txt

=item *

検索結果のリポートは標準出力として出力され，スクリプト名，バージョン，検索された文の数，検索作業をおこなった時間，使用したオプションが記録される。

=back

=head1 OPTIONS

=over 4

=head2 メインオプション:

=over

=item -s

茶筌の解析結果から文章を再構築して検索。形態素の区切りは入らない

=item -w

指定したパターンを正規表現として検索

=item -W

完全一致するパターンのみを検索。正規表現は使えない。

=item -?

使用法の表示 ($instructionを表示する)

※ オプションがない場合は使用法を表示する

=back

=head2 検索モード:

=over 4

=item -m

出現形を単語として検索

=item -y

読み(カタカナ)を検索

=item -M

辞書形を単語として検索

=back

=head2 検索キーワードの書き方のヒント:

=over 4

=item *

シェルによってはキーワードはダブルクオート "" で囲まなくともＯＫ。

=item *

キーワードの後に半角アンダーバー _ に続けて品詞の情報を指定できる。例：

perl searchChasen.pl -w -M "いる_動詞-非自立" < ... 

# 非自立形の動詞「いる」の各種変化形を検索する

=item *

-w をしている場合は部分文字列もマッチするので，もし完全一致させたい場合には，正規表現を使う。例：

perl searchChasen.pl -w -m "^の$" < ... 

# 「の」という出現形のみにマッチする

=item *

-w または -W を指定している場合，品詞が指定できる。指定したパターンは品詞の解析列のいずれかにマッチすればよい。

=item *

-w を指定している場合は品詞にも正規表現が使える。

=item *

検索キーワードはいくつでも指定可能。

=item *

検索モードを変更する場合は，検索キーワードの前に再度モードを指定する。例：

perl searchChasen.pl -w -m "書い" -M "みる" < ... 

#「書いてみた」にもマッチする

perl searchChasen.pl -w -m "書い" "みる" < ... 

# 「書いてみる」などのみがマッチする

=head1 BUGS

=over 4

=item *

encodingで Shift JIS をうまく指定できていない... use encoding の行はコメントアウトしてある。したがって，現バージョンではコントロール文字と同じコードが含まれる一部のマルチバイトの文字をうまく処理できない。

=item *

現在は文中に現れたキーワードを全てマークしているが，例えばキーワードをその順番でマークする，さらには特定の範囲内 (○語以内) に出現するキーワードをマークする，など応用が考えられる。

=back

=head1 AUTHOR

2004-2005 (c) 千葉庄寿 & 麗澤大学言語研究センター言語情報学プロジェクト

2004-2005 (c) CHIBA Shoju & Language Technology Project, LinC, Reitaku University

e-mail: schiba@reitaku-u.ac.jp

URL: http://www.FL.reitaku-u.ac.jp/LINC/projects/langTech/

     http://www.FL.reitaku-u.ac.jp/~schiba/

=cut