gimps-review/script.pl

83 lines
2.2 KiB
Perl

use v5.32;
use HTML::TableExtract;
use File::Slurp;
use Data::Dumper;
use Text::SimpleTable::AutoWidth;
use WWW::Mechanize ();
use List::AllUtils qw/ sum pairmap /;
use List::UtilsBy qw/ nsort_by partition_by /;
use experimental qw/ signatures /;
unless (caller) {
my $ts = get_mersenne_results();
generate_output_table($ts)->draw;
}
sub get_mersenne_results() {
# log in to Mersenne.org and get results for the last year
# excluding everything but PHP and DD results
my $mech = WWW::Mechanize->new;
my $url = join '?', 'https://www.mersenne.org/results/',
join '&',
pairmap { join '=', $a, $b }
exp_lo => 2,
limit => 10_000,
map { $_ => 1 } qw/ extf exp1 execm excert /;
$mech->get($url);
$mech->submit_form(
form_number => 1,
fields => {
user_login => $ENV{'MERSENNE_USER'},
user_password => $ENV{'MERSENNE_PASSWORD'},
} );
# load the results into a table object
my $html_string = $mech->content;
return extract_first_table($html_string);
}
sub extract_first_table ($html) {
return HTML::TableExtract
->new( depth => 0, count => 2 )
->parse( $html =~ s/\n//gr )
->first_table_found;
}
sub generate_output_table ($ts) {
my $tbl = Text::SimpleTable::AutoWidth->new(
captions => [qw/ Computer GHZDaysPerDay /] );
# group GHZ Days results by computer, compute GHZ Days per Day (GHZ Days / Days)
$tbl->row(@$_) for
reverse
nsort_by { $_->[1] }
pairmap { [ $a, $b ] } # group for the sorting
pairmap { $a => sprintf "%.0f", sum(@$b) / @$b } # take the mean
pairmap {
# calculate our stats
$a => [ map { $_->{ghz_days} / $_->{days} } @$b ]
}
partition_by { $_->{machine} } # group by machine
grep { $_->{days} > 0 } # skip entries with no days
map { # get the info
my $machine = $_->[0];
my $days = $_->[4] =~ s/\s//gr;
my $ghz_days = $_->[6] =~ s/\s//gr;
+{ days => $days, ghz_days => $ghz_days, machine => $machine }
}
$ts->rows;
return $tbl;
}