GitHub
/
pbot
mirror of https://github.com/pragma-/pbot.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity

Spinach: add stats tracking and ranking

This commit is contained in:
Pragmatic Software 2019-04-24 03:55:48 -07:00
parent 3c936183a4
commit 940b40e24f
3 changed files with 469 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

141
PBot/Plugins/Spinach.pm
View File

@ -7,11 +7,13 @@ package PBot::Plugins::Spinach;
use warnings;
use strict;
use FindBin;
use lib "$FindBin::RealBin/../..";
use feature 'switch';
no if $] >= 5.018, warnings => "experimental::smartmatch";
use Carp ();
use DBI;
use JSON;
use Lingua::EN::Fractions qw/fraction2words/;
@ -26,10 +28,11 @@ use Data::Dumper;
$Data::Dumper::Sortkeys = sub { my ($h) = @_; my @a = sort grep { not /^(?:seen_questions|alternativeSpellings)$/ } keys %$h; \@a };
$Data::Dumper::Useqq = 1;
use FindBin;
use lib "$FindBin::RealBin/../..";
use PBot::HashObject;
use PBot::Plugins::Spinach::Statskeeper;
use PBot::Plugins::Spinach::Stats;
sub new {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref $_[1] eq 'HASH';
my ($class, %conf) = @_;
@ -50,21 +53,23 @@ sub initialize {
$self->{pbot}->{event_dispatcher}->register_handler('irc.quit', sub { $self->on_departure(@_) });
$self->{pbot}->{event_dispatcher}->register_handler('irc.kick', sub { $self->on_kick(@_) });
$self->{leaderboard_filename} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spinach/spinachlb.sqlite3';
$self->{channel} = '##spinach';
$self->{questions_filename} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spinach/trivia.json';
$self->{stopwords_filename} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spinach/stopwords';
$self->{metadata_filename} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spinach/metadata';
$self->{stats_filename} = $self->{pbot}->{registry}->get_value('general', 'data_dir') . '/spinach/stats.sqlite';
$self->{metadata} = PBot::HashObject->new(pbot => $self->{pbot}, name => 'Spinach Metadata', filename => $self->{metadata_filename});
$self->load_metadata;
$self->create_database;
$self->{stats} = PBot::Plugins::Spinach::Statskeeper->new(filename => $self->{stats_filename});
$self->{statscmd} = PBot::Plugins::Spinach::Stats->new(pbot => $self->{pbot}, channel => $self->{channel}, filename => $self->{stats_filename});
$self->create_states;
$self->load_questions;
$self->load_stopwords;
$self->{channel} = '##spinach';
$self->{choosecategory_max_count} = 4;
$self->{picktruth_max_count} = 4;
}
@ -73,6 +78,7 @@ sub unload {
my $self = shift;
$self->{pbot}->{commands}->unregister('spinach');
$self->{pbot}->{timer}->unregister('spinach timer');
$self->{stats}->end if $self->{stats_running};
}
sub on_kick {
@ -166,47 +172,6 @@ sub save_metadata {
$self->{metadata}->save;
}
sub create_database {
my $self = shift;
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{leaderboard_filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1 }) or die $DBI::errstr;
$self->{dbh}->do(<<SQL);
CREATE TABLE IF NOT EXISTS Leaderboard (
userid NUMERIC,
created_on NUMERIC,
wins NUMERIC,
highscore NUMERIC,
avgscore NUMERIC
)
SQL
$self->{dbh}->disconnect;
};
$self->{pbot}->{logger}->log("Spinach create database failed: $@") if $@;
}
sub dbi_begin {
my ($self) = @_;
eval {
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{leaderboard_filename}", "", "", { RaiseError => 1, PrintError => 0, AutoInactiveDestroy => 1 }) or die $DBI::errstr;
};
if ($@) {
$self->{pbot}->{logger}->log("Error opening Spinach database: $@");
return 0;
} else {
return 1;
}
}
sub dbi_end {
my ($self) = @_;
$self->{dbh}->disconnect;
}
my %color = (
white => "\x0300",
black => "\x0301",
@ -237,7 +202,7 @@ sub spinach_cmd {
my ($self, $from, $nick, $user, $host, $arguments) = @_;
$arguments =~ s/^\s+|\s+$//g;
my $usage = "Usage: spinach join|exit|ready|unready|choose|lie|reroll|skip|score|show|categories|filter|set|unset|kick|abort; for more information about a command: spinach help <command>";
my $usage = "Usage: spinach join|exit|ready|unready|choose|lie|reroll|skip|score|show|rank|categories|filter|set|unset|kick|abort; for more information about a command: spinach help <command>";
my $command;
($command, $arguments) = split / /, $arguments, 2;
@ -288,10 +253,6 @@ sub spinach_cmd {
return "Help is coming soon.";
}
when ('leaderboard') {
return "Help is coming soon.";
}
when ('choose') {
return "Help is coming soon.";
}
@ -324,6 +285,10 @@ sub spinach_cmd {
return "Help is coming soon.";
}
when ('rank') {
return "Help is coming soon.";
}
default {
if (length $arguments) {
return "Spinach has no such command '$arguments'. I can't help you with that.";
@ -404,10 +369,6 @@ sub spinach_cmd {
return $self->load_questions($arguments);
}
when ('leaderboard') {
return "Coming soon.";
}
when ('join') {
if ($self->{current_state} eq 'nogame') {
$self->{state_data} = { players => [], counter => 0 };
@ -892,6 +853,10 @@ sub spinach_cmd {
return $self->{metadata}->unset($index, $key);
}
when ('rank') {
return $self->{statscmd}->rank($arguments);
}
default {
return $usage;
}
@ -1656,6 +1621,7 @@ sub getnewquestion {
delete $player->{lie};
delete $player->{lie_count};
delete $player->{truth};
delete $player->{good_lie};
delete $player->{deceived};
delete $player->{skip};
delete $player->{reroll};
@ -1894,6 +1860,11 @@ sub showlies {
last if @liars;
if ($player->{truth} ne $state->{correct_answer}) {
my $player_id = $self->{stats}->get_player_id($player->{name}, $self->{channel});
my $player_data = $self->{stats}->get_player_data($player_id);
$player_data->{bad_guesses}++;
$self->{stats}->update_player_data($player_id, $player_data);
my $points = $state->{lie_points} * 0.25;
$player->{score} -= $points;
$self->send_message($self->{channel}, "$player->{name} fell for my lie: \"$player->{truth}\". -$points points!");
@ -1914,12 +1885,23 @@ sub showlies {
my $comma = '';
foreach my $liar (@liars) {
my $player_id = $self->{stats}->get_player_id($liar->{name}, $self->{channel});
my $player_data = $self->{stats}->get_player_data($player_id);
$player_data->{players_deceived}++;
$self->{stats}->update_player_data($player_id, $player_data);
$liars_text .= "$comma$liar->{name}'s";
$liars_no_apostrophe .= "$comma$liar->{name}";
$comma = ', ';
$liar->{score} += $state->{lie_points};
$liar->{good_lie} = 1;
}
my $player_id = $self->{stats}->get_player_id($player->{name}, $self->{channel});
my $player_data = $self->{stats}->get_player_data($player_id);
$player_data->{bad_guesses}++;
$self->{stats}->update_player_data($player_id, $player_data);
$self->send_message($self->{channel}, "$player->{name} fell for $liars_text lie: \"$lie\". $liars_no_apostrophe $gains +$state->{lie_points} points!");
$player->{deceived} = $lie;
}
@ -1943,12 +1925,25 @@ sub showtruth {
my ($self, $state) = @_;
if ($state->{ticks} % 4 == 0) {
my $player_id;
my $player_data;
my $players;
my $comma = '';
my $count = 0;
foreach my $player (@{$state->{players}}) {
next if exists $player->{deceived};
$player_id = $self->{stats}->get_player_id($player->{name}, $self->{channel});
$player_data = $self->{stats}->get_player_data($player_id);
$player_data->{questions_played}++;
if (exists $player->{deceived}) {
$self->{stats}->update_player_data($player_id, $player_data);
next;
}
if (exists $player->{truth} and $player->{truth} eq $state->{correct_answer}) {
$player_data->{good_guesses}++;
$self->{stats}->update_player_data($player_id, $player_data);
$count++;
$players .= "$comma$player->{name}";
$comma = ', ';
@ -1980,6 +1975,13 @@ sub reveallies {
next if not exists $player->{lie};
$text .= "$comma$player->{name}: $player->{lie}";
$comma = '; ';
if ($player->{good_lie}) {
my $player_id = $self->{stats}->get_player_id($player->{name}, $self->{channel});
my $player_data = $self->{stats}->get_player_data($player_id);
$player_data->{good_lies}++;
$self->{stats}->update_player_data($player_id, $player_data);
}
}
$self->send_message($self->{channel}, "$text");
@ -2014,12 +2016,28 @@ sub showfinalscore {
my ($self, $state) = @_;
if ($state->{newstate}) {
my $player_id;
my $player_data;
my $mentions = "";
my $text = "";
my $comma = "";
my $i = @{$state->{players}};
$state->{finalscores} = [];
foreach my $player (sort { $a->{score} <=> $b->{score} } @{$state->{players}}) {
$player_id = $self->{stats}->get_player_id($player->{name}, $self->{channel});
$player_data = $self->{stats}->get_player_data($player_id);
$player_data->{games_played}++;
$player_data->{avg_score} += $player->{score};
$player_data->{avg_score} /= $player_data->{games_played};
$player_data->{low_score} = $player->{score} if $player_data->{low_score} == 0;
if ($player->{score} > $player_data->{high_score}) {
$player_data->{high_score} = $player->{score};
} elsif ($player->{score} < $player_data->{low_score}) {
$player_data->{low_score} = $player->{score};
}
if ($i >= 4) {
$mentions = "$player->{name}: " . $self->commify($player->{score}) . "$comma$mentions";
$comma = "; ";
@ -2029,13 +2047,17 @@ sub showfinalscore {
$i--;
next;
} elsif ($i == 3) {
$player_data->{times_third}++;
$text = sprintf("%15s%-13s%7s", "Third place: ", $player->{name}, $self->commify($player->{score}));
} elsif ($i == 2) {
$player_data->{times_second}++;
$text = sprintf("%15s%-13s%7s", "Second place: ", $player->{name}, $self->commify($player->{score}));
} elsif ($i == 1) {
$player_data->{times_first}++;
$text = sprintf("%15s%-13s%7s", "WINNER: ", $player->{name}, $self->commify($player->{score}));
}
$self->{stats}->update_player_data($player_id, $player_data);
push @{$state->{finalscores}}, $text;
$i--;
}
@ -2079,6 +2101,7 @@ sub showfinalscore {
sub nogame {
my ($self, $state) = @_;
$self->{stats}->end if $self->{stats_running};
$state->{result} = 'nogame';
return $state;
}
@ -2152,6 +2175,8 @@ sub getplayers {
sub round1 {
my ($self, $state) = @_;
$self->{stats}->begin;
$self->{stats_running} = 1;
$state->{truth_points} = 500;
$state->{lie_points} = 1000;
$state->{my_lie_points} = $state->{lie_points} * 0.25;

215
PBot/Plugins/Spinach/Stats.pm Normal file
View File

@ -0,0 +1,215 @@
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::Plugins::Spinach::Stats;
use warnings;
use strict;
use FindBin;
use lib "$FindBin::RealBin/../../..";
use PBot::Plugins::Spinach::Statskeeper;
sub new {
Carp::croak("Options to " . __FILE__ . " should be key/value pairs, not hash reference") if ref $_[1] eq 'HASH';
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
$self->{pbot} = $conf{pbot} // Carp::croak("Missing pbot reference to " . __FILE__);
$self->{channel} = $conf{channel} // Carp::croak("Missing channel reference to " . __FILE__);
$self->{filename} = $conf{filename} // 'stats.sqlite';
$self->{stats} = PBot::Plugins::Spinach::Statskeeper->new(filename => $self->{filename});
}
sub sort_generic {
my ($self, $key) = @_;
if ($self->{rank_direction} eq '+') {
return $b->{$key} <=> $a->{$key};
} else {
return $a->{$key} <=> $b->{$key};
}
}
sub print_generic {
my ($self, $key, $player) = @_;
return undef if $player->{games_played} == 0;
return "$player->{nick}: $player->{$key}";
}
sub sort_bad_lies {
my ($self) = @_;
if ($self->{rank_direction} eq '+') {
return $b->{questions_played} - $b->{good_lies} <=> $a->{questions_played} - $a->{good_lies};
} else {
return $a->{questions_played} - $a->{good_lies} <=> $b->{questions_played} - $b->{good_lies};
}
}
sub print_bad_lies {
my ($self, $player) = @_;
return undef if $player->{games_played} == 0;
my $result = $player->{questions_played} - $player->{good_lies};
return "$player->{nick}: $result";
}
sub sort_mentions {
my ($self) = @_;
if ($self->{rank_direction} eq '+') {
return $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third} <=>
$a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third};
} else {
return $a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third} <=>
$b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third};
}
}
sub print_mentions {
my ($self, $player) = @_;
return undef if $player->{games_played} == 0;
my $result = $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third};
return "$player->{nick}: $result";
}
sub rank {
my ($self, $arguments) = @_;
my %ranks = (
highscores => { sort => sub { $self->sort_generic('high_score', @_) }, print => sub { $self->print_generic('high_score', @_) }, title => 'high scores' },
lowscores => { sort => sub { $self->sort_generic('low_score', @_) }, print => sub { $self->print_generic('low_score', @_) }, title => 'low scores' },
avgscores => { sort => sub { $self->sort_generic('avg_score', @_) }, print => sub { $self->print_generic('avg_score', @_) }, title => 'average scores' },
goodlies => { sort => sub { $self->sort_generic('good_lies', @_) }, print => sub { $self->print_generic('good_lies', @_) }, title => 'good lies' },
badlies => { sort => sub { $self->sort_bad_lies(@_) }, print => sub { $self->print_bad_lies(@_) }, title => 'bad lies' },
first => { sort => sub { $self->sort_generic('times_first', @_) }, print => sub { $self->print_generic('times_first', @_) }, title => 'first place' },
second => { sort => sub { $self->sort_generic('times_second', @_) }, print => sub { $self->print_generic('times_second', @_) }, title => 'second place' },
third => { sort => sub { $self->sort_generic('times_third', @_) }, print => sub { $self->print_generic('times_third', @_) }, title => 'third place' },
mentions => { sort => sub { $self->sort_mentions(@_) }, print => sub { $self->print_mentions(@_) }, title => 'mentions' },
games => { sort => sub { $self->sort_generic('games_played', @_) }, print => sub { $self->print_generic('games_played', @_) }, title => 'games played' },
questions => { sort => sub { $self->sort_generic('questions_played', @_) }, print => sub { $self->print_generic('questions_played', @_) }, title => 'questions played' },
goodguesses => { sort => sub { $self->sort_generic('good_guesses', @_) }, print => sub { $self->print_generic('good_guesses', @_) }, title => 'good guesses' },
badguesses => { sort => sub { $self->sort_generic('bad_guesses', @_) }, print => sub { $self->print_generic('bad_guesses', @_) }, title => 'bad guesses' },
deceptions => { sort => sub { $self->sort_generic('players_deceived', @_) }, print => sub { $self->print_generic('players_deceived', @_) }, title => 'players deceived' },
);
my @order = qw/highscores lowscores avgscores first second third mentions games questions goodlies badlies deceptions goodguesses badguesses/;
if (not $arguments) {
my $result = "Usage: rank [-]<keyword> [offset] or rank [-]<nick>; available keywords: ";
$result .= join ', ', @order;
$result .= ".\n";
$result .= "Prefix with a dash to invert sort.\n";
return $result;
}
$arguments = lc $arguments;
if ($arguments =~ s/^([+-])//) {
$self->{rank_direction} = $1;
} else {
$self->{rank_direction} = '+';
}
my $offset = 1;
if ($arguments =~ s/\s+(\d+)$//) {
$offset = $1;
}
if (not exists $ranks{$arguments}) {
$self->{stats}->begin;
my $player_id = $self->{stats}->get_player_id($arguments, $self->{channel}, 1);
my $player_data = $self->{stats}->get_player_data($player_id);
if (not defined $player_id) {
$self->{stats}->end;
return "I don't know anybody named $arguments.";
}
my $players = $self->{stats}->get_all_players($self->{channel});
my @rankings;
foreach my $key (@order) {
my $sort_method = $ranks{$key}->{sort};
@$players = sort $sort_method @$players;
my $rank = 0;
my $stats;
my $last_value = -1;
foreach my $player (@$players) {
$stats = $ranks{$key}->{print}->($player);
if (defined $stats) {
my ($value) = $stats =~ /[^:]+:\s+(.*)/;
$rank++ if $value ne $last_value;
$last_value = $value;
} else {
$rank++ if lc $player->{nick} eq $arguments;
}
last if lc $player->{nick} eq $arguments;
}
if (not $rank) {
push @rankings, "$ranks{key}->{title}: N/A";
} else {
if (not $stats) {
push @rankings, "$ranks{$key}->{title}: N/A";
} else {
$stats =~ s/[^:]+:\s+//;
push @rankings, "$ranks{$key}->{title}: #$rank ($stats)";
}
}
}
my $result = "$player_data->{nick}'s rankings: ";
$result .= join ', ', @rankings;
$self->{stats}->end;
return $result;
}
$self->{stats}->begin;
my $players = $self->{stats}->get_all_players($self->{channel});
my $sort_method = $ranks{$arguments}->{sort};
@$players = sort $sort_method @$players;
my @ranking;
my $rank = 0;
my $last_value = -1;
foreach my $player (@$players) {
my $entry = $ranks{$arguments}->{print}->($player);
if (defined $entry) {
my ($value) = $entry =~ /[^:]+:\s+(.*)/;
$rank++ if $value ne $last_value;
$last_value = $value;
next if $rank < $offset;
push @ranking, "#$rank $entry" if defined $entry;
last if scalar @ranking >= 15;
}
}
my $result;
if (not scalar @ranking) {
if ($offset > 1) {
$result = "No rankings available for $self->{channel} at offset #$offset.\n";
} else {
$result = "No rankings available for $self->{channel} yet.\n";
}
} else {
$result = "Rankings for $ranks{$arguments}->{title}: ";
$result .= join ', ', @ranking;
}
$self->{stats}->end;
return $result;
}
1;

171
PBot/Plugins/Spinach/Statskeeper.pm Normal file
View File

@ -0,0 +1,171 @@
#!/usr/bin/env perl
# This Source Code Form is subject to the terms of the Mozilla Public
# License, v. 2.0. If a copy of the MPL was not distributed with this
# file, You can obtain one at http://mozilla.org/MPL/2.0/.
package PBot::Plugins::Spinach::Statskeeper;
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} // 'stats.sqlite';
}
sub begin {
my $self = shift;
print STDERR "Opening stats 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 Stats (
id INTEGER PRIMARY KEY,
nick TEXT NOT NULL COLLATE NOCASE,
channel TEXT NOT NULL COLLATE NOCASE,
high_score INTEGER DEFAULT 0,
low_score INTEGER DEFAULT 0,
avg_score INTEGER DEFAULT 0,
times_first INTEGER DEFAULT 0,
times_second INTEGER DEFAULT 0,
times_third INTEGER DEFAULT 0,
good_lies INTEGER DEFAULT 0,
players_deceived INTEGER DEFAULT 0,
questions_played INTEGER DEFAULT 0,
games_played INTEGER DEFAULT 0,
good_guesses INTEGER DEFAULT 0,
bad_guesses INTEGER DEFAULT 0
)
SQL
};
print STDERR $@ if $@;
}
sub end {
my $self = shift;
print STDERR "Closing stats SQLite database\n" if $debug;
if(exists $self->{dbh} and defined $self->{dbh}) {
$self->{dbh}->disconnect();
delete $self->{dbh};
}
}
sub add_player {
my ($self, $nick, $channel) = @_;
my $id = eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Stats (nick, channel) VALUES (?, ?)');
$sth->bind_param(1, $nick) ;
$sth->bind_param(2, $channel) ;
$sth->execute();
return $self->{dbh}->sqlite_last_insert_rowid();
};
print STDERR $@ if $@;
return $id;
}
sub get_player_id {
my ($self, $nick, $channel, $dont_create_new) = @_;
my $id = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Stats WHERE nick = ? AND channel = ?');
$sth->bind_param(1, $nick);
$sth->bind_param(2, $channel);
$sth->execute();
my $row = $sth->fetchrow_hashref();
return $row->{id};
};
print STDERR $@ if $@;
$id = $self->add_player($nick, $channel) if not defined $id and not $dont_create_new;
return $id;
}
sub get_player_data {
my ($self, $id, @columns) = @_;
my $player_data = eval {
my $sql = 'SELECT ';
if(not @columns) {
$sql .= '*';
} else {
my $comma = '';
foreach my $column (@columns) {
$sql .= "$comma$column";
$comma = ', ';
}
}
$sql .= ' FROM Stats WHERE id = ?';
my $sth = $self->{dbh}->prepare($sql);
$sth->bind_param(1, $id);
$sth->execute();
return $sth->fetchrow_hashref();
};
print STDERR $@ if $@;
return $player_data;
}
sub update_player_data {
my ($self, $id, $data) = @_;
eval {
my $sql = 'UPDATE Stats 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_all_players {
my ($self, $channel) = @_;
my $players = eval {
my $sth = $self->{dbh}->prepare('SELECT * FROM Stats WHERE channel = ?');
$sth->bind_param(1, $channel);
$sth->execute();
return $sth->fetchall_arrayref({});
};
print STDERR $@ if $@;
return $players;
}
1;