mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-26 05:49:27 +01:00
Add per-question statistics gathering
This commit is contained in:
parent
7a5a3a38f2
commit
5b4fccb3f4
194
modules/cjeopardy/QStatskeeper.pm
Normal file
194
modules/cjeopardy/QStatskeeper.pm
Normal file
@ -0,0 +1,194 @@
|
|||||||
|
#!/usr/bin/env perl
|
||||||
|
|
||||||
|
package QStatskeeper;
|
||||||
|
|
||||||
|
use warnings;
|
||||||
|
use strict;
|
||||||
|
|
||||||
|
use DBI;
|
||||||
|
use Carp qw(shortmess);
|
||||||
|
|
||||||
|
my $debug = 0;
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my ($class, %conf) = @_;
|
||||||
|
my $self = bless {}, $class;
|
||||||
|
$self->initialize(%conf);
|
||||||
|
return $self;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub initialize {
|
||||||
|
my ($self, %conf) = @_;
|
||||||
|
$self->{filename} = $conf{filename} // 'qstats.sqlite';
|
||||||
|
}
|
||||||
|
|
||||||
|
sub begin {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
print STDERR "Opening QStats SQLite database: $self->{filename}\n" if $debug;
|
||||||
|
|
||||||
|
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0 }) or die $DBI::errstr;
|
||||||
|
|
||||||
|
eval {
|
||||||
|
$self->{dbh}->do(<< 'SQL');
|
||||||
|
CREATE TABLE IF NOT EXISTS QStats (
|
||||||
|
id INTEGER PRIMARY KEY,
|
||||||
|
asked_count INTEGER DEFAULT 0,
|
||||||
|
last_asked NUMERIC DEFAULT 0,
|
||||||
|
last_touched NUMERIC DEFAULT 0,
|
||||||
|
correct INTEGER DEFAULT 0,
|
||||||
|
last_correct_time NUMERIC DEFAULT 0,
|
||||||
|
last_correct_nick TEXT COLLATE NOCASE DEFAULT NULL,
|
||||||
|
wrong INTEGER DEFAULT 0,
|
||||||
|
wrong_streak INTEGER DEFAULT 0,
|
||||||
|
highest_wrong_streak INTEGER DEFAULT 0,
|
||||||
|
hints INTEGER DEFAULT 0,
|
||||||
|
quickest_answer_time NUMERIC DEFAULT 0,
|
||||||
|
quickest_answer_nick TEXT COLLATE NOCASE DEFAULT NULL,
|
||||||
|
longest_answer_time NUMERIC DEFAULT 0,
|
||||||
|
longest_answer_nick TEXT COLLATE NOCASE DEFAULT NULL,
|
||||||
|
average_answer_time NUMERIC DEFAULT 0
|
||||||
|
)
|
||||||
|
SQL
|
||||||
|
|
||||||
|
$self->{dbh}->do(<< 'SQL');
|
||||||
|
CREATE TABLE IF NOT EXISTS WrongAnswers (
|
||||||
|
id INTEGER,
|
||||||
|
answer TEXT UNIQUE NOT NULL COLLATE NOCASE,
|
||||||
|
count INTEGER DEFAULT 1
|
||||||
|
)
|
||||||
|
SQL
|
||||||
|
};
|
||||||
|
|
||||||
|
print STDERR $@ if $@;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub end {
|
||||||
|
my $self = shift;
|
||||||
|
|
||||||
|
print STDERR "Closing QStats SQLite database\n" if $debug;
|
||||||
|
|
||||||
|
if(exists $self->{dbh} and defined $self->{dbh}) {
|
||||||
|
$self->{dbh}->disconnect();
|
||||||
|
delete $self->{dbh};
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub add_question {
|
||||||
|
my ($self, $id) = @_;
|
||||||
|
|
||||||
|
eval {
|
||||||
|
my $sth = $self->{dbh}->prepare('INSERT OR IGNORE INTO QStats (id) VALUES (?)');
|
||||||
|
$sth->bind_param(1, $id);
|
||||||
|
$sth->execute();
|
||||||
|
};
|
||||||
|
|
||||||
|
print STDERR $@ if $@;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_question_data {
|
||||||
|
my ($self, $id, @columns) = @_;
|
||||||
|
|
||||||
|
$self->add_question($id);
|
||||||
|
|
||||||
|
my $qdata = eval {
|
||||||
|
my $sql = 'SELECT ';
|
||||||
|
|
||||||
|
if(not @columns) {
|
||||||
|
$sql .= '*';
|
||||||
|
} else {
|
||||||
|
my $comma = '';
|
||||||
|
foreach my $column (@columns) {
|
||||||
|
$sql .= "$comma$column";
|
||||||
|
$comma = ', ';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
$sql .= ' FROM QStats WHERE id = ?';
|
||||||
|
my $sth = $self->{dbh}->prepare($sql);
|
||||||
|
$sth->bind_param(1, $id);
|
||||||
|
$sth->execute();
|
||||||
|
return $sth->fetchrow_hashref();
|
||||||
|
};
|
||||||
|
print STDERR $@ if $@;
|
||||||
|
return $qdata;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub update_question_data {
|
||||||
|
my ($self, $id, $data) = @_;
|
||||||
|
|
||||||
|
eval {
|
||||||
|
my $sql = 'UPDATE QStats SET ';
|
||||||
|
|
||||||
|
my $comma = '';
|
||||||
|
foreach my $key (keys %$data) {
|
||||||
|
$sql .= "$comma$key = ?";
|
||||||
|
$comma = ', ';
|
||||||
|
}
|
||||||
|
|
||||||
|
$sql .= ' WHERE id = ?';
|
||||||
|
|
||||||
|
my $sth = $self->{dbh}->prepare($sql);
|
||||||
|
|
||||||
|
my $param = 1;
|
||||||
|
foreach my $key (keys %$data) {
|
||||||
|
$sth->bind_param($param++, $data->{$key});
|
||||||
|
}
|
||||||
|
|
||||||
|
$sth->bind_param($param, $id);
|
||||||
|
$sth->execute();
|
||||||
|
};
|
||||||
|
print STDERR $@ if $@;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub get_wrong_answers {
|
||||||
|
my ($self, $id) = @_;
|
||||||
|
|
||||||
|
my $answers = eval {
|
||||||
|
my $sth = $self->{dbh}->prepare("SELECT * FROM WrongAnswers WHERE id = ?");
|
||||||
|
$sth->bind_param(1, $id);
|
||||||
|
$sth->execute();
|
||||||
|
return $sth->fetchall_arrayref({});
|
||||||
|
};
|
||||||
|
print STDERR $@ if $@;
|
||||||
|
return $answers;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub add_wrong_answer {
|
||||||
|
my ($self, $id, $answer) = @_;
|
||||||
|
|
||||||
|
$answer = lc $answer;
|
||||||
|
$answer =~ s/^\s+|\s+$//g;
|
||||||
|
|
||||||
|
my $answers = $self->get_wrong_answers($id);
|
||||||
|
|
||||||
|
my $found_ans;
|
||||||
|
foreach my $ans (@$answers) {
|
||||||
|
if ($ans->{answer} eq $answer) {
|
||||||
|
$found_ans = $ans;
|
||||||
|
last;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (not $found_ans) {
|
||||||
|
eval {
|
||||||
|
my $sth = $self->{dbh}->prepare("INSERT INTO WrongAnswers (id, answer) VALUES (?, ?)");
|
||||||
|
$sth->bind_param(1, $id);
|
||||||
|
$sth->bind_param(2, $answer);
|
||||||
|
$sth->execute();
|
||||||
|
};
|
||||||
|
print STDERR $@ if $@;
|
||||||
|
} else {
|
||||||
|
$found_ans->{count}++;
|
||||||
|
eval {
|
||||||
|
my $sth = $self->{dbh}->prepare("UPDATE WrongAnswers SET count = ? WHERE id = ? AND answer = ?");
|
||||||
|
$sth->bind_param(1, $found_ans->{count});
|
||||||
|
$sth->bind_param(2, $id);
|
||||||
|
$sth->bind_param(3, $answer);
|
||||||
|
$sth->execute();
|
||||||
|
};
|
||||||
|
print STDERR $@ if $@;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
1;
|
@ -8,6 +8,7 @@ use Time::Duration qw/duration/;
|
|||||||
use Fcntl qw(:flock);
|
use Fcntl qw(:flock);
|
||||||
|
|
||||||
use IRCColors;
|
use IRCColors;
|
||||||
|
use QStatskeeper;
|
||||||
|
|
||||||
my $CJEOPARDY_FILE = 'cjeopardy.txt';
|
my $CJEOPARDY_FILE = 'cjeopardy.txt';
|
||||||
my $CJEOPARDY_DATA = 'data/cjeopardy.dat';
|
my $CJEOPARDY_DATA = 'data/cjeopardy.dat';
|
||||||
@ -95,7 +96,8 @@ chomp $q;
|
|||||||
chomp $a;
|
chomp $a;
|
||||||
|
|
||||||
$q =~ s/\\\|/|/g;
|
$q =~ s/\\\|/|/g;
|
||||||
$q =~ s/^\[.*?\]\s+//;
|
$q =~ s/^(\d+)\) \[.*?\]\s+/$1) /;
|
||||||
|
my $id = $1;
|
||||||
|
|
||||||
$q =~ s/\b(this keyword|this operator|this behavior|this preprocessing directive|this escape sequence|this mode|this function specifier|this function|this macro|this predefined macro|this header|this pragma|this fprintf length modifier|this storage duration|this type qualifier|this type|this value|this operand|this many|this|these)\b/$color{bold}$1$color{reset}/gi;
|
$q =~ s/\b(this keyword|this operator|this behavior|this preprocessing directive|this escape sequence|this mode|this function specifier|this function|this macro|this predefined macro|this header|this pragma|this fprintf length modifier|this storage duration|this type qualifier|this type|this value|this operand|this many|this|these)\b/$color{bold}$1$color{reset}/gi;
|
||||||
print "$q\n";
|
print "$q\n";
|
||||||
@ -106,6 +108,19 @@ print $fh "$a\n";
|
|||||||
print $fh scalar gettimeofday, "\n";
|
print $fh scalar gettimeofday, "\n";
|
||||||
close $fh;
|
close $fh;
|
||||||
|
|
||||||
|
my $qstats = QStatskeeper->new;
|
||||||
|
$qstats->begin;
|
||||||
|
|
||||||
|
my $qdata = $qstats->get_question_data($id);
|
||||||
|
|
||||||
|
$qdata->{asked_count}++;
|
||||||
|
$qdata->{last_asked} = gettimeofday;
|
||||||
|
$qdata->{last_touched} = gettimeofday;
|
||||||
|
$qdata->{wrong_streak} = 0;
|
||||||
|
|
||||||
|
$qstats->update_question_data($id, $qdata);
|
||||||
|
$qstats->end;
|
||||||
|
|
||||||
|
|
||||||
sub shuffle_questions {
|
sub shuffle_questions {
|
||||||
my $return_index = shift @_;
|
my $return_index = shift @_;
|
||||||
|
File diff suppressed because it is too large
Load Diff
@ -8,6 +8,7 @@ use Time::HiRes qw(gettimeofday);
|
|||||||
use Time::Duration qw(duration);
|
use Time::Duration qw(duration);
|
||||||
use Fcntl qw(:flock);
|
use Fcntl qw(:flock);
|
||||||
|
|
||||||
|
use QStatskeeper;
|
||||||
use Scorekeeper;
|
use Scorekeeper;
|
||||||
use IRCColors;
|
use IRCColors;
|
||||||
|
|
||||||
@ -122,8 +123,15 @@ $scores->begin;
|
|||||||
my $player_id = $scores->get_player_id($nick, $channel);
|
my $player_id = $scores->get_player_id($nick, $channel);
|
||||||
my $player_data = $scores->get_player_data($player_id);
|
my $player_data = $scores->get_player_data($player_id);
|
||||||
|
|
||||||
|
my ($id) = $data[0] =~ m/^(\d+)/;
|
||||||
my @valid_answers = map { decode $_ } split /\|/, encode $data[1];
|
my @valid_answers = map { decode $_ } split /\|/, encode $data[1];
|
||||||
|
|
||||||
|
my $qstats = QStatskeeper->new;
|
||||||
|
$qstats->begin;
|
||||||
|
my $qdata = $qstats->get_question_data($id);
|
||||||
|
|
||||||
|
$qdata->{last_touched} = gettimeofday;
|
||||||
|
|
||||||
my $incorrect_percentage = 100;
|
my $incorrect_percentage = 100;
|
||||||
|
|
||||||
foreach my $answer (@valid_answers) {
|
foreach my $answer (@valid_answers) {
|
||||||
@ -177,6 +185,25 @@ foreach my $answer (@valid_answers) {
|
|||||||
print " It took $duration to answer that question.\n";
|
print " It took $duration to answer that question.\n";
|
||||||
}
|
}
|
||||||
|
|
||||||
|
$qdata->{correct}++;
|
||||||
|
$qdata->{last_correct_time} = gettimeofday;
|
||||||
|
$qdata->{last_correct_nick} = $nick;
|
||||||
|
|
||||||
|
if (gettimeofday - $qdata->{last_touched} < 60 * 5) {
|
||||||
|
$qdata->{average_answer_time} += $elapsed;
|
||||||
|
$qdata->{average_answer_time} /= $qdata->{correct};
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($qdata->{quickest_answer_time} == 0 or $elapsed < $qdata->{quickest_answer_time}) {
|
||||||
|
$qdata->{quickest_answer_time} = $elapsed;
|
||||||
|
$qdata->{quickest_answer_nick} = $nick;
|
||||||
|
}
|
||||||
|
|
||||||
|
if ($elapsed > $qdata->{longest_answer_time}) {
|
||||||
|
$qdata->{longest_answer_time} = $elapsed;
|
||||||
|
$qdata->{longest_answer_nick} = $nick;
|
||||||
|
}
|
||||||
|
|
||||||
my $streakers = $scores->get_all_correct_streaks($channel);
|
my $streakers = $scores->get_all_correct_streaks($channel);
|
||||||
|
|
||||||
foreach my $streaker (@$streakers) {
|
foreach my $streaker (@$streakers) {
|
||||||
@ -257,6 +284,9 @@ foreach my $answer (@valid_answers) {
|
|||||||
$scores->update_player_data($player_id, $player_data);
|
$scores->update_player_data($player_id, $player_data);
|
||||||
$scores->end;
|
$scores->end;
|
||||||
|
|
||||||
|
$qstats->update_question_data($id, $qdata);
|
||||||
|
$qstats->end;
|
||||||
|
|
||||||
unlink "$CJEOPARDY_DATA-$channel";
|
unlink "$CJEOPARDY_DATA-$channel";
|
||||||
unlink "$CJEOPARDY_HINT-$channel";
|
unlink "$CJEOPARDY_HINT-$channel";
|
||||||
|
|
||||||
@ -316,6 +346,15 @@ if ($player_data->{highest_wrong_streak} > $player_data->{lifetime_highest_wrong
|
|||||||
$player_data->{lifetime_highest_wrong_streak} = $player_data->{highest_wrong_streak};
|
$player_data->{lifetime_highest_wrong_streak} = $player_data->{highest_wrong_streak};
|
||||||
}
|
}
|
||||||
|
|
||||||
|
$qdata->{wrong}++;
|
||||||
|
$qdata->{wrong_streak}++;
|
||||||
|
|
||||||
|
if ($qdata->{wrong_streak} > $qdata->{highest_wrong_streak}) {
|
||||||
|
$qdata->{highest_wrong_streak} = $qdata->{wrong_streak};
|
||||||
|
}
|
||||||
|
|
||||||
|
$qstats->add_wrong_answer($id, $lctext);
|
||||||
|
|
||||||
my %streaks = (
|
my %streaks = (
|
||||||
5 => "Guessing, are we, $nick?",
|
5 => "Guessing, are we, $nick?",
|
||||||
7 => "Think of your correct/incorrect ratio! Use a hint, $nick!",
|
7 => "Think of your correct/incorrect ratio! Use a hint, $nick!",
|
||||||
@ -327,3 +366,6 @@ if (exists $streaks{$player_data->{wrong_streak}}) {
|
|||||||
|
|
||||||
$scores->update_player_data($player_id, $player_data);
|
$scores->update_player_data($player_id, $player_data);
|
||||||
$scores->end;
|
$scores->end;
|
||||||
|
|
||||||
|
$qstats->update_question_data($id, $qdata);
|
||||||
|
$qstats->end;
|
||||||
|
@ -8,6 +8,7 @@ use Time::Duration qw/duration/;
|
|||||||
use Fcntl qw(:flock);
|
use Fcntl qw(:flock);
|
||||||
|
|
||||||
use Scorekeeper;
|
use Scorekeeper;
|
||||||
|
use QStatskeeper;
|
||||||
use IRCColors;
|
use IRCColors;
|
||||||
|
|
||||||
my $CJEOPARDY_DATA = 'data/cjeopardy.dat';
|
my $CJEOPARDY_DATA = 'data/cjeopardy.dat';
|
||||||
@ -111,3 +112,12 @@ $player_data->{hints}++;
|
|||||||
$player_data->{lifetime_hints}++;
|
$player_data->{lifetime_hints}++;
|
||||||
$scores->update_player_data($id, $player_data);
|
$scores->update_player_data($id, $player_data);
|
||||||
$scores->end;
|
$scores->end;
|
||||||
|
|
||||||
|
($id) = $data[0] =~ m/^(\d+)/;
|
||||||
|
my $qstats = QStatskeeper->new;
|
||||||
|
$qstats->begin;
|
||||||
|
my $qdata = $qstats->get_question_data($id);
|
||||||
|
$qdata->{last_touched} = gettimeofday;
|
||||||
|
$qdata->{hints}++;
|
||||||
|
$qstats->update_question_data($id, $qdata);
|
||||||
|
$qstats->end;
|
||||||
|
Loading…
Reference in New Issue
Block a user