3
0
mirror of https://github.com/pragma-/pbot.git synced 2024-12-25 04:02:37 +01:00
pbot/modules/cjeopardy/cjeopardy_qstats.pl

299 lines
8.3 KiB
Perl
Raw Normal View History

2015-05-23 15:24:49 +02:00
#!/usr/bin/env perl
2021-07-11 00:00:22 +02:00
# SPDX-FileCopyrightText: 2021 Pragmatic Software <pragma78@gmail.com>
# SPDX-License-Identifier: MIT
License project under MPL2 This patch adds the file LICENSE which is the verbatim copy of the Mozilla Public License Version 2.0 as retreived from https://www.mozilla.org/media/MPL/2.0/index.815ca599c9df.txt on 2017-03-05. This patch also places license headers for the MPL2 type A variant of the license header in the following files: PBot/AntiFlood.pm PBot/BanTracker.pm PBot/BlackList.pm PBot/BotAdminCommands.pm PBot/BotAdmins.pm PBot/ChanOpCommands.pm PBot/ChanOps.pm PBot/Channels.pm PBot/Commands.pm PBot/DualIndexHashObject.pm PBot/EventDispatcher.pm PBot/FactoidCommands.pm PBot/FactoidModuleLauncher.pm PBot/Factoids.pm PBot/HashObject.pm PBot/IRCHandlers.pm PBot/IgnoreList.pm PBot/IgnoreListCommands.pm PBot/Interpreter.pm PBot/LagChecker.pm PBot/Logger.pm PBot/MessageHistory.pm PBot/MessageHistory_SQLite.pm PBot/NickList.pm PBot/PBot.pm PBot/Plugins.pm PBot/Plugins/AntiAway.pm PBot/Plugins/AntiKickAutoRejoin.pm PBot/Plugins/AntiRepeat.pm PBot/Plugins/AntiTwitter.pm PBot/Plugins/AutoRejoin.pm PBot/Plugins/Counter.pm PBot/Plugins/Quotegrabs.pm PBot/Plugins/Quotegrabs/Quotegrabs_Hashtable.pm PBot/Plugins/Quotegrabs/Quotegrabs_SQLite.pm PBot/Plugins/UrlTitles.pm PBot/Plugins/_Example.pm PBot/Refresher.pm PBot/Registerable.pm PBot/Registry.pm PBot/RegistryCommands.pm PBot/SQLiteLogger.pm PBot/SQLiteLoggerLayer.pm PBot/SelectHandler.pm PBot/StdinReader.pm PBot/Timer.pm PBot/Utils/ParseDate.pm PBot/VERSION.pm build/update-version.pl modules/acronym.pl modules/ago.pl modules/c11std.pl modules/c2english.pl modules/c2english/CGrammar.pm modules/c2english/c2eng.pl modules/c99std.pl modules/cdecl.pl modules/cfaq.pl modules/cjeopardy/IRCColors.pm modules/cjeopardy/QStatskeeper.pm modules/cjeopardy/Scorekeeper.pm modules/cjeopardy/cjeopardy.pl modules/cjeopardy/cjeopardy_answer.pl modules/cjeopardy/cjeopardy_filter.pl modules/cjeopardy/cjeopardy_hint.pl modules/cjeopardy/cjeopardy_qstats.pl modules/cjeopardy/cjeopardy_scores.pl modules/cjeopardy/cjeopardy_show.pl modules/codepad.pl modules/compiler_block.pl modules/compiler_client.pl modules/compiler_vm/Diff.pm modules/compiler_vm/cc modules/compiler_vm/compiler_client.pl modules/compiler_vm/compiler_server.pl modules/compiler_vm/compiler_server_vbox_win32.pl modules/compiler_vm/compiler_server_watchdog.pl modules/compiler_vm/compiler_vm_client.pl modules/compiler_vm/compiler_vm_server.pl modules/compiler_vm/compiler_watchdog.pl modules/compiler_vm/languages/_c_base.pm modules/compiler_vm/languages/_default.pm modules/compiler_vm/languages/bash.pm modules/compiler_vm/languages/bc.pm modules/compiler_vm/languages/bf.pm modules/compiler_vm/languages/c11.pm modules/compiler_vm/languages/c89.pm modules/compiler_vm/languages/c99.pm modules/compiler_vm/languages/clang.pm modules/compiler_vm/languages/clang11.pm modules/compiler_vm/languages/clang89.pm modules/compiler_vm/languages/clang99.pm modules/compiler_vm/languages/clangpp.pm modules/compiler_vm/languages/clisp.pm modules/compiler_vm/languages/cpp.pm modules/compiler_vm/languages/freebasic.pm modules/compiler_vm/languages/go.pm modules/compiler_vm/languages/haskell.pm modules/compiler_vm/languages/java.pm modules/compiler_vm/languages/javascript.pm modules/compiler_vm/languages/ksh.pm modules/compiler_vm/languages/lua.pm modules/compiler_vm/languages/perl.pm modules/compiler_vm/languages/python.pm modules/compiler_vm/languages/python3.pm modules/compiler_vm/languages/qbasic.pm modules/compiler_vm/languages/scheme.pm modules/compiler_vm/languages/server/_c_base.pm modules/compiler_vm/languages/server/_default.pm modules/compiler_vm/languages/server/c11.pm modules/compiler_vm/languages/server/c89.pm modules/compiler_vm/languages/server/c99.pm modules/compiler_vm/languages/server/clang.pm modules/compiler_vm/languages/server/clang11.pm modules/compiler_vm/languages/server/clang89.pm modules/compiler_vm/languages/server/clang99.pm modules/compiler_vm/languages/server/cpp.pm modules/compiler_vm/languages/server/freebasic.pm modules/compiler_vm/languages/server/haskell.pm modules/compiler_vm/languages/server/java.pm modules/compiler_vm/languages/server/qbasic.pm modules/compiler_vm/languages/server/tendra.pm modules/compiler_vm/languages/sh.pm modules/compiler_vm/languages/tendra.pm modules/compliment modules/cstd.pl modules/define.pl modules/dice_roll.pl modules/excuse.sh modules/expand_macros.pl modules/fnord.pl modules/funnyish_quote.pl modules/g.pl modules/gdefine.pl modules/gen_cfacts.pl modules/gencstd.pl modules/get_title.pl modules/getcfact.pl modules/google.pl modules/gspy.pl modules/gtop10.pl modules/gtop15.pl modules/headlines.pl modules/horoscope modules/horrorscope modules/ideone.pl modules/insult.pl modules/love_quote.pl modules/man.pl modules/map.pl modules/math.pl modules/prototype.pl modules/qalc.pl modules/random_quote.pl modules/seen.pl modules/urban modules/weather.pl modules/wikipedia.pl pbot.pl pbot.sh It is highly recommended that this list of files is reviewed to ensure that all files are the copyright of the sole maintainer of the repository. If any files with license headers contain the intellectual property of anyone else, it is recommended that a request is made to revise this patch or that the explicit permission of the co-author is gained to allow for the license of the work to be changed. I (Tomasz Kramkowski), the contributor, take no responsibility for any legal action taken against the maintainer of this repository for incorrectly claiming copyright to any work not owned by the maintainer of this repository.
2017-03-05 22:33:31 +01:00
2015-05-23 15:24:49 +02:00
use warnings;
use strict;
use Time::HiRes qw(gettimeofday);
use Time::Duration qw(duration concise);
use POSIX 'strftime';
use lib ".";
2015-05-23 15:24:49 +02:00
use QStatskeeper;
my $command = shift @ARGV;
my $opt = join ' ', @ARGV;
$command = '' if not defined $command;
$opt = '' if not defined $opt;
2015-05-25 16:17:20 +02:00
my $rank_direction = '+';
sub sort_correct {
if ($rank_direction eq '+') {
return $b->{correct} <=> $a->{correct};
} else {
return $a->{correct} <=> $b->{correct};
}
}
sub print_correct {
my $qdata = shift @_;
return undef if $qdata->{correct} == 0;
return "$qdata->{id} ($qdata->{correct})";
}
sub sort_wrong {
if ($rank_direction eq '+') {
return $b->{wrong} <=> $a->{wrong};
} else {
return $a->{wrong} <=> $b->{wrong};
}
}
sub print_wrong {
my $qdata = shift @_;
return undef if $qdata->{wrong} == 0;
return "$qdata->{id} ($qdata->{wrong})";
}
sub sort_wrongstreak {
if ($rank_direction eq '+') {
return $b->{highest_wrong_streak} <=> $a->{highest_wrong_streak};
} else {
return $a->{highest_wrong_streak} <=> $b->{highest_wrong_streak};
}
}
sub print_wrongstreak {
my $qdata = shift @_;
return undef if $qdata->{highest_wrong_streak} == 0;
return "$qdata->{id} ($qdata->{highest_wrong_streak})";
}
sub sort_hints {
if ($rank_direction eq '+') {
return $b->{hints} <=> $a->{hints};
} else {
return $a->{hints} <=> $b->{hints};
}
}
sub print_hints {
my $qdata = shift @_;
return undef if $qdata->{hints} == 0;
return "$qdata->{id} ($qdata->{hints})";
}
sub sort_quickest {
if ($rank_direction eq '+') {
return $a->{quickest_answer_time} <=> $b->{quickest_answer_time};
} else {
return $b->{quickest_answer_time} <=> $a->{quickest_answer_time};
}
}
sub print_quickest {
my $qdata = shift @_;
return undef if $qdata->{quickest_answer_time} == 0;
if ($qdata->{quickest_answer_time} < 60) {
return "$qdata->{id} (" . sprintf("%.02fs", $qdata->{quickest_answer_time}) . ")";
} else {
return "$qdata->{id} (" . (concise duration $qdata->{quickest_answer_time}) . ")";
}
}
sub sort_longest {
if ($rank_direction eq '+') {
return $b->{longest_answer_time} <=> $a->{longest_answer_time};
} else {
return $a->{longest_answer_time} <=> $b->{longest_answer_time};
}
}
sub print_longest {
my $qdata = shift @_;
return undef if $qdata->{longest_answer_time} == 0;
if ($qdata->{longest_answer_time} < 60) {
return "$qdata->{id} (" . sprintf("%.02fs", $qdata->{longest_answer_time}) . ")";
} else {
return "$qdata->{id} (" . (concise duration $qdata->{longest_answer_time}) . ")";
}
}
sub sort_average {
if ($rank_direction eq '+') {
return $a->{average_answer_time} <=> $b->{average_answer_time};
} else {
return $b->{average_answer_time} <=> $a->{average_answer_time};
}
}
sub print_average {
my $qdata = shift @_;
return undef if $qdata->{average_answer_time} == 0;
if ($qdata->{average_answer_time} < 60) {
return "$qdata->{id} (" . sprintf("%.02fs", $qdata->{average_answer_time}) . ")";
} else {
return "$qdata->{id} (" . (concise duration $qdata->{average_answer_time}) . ")";
}
}
2015-05-23 15:24:49 +02:00
if (lc $command eq 'rank') {
2015-05-25 16:17:20 +02:00
my %ranks = (
correct => { sort => \&sort_correct, print => \&print_correct, title => 'correct answers' },
wrong => { sort => \&sort_wrong, print => \&print_wrong, title => 'wrong answers' },
wrongstreak => { sort => \&sort_wrongstreak, print => \&print_wrongstreak, title => 'wrong answer streak' },
hints => { sort => \&sort_hints, print => \&print_hints, title => 'hints used' },
quickest => { sort => \&sort_quickest, print => \&print_quickest, title => 'quickest answer time' },
longest => { sort => \&sort_longest, print => \&print_longest, title => 'longest answer time' },
average => { sort => \&sort_average, print => \&print_average, title => 'average answer time' },
);
if (not $opt) {
print "Usage: qstats rank [-]<keyword> [offset] or rank [-]<question id>; available keywords: ";
2015-05-25 16:17:20 +02:00
print join ', ', sort keys %ranks;
print ".\n";
print "Prefixing the keyword or question id with a dash will invert the sort direction for each category. Specifying an offset will start ranking at that offset.\n";
2015-05-25 16:17:20 +02:00
exit;
}
my $qstats = QStatskeeper->new;
$qstats->begin;
$opt = lc $opt;
if ($opt =~ s/^([+-])//) {
$rank_direction = $1;
}
my $offset = 1;
if ($opt =~ s/\s+(\d+)$//) {
$offset = $1;
}
if (not exists $ranks{$opt}) {
print "Ranking specific questions coming soon.\n";
$qstats->end;
exit;
}
my $qdatas = $qstats->get_all_questions();
my $sort_method = $ranks{$opt}->{sort};
@$qdatas = sort $sort_method @$qdatas;
my @ranking;
my $rank = 0;
my $last_value = -1;
foreach my $qdata (@$qdatas) {
my $entry = $ranks{$opt}->{print}->($qdata);
if (defined $entry) {
my ($value) = $entry =~ /\((.*)\)$/;
$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;
}
}
if (not scalar @ranking) {
if ($offset > 1) {
print "No rankings available at offset #$offset.\n";
} else {
print "No rankings available yet.\n";
}
} else {
print "Rankings for $ranks{$opt}->{title}: ";
print join ', ', @ranking;
print "\n";
}
$qstats->end;
2015-05-23 15:24:49 +02:00
} elsif ($command =~ m/^\d+$/) {
my $qstats = QStatskeeper->new;
$qstats->begin;
if (not $qstats->find_question($command)) {
print "No such question $command.\n";
$qstats->end;
exit;
}
my $qdata = $qstats->get_question_data($command);
my $wrong_answers = $qstats->get_wrong_answers($command);
$qstats->end;
my $stats = "Question $command: ";
$stats .= "asked: $qdata->{asked_count}";
if ($qdata->{last_asked}) {
my $date = strftime '%b %e %H:%M %Y', localtime $qdata->{last_asked};
$stats .= " (last on $date)";
}
$stats .= ", ";
$stats .= "correct: $qdata->{correct}";
if ($qdata->{last_correct_time}) {
my $date = strftime '%b %e %H:%M %Y', localtime $qdata->{last_correct_time};
$stats .= " (last by $qdata->{last_correct_nick} on $date)";
}
$stats .= ", ";
$stats .= "wrong: $qdata->{wrong}, wrong streak: $qdata->{wrong_streak}, highest wrong streak: $qdata->{highest_wrong_streak}, ";
$stats .= "hints: $qdata->{hints}, ";
$stats .= "quickest: ";
if ($qdata->{quickest_answer_time}) {
if ($qdata->{quickest_answer_time} < 60) {
$stats .= sprintf("%.2fs", $qdata->{quickest_answer_time});
} else {
$stats .= concise duration $qdata->{quickest_answer_time};
}
my $date = strftime '%b %e %H:%M %Y', localtime $qdata->{quickest_answer_date};
$stats .= " by $qdata->{quickest_answer_nick} on $date";
} else {
$stats .= "N/A";
}
$stats .= ", ";
$stats .= "longest: ";
if ($qdata->{longest_answer_time}) {
if ($qdata->{longest_answer_time} < 60) {
$stats .= sprintf("%.2fs", $qdata->{longest_answer_time});
} else {
$stats .= concise duration $qdata->{longest_answer_time};
}
my $date = strftime '%b %e %H:%M %Y', localtime $qdata->{longest_answer_date};
$stats .= " by $qdata->{longest_answer_nick} on $date";
} else {
$stats .= "N/A";
}
$stats .= ", ";
$stats .= "average: ";
if ($qdata->{average_answer_time}) {
if ($qdata->{average_answer_time} < 60) {
$stats .= sprintf("%.2fs", $qdata->{average_answer_time});
} else {
$stats .= concise duration $qdata->{average_answer_time};
}
} else {
$stats .= "N/A";
}
if (@$wrong_answers) {
$stats .= ", wrong answers: ";
my $count = 0;
my $sep = "";
foreach my $answer (sort { $b->{count} <=> $a->{count} } @$wrong_answers) {
last if ++$count >= 10;
$stats .= $sep;
$stats .= $answer->{answer};
if ($answer->{count} > 1) {
$stats .= "($answer->{count})";
}
$sep = ", ";
}
}
print "$stats\n";
} else {
print "Usage: `qstats <question id>` or `qstats rank [keyword]`; See `qstats rank` for available keywords.\n";
}