Tau Station Discreet work parser

discreet-rewards.pl

#!/usr/bin/perl -ws
## Parse discreet work logs shown at
##   http://taustation.wikidot.com/discreet-work
use strict; use warnings; use 5.014;

# -s disable summary info
# -h disable header
# -d disable data row
our ($s, $h, $d);
use Encode;

# Set to 1 to show ±error values to 95% confidence. Errors are pretty low,
# so leave off in general since many will mis-interpret as some kind of variance.
my $SHOW_ERRORS = 1;


my $file = shift;
open my $F, "<", $file or die "Error reading $file: $!";
my @chunks = do { local $/; split /\n\n+/, decode("UTF-8", scalar <$F>); };

my (@rv, $stat_count, %stat, %range);
my %tier = (ration => {}, stim => {});
for (@chunks) {
    s/^\s+//;
    s/\s+$//;

    my %report;
    for (split /\n/, $_) {
        if (/received ([\d.]+) credits/) {
            $report{cr} += $1;
            update_range(\%range, Credit => $1);
        }

        elsif (/(\w+) stat has increased by ([\d.]+)\./) {
            $stat_count++;
            $stat{$1}++;
            $report{stat} += $2;
            update_range(\%range, Stat => $2);
        }

        elsif (/^\+([^=]+)(?:=([\d.]+))?/) {
            my ($item, $value) = ($1, $2);
            if ($item =~ /Food and water daily ration tier (?<tier>\d+)|Tier (?<tier>\d+) Ration/i) {
                $report{ration}++;
                $tier{ration}{$+{tier}}++;
            }
            elsif ($item =~ /^(?:Str|Agi|Sta|Soc|Int|Civ|Mil) T0?(\d+)\-/) {# new naming scheme
                $report{stim}++;
                $tier{stim}{"v$1"}++;
            }
            elsif ($item =~ / Stim, (v\d+)\./) {# old naming scheme
                $report{stim}++;
                $tier{stim}{$1}++;
            }
            elsif ($value) {
                $report{weapon} += $value;
            }
            else {
                say STDERR "WARNING: Unknown item or missing weapon value in: $_";
            }
        }

        elsif (/^(?:!|You have received.*? ')(?:Food and.*?tier (?<tier>\d+)|Tier (?<tier>\d+) Ration)/i) {
            $report{ration}++;
            $tier{ration}{$+{tier}}++;
        }

        elsif (/^You have received.*? '(?:Str|Agi|Sta|Soc|Int|Civ|Mil) T0?(\d+)\-/) {
            $report{stim}++;
            $tier{stim}{"v$1"}++;
        }

        elsif (/^You have received.*? '.* Stim, (v\d+)\.[\d.]+'/) {
            $report{stim}++;
            $tier{stim}{$1}++;
        }

        elsif (/received (\d+) bonds?/) {
            $report{bond} += $1;
        }

        elsif (/received ([\d.]+) bonus credits/) {
            $report{cr} += $1;
        }

        elsif (/^You no longer have .*?/) {
            # Carried (can steal) but not keeping
        }

        elsif (/completed the "Anonymous" mission/) { }
        elsif (/^\s*#/) { }
        else { say STDERR "WARNING: Can't parse line: $_"; }
    }
    push @rv, \%report if %report;
}

die "No mission results found\n" unless @rv;

my %report;
my $count = @rv;
my ($first, @rest) = @rv;
for my $field (qw/ cr stat bond weapon ration stim /) {
    my ($m_a, $s_i) = ($$first{$field}//0, 0);
    my $m_b;
    my $i = $$first{$field} ? 1 : 0;

    for my $rec (@rest) {
        next unless $$rec{$field};
        my $x = $$rec{$field};
        # on-line calculation of variance (Welford's method) Calculate mean
        # and variance from only those missions which give this reward.
        $i++;
        $m_b = $m_a + ($x - $m_a) / $i;
        $s_i = $s_i + ($x - $m_a) * ($x - $m_b);
        $m_a = $m_b;
    }

    # Percent of missions which pay out this reward
    my $p = $i/$count;

    $report{$field} = $m_a * $p;
    $report{"${field}_sd"}  = ($i > 1) ? sqrt($s_i / ($i - 1)) : 0;

    if ($i > 1) {
        # Standard error at 95% confidence level
        my $err_a = $report{"${field}_sd"} / sqrt($i);

        # But we want error bars on (p * mean), so:
        #    err_product = mean_product * sqrt( (err_A / mean_A)^2 + (err_B / mean_B)^2 )
        my $err_p = sqrt($p * (1-$p) / $count);

        $report{"${field}_err"} = $report{$field} * sqrt(($err_a/$m_a)**2 + ($err_p/$p)**2);
    }
    else {
        $report{"${field}_err"} = "???";
    }
}


my (@th, @tr);
push @th, "||~ Station";
push @tr, "|| {STATION} _\n (of $count missions)";

push @th, "||~ Credits";
push @tr, cell(cr => 2);

push @th, "||~ Stat";
push @tr, cell(stat => 3);

push @th, "||~ Bonds";
push @tr, cell(bond => 2);

push @th, "||~ Weapons _\n (sell for)";
push @tr, cell(weapon => 2);

push @th, "||~ Rations";
push @tr, cell(ration => 3, (%{$tier{ration}} ? (comment => "tier " . join(", ", sort keys %{$tier{ration}})) : ()));

push @th, "||~ Stims";
push @tr, cell(stim => 3, comment => join(", ", sort keys %{$tier{stim}}));

my @stat_pct;
for my $s (sort { $stat{$b} <=> $stat{$a} } keys %stat) {
    push @stat_pct, sprintf "%s: %.0f%%", uc(substr($s, 0, 3)), 100*$stat{$s}/$stat_count;
}
push @th, "||~ Stats affected";
push @tr, "|| " . join(", _\n ", @stat_pct);


# Report!
#--------
say "Processed $count instances" unless $s;
say "$_ range: $range{$_}[0]–$range{$_}[1]" for grep $range{$_} && !$s, qw/ Stat /;
say "@th ||" unless $h;
say "@tr ||" unless $d;


sub cell {
    my ($field, $digits, %opt) = @_;
    $opt{align} //= ">";
    my @rv;
    if ($report{$field}) {
        push @rv, "||$opt{align}";
        push @rv, sprintf "**%.*f**", $digits, $report{$field};
        if ($SHOW_ERRORS) {
            push @rv, (
                "_\n",
                "[[size smaller]]" .
                (($report{"${field}_err"} =~ /[^\d.]/)
                    ? ("±" . $report{"${field}_err"})
                    : sprintf("±%.*f", $digits, $report{"${field}_err"})
                ) .
                "[[/size]]"
            );
        }
    }
    else {
        push @rv, "||= —";
    }
    push @rv, "_\n ($opt{comment})" if $opt{comment};

    return join(" ", @rv);
}

sub update_range {
    my ($h, $key, $val) = @_;
    if ($$h{$key}) {
        $$h{$key}[0] = $val if $val < $$h{$key}[0];
        $$h{$key}[1] = $val if $val > $$h{$key}[1];
    } else {
        $$h{$key} = [ $val, $val ];
    }
}