3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-10-01 17:16:39 +02:00

C Jeopardy: Add tons of new questions; add support for supplemental tidbits; don't obscure dashes and underscors in hints

This commit is contained in:
Pragmatic Software 2014-08-03 22:20:54 +00:00
parent 55bdc5b930
commit 4bf78bf978
5 changed files with 1356 additions and 191 deletions

View File

@ -13,7 +13,7 @@ use warnings;
# These are set automatically by the build/commit script
use constant {
BUILD_NAME => "PBot",
BUILD_REVISION => 760,
BUILD_REVISION => 761,
BUILD_DATE => "2014-08-03",
};

View File

@ -15,6 +15,9 @@ my $TIMELIMIT = 300;
my $channel = shift @ARGV;
my $text = join(' ', @ARGV);
sub encode { my $str = shift; $str =~ s/\\(.)/{sprintf "\\%03d", ord($1)}/ge; return $str; }
sub decode { my $str = shift; $str =~ s/\\(\d{3})/{"\\" . chr($1)}/ge; return $str }
if ($channel !~ /^#/) {
print "Sorry, C Jeopardy must be played in a channel.\n";
exit;
@ -28,7 +31,8 @@ if (defined $ret) {
if (scalar gettimeofday - $last_timestamp <= $TIMELIMIT) {
my $duration = duration($TIMELIMIT - scalar gettimeofday - $last_timestamp);
print "The current question is: $last_question You may request a new question in $duration.\n";
print "The current question is: $last_question";
print "You may request a new question in $duration.\n";
close $fh;
exit;
}
@ -62,7 +66,8 @@ if (not length $text) {
my @questions;
open $fh, "<", $CJEOPARDY_FILE or die "Could not open $CJEOPARDY_FILE: $!";
while (my $question = <$fh>) {
my ($question_only) = split /\|/, $question, 2;
my ($question_only) = map { decode $_ } split /\|/, encode($question), 2;
$question_only =~ s/\\\|/|/g;
next if length $text and $question_only !~ /\Q$text\E/i;
push @questions, $question;
}
@ -79,11 +84,13 @@ if (length $text) {
my $question = $questions[$question_index];
my ($q, $a) = split /\|/, $question, 2;
my ($q, $a) = map { decode $_ } split /\|/, encode($question), 2;
chomp $q;
chomp $a;
$q =~ s/\\\|/|/g;
$q =~ s/^\[.*?\]\s+//;
print "$q\n";
open $fh, ">", "$CJEOPARDY_DATA-$channel" or die "Could not open $CJEOPARDY_DATA-$channel: $!";

File diff suppressed because it is too large Load Diff

View File

@ -8,6 +8,8 @@ use Text::Levenshtein qw(fastdistance);
my $CJEOPARDY_DATA = 'cjeopardy.dat';
my $CJEOPARDY_HINT = 'cjeopardy.hint';
my $hint_only_mode = 0;
my $channel = shift @ARGV;
my $text = join(' ', @ARGV);
@ -19,15 +21,15 @@ if ($channel !~ /^#/) {
exit;
}
$text = lc $text;
$text =~ s/^\s*is\s*//;
$text =~ s/^\s*are\s*//;
$text =~ s/^(a|an)\s+//;
$text =~ s/^\s*is\s*//i;
$text =~ s/^\s*are\s*//i;
$text =~ s/^(a|an)\s+//i;
$text =~ s/\s*\?*$//;
$text =~ s/^\s+//;
$text =~ s/\s+$//;
my $lctext = lc $text;
if (not length $text) {
if (not length $lctext) {
print "What?\n";
exit;
}
@ -43,14 +45,25 @@ foreach my $answer (@valid_answers) {
chomp $answer;
$answer =~ s/\\\|/|/g;
my $distance = fastdistance($text, lc $answer);
my $length = (length($text) > length($answer)) ? length $text : length $answer;
my $supplemental_text;
if ($answer =~ s/\s*{(.*)}\s*$//) {
$supplemental_text = $1;
}
my $distance = fastdistance($lctext, lc $answer);
my $length = (length($lctext) > length($answer)) ? length $lctext : length $answer;
if ($distance / $length < 0.15) {
if ($distance == 0) {
print "'$answer' is correct!\n";
print "'$answer' is correct!";
} else {
print "'$text' is close enough to '$answer'. You are correct!\n"
print "'$text' is close enough to '$answer'. You are correct!"
}
if (defined $supplemental_text) {
print " $supplemental_text\n";
} else {
print "\n";
}
unlink "$CJEOPARDY_DATA-$channel";
@ -58,7 +71,14 @@ foreach my $answer (@valid_answers) {
if ($channel eq '#cjeopardy') {
my $question = `./cjeopardy.pl $channel`;
print "Next question: $question\n";
if ($hint_only_mode) {
my $hint = `./cjeopardy_hint.pl $channel`;
$hint =~ s/^Hint: //;
print "Next hint: $hint\n";
} else {
print "Next question: $question\n";
}
}
exit;
}

View File

@ -27,12 +27,18 @@ open my $fh, "<", "$CJEOPARDY_DATA-$channel" or print "There is no open C Jeopar
@data = <$fh>;
close $fh;
my @valid_answers = map { lc decode $_ } split /\|/, encode $data[1];
my @valid_answers = map { decode $_ } split /\|/, encode $data[1];
my ($hint, $length) = ('', 0);
foreach my $answer (@valid_answers) {
chomp $answer;
$answer =~ s/\\\|/|/g;
my $supplemental_text;
if ($answer =~ s/\s*{(.*)}\s*$//) {
$supplemental_text = $1;
}
if (length $answer > $length) {
$length = length $answer;
$hint = $answer;
@ -47,11 +53,15 @@ if (defined $ret) {
close $fh;
}
$last_timeout = 0 if not defined $last_timeout;
my $duration = scalar gettimeofday - $last_timeout;
if ($duration < $timeout) {
$duration = duration($timeout - $duration);
print "Please wait $duration before requesting another hint.\n";
exit;
unless ($duration eq 'just now') {
print "Please wait $duration before requesting another hint.\n";
exit;
}
}
$hint_counter++;
@ -63,11 +73,16 @@ close $fh;
my $hidden_character_count = int length ($hint) * $hints[$hint_counter > $#hints ? $#hints : $hint_counter];
my $spaces = () = $hint =~ / /g;
my $dashes = () = $hint =~ /-/g;
my $underscores = () = $hint =~ /_/g;
my @indices;
while (@indices <= $hidden_character_count) {
while (@indices <= $hidden_character_count - $spaces - $dashes - $underscores) {
my $index = int rand($length);
next if substr($hint, $index, 1) eq ' ';
my $char = substr($hint, $index, 1);
next if $char eq ' ';
next if $char eq '-';
next if $char eq '_';
next if grep { $index eq $_ } @indices;
push @indices, $index;
}