# chasen search tool pickChasen.pl
# first created 2004-02-28; last updated 2005-03-04
# 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.2';
my $instruction = "Usage: perl pickChasen.pl \-myM\[p\] \"keyword\" \< inputfilename\nFor more detailed information, try: perldoc pickChasen.pl (written in Japanese)";

# 使用法: perl pickChasen.pl -[オプション] "検索パターン" < 検索ファイル名
# 茶筌の標準的な解析結果を標準出力から読み込み，指定した検索パターンを含む茶筌の解析結果の断片を頻度順に出力するPerlスクリプト。
# Windows XPのコマンドプロンプト上から ActivePerl 5.8.6 を使い, chasen 2.3.3で解析したシフトJISテキストを用いて動作確認している

###### 利用方法 ######
# メインオプション(-m -y -M のいずれか)は必須
# オプション p は任意。出力に品詞情報のうち，最初の列 (基本品詞情報) のみ表示させる場合に指定
# 検索パターンは一つだけ指定する。複数個入れても無視されるので注意。
# 検索パターンには正規表現を指定可能。
# 検索したいデータは必ず標準入力 (<) から読み込む。入力データは茶筌の標準的な解析結果を想定している。
# 出力結果をファイルに保存したい場合には，標準出力 (>) として出力ファイル名を指定する。例：
#     perl pickChasen.pl -M "ように" < input.txt > output.txt
#     (茶筌の解析結果であるファイル input.txt から「ように」というパターンの解析結果を含む断片を検索し，output.txt に出力)
# 検索結果のリポートは標準出力として出力され，スクリプト名，バージョン，検索されたパターンの数，検索作業をおこなった時間，指定したオプションが記録される。
# perldoc [パス]pickCasen.pl で Pod (plain old documentation) スタイルのヘルプを読むことができる。途中で perldoc を終了する場合は q キーを押す。

###### メインオプション: ######
# -m = 出現形から検索
# -y = 読み(カタカナ)を検索
# -M = 辞書形を単語としてならべたものを検索
# -? = 使用法の表示 ($instructionを表示する)
# -mp, -yp, Mp = -m, -y, -M の各パターンで検索するが，結果の頻度の計算と表示の際に品詞情報は基本的なもの (品詞情報の最初の列) のみを使う
# オプションがない場合も使用法を表示する

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

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

my $s_items; # データを入れるリファレンス
my $s_number = 0; # 文番号 (初期値0)
my $w_number = 0; # 単語番号 (初期値0)
my $keyword = "";
my $option;
my $mode;
my %parsed = (); # 解析パターンを入れるハッシュ。ハッシュの値は頻度
# 茶筌の解析結果の列番号。メインオプションに使用
my %columns = (
	wordform => 0, # 出現形
	yomi => 1, # 読み (カタカナ)
	baseform => 2, # 基本形
	pos1 => 3, # 品詞1
	pos2 => 4, # 品詞2
	pos3 => 5 # 品詞3
	);
my $restrictPOS = 0;
my $hits = 0;

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

# メインオプションの設定： -m 出現形 -y 読み(カタカナ) -M 基本形
# オプションに p をつけて -mp, -yp, -Mp とすると，結果表示の際，品詞情報は最初の列のみが含まれる
$option = shift (@ARGV);
if ($option =~ /^-m/) {
	$mode = $columns{"wordform"};
	if ($option =~ /p/) {
		$restrictPOS = 1;
	}
} elsif ($option =~ /^-y/) {
	$mode = $columns{"yomi"};
	if ($option =~ /p/) {
		$restrictPOS = 1;
	}
} elsif ($option =~ /^-M/) {
	$mode = $columns{"baseform"};
	if ($option =~ /p/) {
		$restrictPOS = 1;
	}
} elsif ($option =~ /^-\?/) {
	print $instruction . "\n";
	exit;
} else { # $option eq ""
	print "Specify correct option: $instruction\n";
	exit;
}

my $keyword_original = shift (@ARGV);
# 検索キーワードを quote regex operator としてwrapする
$keyword = qr/$keyword_original/; 

while (defined(my $line = <STDIN>)) {
	# my $line = decode("shiftjis", $_); # decode STDIN
	chomp ($line);
	if ($line eq "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++;
	}
}

# 解析結果を頻度ごとにソートし表示
foreach my $parsed_item (sort { $parsed{$b} <=> $parsed{$a} } keys %parsed) {
	print '#' x $parsed{$parsed_item} . "\t" . $parsed{$parsed_item} . " example(s) found:\n";
	print $parsed_item;
	$hits += $parsed{$parsed_item};
}
# 結果をリポート
my $now = localtime();
print "In total, " . $0 . " version " . $version . " found " . $hits . " example(s) at $now.\nStrings searched are: \"$keyword_original\"\n";

#### subroutines ####

sub search_keyword {
	my $s = shift; # データのリファレンス
	my $n = shift; # 文番号
	my @words; # 単語を入れる配列
	my @lengths; # 単語の長さを入れる配列
	my $sentence;
	if ($keyword ne "") { # 文全体を再構築して検索
		my $match = 0;
		my $hit = 0; # マッチのあるなしを判別する変数。0ならばマッチなし。
		my $len = 0; # 単語の長さを入れる変数
		foreach my $w (@{$s}) { # 登録されたデータ行ごとに処理
			# 検索モードにあわせて単語とその長さ情報を配列に格納
			push @words, $w->[$mode];
			$len += length($w->[$mode]);
			push @lengths, $len;
		}
		$sentence = join ("", @words); # 配列を結合
		if ($sentence =~ /$keyword/g) { # キーワードで検索し，マッチしたら
			my $id1 = length ($`); # マッチの開始位置
			my $id2 = length ($`) + length ($&); # マッチの終了位置
			my $start_match = 0;
			my $end_match = 0;
			my $str_match = "";
			for (my $i = 0; $i < scalar (@words); $i++) {
				if ($id1 < $lengths[$i] && $start_match == 0) {
					if ($i == 0 && $id1 < $lengths[$i]) { # マッチが最初の単語で起こる
						if ($restrictPOS == 1) { # 品詞情報を最初の列のみに制限
							$str_match .= join ("\t", splice(@{$$s[$i]}, $columns{'wordform'}, $columns{'pos1'} + 1)) . "\n";
						} else { # 品詞情報を全て表示
							$str_match .= join ("\t", @{$$s[$i]}) . "\n";
						}
						$start_match = 1;
						if ($str_match =~ /$keyword/) {
							$end_match = 1;
						}
					} elsif ($i > 0 && $lengths[$i-1] <= $id1) { # マッチが2語目から起こる
						if ($restrictPOS == 1) { # 品詞情報を最初の列のみに制限
							$str_match .= join ("\t", splice(@{$$s[$i]}, $columns{'wordform'}, $columns{'pos1'} + 1)) . "\n";
						} else { # 品詞情報を全て表示
							$str_match .= join ("\t", @{$$s[$i]}) . "\n";
						}
						$start_match = 1;
						if ($str_match =~ /$keyword/) {
							$end_match = 1;
						}
					}
				} elsif ($start_match == 1 && $end_match == 0) {
					if ($id2 <= $lengths[$i]) {
						if ($restrictPOS == 1) { # 品詞情報を最初の列のみに制限
							$str_match .= join ("\t", splice(@{$$s[$i]}, $columns{'wordform'}, $columns{'pos1'} + 1)) . "\n";
						} else { # 品詞情報を全て表示
							$str_match .= join ("\t", @{$$s[$i]}) . "\n";
						}
						$end_match = 1;
					} else { # 1語でマッチが終了した場合
						if ($restrictPOS == 1) { # 品詞情報を最初の列のみに制限
							$str_match .= join ("\t", splice(@{$$s[$i]}, $columns{'wordform'}, $columns{'pos1'} + 1)) . "\n";
						} else { # 品詞情報を全て表示
							$str_match .= join ("\t", @{$$s[$i]}) . "\n";
						}
					}
				} 
			}
			if ($end_match == 1) { # マッチがきちんと終了したことを確認してハッシュに記録
				$parsed{"$str_match"}++;
				$start_match = 0;
				$end_match = 0;
			}
		}
		undef $sentence;
		undef @words;
	} else { # もし検索キーワードが不明だったら
		print "Set the keyword correctly:\n$instruction";
		exit;
	}
}

__END__

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

=head1 SYNOPSIS

=over 4

=item *

指定した検索パターンを含む茶筌の解析パターンを抽出し，頻度順に出力するPerlスクリプト：

perl pickChasen.pl -[オプション] "検索パターン" < 検索ファイル名

=item *

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

chasen 検索ファイル名 | perl pickChasen.pl -[オプション] "検索パターン"

=back

=head1 DESCRIPTION

標準入力を利用して茶筌の標準的な解析結果を読み込み，指定した検索パターンを含む解析部分を抽出し，頻度順に出力するPerlスクリプト。

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

=over 4

=item *

メインオプション(-m -y -M のいずれか)は必須。-?で使用方法を表示。

=item *

オプション p は任意。出力に品詞情報のうち，最初の列 (基本品詞情報) のみ表示させる場合に指定

=item *

検索パターンは一つだけ指定する。複数個入れても無視されるので注意。

=item *

検索パターンには正規表現を指定可能。

=item *

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

=item *

出力結果をファイルに保存したい場合には，標準出力 (>) として出力ファイル名を指定する。茶筌の解析結果であるファイル input.txt から「ように」というパターンの解析結果を含む断片を検索し，output.txt に出力する例：

perl pickChasen.pl -M "ように" < input.txt > output.txt

=item *

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

###	3 example(s) found:

よう	ヨウ	よう	名詞-非自立-助動詞語幹

に	ニ	に	助詞-副詞化

In total, pickChasen.pl version 0.2 found 3 example(s) at Fri Mar  4 09:52:16 2005.
Strings searched are: "ように"

=back

=head1 OPTIONS

=over 4

=head2 メインオプション:

=over

=item -m

出現形から検索

=item -y

読み(カタカナ)を検索

=item -M

辞書形を単語としてならべたものを検索

=item -?

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

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

=item -mp, -yp, Mp

-m, -y, -M の各パターンで検索するが，結果の頻度の計算と表示の際に品詞情報は基本的なもの (品詞情報の最初の列) 以外を省略する

=back

=head1 BUGS

=over 4

=item *

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

=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