人工無脳を作ってみようとするよ4
Perlオブジェクト指向プログラミング
Perl&CGI最強講座
このあたりの記事を読みつつ、今まで書いたスクリプトをモジュール化。書き方まずいところあったか、ベタ書き時より遅くなってる処理あるけどよしとする。そのかわりに処理の流れがわかりやすくなって超うれしいですね。
そういえば名前考えてなかったので以後「人工無脳目指すスクリプト」もとい、「人工無脳めざし」と呼ぶことにします。つづりは「Mezassi」。Mezasiじゃないのは、Mezassiで検索したら0件だったから。
以下、今回作ったモジュール「Mezassi.pm」を使った無脳と会話スクリプト、talk.pl。
#!/usr/bin/perl -w use Mezassi; my $mezassi = Mezassi->new; #$mezassi->read_dic("foo.dic"); ## 辞書foo.dicを使いたい時は、文頭の#を削除 #$mezassi->read_log("foo.log"); ## 会話履歴foo.logを使いたい時は、文頭の#を削除 while(<STDIN>){ $mezassi->write_log("foo.log",$_); ## ユーザの発言を履歴foo.logに追記 $mezassi->read_sentence($_); ## ユーザの発言を解析、学習 printf("%s\n", $mezassi->gen_sentence); ## 学習内容を元に一文出力 } $mezassi->write_dic("foo.dic"); ## 学習結果を辞書foo.dicに保存
ああ、こんなアッサリ書ける日が来るとは思わなかったよジョップリン。この気持ち良さは筆舌にしがたい。
試しに無学習状態から会話をしてみた。「> 」付いてないほうがMezassi。意外とおもしろくて長くなった。
% ./talk.pl > こんにちはこんにちは! こんにちはこんにちはこんにちはこんにちは! > しつこいなあ。 しつこいなあ。 > しつこいのは僕ではなくて君だ。 こんにちはこんにちは! > なんか別のこと言ってみれ。 しつこいなあ。 > 鸚鵡がえしばっかりじゃなくて、個性溢れること言いなさい。 しつこいなあ。 > そうか? しつこいなあ。 > そこまで言われると凹む。 なんか別のこと言ってみれ。 > 色々言ってるんですけどね。 鸚鵡がえしばっかりじゃなくて君だ。 > 僕は十分に個性的ですから、問題は君です。 鸚鵡がえしばっかりじゃなくて君ですけどね。 > 丁寧に言っても何も変わらないよ。 丁寧に個性溢れること言っても何も何も何も変わらないよ。 > そういうもんなのかねえ。 なんか別のは僕は僕では僕では僕ではなくてみれ。 > 意味わからないですね君は。 なんか別のこと言いなさい。 > 偉そうだな。 僕は君です。 > うへ。 偉そうか? > うん、かなり。 しつこいのは。 > 俺か君かどっちかだ。 そうか? > それ以外ここにはいないよ。 しつこいのはなくてみれ。 > もう朝だから俺は休む。 それ以外ここに言ってみれ。 > うーん、まだまだだなこの子は。 なんか別のは十分に言ってみれ。 > まずこっちの言葉に反応する仕組みが存在しないしね…… もう朝だ。 > そそ。 俺は。 > 俺だ。 それ以外ここに反応する仕組みが存在しないよ。 > んだね。 俺だ。 > んじゃ。 うへ。
とりあえず叩き台ができたので、ここからアルゴリズムとか辞書の形式とかを改良すればMezassiがまともな無脳に近づける気がする。
以下無脳エンジン、Mezassi.pm。
# Markov Model Chatbot "Mezassi" Engine package Mezassi; use MeCab; sub new{ my $cmd = my $pkg = shift; my $hash = { dic_hash => {}, mecab_cmd => new MeCab::Tagger("-Owakati"), }; bless $hash, $pkg; } sub add_chain{ my $self = shift; my $word = shift; my $nextwords = shift; my $ref_dic = $self->{'dic_hash'}; if(defined($ref_dic->{$word})){ $ref_dic->{$word} .= ","; } $ref_dic->{$word} .= $nextwords; } sub read_dic{ my $self = shift; my $dic_name = shift; open(DIC, $dic_name)||die("cannot open $dic_name\n"); while(<DIC>){ my ($word, $nextwords) = split("="); chomp($nextwords); $self->add_chain($word, $nextwords); } close(DIC); return $self->{'dic_hash'}; } sub write_dic{ my $self = shift; my $dic_name = shift; my $ref_dic = $self->{'dic_hash'}; @keys = sort(keys(%$ref_dic)); open(DIC, ">$dic_name")||die("cannot open $dic_name\n"); foreach(@keys){ printf DIC ("%s=%s\n", $_, $ref_dic->{$_}); } close(DIC); } sub read_sentence{ my $self = shift; my $sentence = shift; my $cmd = $self->{'mecab_cmd'}; return if($sentence =~ /^$/); chomp($sentence); my @wordlist = split(" ", $cmd->parse($sentence)); my $word = "\\bos"; foreach(@wordlist){ $_ = escape($_); $self->add_chain($word, $_); $word = $_; } $self->add_chain($word, "\\eos"); } sub gen_sentence{ my $self = shift; my $word = "\\bos"; my $ref_dic = $self->{'dic_hash'}; my @next_wordlist = split(",", $ref_dic->{$word}); my $sentence = ""; while(($word = $next_wordlist[rand(@next_wordlist)]) ne "\\eos"){ $sentence .= $word; @next_wordlist = split(",", $ref_dic->{$word}); } return descape($sentence); } sub escape{ my $word = shift; $word =~ s/\\/\\\\/g; $word =~ s/=/\\eq/g; $word =~ s/,/\\camma/g; return $word; } sub descape{ my $word = shift; $word =~ s/[^\\]\\eq/=/g; $word =~ s/^\\eq/=/g; $word =~ s/[^\\]\\camma/,/g; $word =~ s/^\\camma/,/g; $word =~ s/\\\\/\\/g; return $word; } sub read_log{ my $self = shift; my $log_name = shift; open(LOG, $log_name)||die("cannot open $log_name\n"); while(<LOG>){ $self->read_sentence($_); } close(LOG); } sub write_log{ my $self = shift; my $log_name = shift; my $sentence = shift; open(LOG, ">>$log_name")||die("cannot open $log_name\n"); print LOG $sentence; close(LOG); } 1;
いいかげんはてなにはっつけるのもうざい程度には長いかな。
昔っから一度言いたかったんですが、このスクリプトは誰でも煮るなり焼くなり好きに好きにすればいいです。ただし電通大の自然言語処理の講義でプログラム課題を出そうとしてる人、コピペは禁止。俺と同じ講義取ってるような人はさっさともっと参考になる素晴しい他のサイトとかを見ればよろしいです。
なまこなWikiとか、かなり参考になると思います。まったくもって微々たる速度で後追いしてるだけじゃないのか俺という気がして、あまりちゃんと読み込んでないくらい参考になる空気が漂っています。
そんなこと言わんでも、わざわざ俺の書いたような変なスクリプトを煮たり焼いたりしたい人がいるとは、あまり思えないけど。