From 52172a1a697be94c99123f265ebcd64871d6379e Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Mon, 30 Mar 2015 14:11:04 +0300 Subject: [PATCH] Add non-DBIC versions of all methods and a benchmark script --- MANIFEST | 1 + Makefile.PL | 3 + bm.pl | 55 ++++++++ db.sql | 65 +++++++++ lib/Gruntmaster/Data.pm | 302 ++++++++++++++++++++++++++++++++++++++-- 5 files changed, 417 insertions(+), 9 deletions(-) create mode 100644 bm.pl diff --git a/MANIFEST b/MANIFEST index 66be71b..3952d78 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,3 +1,4 @@ +bm.pl Changes db.sql gruntmaster-contest diff --git a/Makefile.PL b/Makefile.PL index d260b0f..8edc120 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -21,7 +21,9 @@ WriteMakefile( Bytes::Random::Secure 0 Class::Method::Modifiers 0 Date::Parse 0 + DBI 0 DBIx::Class 0 + DBIx::Simple 0 DBD::Pg 0 Digest::SHA 0 File::Slurp 0 @@ -29,6 +31,7 @@ WriteMakefile( Lingua::EN::Inflect 0 JSON::MaybeXS 0 PerlX::Maybe 0 + SQL::Abstract 0 Sub::Name 0/, }, BUILD_REQUIRES => { diff --git a/bm.pl b/bm.pl new file mode 100644 index 0000000..0dc688d --- /dev/null +++ b/bm.pl @@ -0,0 +1,55 @@ +#!/usr/bin/perl +use v5.14; +use warnings; + +use lib 'lib'; + +use Benchmark; +use Gruntmaster::Data; + +my $db = Gruntmaster::Data->connect('dbi:Pg:'); + +timethese(-1, { + orig => sub { $db->user_list_orig }, + new => sub { $db->user_entry }, +}); + +timethese(-1, { + orig => sub { $db->user_entry_orig('PlayLikeNeverB4') }, + new => sub { $db->user_entry('PlayLikeNeverB4') }, +}); + +timethese(-1, { + orig => sub { $db->contest_list_orig }, + new => sub { $db->contest_entry }, +}); + +timethese(-1, { + orig => sub { $db->contest_entry_orig('mc2015r4') }, + new => sub { $db->contest_entry('mc2015r4') }, +}); + +timethese(-1, { + orig => sub { $db->problem_list_orig }, + new => sub { $db->problem_list }, +}); + +timethese(-1, { + orig => sub { $db->problem_entry_orig('aplusb') }, + new => sub { $db->problem_entry('aplusb') }, +}); + +timethese(50, { + orig => sub { $db->job_list_orig }, + new => sub { $db->job_list }, +}); + +timethese(-1, { + orig => sub { $db->job_entry_orig(9000) }, + new => sub { $db->job_entry(9000) }, +}); + +timethese(10, { + orig => sub { $db->update_status_orig }, + new => sub { $db->update_status }, +}); diff --git a/db.sql b/db.sql index a9ea727..f9fc0f3 100644 --- a/db.sql +++ b/db.sql @@ -169,3 +169,68 @@ INSERT INTO column_comments VALUES ('jobs', 'result_text', 'Job result (human-re INSERT INTO column_comments VALUES ('jobs', 'results', 'Per-test results (JSON array of hashes with keys id (test number, counting from 1), result (integer constant from Gruntmaster::Daemon::Constants), result_text (human-readable text), time (execution time in decimal seconds))'); INSERT INTO column_comments VALUES ('problem_status', 'solved', 'True if the result is Accepted, False otherwise'); + +CREATE OR REPLACE VIEW user_data AS (SELECT + id,admin,name,town,university,country,level,lastjob + FROM users +); + +CREATE OR REPLACE VIEW user_solved_problems AS (SELECT + us.id, + COALESCE(array_agg(ps.problem) FILTER (WHERE ps.problem IS NOT NULL), ARRAY[]::text[]) AS solved + FROM users us + LEFT JOIN (SELECT * FROM problem_status WHERE solved = TRUE) ps ON ps.owner=id + GROUP BY us.id); + +CREATE OR REPLACE VIEW user_attempted_problems AS (SELECT + us.id, + COALESCE(array_agg(ps.problem) FILTER (WHERE ps.problem IS NOT NULL), ARRAY[]::text[]) AS attempted + FROM users us + LEFT JOIN (SELECT * FROM problem_status WHERE solved = FALSE) ps ON ps.owner=id + GROUP BY us.id); + +CREATE OR REPLACE VIEW user_contests AS (SELECT + us.id, + COALESCE(array_agg(cs.contest) FILTER (WHERE cs.contest IS NOT NULL), ARRAY[]::text[]) AS contests + FROM users us + LEFT JOIN contest_status cs ON cs.owner=id + GROUP BY us.id); + +CREATE OR REPLACE VIEW user_list AS (SELECT + dt.*, + COALESCE(array_length(solved, 1), 0) AS solved, + COALESCE(array_length(attempted, 1), 0) AS attempted, + COALESCE(array_length(contests, 1), 0) AS contests + FROM user_data dt + JOIN user_contests ct USING (id) + JOIN user_solved_problems sp USING (id) + JOIN user_attempted_problems ap USING (id) + ORDER BY solved DESC, attempted DESC, id); + +CREATE OR REPLACE VIEW contest_entry AS (SELECT + id,name,description,editorial,start,stop,owner, + (EXTRACT(epoch from NOW()) >= start) AS started, + (EXTRACT(epoch from NOW()) >= stop) AS finished + FROM contests + ORDER BY start DESC); + +CREATE OR REPLACE VIEW job_entry AS (SELECT + id,contest,date,errors,extension,format,private,problem,result,result_text,results,owner, + LENGTH(source) AS size + FROM jobs + ORDER BY id DESC); + +-- CREATE OR REPLACE FUCNTION source_private(jobid INT) RETURNS BOOLEAN AS $$ +-- BEGIN +-- private BOOLEAN; +-- problem TEXT; +-- contest TEXT; + +-- SELECT private, problem, contest INTO STRICT private, problem, contest FROM jobs WHERE id = jobid; +-- IF private THEN +-- RETURN TRUE; +-- END IF + +-- IF +-- END; +-- $$ diff --git a/lib/Gruntmaster/Data.pm b/lib/Gruntmaster/Data.pm index 50dcfd5..3da2529 100644 --- a/lib/Gruntmaster/Data.pm +++ b/lib/Gruntmaster/Data.pm @@ -24,6 +24,12 @@ use JSON::MaybeXS qw/decode_json/; use HTTP::Tiny; use PerlX::Maybe qw/maybe/; use Sub::Name qw/subname/; +use Class::Method::Modifiers qw/around/; + +use DBI; +use DBIx::Simple; +use List::Util qw/sum/; +use SQL::Abstract; use constant CONTEST_PUBLIC_COLUMNS => [qw/id name description start stop owner/]; use constant PROBLEM_PUBLIC_COLUMNS => [qw/id author writer level name owner private timeout olimit value/]; @@ -45,7 +51,75 @@ BEGIN { } } -sub user_list { +my %statements = ( + user_list_sth => 'SELECT * FROM user_list LIMIT 200', + user_entry_sth => 'SELECT * FROM user_data WHERE id = ?', + + problem_status_sth => 'SELECT problem,solved FROM problem_status WHERE owner = ?', + contest_status_sth => 'SELECT contest,score,rank FROM contest_status WHERE owner = ?', + + contest_list_sth => 'SELECT * FROM contest_entry', + contest_entry_sth => 'SELECT * FROM contest_entry WHERE id = ?', + contest_full_sth => 'SELECT * FROM contests WHERE id = ?', + contest_problems_sth => 'SELECT problem FROM contest_problems JOIN problems pb ON problem=pb.id WHERE contest = ? ORDER BY pb.value', + contest_has_problem_sth => 'SELECT EXISTS(SELECT 1 FROM contest_problems WHERE contest = ? AND problem = ?)', + opens_sth => 'SELECT problem,owner,time FROM opens WHERE contest = ?', + + problem_entry_sth => 'SELECT ' . (join ',', @{PROBLEM_PUBLIC_COLUMNS()}, 'statement', 'solution') . ' FROM problems WHERE id = ?', + limits_sth => 'SELECT format,timeout FROM limits WHERE problem = ?', + problem_values_sth => 'SELECT id,value FROM problems', + + job_entry_sth => 'SELECT * FROM job_entry WHERE id = ?', + job_full_sth => 'SELECT * FROM jobs WHERE id = ?', +); + +around connect => sub { + my $orig = shift; + my $self = $orig->(@_); + $self->{dbh} = DBI->connect($_[1]); + $self->{dbis} = DBIx::Simple->new($self->{dbh}); + $self->{dbis}->keep_statements = 100; + $self +}; + +sub purge; + +sub query { + my ($self, $stat, @extra) = @_; + $self->{dbis}->query($statements{$stat} // $stat, @extra) +} + +my (%name_cache, %name_cache_time); +use constant NAME_CACHE_MAX_AGE => 5; + +sub object_name { + my ($self, $table, $id) = @_; + $name_cache_time{$table} //= 0; + if (time - $name_cache_time{$table} > NAME_CACHE_MAX_AGE) { + $name_cache_time{$table} = time; + $name_cache{$table} = {}; + $name_cache{$table} = $self->{dbis}->select($table, 'id,name')->map; + } + + $name_cache{$table}{$id} +} + + +sub add_names { + my ($self, $el) = @_; + if (ref $el eq 'ARRAY') { + $self->add_names($_) for @$el + } else { + for my $object (qw/contest owner problem/) { + my $table = $object eq 'owner' ? 'users' : "${object}s"; + $el->{"${object}_name"} = $self->object_name($table, $el->{$object}) if defined $el->{$object} + } + } + + $el +} + +sub user_list_orig { my ($self) = @_; my $rs = $self->users->search(undef, {columns => USER_PUBLIC_COLUMNS} ); my (%solved, %attempted, %contests); @@ -68,7 +142,7 @@ sub user_list { \@users } -sub user_entry { +sub user_entry_orig { my ($self, $id) = @_; my $user = $self->users->find($id, {columns => USER_PUBLIC_COLUMNS, prefetch => [qw/problem_statuses contest_statuses/]}); my @problems = map { {problem => $_->get_column('problem'), solved => $_->solved} } $user->problem_statuses->search(undef, {order_by => 'problem'}); @@ -76,7 +150,23 @@ sub user_entry { +{ $user->get_columns, problems => \@problems, contests => \@contests } } -sub problem_list { +sub user_list { + my ($self) = @_; + scalar $self->query('user_list_sth')->hashes +} + +sub user_entry { + my ($self, $id) = @_; + my $ret = $self->query('user_entry_sth', $id)->hash; + $ret->{problems} = $self->query('problem_status_sth', $id)->hashes; + $ret->{contests} = $self->query('contest_status_sth', $id)->hashes; + + $self->add_names($ret->{problems}); + $self->add_names($ret->{contests}); + $ret; +} + +sub problem_list_orig { my ($self, %args) = @_; my @columns = @{PROBLEM_PUBLIC_COLUMNS()}; push @columns, 'solution' if $args{solution} && $args{contest} && !$self->contest($args{contest})->is_running; @@ -93,7 +183,28 @@ sub problem_list { \%params } -sub problem_entry { +sub problem_list { + my ($self, %args) = @_; + my @columns = @{PROBLEM_PUBLIC_COLUMNS()}; + push @columns, 'solution' if $args{solution}; + my %where; + $where{private} = 0 unless $args{contest} || $args{private}; + $where{'cp.contest'} = $args{contest} if $args{contest}; + $where{owner} = $args{owner} if $args{owner}; + + my $table = $args{contest} ? 'problems JOIN contest_problems cp ON cp.problem = id' : 'problems'; + my $ret = $self->{dbis}->select(\$table, \@columns, \%where, 'name')->hashes; + $self->add_names($ret); + + my %params; + for (@$ret) { + $params{$_->{level}} //= []; + push @{$params{$_->{level}}}, $_ + } + \%params +} + +sub problem_entry_orig { my ($self, $id, $contest, $user) = @_; my $running = $contest && $self->contest($contest)->is_running; my @columns = @{PROBLEM_PUBLIC_COLUMNS()}; @@ -125,7 +236,23 @@ sub problem_entry { } } -sub contest_list { +sub problem_entry { + my ($self, $id, $contest, $user) = @_; + $contest &&= $self->contest_entry($contest); + my $ret = $self->query(problem_entry_sth => $id)->hash; + $self->add_names($ret); + my $limits = $self->query(limits_sth => $id)->hashes; + $ret->{limits} = $limits if @$limits; + + if ($contest) { + $ret->{contest_start} = $contest->{start}; + $ret->{contest_stop} = $contest->{stop}; + } + + $ret +} + +sub contest_list_orig { my ($self, %args) = @_; my $rs = $self->contests->search(undef, {columns => CONTEST_PUBLIC_COLUMNS, order_by => {-desc => 'start'}, prefetch => 'owner'}); $rs = $rs->search({owner => $args{owner}}) if $args{owner}; @@ -138,13 +265,44 @@ sub contest_list { \%params } -sub contest_entry { +sub contest_entry_orig { my ($self, $id) = @_; my $ct = $self->contests->find($id,{columns => CONTEST_PUBLIC_COLUMNS}); +{ $ct->get_columns, started => !$ct->is_pending, finished => $ct->is_finished, owner_name => $ct->owner->name } } -sub job_list { +sub contest_list { + my ($self) = @_; + my $ret = $self->query('contest_list_sth')->hashes; + $self->add_names($ret); + + my %ret; + for (@$ret) { + my $state = $_->{finished} ? 'finished' : $_->{started} ? 'running' : 'pending'; + $ret{$state} //= []; + push @{$ret{$state}}, $_; + } + + \%ret +} + +sub contest_entry { + my ($self, $id) = @_; + my $ret = $self->query(contest_entry_sth => $id)->hash; + $self->add_names($ret); +} + +sub contest_full { + my ($self, $id) = @_; + scalar $self->query(contest_full_sth => $id)->hash; +} + +sub contest_has_problem { + my ($self, $contest, $problem) = @_; + $self->query('contest_has_problem_sth')->flat +} + +sub job_list_orig { my ($self, %args) = @_; $args{page} //= 1; my $rs = $self->jobs->search(undef, {order_by => {-desc => 'me.id'}, prefetch => ['problem', 'owner', 'contest'], rows => JOBS_PER_PAGE, page => $args{page}}); @@ -171,7 +329,7 @@ sub job_list { } } -sub job_entry { +sub job_entry_orig { my ($self, $id) = @_; my $job = $self->jobs->find($id, {prefetch => ['problem', 'owner', 'contest']}); my %params = $job->get_columns; @@ -184,7 +342,109 @@ sub job_entry { \%params } -sub update_status { +sub job_list { + my ($self, %args) = @_; + $args{page} //= 1; + my %where = ( + maybe contest => $args{contest}, + maybe owner => $args{owner}, + maybe problem => $args{problem}, + maybe result => $args{result}, + ); + $where{private} = 0 unless $args{private}; + + my $rows = $self->{dbis}->select('job_entry', 'COUNT(*)', \%where)->list; + my $pages = int (($rows + JOBS_PER_PAGE - 1) / JOBS_PER_PAGE); + my ($stmt, @bind) = $self->{dbis}->abstract->select('job_entry', '*', \%where, {-desc => 'id'}); + my $jobs = $self->{dbis}->query("$stmt LIMIT " . JOBS_PER_PAGE . ' OFFSET ' . ($args{page} - 1) * JOBS_PER_PAGE, @bind)->hashes; + my %ret = ( + log => $jobs, + current_page => $args{page}, + last_page => $pages, + ); + $self->add_names($ret{log}); + $ret{previous_page} = $args{page} - 1 if $args{page} - 1; + $ret{next_page} = $args{page} + 1 if $args{page} < $pages; + + \%ret; +} + +sub job_entry { + my ($self, $id) = @_; + my $ret = $self->query(job_entry_sth => $id)->hash; + $ret->{results} &&= decode_json $ret->{results}; + $self->add_names($ret); +} + +sub job_full { + my ($self, $id) = @_; + scalar $self->query(job_full_sth => $id)->hash +} + +sub create_job { + my ($self, %args) = @_; + $self->{dbis}->update('users', {lastjob => time}); + purge '/log/'; + scalar $self->{dbis}->insert('jobs', \%args, {returning => 'id'})->list +} + +sub calc_score { + my ($mxscore, $time, $tries, $totaltime) = @_; + my $score = $mxscore; + $time = 0 if $time < 0; + $time = 300 if $time > $totaltime; + $score = ($totaltime - $time) / $totaltime * $score; + $score -= $tries / 10 * $mxscore; + $score = $mxscore * 3 / 10 if $score < $mxscore * 3 / 10; + int $score + 0.5 +} + +sub standings { + my ($self, $ct) = @_; + $ct = $self->contest_entry($ct); + + my @problems = $self->query(contest_problems_sth => $ct->{id})->flat; + my $pblist = $self->problem_list; + my %values = $self->query('problem_values_sth')->map; +# $values{$_} = $values{$_}->{value} for keys %values; + + my (%scores, %tries, %opens); + my $opens = $self->query(opens_sth => $ct->{id}); + while ($opens->into(my ($problem, $owner, $time))) { + $opens{$problem, $owner} = $time; + } + + my $jobs = $self->{dbis}->select('job_entry', '*', {contest => $ct->{id}}, 'id'); + + while (my $job = $jobs->hash) { + my $open = $opens{$job->{problem}, $job->{owner}} // $ct->{start}; + my $time = $job->{date} - $open; + next if $time < 0; + my $value = $values{$job->{problem}}; + my $factor = $job->{result} ? 0 : 1; + $factor = $1 / 100 if $job->{result_text} =~ /^(\d+ )/s; + $scores{$job->{owner}}{$job->{problem}} = int ($factor * calc_score ($value, $time, $tries{$job->{owner}}{$job->{problem}}++, $ct->{stop} - $ct->{start})); + } + + my @st = sort { $b->{score} <=> $a->{score} or $a->{user} cmp $b->{user} } map { ## no critic (ProhibitReverseSortBlock) + my $user = $_; + +{ + user => $user, + user_name => $self->object_name(users => $user), + score => sum (values %{$scores{$user}}), + scores => [map { $scores{$user}{$_} // '-'} @problems], + } + } keys %scores; + + $st[0]->{rank} = 1 if @st; + $st[$_]->{rank} = $st[$_ - 1]->{rank} + ($st[$_]->{score} < $st[$_ - 1]->{score}) for 1 .. $#st; + +{ + st => \@st, + problems => [map { [ $_, $self->object_name(problems => $_)] } @problems], + } +} + +sub update_status_orig { my ($self) = @_; my @jobs = $self->jobs->search({'me.private' => 0}, {cache => 1, prefetch => 'problem', order_by => 'me.id'})->all; @@ -214,6 +474,30 @@ sub update_status { $self->txn_do($txn); } +sub update_status { + my ($self) = @_; + my $jobs = $self->{dbis}->select('jobs', 'id,owner,problem,result', {}, 'id'); + + my %hash; + while ($jobs->into(my ($id, $owner, $problem, $result))) { + $hash{$problem, $owner} = [$id, $result ? 0 : 1]; + } + + my @problem_statuses = map { [split ($;), @{$hash{$_}} ] } keys %hash; + + my @contest_statuses = map { + my $ct = $_; + map { [$ct, $_->{user}, $_->{score}, $_->{rank}] } @{$self->standings($ct)->{st}} + } $self->{dbis}->select('contests', 'id')->flat; + + $self->{dbis}->begin; + $self->{dbis}->delete('problem_status'); + $self->{dbis}->query('INSERT INTO problem_status (problem,owner,job,solved) VALUES (??)', @$_) for @problem_statuses; + $self->{dbis}->delete('contest_status'); + $self->{dbis}->query('INSERT INTO contest_status (contest,owner,score,rank) VALUES (??)', @$_) for @contest_statuses; + $self->{dbis}->commit +} + my @PURGE_HOSTS = exists $ENV{PURGE_HOSTS} ? split ' ', $ENV{PURGE_HOSTS} : (); my $ht = HTTP::Tiny->new; -- 2.39.2