トップ 差分 一覧 ソース 検索 ヘルプ PDF RSS ログイン

chabo - AI(Artificial incompetence) chabo(chat bot) module

リファクタ

cgiのチャボをmojoliciousのモジュールに作り直した。サーバーサイドとフロントエンドを完全に分離しコードをスッキリ？させた。

  • 旧
  • 新 じゃんけん機能追加

チャボは入力文字列より単語を抽出しその単語よりマルコフ連鎖で文章を作成し出力する。

mecab

日本語の文章を分かち書きするのに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>

フロントエンド

  • Mojo::JSONにnewが無い

https://qiita.com/ymko/items/03780e066ba3bf34d8e5ここで助けてもらう

--- old_websock.pl	2018-02-21 20:42:20.163489464 +0900
+++ websock.pl	2018-02-21 06:15:52.791489028 +0900
@@ -3,5 +3,6 @@
 use Mojolicious::Lite;
 use DateTime;
-use Mojo::JSON;
+# use Mojo::JSON;
+use Mojo::JSON qw(encode_json);
 use Mojo::UserAgent;
 use Encode qw/from_to decode_utf8 encode_utf8 decode encode/;
@@ -38,5 +39,5 @@
         }
 
-        my $json = Mojo::JSON->new;
+#        my $json = Mojo::JSON->new;
         my $dt   = DateTime->now( time_zone => 'Asia/Tokyo');
 
@@ -57,9 +58,10 @@
             $self->app->log->debug('clients', Dumper $clients->{$_});
             $clients->{$_}->send(
-                decode_utf8($json->encode({
+#                decode_utf8($json->encode({
+                decode_utf8(encode_json{
                     hms  => $dt->hms,
                     name => $name,
                     text => $message,
-                }))
+                })
             );
 
@@ -67,9 +69,10 @@
             if($txt ne ''){
                 $clients->{$_}->send(
-                    decode_utf8($json->encode({
+#                    decode_utf8($json->encode({
+                decode_utf8(encode_json{
                         hms  => $dt->hms,
                         name =>'チャボ',
                         text => $txt,
-                    }))
+                    })
                 );
             }

ジャンケン判定を追加

              my $r = 0;
              do{$hand->{'pc'}->{hand} = $handArray->[int(rand()*3)];$hand->{'pc'}->{name} = $cpname} if(keys %$hand == 1);
              $r |= 1 << $handItem->{$hand->{$_}->{hand}} for(keys %$hand);
              $win = ('','DRAW','DRAW',,$handArray->[0],'DRAW',$handArray->[2],$handArray->[1],'DRAW')[$r]; 
              $diffusion->('判定',join('|',(map{$hand->{$_}->{name}.$hand->{$_}->{hand}} keys %$hand),
                  qw(不明 引き分け 引き分け グーの勝ち 引き分け パーの勝ち チョキの勝ち 引き分け)[$r]));

webperl.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use Mojolicious::Lite;
use DateTime;
use Mojo::JSON qw(encode_json);
use Mojo::UserAgent;
use Encode qw/from_to decode_utf8 encode_utf8 decode encode/;
use Data::Dumper qw/Dumper/;

my $clients = {};
my $jankenStat = 0;
my $handItem = {'&#x270A'=> 0, '&#x270C'=> 1, '&#x270B'=> 2};
my $handArray = [sort {$handItem->{$a} <=> $handItem->{$b}} keys %$handItem];
my $hand = {};
my $win = '';
my $cpname = 'ちゃぼ';
my $DEBUG = 0;

get '/' => sub {
   my $self = shift;
   $self->stash->{hand} = $handArray;
} => '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);
};
websocket '/echo' => sub {
   my $self = shift;
   Mojo::IOLoop->stream($self->tx->connection)->timeout(0);
   app->log->debug(sprintf 'Client connected: %s', $self->tx) if($DEBUG);
   my $id = sprintf "%s", $self->tx;
   app->log->debug("id:".$id) if($DEBUG);
   $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) if($DEBUG);
       $name = '名無し' unless($name);
       my $diffusion = sub {
           my ($name,$message) = @_;
           my $dt   = DateTime->now( time_zone => 'Asia/Tokyo');
           for (keys %$clients) {
               $self->app->log->debug('clients', Dumper $clients->{$_}) if($DEBUG);
               my $judge = ($win ne '' && exists($hand->{$_}->{hand}) && $win eq $hand->{$_}->{hand}) ?
                   ' (あなたの勝ちです)' : '';
               $clients->{$_}->send(
                   decode_utf8(encode_json{
                       hms  => $dt->hms,
                       name => $name,
                       text => $message . $judge,
                   })
               );
           }
       };
       if ($jankenStat == 1 and grep {$message eq $_} @$handArray ){
           $hand->{$id} = {hand => $message, name => $name};
           return 1;
       }
       $diffusion->($name,$message); 
       if($message eq 'じゃんけん' && $jankenStat == 0){
           $jankenStat = 1;
           Mojo::IOLoop->timer(1=> sub{
               $diffusion->($cpname,'ポン');
               $hand = {};
           });
           Mojo::IOLoop->timer(4=> sub{
               $jankenStat = 0;
               my $r = 0;
               do{$hand->{'pc'}->{hand} = $handArray->[int(rand()*3)];$hand->{'pc'}->{name} = $cpname} if(keys %$hand == 1);
               $r |= 1 << $handItem->{$hand->{$_}->{hand}} for(keys %$hand);
               $win = ('','DRAW','DRAW',,$handArray->[0],'DRAW',$handArray->[2],$handArray->[1],'DRAW')[$r]; 
               $diffusion->('判定',join('|',(map{$hand->{$_}->{name}.$hand->{$_}->{hand}} keys %$hand),
                   qw(不明 引き分け 引き分け グーの勝ち 引き分け パーの勝ち チョキの勝ち 引き分け)[$r]));
               $hand = {};
           });
           return 1;
       }
       # チャボに話しかける  --- START
       my $ua = Mojo::UserAgent->new;
       my $name_euc = decode_utf8($name);
       my $ans = $ua->get(Mojo::URL->new("http://www21051ue.sakura.ne.jp:3003/api/chabo/chatbot?name=$name&action=TALK&chat=$message"))->res->body;
       $ans =~ s|<answer>(.*)</answer>|$1|;
       $ans = decode('UTF-8',$ans);
       # チャボに話しかける  --- END
       # チャボの話を拡散する  --- START
       $diffusion->($cpname,$ans) if ($ans ne ''); 
       # チャボの話を拡散する  --- 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) {
   $('#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('');
   }
 });
 $('#janken').click(function (e) {
   ws.send($('#name').val() + "\t" + 'じゃんけん');
 });
 $('#gu').click(function (e) {
   ws.send($('#name').val() + "\t" + '<%== $hand->[0] %>');
 });
 $('#choki').click(function (e) {
   ws.send($('#name').val() + "\t" + '<%== $hand->[1] %>');
 });
 $('#pa').click(function (e) {
   ws.send($('#name').val() + "\t" + '<%== $hand->[2] %>');
 });
});
% end
<h1>Mojolicious + WebSocket</h1>
ここでの発言は<a href="http://park15.wakwak.com/~k-lovely/cgi-bin/wiki/wiki.cgi?page=chabo+%2D+AI%28Artificial+incompetence%29+chabo%28chat+bot%29+module">チャボ</a>に記憶され何処かで引用される可能性が有ります。ご注意下さい。<br />
<div class="ScrollBox" id="log2">
</div>

<p>name<input type="text" id="name" />
<br />msg<input type="text" id="msg" size="80"/></p>
  <button type="button" id="janken">じゃんけん</button>
  <button type="button" id="gu"><font size=50><%== $hand->[0] %></font></button>
  <button type="button" id="choki"><font size=50><%== $hand->[1] %></font></button>
  <button type="button" id="pa"><font size=50><%== $hand->[2] %></font></button>

[<%= 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>
Powered by FreeStyleWiki3.5.7 with Perl5.020003

メニュー

最新

2025/11/26

2025/10/31

2025/10/22

2025/8/18

2025/7/17

検索

キーワード
AND OR