Add per-question statistics gathering

modules/cjeopardy/QStatskeeper.pm

@@ -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;

modules/cjeopardy/cjeopardy.pl

@@ -8,6 +8,7 @@ use Time::Duration qw/duration/;
 use Fcntl qw(:flock);
 
 use IRCColors;
+use QStatskeeper;
 
 my $CJEOPARDY_FILE    = 'cjeopardy.txt';
 my $CJEOPARDY_DATA    = 'data/cjeopardy.dat';
@@ -95,7 +96,8 @@ chomp $q;
 chomp $a;
 
 $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;
 print "$q\n";
@@ -106,6 +108,19 @@ print $fh "$a\n";
 print $fh scalar gettimeofday, "\n";
 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 {
   my $return_index = shift @_;

modules/cjeopardy/cjeopardy_answer.pl

@@ -8,6 +8,7 @@ use Time::HiRes qw(gettimeofday);
 use Time::Duration qw(duration);
 use Fcntl qw(:flock);
 
+use QStatskeeper;
 use Scorekeeper;
 use IRCColors;
 
@@ -122,8 +123,15 @@ $scores->begin;
 my $player_id = $scores->get_player_id($nick, $channel);
 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 $qstats = QStatskeeper->new;
+$qstats->begin;
+my $qdata = $qstats->get_question_data($id);
+
+$qdata->{last_touched} = gettimeofday;
+
 my $incorrect_percentage = 100;
 
 foreach my $answer (@valid_answers) {
@@ -177,6 +185,25 @@ foreach my $answer (@valid_answers) {
       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);
 
     foreach my $streaker (@$streakers) {
@@ -257,6 +284,9 @@ foreach my $answer (@valid_answers) {
     $scores->update_player_data($player_id, $player_data);
     $scores->end;
 
+    $qstats->update_question_data($id, $qdata);
+    $qstats->end;
+
     unlink "$CJEOPARDY_DATA-$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};
 }
 
+$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 = (
   5  => "Guessing, are we, $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->end;
+
+$qstats->update_question_data($id, $qdata);
+$qstats->end;

modules/cjeopardy/cjeopardy_hint.pl

@@ -8,6 +8,7 @@ use Time::Duration qw/duration/;
 use Fcntl qw(:flock);
 
 use Scorekeeper;
+use QStatskeeper;
 use IRCColors;
 
 my $CJEOPARDY_DATA   = 'data/cjeopardy.dat';
@@ -111,3 +112,12 @@ $player_data->{hints}++;
 $player_data->{lifetime_hints}++;
 $scores->update_player_data($id, $player_data);
 $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;