# File: Rank.pm # # Purpose: Ranks players by various keywords. # SPDX-FileCopyrightText: 2021 Pragmatic Software # SPDX-License-Identifier: MIT package PBot::Plugin::Spinach::Rank; use PBot::Imports; use FindBin; use lib "$FindBin::RealBin/../../.."; use PBot::Plugin::Spinach::Stats; use Math::Expression::Evaluator; 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::Plugin::Spinach::Stats->new(pbot => $self->{pbot}, 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 print_avg_score { my ($self, $player) = @_; return undef if $player->{games_played} == 0; my $result = int $player->{avg_score}; return "$player->{nick}: $result"; } 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 sort_expr { my ($self) = @_; my $result = eval { my $result_a = $self->{expr}->val( { highscore => $a->{high_score}, lowscore => $a->{low_score}, avgscore => $a->{avg_score}, goodlies => $a->{good_lies}, badlies => $a->{questions_played} - $a->{good_lies}, first => $a->{times_first}, second => $a->{times_second}, third => $a->{times_third}, mentions => $a->{games_played} - $a->{times_first} - $a->{times_second} - $a->{times_third}, games => $a->{games_played}, questions => $a->{questions_played}, goodguesses => $a->{good_guesses}, badguesses => $a->{bad_guesses}, deceptions => $a->{players_deceived} } ); my $result_b = $self->{expr}->val( { highscore => $b->{high_score}, lowscore => $b->{low_score}, avgscore => $b->{avg_score}, goodlies => $b->{good_lies}, badlies => $b->{questions_played} - $b->{good_lies}, first => $b->{times_first}, second => $b->{times_second}, third => $b->{times_third}, mentions => $b->{games_played} - $b->{times_first} - $b->{times_second} - $b->{times_third}, games => $b->{games_played}, questions => $b->{questions_played}, goodguesses => $b->{good_guesses}, badguesses => $b->{bad_guesses}, deceptions => $b->{players_deceived} } ); if ($self->{rank_direction} eq '+') { return $result_b <=> $result_a; } else { return $result_a <=> $result_b; } }; if ($@) { $self->{pbot}->{logger}->log("expr sort error: $@\n"); return 0; } return $result; } sub print_expr { my ($self, $player) = @_; return undef if $player->{games_played} == 0; my $result = eval { $self->{expr}->val( { highscore => $player->{high_score}, lowscore => $player->{low_score}, avgscore => $player->{avg_score}, goodlies => $player->{good_lies}, badlies => $player->{questions_played} - $player->{good_lies}, first => $player->{times_first}, second => $player->{times_second}, third => $player->{times_third}, mentions => $player->{games_played} - $player->{times_first} - $player->{times_second} - $player->{times_third}, games => $player->{games_played}, questions => $player->{questions_played}, goodguesses => $player->{good_guesses}, badguesses => $player->{bad_guesses}, deceptions => $player->{players_deceived} } ); }; if ($@) { $self->{pbot}->{logger}->log("Error in expr print: $@\n"); return undef; } return "$player->{nick}: $result"; } sub rank { my ($self, $arguments) = @_; my %ranks = ( highscore => { sort => sub { $self->sort_generic('high_score', @_) }, print => sub { $self->print_generic('high_score', @_) }, title => 'high score' }, lowscore => { sort => sub { $self->sort_generic('low_score', @_) }, print => sub { $self->print_generic('low_score', @_) }, title => 'low score' }, avgscore => { sort => sub { $self->sort_generic('avg_score', @_) }, print => sub { $self->print_avg_score(@_) }, title => 'average score' }, 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' }, expr => { sort => sub { $self->sort_expr(@_) }, print => sub { $self->print_expr(@_) }, title => 'expr' }, ); my @order = qw/highscore lowscore avgscore first second third mentions games questions goodlies badlies deceptions goodguesses badguesses expr/; if (not $arguments) { my $result = "Usage: rank [-] [offset] or rank [-]; 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; } my $opt_arg; if ($arguments =~ /^expr/) { if ($arguments =~ s/^expr (.+)$/expr/) { $opt_arg = $1; } else { return "Usage: spinach rank expr "; } } 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) { next if $key eq 'expr'; 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}); if ($arguments eq 'expr') { $self->{expr} = eval { Math::Expression::Evaluator->new($opt_arg) }; if ($@) { my $error = $@; $error =~ s/ at .*//ms; return "Bad expression: $error"; } $self->{expr}->optimize; } 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 { if ($arguments eq 'expr') { $result = "Rankings for $opt_arg: "; } else { $result = "Rankings for $ranks{$arguments}->{title}: "; } $result .= join ', ', @ranking; } $self->{stats}->end; return $result; } 1;