GoogleのDevフォーラム2010のQuizのお知らせが来たので早速やってみてるよ。
で、とりあえずShiritoriがおもしろそうなのでやってみてるんだけど、
要は用意された文字のリストを使って、googleのしりとりサーバと勝負して勝て!っていう課題。
なんか、HUNTERxHUNTERみたいでかっこいいなw
んで、普通にやると画面にボタンがあって、選ぶんだけど、ボタンぽちぽちボタンを押してても埒があかないので、
そうか『Super Hacker:Shiritori』とか言うくらいだし、スパハカーなら手動とかありえんよなwとか思って、
自動でしりとり応戦してくれるサーバを開発してみた。
googleしりとりサーバ vs しりとり応戦サーバの図
たぶん、これを開発することがこの出題意図だよな。さすがググール。
サーバとサーバがえいやえいや対決してるなんて、なんだかハイテク。
結果、Lv1(スライム)とLv2(バラモス)は難なくクリアできたけど、
Lv3(ゾーマ)は10000回くらいトライしてるがまだ、クリアできね。ぐふ
たぶん、『ひかりのたま』的なアイテム使わないと勝てないように出来てるんだろうなー…

追記
gdd2010jpも終わったので『しりとり応戦サーバ』のソース公開します。
Cookie部分はセッション情報なども入ってる為、コメントアウトしてます。
#!/usr/bin/perl
use LWP::UserAgent;
use Jcode;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use strict qw(vars);
use POSIX;
my $COOKIE = qq{xxxx}; ## 中身はセキュリティー的な問題で内緒
my $sub_section = 2;
my @pettern;
my $try = 0;
my $count = 0;
while(1){
my $question = get_question();
my $answer = (sort {rand($b)<=>rand($a)} @{$question->{answers}})[0];
p("Question:[$question->{question}] / Answer:[$answer]");
&do_answer($question->{hash}, $answer );
my $res = get_question();
p("[$try][$count]try");
$count++;
p("status:[$res->{status}]") if($res->{status});
if($res->{status} eq "lose"){
p("Reset");
$try++;
do_reset($res->{hash});
} elsif($res->{status} eq "win"){
p("Finish!!");
} else {
p("Next!");
}
sleep 1;
}
sub p{
my $word = shift;
my $date = POSIX::strftime("%H:%M:%S",localtime);
print "$date:$word\n";
}
sub do_answer{
my ($hash,$word) = @_;
my $question = &get_question();
# リクエストの生成
my %form = (
'answer0' => $word,
'problem' => 'shiritori',
'sub_section' => $sub_section,
'hash' => $hash,
'submit_button' => '選択',
);
my $req = POST("http://gdd-2010-quiz-japan.appspot.com/problems/submit", [%form]);
$req->referer("http://gdd-2010-quiz-japan.appspot.com/problems?problem=shiritori&sub_section=$sub_section");
$req->header("Cookie",$COOKIE);
my $ua = LWP::UserAgent->new;
my $res = $ua->request($req);
}
sub do_reset{
my $hash = shift;
my $question = &get_question();
# リクエストの生成
my %form = ('problem' => 'shiritori',
'sub_section' => $sub_section,
'hash' => $hash,
'reset_button' => 'ゲームをリセット',
'answer0' => 'reset',
);
my $req = POST("http://gdd-2010-quiz-japan.appspot.com/problems/submit", [%form]);
$req->referer("http://gdd-2010-quiz-japan.appspot.com/problems?problem=shiritori&sub_section=$sub_section");
$req->header("Cookie",$COOKIE);
my $ua = LWP::UserAgent->new;
my $res = $ua->request($req);
}
sub get_question{
my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/5.0 (Windows; U; Windows NT 6.0; ja; rv:1.9.2.8) Gecko/20100722 Firefox/3.6.8 ');
my $req = HTTP::Request->new(GET => "http://gdd-2010-quiz-japan.appspot.com/problems?problem=shiritori&sub_section=$sub_section");
$req->referer("http://gdd-2010-quiz-japan.appspot.com/problems?problem=shiritori&sub_section=$sub_section");
$req->header("Accept-Encoding","gzip,deflate");
$req->header("Cookie",$COOKIE);
return parse_question(($ua->request($req))->content);
}
sub parse_question{
my $res = shift;
my $status;
if($res =~ /勝ち/){
$status = "win";
} elsif($res =~ /負け/){
$status = "lose";
}
my $flag;
my @con;
my @ans;
my @hist;
my $flag1;
my $flag2;
for(split /\n/,$res){
$flag=1 if(/辞書/);
$flag=0 if(/履歴/);
if($flag){
push @con,$_;
}
$flag2=1 if(/履歴/);
$flag2=0 if(/回答/);
if($flag2){
push @ans,$_;
}
}
my %hist;
@con = map {m@<li>(.*)</li>@ ; $1 } grep {m@<li>@} @con;
@ans = map {m@<li>(.*)</li>@ ; $1 } grep {m@<li>@} @ans;
for(@ans){
$hist{$_}=1;
}
my ($hash) = (grep {/hash/} split /\n/,$res)[0] =~ m@value="([^"]+)"@;
my $question = $ans[-1];
my @answers = grep {(get_word($_))->{st} eq (get_word($question))->{en} } grep { !$hist{$_} } @con;
return {status=>$status, answers => \@answers, history=>\@ans, question=> $question, list=>\@con,hash=>$hash };
}
sub get_word {
my $word = shift;
my ($st) = $word =~ m@^(.)@;
my ($en) = $word =~ m@(.)$@;
return {st=>$st,en=>$en};
}

