Implement fuzzy matching in bred answer checking to avoid repeating input phrase.
This commit is contained in:
1
cpanfile
1
cpanfile
@@ -20,4 +20,5 @@ requires 'Log::Any::For::Std';
|
|||||||
requires 'Mojo::Base';
|
requires 'Mojo::Base';
|
||||||
requires 'Mojo::IOLoop';
|
requires 'Mojo::IOLoop';
|
||||||
requires 'Mojo::UserAgent';
|
requires 'Mojo::UserAgent';
|
||||||
|
requires 'Text::Fuzzy';
|
||||||
requires 'URI::URL';
|
requires 'URI::URL';
|
||||||
|
|||||||
@@ -13,6 +13,7 @@ use URI::URL;
|
|||||||
use JSON::XS qw(decode_json encode_json);
|
use JSON::XS qw(decode_json encode_json);
|
||||||
use Digest::MD5 qw(md5_base64);
|
use Digest::MD5 qw(md5_base64);
|
||||||
use DB_File;
|
use DB_File;
|
||||||
|
use Text::Fuzzy qw(distance_edits);
|
||||||
use conf qw(loadConf);
|
use conf qw(loadConf);
|
||||||
use lat qw(latAnswer);
|
use lat qw(latAnswer);
|
||||||
use karma qw(karmaSet karmaGet);
|
use karma qw(karmaSet karmaGet);
|
||||||
@@ -22,7 +23,7 @@ use archeologist qw (dig);
|
|||||||
|
|
||||||
use vars qw/$VERSION/;
|
use vars qw/$VERSION/;
|
||||||
use Exporter qw(import);
|
use Exporter qw(import);
|
||||||
our @EXPORT_OK = qw(weather trim randomCommonPhrase command highlight botsleep);
|
our @EXPORT_OK = qw(weather trim randomCommonPhrase command highlight botsleep fmatch);
|
||||||
$VERSION = '1.0';
|
$VERSION = '1.0';
|
||||||
|
|
||||||
my $c = loadConf();
|
my $c = loadConf();
|
||||||
@@ -362,6 +363,21 @@ sub botsleep {
|
|||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
sub fmatch {
|
||||||
|
my $srcphrase = shift;
|
||||||
|
my $answer = shift;
|
||||||
|
|
||||||
|
my ($distance, undef) = distance_edits ($srcphrase, $answer);
|
||||||
|
my $srcphraselen = length $srcphrase;
|
||||||
|
my $distance_max = int ($srcphraselen - ($srcphraselen * (100 - (90 / ($srcphraselen ** 0.5))) * 0.01));
|
||||||
|
|
||||||
|
if ($distance >= $distance_max) {
|
||||||
|
return 0;
|
||||||
|
} else {
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
||||||
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
# vim: set ft=perl noet ai ts=4 sw=4 sts=4:
|
||||||
|
|||||||
@@ -12,7 +12,7 @@ use File::Path qw(mkpath);
|
|||||||
use Hailo;
|
use Hailo;
|
||||||
use Mojo::Base 'Teapot::Bot::Brain';
|
use Mojo::Base 'Teapot::Bot::Brain';
|
||||||
use conf qw(loadConf);
|
use conf qw(loadConf);
|
||||||
use botlib qw(weather trim randomCommonPhrase command highlight botsleep);
|
use botlib qw(weather trim randomCommonPhrase command highlight botsleep fmatch);
|
||||||
use karma qw(karmaSet);
|
use karma qw(karmaSet);
|
||||||
use fortune qw(fortune fortune_toggle_list);
|
use fortune qw(fortune fortune_toggle_list);
|
||||||
|
|
||||||
@@ -287,12 +287,7 @@ sub __on_msg {
|
|||||||
|
|
||||||
$phrase = lc ($phrase);
|
$phrase = lc ($phrase);
|
||||||
|
|
||||||
if (lc ($reply) eq $phrase) {
|
if (fmatch (lc ($reply), $phrase)) {
|
||||||
$reply = randomCommonPhrase ();
|
|
||||||
} elsif (lc ($reply) eq substr ($phrase, 0, -1)) {
|
|
||||||
# in case of trailing dot
|
|
||||||
$reply = randomCommonPhrase ();
|
|
||||||
} elsif (substr (lc ($reply), 0, -1) eq $phrase) {
|
|
||||||
$reply = randomCommonPhrase ();
|
$reply = randomCommonPhrase ();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user