KH Coderでの抽出語リスト作成の自動化

はじめに

KH Coderでの抽出語リストの作成を自動化してみた。
自動化したのは以下の記事で書いた作業である。

具体的には、以下の4ステップのうちの2.～4.を自動化してみた。

1. 入力用のテキストファイルを作成
2. KH Coderでプロジェクトを作成
3. 複合語リストを作成
4. 抽出語リストの作成

自動実行をするためのスクリプトは、Perlで実装する。

自動実行の方法

FAQ

KH CoderのFAQで自動実行の方法が述べられている。

自動化を行なう見本として「plugin_jp\auto_run.pm」を同梱しています。

コマンドプロンプトを立ち上げ、KH Coder（kh_coder.exe）が格納されているフォルダに移動し、以下を実行すると、auto_run.pmが実行できる。2つ目の引数のファイルパスには、自動的に分析を行いたいテキストファイルをフルパスで指定する。

> kh_coder.exe -auto_run ファイルパス

「Rのパッケージおよびツールの作成と応用 (シリーズ Useful R 10)」，共立出版，2014

KH Coderの開発者である樋口耕一氏が執筆された書籍「Rのパッケージおよびツールの作成と応用 (シリーズ Useful R 10)」の4.3章で、KH Coderによる分析の自動化の方法が説明されている。

KH Coderのソースコード

KH Coderのソースコードは、GitHubで公開されている。
KH Coderのソースコードを参考にしながら、自動実行をするためのスクリプトを実装する。

作成したプログラム

# コマンドラインから「kh_coder.exe -auto_run テキストファイル名」のように起動すると、以下を実行する。
# 1. KH Coderでプロジェクトを作成
# 2. 複合語リストを作成
# 3. 抽出語リストの作成
# プロジェクトを削除すると抽出語リストが削除されてしまうため、プロジェクトの削除処理は一旦コメントアウトしている。

import csv;

package auto_run;

sub plugin_config{

	# 自動処理を行うかどうか判断
	if ( defined($ARGV[0]) && defined($ARGV[1]) && $ARGV[0] eq '-auto_run' && -e $ARGV[1] ){
		
		# ファイル名指定
		my $file_target = $ARGV[1];
		my $file_save   = 'net.png';

		# プロジェクト新規作成
		my $new = kh_project->new(
		    target => $file_target,
		    comment => 'auto',
		) or die("could not create a project\n");
		kh_projects->read->add_new($new) or die("could not save the project\n");

		# 新規作成したプロジェクトを開く
		$new->open or die("could not open the project\n");
		$::project_obj->morpho_analyzer_lang( 'jp' );
		$::project_obj->morpho_analyzer( 'chasen' );
		
		# 複合語リストを作成する
		use mysql_hukugo;
		mysql_hukugo->run_from_morpho;
		
		# 複合語リストのExcelファイルをCSVファイルに変換
		my $target_excel = $::project_obj->file_HukugoList;
		my $file_vars = "hukugo.txt";
		use screen_code::rde_excel_to_csv;
		use rde_kh_spreadsheet;
		my $sheet_obj = rde_kh_spreadsheet->new($target_excel);
		my $header = screen_code::rde_excel_to_csv::save_excel_to_csv(
			$sheet_obj,
			filev    => $file_vars
		);
		
		# 複合語リストのCSVファイルを読み加工し、強制抽出する語のリストを作成する
		my @row;
		my @records;
		my $filename = "hukugo.txt";
		open (IN, "./$filename") or die("could not read file: $filenamer\n");
		while(<IN>){
			chomp;
			push(@row, $_);
		}
		close(IN);
		# タイトル行を削除し、1列目のみ抽出する（頻出数の列を削除し複合語の列のみにする）
		shift(@row);
		foreach(@row){
			my @column = split(/,/, $_);
			push(@records, "$column[0]");
		}
		# 複合語を逆順にソートする
		@records = sort {$b cmp $a} @records;
		# 複合語リストのCSVファイルに書き戻す
		open(DATA, ">./$filename");
		print DATA "$_\n" foreach(@records);
		close(DATA);
		
		# ファイルからの読み込みでの強制抽出する語の指定をする
		my $win = gui_window::dictionary->open;
		$win->config->words_mk_file_chk(1);
		$win->config->words_mk_file("./$filename");
		$win->config->save;

		# 前処理実行
		my $wait_window = gui_wait->start;
		&gui_window::main::menu::mc_morpho_exec;
		$wait_window->end(no_dialog => 1);
		
		# 抽出語リストをExcelで開く
		my $target_file = mysql_words->word_list_custom(
			type  => 'def',
			num   => 'tf',
			ftype => 'xls',
		);
		gui_OtherWin->open($target_file);

		# プロジェクトを閉じる
		$::main_gui->close_all;
		undef $::project_obj;

		# プロジェクトを削除
		#（最後に追加したプロジェクトの削除）
		# my $win_opn = gui_window::project_open->open;
		# my $n = @{$win_opn->projects->list} - 1;
		# $win_opn->{g_list}->selectionClear(0);
		# $win_opn->{g_list}->selectionSet($n);
		# $win_opn->delete;
		# $win_opn->close;

		# KH Coderを終了
		exit;
	
	}

	return undef;
}

1;

KH Coderのソースコードの調べ方

今回、KH Coderのソースコードから、参考となる箇所を特定し、真似しながら実装を行った。
KH Coderのソースコードの調べ方の詳細ついては、書籍『Rのパッケージおよびツールの作成と応用』のp.123-127を参照。

ポイント

\khcoder\kh_lib\gui_windowの下で、ダイアログのタイトル名で検索をすると、該当のダイアログに関するコードがヒットする。
コード内のコメントで、ダイアログのタイトル名を記載していただけているため、この方法が利用できる。

コード調査結果

以下をするために参考にしたコードを示す。

• 複合語リスト作成
• ファイルからの読み込みでの強制抽出する語の指定
• 抽出語リスト作成

「複合語リスト作成」をするための参考コード

\khcoder\kh_lib\gui_window\main\menu.pm

sub mc_hukugo{
	my $self = shift;
	my $mw = $::main_gui->{win_obj};

	my $file_hukugo = $::config_obj->os_path( $::project_obj->file_HukugoList );
	my $file_target = $::config_obj->os_path( $::project_obj->file_target );
	
	my $if_exec = 1;
	if (
		   ( -e $file_hukugo )
		&& ( mysql_exec->table_exists('hukugo') )
	){
		my $t0 = (stat $file_target)[9];
		my $t1 = (stat $file_hukugo)[9];
		if ($t0 < $t1){
			$if_exec = 0; # この場合だけ解析しない
		}
	}

	if ($if_exec){
		my $ans = $mw->messageBox(
			-message => kh_msg->gget('cont_big_pros'),
			-icon    => 'question',
			-type    => 'OKCancel',
			-title   => 'KH Coder'
		);
		unless ($ans =~ /ok/i){ return 0; }

		my $w = gui_wait->start;
		use mysql_hukugo;
		mysql_hukugo->run_from_morpho;
		$w->end;
	}

	gui_window::hukugo->open;
}

\khcoder\kh_lib\gui_window\hukugo.pm

sub _new{
	my $self = shift;
	$self->{win_obj}->title(
		$self->gui_jt(kh_msg->get('win_title')) # 複合語の検出（茶筌）
	);

	# エントリと検索ボタンのフレーム
	my $fra4 = $self->{win_obj}->LabFrame(
		-label => 'Filter Entry',
		-labelside => 'acrosstop',
		-borderwidth => 2,
	)->pack(-fill=>'x');
	my $fra4e = $fra4->Frame()->pack(-expand => 'y', -fill => 'x');

	my $e1 = $fra4e->Entry(
		-font => "TKFN",
		-background => 'white'
	)->pack(-expand => 'y', -fill => 'x', -side => 'left');
	$self->{win_obj}->bind('Tk::Entry', '<Key-Delete>', \&gui_jchar::check_key_e_d);
	$e1->bind("<Key>",[\&gui_jchar::check_key_e,Ev('K'),\$e1]);
	$e1->bind("<Key-Return>",sub{$self->search;});
	$e1->bind("<KP_Enter>",sub{$self->search;});

	my $sbutton = $fra4e->Button(
		-text => kh_msg->get('run'), # 検索
		-font => "TKFN",
		-command => sub{$self->search;}
	)->pack(-side => 'right', -padx => '2');

	my $blhelp = $self->{win_obj}->Balloon();
	$blhelp->attach(
		$sbutton,
		-balloonmsg => '"ENTER" key',
		-font => "TKFN"
	);

	# オプション・フレーム
	my $fra4i = $fra4->Frame->pack(-expand => 'y', -fill => 'x');

	$self->{optmenu_andor} = gui_widget::optmenu->open(
		parent  => $fra4i,
		pack    => {-anchor=>'e', -side => 'left', -padx => 2},
		options =>
			[
				[kh_msg->get('gui_window::word_search->or') , 'OR'], # OR検索
				[kh_msg->get('gui_window::word_search->and'), 'AND'], # AND検索
			],
		variable => \$self->{and_or},
	);

	$self->{optmenu_bk} = gui_widget::optmenu->open(
		parent  => $fra4i,
		pack    => {-anchor=>'e', -side => 'left', -padx => 12},
		options =>
			[
				[kh_msg->get('gui_window::word_search->part')  => 'p'], # 部分一致
				[kh_msg->get('gui_window::word_search->comp') => 'c'], # 完全一致
				[kh_msg->get('gui_window::word_search->forw') => 'z'], # 前方一致
				[kh_msg->get('gui_window::word_search->back') => 'k'] # 後方一致
			],
		variable => \$self->{s_mode},
	);

	# 結果表示部分
	my $fra5 = $self->{win_obj}->LabFrame(
		-label => 'List (Top 500)',
		-labelside => 'acrosstop',
		-borderwidth => 2
	)->pack(-expand=>'yes',-fill=>'both');
	
	my $hlist_fra = $fra5->Frame()->pack(-expand => 'y', -fill => 'both');

	my $lis = $hlist_fra->Scrolled(
		'HList',
		-scrollbars       => 'osoe',
		-header           => 1,
		-itemtype         => 'text',
		-font             => 'TKFN',
		-columns          => 2,
		-padx             => 2,
		-background       => 'white',
		-selectforeground   => $::config_obj->color_ListHL_fore,
		-selectbackground   => $::config_obj->color_ListHL_back,
		-selectborderwidth  => 0,
		-highlightthickness => 0,
		-selectmode       => 'extended',
		#-height           => 20,
	)->pack(-fill =>'both',-expand => 'yes');

	$lis->header('create',0,-text => kh_msg->get('h_huku')); # 複合語
	$lis->header('create',1,-text => kh_msg->get('h_freq')); # 出現数

	$fra5->Button(
		-text => kh_msg->gget('copy'), # コピー
		-font => "TKFN",
		-borderwidth => '1',
		-command => sub {gui_hlist->copy($self->{list});}
	)->pack(-side => 'right');

	$self->{conc_button} = $fra5->Button(
		-text => kh_msg->get('whole'), # 全複合語のリスト
		-font => "TKFN",
		-borderwidth => '1',
		-command => sub {$self->open_full_list;}
	)->pack(-side => 'left');
	
	$self->{list}  = $lis;
	$self->{entry}   = $e1;

	return $self;
}

sub open_full_list{
	my $self = shift;
	my $debug = 1;

	my $target_csv = $::project_obj->file_HukugoList;
	gui_OtherWin->open($target_csv);
}

「ファイルからの読み込みでの強制抽出する語の指定」をするための参考コード

\khcoder\kh_lib\gui_window\dictionary.pm

sub save{
	my $self = shift;

	# 強制抽出
	my @mark; my %check;
	my $t = $self->t1->get("1.0","end");
	$t =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
	#print Jcode->new("$t\n")->sjis;

	foreach my $i (split /\n/, $t){
		$i =~ s/\x0D|\x0A//g;
		if (length($i) and not $check{$i}) {
			push @mark, $i;
			$check{$i} = 1;
		}
	}

	if ( $self->{ff_mark_check_v} == 0 ){
		$self->config->words_mk_file_chk(0);
	} else {
		my $file = $::config_obj->os_path(
			$self->gui_jg(
				$self->{ff_mark_entry}->get
			)
		);
		
		unless (-e $file){
			gui_errormsg->open(
				msg    => kh_msg->get('file_error')."\n$file",
				type   => 'msg',
				#window => $self->win_obj,
			);
			return 0;
		}
		
		$self->config->words_mk_file_chk(1);
		$self->config->words_mk_file($file);
	}

	$self->config->words_mk(\@mark); # ファイル利用のあとから設定

	# 使用しない語
	my @stop; %check = ();
	$t = $self->t2->get("1.0","end");
	$t =~ s/\x0D\x0A|\x0D|\x0A/\n/g;
	#print Jcode->new("$t\n")->sjis;

	foreach my $i (split /\n/, $t){
		$i =~ s/\x0D|\x0A//g;
		if (length($i) and not $check{$i}) {
			push @stop, $i;
			$check{$i} = 1;
		}
	}
	
	if ( $self->{ff_stop_check_v} == 0 ){
		$self->config->words_st_file_chk(0);
	} else {
		my $file = $::config_obj->os_path(
			$self->gui_jg(
				$self->{ff_stop_entry}->get
			)
		);

		unless (-e $file){
			gui_errormsg->open(
				msg    => kh_msg->get('file_error')."\n$file",
				type   => 'msg',
				#window => $self->win_obj,
			);
			return 0;
		}
		
		$self->config->words_st_file_chk(1);
		$self->config->words_st_file($file);
	}

	$self->config->words_st(\@stop); # ファイル利用のあとから設定

	# 品詞選択
	if ($self->config->hinshi_list){
		my $changed = 0;
		my $row = 0;
		foreach my $i (@{$self->config->hinshi_list}){
			#print Jcode->new("$i, ".$self->checks->[$row]."\n",'euc')->sjis;
			$self->config->ifuse_this($i,$self->gui_jg($self->checks->[$row]));
			if ($self->{checks}[$row] != $self->{org_checks}[$row]) {
				$changed = 1;
			}
			
			++$row;
		}
		if ( $changed ){
			my $settings = $::project_obj->load_dmp(
				name => 'widget_words',
			);
			if ($settings) {
				$settings->{hinshi} = undef;
				$::project_obj->save_dmp(
					name => 'widget_words',
					var  => $settings,
				);
			}
		}
	}

	$self->config->save;
	$::main_gui->close_all;
	
	# Main Windowの表示を更新
	$::main_gui->inner->refresh;
	
}

「抽出語リスト作成」をするための参考コード

\khcoder\kh_lib\gui_window\word_list.pm

sub _new{
	my $self = shift;
	my $mw = $::main_gui->mw;
	my $win = $self->{win_obj};
	$win->title($self->gui_jt( kh_msg->get('win_title') )); # '抽出語リスト - オプション'

	#--------------#
	#   表の形式   #

	my $lf0 = $win->LabFrame(
		-label => 'Options',
		-labelside => 'acrosstop',
		-borderwidth => 2,
	)->pack(-fill => 'x');

	$lf0->Label(
		-text => kh_msg->get('type'),#$self->gui_jchar('抽出語リストの形式：'),
		-font => "TKFN",
	)->pack(-anchor => 'w');

	my $f1 = $lf0->Frame->pack(-fill => 'x');
	
	$f1->Label(
		-text => '   ',
		-font => "TKFN",
	)->pack(-side => 'left', -padx => 2);

	$f1->Radiobutton(
		-text             => kh_msg->get('hinshi'),#$self->gui_jchar('品詞別'),
		-font             => "TKFN",
		-variable         => \$radio_type,
		-value            => 'def',
	)->pack(-side => 'left', -padx => 4);

	$f1->Radiobutton(
		-text             => kh_msg->get('top150'),#$self->gui_jchar('頻出150語'),
		-font             => "TKFN",
		-variable         => \$radio_type,
		-value            => '150',
	)->pack(-side => 'left', -padx => 4);

	$f1->Radiobutton(
		-text             => kh_msg->get('single'),#$self->gui_jchar('1列'),
		-font             => "TKFN",
		-variable         => \$radio_type,
		-value            => '1c',
	)->pack(-side => 'left', -padx => 4);

	#----------#
	#   数値   #

	$lf0->Label(
		-text => kh_msg->get('count'),#$self->gui_jchar('記入する数値：'),
		-font => "TKFN",
	)->pack(-anchor => 'w');

	my $f2 = $lf0->Frame->pack(-fill => 'x');
	
	$f2->Label(
		-text => '   ',
		-font => "TKFN",
	)->pack(-side => 'left', -padx => 2);

	my $inv0 = $f2->Radiobutton(
		-text             => kh_msg->get('tf'),#$self->gui_jchar('出現回数（TF）'),
		-font             => "TKFN",
		-variable         => \$radio_num,
		-value            => 'tf',
		-command          => sub {
			$self->{tani_obj}->win_obj->configure(-state, 'disabled');
		},
	)->pack(-side => 'left', -padx => 4);

	$f2->Radiobutton(
		-text             => kh_msg->get('df'),#$self->gui_jchar('文書数（DF）'),
		-font             => "TKFN",
		-variable         => \$radio_num,
		-value            => 'df',
		-command          => sub {
			$self->{tani_obj}->win_obj->configure(-state, 'normal');
		},
	)->pack(-side => 'left', -padx => 4);

	$self->{tani_obj} = gui_widget::tani->open(
		parent => $f2,
		pack   => {
			-anchor => 'w',
			-pady   => 1,
			-side   => 'left'
		}
	);
	$self->{tani_obj}->win_obj->configure(-state, 'disabled')
		if $radio_num eq 'tf';

	#------------------#
	#   ファイル形式   #

	$lf0->Label(
		-text => kh_msg->get('file_type'),#$self->gui_jchar('出力するファイルの形式：'),
		-font => "TKFN",
	)->pack(-anchor => 'w');

	my $f3 = $lf0->Frame->pack(-fill => 'x');
	
	$f3->Label(
		-text => '   ',
		-font => "TKFN",
	)->pack(-side => 'left', -padx => 2);

	$f3->Radiobutton(
		-text             => kh_msg->get('csv'),#$self->gui_jchar('カンマ区切り (*.csv)'),
		-font             => "TKFN",
		-variable         => \$radio_ftype,
		-value            => 'csv',
	)->pack(-side => 'left', -padx => 4);

	$f3->Radiobutton(
		-text             => kh_msg->get('xlsx'),#$self->gui_jchar('Excel (*.xls)'),
		-font             => "TKFN",
		-variable         => \$radio_ftype,
		-value            => 'xls',
	)->pack(-side => 'left', -padx => 4);


	$win->Button(
		-text => kh_msg->gget('cancel'),#$self->gui_jchar('キャンセル'),
		-font => "TKFN",
		-width => 8,
		-command => sub{$self->close;}
	)->pack(-side => 'right',-padx => 2);

	$win->Button(
		-text => kh_msg->gget('ok'),#'OK',
		-width => 8,
		-font => "TKFN",
		-command => sub{$self->save;}
	)->pack(-side => 'right')->focus;
	
	return $self;
}

sub save{
	my $self = shift;
	my $target_file = mysql_words->word_list_custom(
		type  => $self->gui_jg( $radio_type  ),
		num   => $self->gui_jg( $radio_num   ),
		ftype => $self->gui_jg( $radio_ftype ),
		tani  => $self->{tani_obj}->tani,
	);
	$self->close;
	gui_OtherWin->open($target_file);
	
	return 1;
}

save()の処理を参考に、抽出語リストをExcelで開くことが可能。
tani の意味は分からない。
今回は、tani を設定しなくても、期待通りの動作をした。

Perlに関する参考記事

トラブル

KH Coderが起動しない

C:\khcoder3\plugin_jp の下に、新しいpmファイルを置くとKH Coderが起動しなくなる。
エラーメッセージは以下。

c:\khcoder3>kh_coder
Encoding of this Console: cp932
Encoding of this file system: cp932
Locale: cp932
This is KH Coder 3.Beta.01g on MSWin32.
CWD: c:/khcoder3
Available Physical Memory: 2047MB
Checking MySQL connection...
R Version: 3.1, x86_64
Using un-threaded functions...
Can't locate object method "plugin_config" via package "auto_run_original" (perhaps you forgot to load "auto_run_original"?) at /<c:\khcoder3\kh_coder.exe>gui_window/main/menu.pm line 846.

実行エラーの内容を確認できない

KH Coderが起動に失敗する場合は、コンソール画面が消えてしまって、内容を確認できない場合が多いらしい。
次の手順で、コンソール表示の内容を確認できる。

1. スタートボタン（画面一番下、左の方にあるWindowsの旗のボタン）から「すべのアプリ」→「Windowsシステムツール」→「コマンドプロンプト」をクリック。Windows 11では「Windows Terminal」でも可。
2. 以下の行を順に貼り付けては「Enter」キーを押していくことでKH Coderを起動。
   1. cd c:\khcoder3
   2. kh_coder

サブルーチンが実行できない

各ダイアログの持っているサブルーチンを実行するためには、open()をしないといけない。
useでモジュールを読み込むようにしても、実行できない。

以下のようにすると、gui_window::dictionaryのサブルーチンが実行できる。

		my $win = gui_window::dictionary->open;
		$win->config->words_mk_file_chk(1);
		$win->config->words_mk_file("./$filename");
		$win->config->save;

作成が成功した抽出語リストが開けない（削除されている）

以下の処理などで、プロジェクトを削除すると、そのプロジェクトで作成した抽出語リストも削除される。

		# プロジェクトを削除
		#（最後に追加したプロジェクトの削除）
		my $win_opn = gui_window::project_open->open;
		my $n = @{$win_opn->projects->list} - 1;
		$win_opn->{g_list}->selectionClear(0);
		$win_opn->{g_list}->selectionSet($n);
		$win_opn->delete;
		$win_opn->close;

謝辞

非常に有益なツールを開発・公開してくださった樋口耕一氏に感謝申し上げます。