リファクタ
cgiのチャボをmojoliciousのモジュールに作り直した。サーバーサイドとフロントエンドを完全に分離しコードをスッキリ？させた。
チャボは入力文字列より単語を抽出しその単語よりマルコフ連鎖で文章を作成し出力する。
日本語の文章を分かち書きするのにmecabを使用。mecabには内部文字列をencode(バイト列に変換)してmecabからの戻り値をdecode(内部文字列に変換)して使います。
use Encode;
use Text::MeCab;
sub text_parse{
my $s = shift;
my $text = shift;
my $parser = Text::MeCab->new();
my $n = $parser->parse(encode('utf-8',$text));
my @ret = ();
do{
push(@ret,+{surface=>decode('utf-8',$n->surface),feature=>decode('utf-8',$n->feature)});
} while ($n = $n->next);
return \@ret;
}
３連のマルコフデータをランダムに連結し人工無能的文書を作成する。
sub put_together{
my $s = shift;
my $word = shift||'わたし';
my @words = ();
my $dbh = $s->app->model->webdb->dbh;
# 最初の一言
my $sql = "select word1,word2 from @{[$s->markov]} where word1 like ? or word2 like ? order by rand() limit 1";
my $data = $dbh->selectall_arrayref($sql,+{Slice => +{}},'%'.$word.'%','%'.$word.'%');
push(@words,$data->[0]->{word1});
push(@words,$data->[0]->{word2});
# 後ろを作成
$sql = "select word1,word2,word3 from @{[$s->markov]} where word1 = ? and word2 = ? order by rand() limit 1";
my $sth = $dbh->prepare($sql);
while(1){
$sth->execute($words[-2],$words[-1]);
if(my $ref = $sth->fetchrow_hashref()){
if($ref->{word3} =~ /EOS/){
last;
}
push(@words,$ref->{word3});
}else{
last;
}
}
# 前を作成
$sql = "select word1,word2,word3 from @{[$s->markov]} where word2 = ? and word3 = ? order by rand() limit 1";
$sth = $dbh->prepare($sql);
while(1){
$sth->execute($words[0],$words[1]);
if(my $ref = $sth->fetchrow_hashref()){
unshift(@words,$ref->{word1});
}else{
last;
}
}
return @words;
}
ソース
package Tool::mmt::Controller::Chabo;
use Mojo::Base 'Tool::mmt::Controller::Json';
=head1 NAME
chabo - AI(Artificial incompetence) chabo(chat bot) module
=cut
use Encode;
use Text::MeCab;
has chatdata => 'test.chatdata';
has markov => 'test.markov';
sub sample_parse{
my $s = shift;
my $r = $s->text_parse($s->get_para('text','テスト'));
$s->json_or_jsonp( $s->render(json => $r, partial => 1));
}
sub sample_put_together{
my $s = shift;
my @t = (join('',$s->put_together($s->get_para('text','わたし'))));
$s->json_or_jsonp( $s->render(json=>\@t,partial =>1));
}
sub sample_get_time_line{
my $s = shift;
my $r = $s->time_line();
$s->json_or_jsonp( $s->render(json => $r, partial => 1));
}
sub talk{
my $s = shift;
my $r = $s->text_parse($s->get_para('text','わたし'));
my $w = $s->select_word($r);
my @ans = (join('',$s->put_together($w)));
unshift(@ans,$w);
$s->json_or_jsonp( $s->render(json=>\@ans,partial =>1));
}
sub chatbot{
my $s = shift;
my $name = $s->get_para('name','no name');
my $action = $s->get_para('action','');
my $chat = $s->get_para('chat','');
my $id = $s->write_log($name,$chat);
my $r = $s->text_parse($chat);
my ($w,$ans);
$w = $s->select_word($r);
$ans = (join('',$s->put_together($w)));
$ans = $s->arrange_text($ans);
$s->put_markov($r,$id);
$s->write_log('チャボ',$ans);
$s->stash->{answer} = $ans;
}
sub arrange_text{
my $s = shift;
my $text = shift;
$text =~ s/^RT@[^:]+://g;
return $text;
}
sub write_log{
my $s = shift;
my $name = shift;
my $chat = shift;
return if($chat eq '');
my $dbh = $s->app->model->webdb->dbh;
$dbh->do("INSERT INTO @{[$s->chatdata]} (name,chat) values (?,?)",undef,$name,$chat);
return $dbh->{mysql_insertid};
}
sub select_word{
my $s = shift;
my $ws = shift;
my @a = grep {$_->{feature} =~ '名詞'} @$ws;
return $a[int(rand scalar @a)]->{ surface };
}
sub get_para{
my $s = shift;
my $item = shift||'text';
my $def = shift;
my $t = $s->param($item);
if ($t eq "") {
$t = ref $s->req->json eq 'HASH' ? $s->req->json->{$item}
: $def;
}
return $t
}
sub text_parse{
my $s = shift;
my $text = shift;
my $parser = Text::MeCab->new();
my $n = $parser->parse(encode('utf-8',$text));
my @ret = ();
do{
push(@ret,+{surface=>decode('utf-8',$n->surface),feature=>decode('utf-8',$n->feature)});
} while ($n = $n->next);
return \@ret;
}
sub put_together{
my $s = shift;
my $word = shift||'わたし';
my @words = ();
my $dbh = $s->app->model->webdb->dbh;
# 最初の一言
my $sql = "select word1,word2 from @{[$s->markov]} where word1 like ? or word2 like ? order by rand() limit 1";
my $data = $dbh->selectall_arrayref($sql,+{Slice => +{}},'%'.$word.'%','%'.$word.'%');
push(@words,$data->[0]->{word1});
push(@words,$data->[0]->{word2});
# 後ろを作成
$sql = "select word1,word2,word3 from @{[$s->markov]} where word1 = ? and word2 = ? order by rand() limit 1";
my $sth = $dbh->prepare($sql);
while(1){
$sth->execute($words[-2],$words[-1]);
if(my $ref = $sth->fetchrow_hashref()){
if($ref->{word3} =~ /EOS/){
last;
}
push(@words,$ref->{word3});
}else{
last;
}
}
# 前を作成
$sql = "select word1,word2,word3 from @{[$s->markov]} where word2 = ? and word3 = ? order by rand() limit 1";
$sth = $dbh->prepare($sql);
while(1){
$sth->execute($words[0],$words[1]);
if(my $ref = $sth->fetchrow_hashref()){
unshift(@words,$ref->{word1});
}else{
last;
}
}
return @words;
}
sub time_line{
my $s = shift;
my $limit = shift||50;
my $start = shift||0;
my $dbh = $s->app->model->webdb->dbh;
my $sql = "select UPD_TIME,name,chat from @{[$s->chatdata]} order by SEQ_NO desc limit ?,?";
my $data = $dbh->selectall_arrayref($sql,+{Slice => +{}},$start,$limit);
return $data;
}
sub put_markov{
my $s = shift;
my $r = shift;
my $id = shift;
my $dbh = $s->app->model->webdb->dbh;
my $sth = $dbh->prepare("insert @{[$s->markov]} (word1,word2,word3,chat_No,part)
values (?,?,?,?,?)");
if (@$r > 2 ) {
# 「2語の接頭語と1語の接尾語」のマルコフ連鎖テーブルを作成
# $markov{接頭語前}{接頭語後ろ}[no]=接尾語 の形式
# $markov{$wakatigaki[0]}{$wakatigaki[1]}[]=$wakatigaki[2];
for (my $i = 2 ; $i < @$r ; $i++) {
$sth->execute($r->[$i-2]->{surface}
,$r->[$i-1]->{surface},$r->[$i]->{surface}
,$id,$r->[$i-2]->{feature});
}
}
}
1;
<html>
<head>
<title>chabo</title>
</head>
<body>
<answer><%= stash('answer') %></answer>
</body>
</html>
#!/usr/bin/env perl
use utf8;
use Mojolicious::Lite;
use DateTime;
use Mojo::JSON;
use Mojo::UserAgent;
use Encode qw/from_to decode_utf8 encode_utf8 decode encode/;
use Data::Dumper qw/Dumper/;
get '/' => sub {
my $self = shift;
} => 'index';
get '/time_line' => sub {
my $s = shift;
my $ua = Mojo::UserAgent->new;
my $ans = $ua->get(Mojo::URL->new("http://www21051ue.sakura.ne.jp:3003/api/chabo/sample_get_time_line"))->res;
$s->render(json => $ans->json);
};
my $clients = {};
websocket '/echo' => sub {
my $self = shift;
Mojo::IOLoop->stream($self->tx->connection)->timeout(0);
app->log->debug(sprintf 'Client connected: %s', $self->tx);
my $id = sprintf "%s", $self->tx;
app->log->debug("id:".$id);
$clients->{$id} = $self->tx;
$self->on(message => sub {
my ($self, $msg) = @_;
my ($name,$message) = split(/\t/,$msg);
$self->app->log->debug('name: ', $name, 'message: ', $message);
unless($name){
$name = '名無し';
}
my $json = Mojo::JSON->new;
my $dt = DateTime->now( time_zone => 'Asia/Tokyo');
# チャボに話しかける --- START
my $ua = Mojo::UserAgent->new;
my $name_euc = decode_utf8($name);
# my $ans = $ua->get(Mojo::URL->new("http://www21051ue.sakura.ne.jp/chabo/chatbot_utf8.cgi?name=$name&action=TALK&chat=$message"))->res->body;
my $ans = $ua->get(Mojo::URL->new("http://www21051ue.sakura.ne.jp:3003/api/chabo/chatbot?name=$name&action=TALK&chat=$message"))->res->body;
my $txt = '';
if($ans =~ m|<answer>(.*)</answer>|){
$txt = decode('UTF-8',$1);
}else{
$txt = decode('UTF-8',$ans);
}
# チャボに話しかける --- END
for (keys %$clients) {
$self->app->log->debug('clients', Dumper $clients->{$_});
$clients->{$_}->send(
decode_utf8($json->encode({
hms => $dt->hms,
name => $name,
text => $message,
}))
);
# チャボの話を拡散する --- START
if($txt ne ''){
$clients->{$_}->send(
decode_utf8($json->encode({
hms => $dt->hms,
name =>'チャボ',
text => $txt,
}))
);
}
# チャボの話を拡散する --- END
}
});
$self->on(finish => sub {
app->log->debug('Client disconnected');
delete $clients->{$id};
});
};
app->start;
__DATA__
@@ index.html.ep
% layout 'main';
%= javascript begin
jQuery(function($) {
$('#msg').focus();
// １番下にスクロールする -- START
var go_bottom = function(targetId){
var $obj = $("#" + targetId);
if ($obj.length == 0) return;
$obj.scrollTop($obj[0].scrollHeight);
};
// １番下にスクロールする -- END
var log = function (text) {
// $('#log').val( $('#log').val() + text + "\n");
// go_bottom('log');
$('#log2').append(text + '<br>');
go_bottom('log2');
};
var time_line = function (){
$.ajax({
url: '/time_line',
type: 'GET',
dataType: 'json',
success: function( data,textStatus,jqXHR){
for(let j in data){
let i = data.length - j - 1;
log('[' + data[i].UPD_TIME + '] (' + data[i].name + ') ' + data[i].chat);
}
}
});
};
var ws = new WebSocket('<%= url_for('/echo')->to_abs->scheme('ws'); %>');
ws.onopen = function () {
log('Connection opened');
time_line();
};
ws.onmessage = function (msg) {
var res = JSON.parse(msg.data);
log('[' + res.hms + '] (' + res.name + ') ' + res.text);
};
$('#msg').keydown(function (e) {
if (e.keyCode == 13 && $('#msg').val()) {
ws.send($('#name').val() + "\t" + $('#msg').val());
$('#msg').val('');
}
});
});
% end
<h1>Mojolicious + WebSocket</h1>
ここでの発言はチャボに記憶され何処かで引用される可能性が
有ります。ご注意下さい。<br />
<div class="ScrollBox" id="log2">
</div>
<p>name<input type="text" id="name" /><br />msg<input type="text" id="msg" size="80"/></p>
[<%= url_for('/echo')->to_abs->scheme('ws'); %>]
<div>
</div>
@@ layouts/main.html.ep
<html>
<head>
<meta charset="<%= app->renderer->encoding %>">
<title>WebSocket Client</title>
%= javascript 'https://ajax.googleapis.com/ajax/libs/jquery/1.7/jquery.min.js'
<style type="text/css">
textarea {
width: 80em;
height:20em;
}
div.ScrollBox {overflow:auto;width:1000px;height:350px;border:1px black solid;margin:0px}
</style>
</head>
<body><%= content %></body>
</html>
