人工無脳をつくってみようとする6

Programming Perl 人工無脳

文字単位N-gramモデルか、MeCabによる単語単位N-gramモデルかを選べるように。辞書データの保存は我流謎フォーマットから、StorableモジュールかData::Dumperモジュールで行なうように。あとはそーね、(2+i)-gramモデルに対応。1-gramモデルで統計を取るにはちょっとコード書き換えなきゃいけねー。
んで、それらの違いをパラメータの変更でできるように。
人工無脳としての機能改良はほぼ無し。っていうかまだ全く人工無脳エンジンとしてなりたってないし。
考えていることは、MeCabから品詞IDを貰ってほげほげすることと、会話中にぐぐって勝手に知識を増やすこと、トリガーモデルっぽいものを組み込むこと。あと会話らしくするための、相手の発言により生起確率をほげほげしてくれるモデルの搭載。っていうか、これが無いと無脳じゃねえ。
というわけで、まだまだ無脳には遠いMezassiエンジン。持ってるモデルはまだN-gramしか無いけどがんばれめざし、負けるなめざし。

# Chatbot "Mezassi" Engine
package Mezassi;

use strict;
use warnings;
use Storable qw(nstore retrieve);
use Data::Dumper;
$Data::Dumper::Indent=1;
use MeCab;

sub new{
  my ($pkg) = @_;
  $conf = {
    dic_hash => {},
    bos => ['&bos1;', '&bos2;', '&bos3;'],
    eos => '&eos;',
    unit => 'word',
    dic_type => 'store',
  };
  bless $conf, $pkg;
}
BEGIN{
  my $mecab = new MeCab::Tagger("-Owakati");
  my $ascii = '[\x00-\x7F]';
  my $twoBytes = '[\x8E\xA1-\xFE][\xA1-\xFE]';
  my $threeBytes = '\x8F[\xA1-\xFE][\xA1-\xFE]';
  sub unitsplit{
    my ($self, $sentence) = @_;
    if($self->{'unit'} eq 'word'){
      return split(" ", $mecab->parse($sentence));
    }
    elsif($self->{'unit'} eq 'character'){
      return $sentence =~ /$ascii|$twoBytes|$threeBytes/og;
    }
  }
}
sub add_chain{
  my ($self, $next, @preunits) = @_;
  my $chain = $self->{'dic_hash'};
  foreach(@preunits){
    ++($chain->{sum});
    $chain->{next}{$_}={} if(!defined($chain->{next}{$_}));
    $chain = $chain->{next}{$_};
  }
  ++($chain->{"sum"});
  ++($chain->{next}{$next});
}
sub get_chain{
  my $self = shift;
  my @preunits = @_;
  my $chain = $self->{'dic_hash'};
  foreach(@preunits){
    $chain = $chain->{next}{$_};
  }
  return $chain;
}
sub read_dic{
  my ($self, $dic_name) = @_;

  if($self->{'dic_type'} eq 'store'){
    $self->{'dic_hash'} = retrieve($dic_name);
  }
  elsif($self->{'dic_type'} eq 'dump'){
    $self->{'dic_hash'} = require $dic_name;
  }
}
sub write_dic{
  my ($self, $dic_name) = @_;

  if($self->{'dic_type'} eq 'store'){
    nstore($self->{'dic_hash'}, $dic_name);
  }
  elsif($self->{'dic_type'} eq 'dump'){
    open(DIC, ">$dic_name");
    print DIC Dumper($self->{'dic_hash'});
    close(DIC);
  }
}
sub read_sentence{
  my ($self, $sentence) = @_;
  my @preunits = @{$self->{'bos'}};

  return if($sentence eq "\n");
  chomp($sentence);
  my @unitlist = $self->unitsplit($sentence);
  foreach(@unitlist){
    $_ = escape($_);
    $self->add_chain($_, @preunits);
    shift @preunits;
    push(@preunits, $_);
  }
  $self->add_chain($self->{'eos'}, @preunits);
}
sub gen_sentence{
  my ($self) = @_;
  my @preunits = @{$self->{'bos'}};
  my $sentence = "";

  my $chain = $self->get_chain(@preunits);
  while(defined($chain)){
    my @next_list = keys(%{$chain->{next}});
    my $next_sum = $chain->{"sum"};
    foreach(@next_list){
      if(rand($next_sum) > $chain->{next}{$_}){
        $next_sum -= $chain->{next}{$_};
        next;
      }
      shift @preunits;
      push(@preunits, $_);
      last;
    }
    last if($preunits[@preunits-1] eq $self->{'eos'});
    $sentence .= $preunits[@preunits-1];
    $chain = $self->get_chain(@preunits);
  }
  return descape($sentence);
}
sub escape{
  my ($unit) = @_;
  $unit =~ s/&/&/g;
  return $unit;
}
sub descape{
  my ($unit) = @_;
  $unit =~ s/&/&/g;
  return $unit;
}
sub read_log{
  my ($self, $log_name) = @_;

  open(LOG, $log_name)||die("cannot open $log_name\n");
  while(<LOG>){
    $self->read_sentence($_);
  }
  close(LOG);
}
sub write_log{
  my ($self, $log_name, $sentence) = @_;

  open(LOG, ">>$log_name")||die("cannot open $log_name\n");
  print LOG $sentence;
  close(LOG);
}
sub reset_dic{
  my ($self) = @_;
  $self->{'dic_hash'} = {};
}
1;

コメントが無いなあ。設計がいきあたりばったりなもんで。脳味噌はいまだに行指向プログラミング。

test