Skip to content

Instantly share code, notes, and snippets.

@ytnobody
Created Dec 22, 2016
Embed
What would you like to do?
Perl入学式 Advent Calendar 2016 第23日目 「Perlで替え歌エンジンをつくる」
requires 'JSON';
requires 'LWP::UserAgent';
requires 'LWP::Protocol::https';
use strict;
use warnings;
### 日本語を取り扱うので、内部文字コードはぜんぶutf8とみなす
use utf8;
### 日本語を出力するため、標準出力のモードをバイナリモードにする
binmode STDOUT, ":utf8";
### 今回使うモジュールたち
use JSON;
use URI;
use LWP::UserAgent;
### 差し替えに使う単語たち
my @nouns = qw(
インフラ エンジニア 企画 権力 賃金
残業 休日出勤 障害 技術負債 レポジトリ
);
### ここで替え歌をつくる
kaeuta('真っ赤なお鼻のトナカイさんはいつもみんなの笑い物');
### 替え歌作成関数
sub kaeuta {
my $lyric = shift;
my $agent = LWP::UserAgent->new;
my $uri = URI->new('https://ytnobody-mecab.arukascloud.io/');
$uri->query_form(text => $lyric);
my $res = $agent->get($uri->as_string);
if ($res->is_success) {
my $data = decode_json($res->content);
printf "%s\n", join("", map {change_item($_)} grep {$_->{surface}} @{$data->{nodes}});
}
}
### ランダムに差し替え単語をチョイスする関数
sub get_noun_rand {
my $i = int(rand(scalar(@nouns)));
return $nouns[$i];
}
### 差し替え対象となる「名詞/一般」の単語であるかをチェックする関数
sub is_general_noun {
my $item = shift;
$item->{feature}[0] eq '名詞' && $item->{feature}[1] eq '一般';
}
### 差し替え対象の単語を高確率で差し替える関数
sub change_item {
my $item = shift;
return $item->{surface} if rand(10) > 7;
is_general_noun($item) ? get_noun_rand() : $item->{surface};
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment