report

#!/opt/maths/bin/perl
use strict;
use warnings;
use Math::GMP;
use Math::Prime::Util qw{ factor_exp };
use List::Util qw{ first reduce };
use lib ('./lib');
use Seq::Db;
use Type;
use Math::xGMP;

my($debug, $opt_composite, $opt_table, $opt_run, $commas) = (0, 0, 0, 0, 0);
my $order = 'n';
my $typename = 't';
my $nfilter;
my $filter = sub { 1 };
while (@ARGV && $ARGV[0] =~ /^-/) {
    my $arg = shift(@ARGV);
    last if $arg eq '--';
    $debug = 1, next if $arg eq '-d';
    $opt_composite = 1, next if $arg eq '-c';
    $opt_table = 1, next if $arg eq '-t';
    $opt_run = 1, next if $arg eq '-r';
    $commas = 1, next if $arg eq '-C';
    $order = [ \'LENGTH(checked)', 'checked' ], next if $arg eq '-z';
    $typename = $1, next if $arg =~ /^-y(.*)/;
    $filter = chain_sig($filter, $1 || shift(@ARGV)), next
            if $arg =~ /^-s(.*)/;
    $filter = chain_fact($filter, $1 || shift(@ARGV)), next
            if $arg =~ /^-f(.*)/;
    $filter = chain_min($filter, $1 || shift(@ARGV)), next
            if $arg =~ /^-n(.*)/;
    $filter = chain_max($filter, $1 || shift(@ARGV)), next
            if $arg =~ /^-x(.*)/;
    $filter = chain_maxprime($filter, $1 || shift(@ARGV)), next
            if $arg =~ /^-mp(.*)/;
    $filter = chain_topprime($filter, $1 || shift(@ARGV)), next
            if $arg =~ /^-tp(.*)/;
    $filter = chain_mod($filter, $1, $2), next
            if $arg =~ /^-m(\d+)=([0-9,]+)$/;
    ($nfilter, $filter) = ($filter, sub { 1 }), next
            if $arg eq '-k';
    die "Unknown option '$arg'";
}
my($n, $k) = @ARGV;
if ($n) {
    $filter = chain_min($filter, $n);
    $filter = chain_max($filter, $n);
}
my $type = Type->new($typename);

local @ENV{qw{ DBI_TRACE DBIC_TRACE }} = (1, 1) if $debug;
my $db = Seq::Db->new($type, 0);

use Data::Dumper;
local $Data::Dumper::Indent = $Data::Dumper::Sortkeys = 1;

if ($nfilter) {
    report_all();
} elsif ($opt_table || !$n) {
    report_g();
} elsif (!$k) {
    report_f();
} elsif (!$opt_run) {
    report_fk();
} else {
    report_run();
}
exit 0;

sub report_all {
    for my $g ($db->resultset('TauG')->search(
        undef, { order_by => $order }
    )->all) {
        my $n = $g->n;
        next unless $nfilter->($n);
        for my $f (@{ $g->fall($db) }) {
            my $k = $f->k;
            next unless $filter->($k);
            _report_fk($g, $f);
        }
    }
    return;
}

sub knowng {
    my($g) = @_;
    my $max = 0;
    for my $f (@{ $g->fall($db) }) {
        next if $f->k <= $max;
        $max = $f->k if $f->f;  # whether or not $f->complete
    }
    return $max;
}

sub report_g {
    # tau(n) only relevant for tauseq, addseq
    my $tauish = ($type->typename =~ /^[ta]$/) ? 1 : 0;

    for my $g ($db->resultset('TauG')->search(
        undef, { order_by => $order }
    )->all) {
        my $n = $g->n;
        next unless $filter->($n);
        if ($g->depend && !$g->complete) {
            $g->update_depends($db);
        }
        next if $g->checked == 0 && !$g->complete;
        next if $opt_composite && (
            $g->prime || $g->complete || $g->depend
        );
        if ($opt_table) {
            my $f = (
                !$g->complete && $g->depend && $g->depended->ming == $g->ming
            ) ? sprintf('g(%s)', $g->depend_n)
                : _fc(_maxf($g));
            my $ming = ($g->superset ? '+' : '')
                    . ($g->subset ? '-' : '')
                    . $g->ming;
            if ($tauish) {
                printf(
                    "%5s | %4s | %5s | %5s | %20s | %s\n",
                    $n, _tau($n), $ming, $g->maxg, $f, _comments($g),
                );
            } else {
                printf(
                    "%5s | %5s | %5s | %27s | %s\n",
                    $n, $ming, $g->maxg, $f, _comments($g),
                );
            }
            next;
        }
        if ($g->complete) {
            printf "g(%s) = %s\n", $g->n, $g->maxg;
        } elsif ($g->depend) {
            printf "g(%s) = g(%s)\n", $g->n, $g->depend_n;
        } else {
            my $ming = $g->ming;
            my $knowng = knowng($g);
            $ming = "$ming/$knowng" if $ming < $knowng;
            my $bisected = ($knowng < $g->maxg)
                    ? sprintf(" b%s", $g->bisected // 0) : '';
            printf "g(%s) in [%s .. %s%s], checked to %s\n",
                    $g->n, $ming, $g->maxg, $bisected // 0, $g->checked;
        }
    }
    return;
}

sub last_complete {
    my($f) = @_;
    return reduce { ($a->runid > $b->runid) ? $a : $b } grep {
        $_->owner == 1 && $_->complete && !$_->partial
    } $f->runs->all;
}


sub _report_fk {
    my($g, $f) = @_;
    if ($f->impossible) {
        printf "f(%s, %s) is impossible\n", $f->n, $f->k;
    } elsif ($f->complete && !$f->depend) {
        if ($f->f) {
            my $rt = last_complete($f);
            my $st = '';
            if ($rt) {
                $st = sprintf ' (%s%.2fs)', $rt->old ? '*' : '', $rt->runtime;
            }
            printf "f(%s, %s) = %s%s\n", $f->n, $f->k, _f($f->f), $st;
        } elsif ($f->k <= $g->maxg) {
            printf "f(%s, %s) > %s\n", $f->n, $f->k, _f($g->checked);
        } # else ignore, it was proven impossible
    } elsif ($f->complete && $f->depend) {
        if ($f->f) {
            printf "f(%s, %s) = %s = %s f(%s, %s)\n",
                    $f->n, $f->k, _f($f->f), $f->depend_m, $f->depend_n, $f->k;
        } else {
            printf "f(%s, %s) = %s f(%s, %s)\n",
                    $f->n, $f->k, $f->depend_m, $f->depend_n, $f->k;
        }
    } elsif ($f->f && !$f->complete) {
        printf "f(%s, %s) <= %s\n", $f->n, $f->k, _f($f->f);
    } else {
        printf "f(%s, %s) > %s\n", $f->n, $f->k, _f($g->checked)
                unless $g->depend;
    }
    return;
}

sub report_fk {
    my $g = $db->resultset('TauG')->find({ n => $n });
    my $f = $db->resultset('TauF')->find({ n => $n, k => $k });
    _report_fk($g, $f);
    return;
}

sub report_f {
    my $g = $db->resultset('TauG')->find({ n => $n });
    if ($g->complete) {
        printf "g(%s) = %s\n", $g->n, $g->maxg;
    } elsif ($g->depend) {
        printf "g(%s) = g(%s)\n", $g->n, $g->depend_n;
    } else {
        printf "g(%s) in [%s .. %s], checked to %s\n",
                $g->n, $g->ming, $g->maxg, $g->checked;
    }
    my $max = $g->maxg;
    for my $f (@{ $g->fall($db) }) {
        _report_fk($g, $f);
    }
    return;
}

sub run_by_owner {
    my($r) = @_;
    my $owner = $r->owner;
    return join ' ', @{ $r->command } if $owner == 0;
    return sprintf 'oul %s %s', $r->n, $r->k if $owner == 1;
    return "unknown owner=$owner";
}

sub report_run {
    my $g = $db->resultset('TauG')->find({ n => $n });
    my $f = $db->resultset('TauF')->find({ n => $n, k => $k });
    for my $r ($f->runs->all) {
        printf "[%s] %s\n",
            run_by_owner($r),
            $r->complete ? sprintf('complete %.3f + %.3f',
                    $r->preptime // 0, $r->runtime // 0)
            : sprintf('%s, prio %.2f',
                    $r->running ? 'running' : 'waiting', $r->priority);
    }
}

sub chain_min {
    my($next, $min) = @_;
    return sub { $_[0] >= $min && $next->($_[0]) };
}

sub chain_max {
    my($next, $max) = @_;
    return sub { $_[0] <= $max && $next->($_[0]) };
}

sub chain_fact {
    my($next, $fact) = @_;
    return sub { ($_[0] % $fact) == 0 && $next->($_[0]) };
}

sub chain_sig {
    my($next, $sig) = @_;
    # Either '1,2,3' => p^1 q^2 r^3 or '12p^2q' => 12 p^2 q
    my($k, @pow) = (1);
    if ($sig =~ /[a-z]/i) {
        $k = $1 if $sig =~ s/^(\d+)//;
        @pow = map +(/\w\^(\d+)/ ? $1 : 1), split /(?=[a-z])/, $sig;
    } else {
        @pow = split /,/, $sig;
    }
    my $vsig = join ',', sort { $b <=> $a } @pow;
    return sub {
        my $n = $_[0];
        return 0 unless $next->($n);
        return 0 unless ($n % $k) == 0;
        $n /= $k;
        return 0 if gcd($n, $k) > 1;
        my $vn = join ',', sort { $b <=> $a } map $_->[1], factor_exp($n);
        return $vn eq $vsig ? 1 : 0;
    };
}

sub chain_maxprime {
    my($next, $p) = @_;
    return sub {
        return 0 unless $next->($_[0]);
        my $tp = (factor_exp($_[0]))[-1][0];
        return $p >= $tp ? 1 : 0;
    };
}

sub chain_topprime {
    my($next, $p) = @_;
    return sub {
        return 0 unless $next->($_[0]);
        my $tp = (factor_exp($_[0]))[-1][0];
        return $p == $tp ? 1 : 0;
    };
}

sub chain_mod {
    my($next, $m, $v) = @_;
    my %v = map +($_ => 1), split /,/, $v;
    return sub {
        return 0 unless $next->($_[0]);
        return $v{$_[0] % $m} ? 1 : 0;
    };
}

sub _tau {
    my($n) = @_;
    my $k = 1;
    $k *= $_->[1] + 1 for factor_exp($n);
    return $k;
}

sub _maxf {
    my($g) = @_;
    my @f = grep $_->complete && $_->f, $g->f->all;
    return @f ? $f[-1]->f : '-';
}

sub gcd {
    my($a, $b) = @_;
    $a = Math::GMP->new($a) unless ref $a;
    return $a->bgcd($b);
}

sub _comments {
    my($g) = @_;
    my $n = $g->n;
    my @f = $g->f->all;
    my @c;
    if ($g->complete) {
        push @c, 'complete';
    } elsif ($g->depend) {
        push @c, 'dependent';
    } else {
        push @c, sprintf 'checked %s', _fe('%.2g', $g->checked);
    }
    my $f = first { $_->complete && $_->depend } @f;
    if ($f) {
        push @c, sprintf'%s f(%s, k>%s)',
                $f->depend_m, $f->depend_n, $f->k - 1;
    }
    $f = first { $_->minc } @f;
    if ($f) {
        my($r) = $f->runs->search_bitfield({ fix_power => 1 },
                { limit => 1 })->all;
        if ($r) {
            push @c, sprintf 'fix_power: k >= %s, -c > %s',
                    $r->k, $f->minc;
        }
    }
    return join "; ", @c;
}

sub _f {
    my($n) = @_;
    $commas ? _fc($n) : "$n";
}
sub _fe {
    my($ft, $n) = @_;
    my $s = (sprintf $ft, "$n") =~ s{e\+?0*(?=\d)}{e}r;
    if ($s =~ /inf/i) {
        my $log = $n->log10;
        my $exp = int($log);
        my $rem = $log - $exp;
        $s = sprintf $ft, 10 ** $rem;
        $s =~ s{e\d+|$}{e$exp};
    }
    return $s;
}
sub _fc {
    my($n) = @_;
    (sprintf '%s', $n) =~ s{(?<=\d)(?=(?:\d{3})+\z)}{,}gr;
}