#!/usr/bin/perl -w

# This script is for testing Sereal decode speeds, with various
# generated test inputs (which are first encoded).  Sample usages:
#
# decode.pl --build --output=data.srl
#
# will (1) build a "graph" (a hash of small strings, really,
# which can be seen as an adjacency list representation of
# a graph, the vertex and its neighbors) of 1e5 vertices
# (2) decode the encoded blob 5 times (the 'graph', 1e5, and 5
# being the defaults).
#
# Other inputs types (--type=T) are
# aoi (array of int) (value == key)
# aoir (array of int) (value == randomly shuffled key)
# aof (array of float) (rand())
# aos (array of string) (value eq key)
# hoi (hash of int)
# hof (hash of float)
# hos (hash of string)
#
# The 'base' number of elements in each case is controlled by --elem=N.
# For the array and hash the number of elements is trivial, for the graph
# the total number of elements (in its hash-of-hashes) is O(N log N).
#
# The number decode repeats is controlled by --repeat_decode=N and --repeat_decode=N.
#
# The encode input needs to be built only once, the --output tells
# where to save the encoded blob.  The encode blob can be read back
# from the save file with --input, much faster, especially in the case
# of the graph input.

use strict;

use Time::HiRes;
use Sereal::Encoder;
use Sereal::Decoder;
use Getopt::Long;
use Fcntl qw[O_RDONLY O_WRONLY O_CREAT O_TRUNC];
use List::Util qw[shuffle];

sub MB () { 2 ** 20 }

my %Opt;
my @Opt = ('input=s', 'output=s', 'type=s', 'elem=f', 'build',
           'repeat_encode=i', 'repeat_decode=i',

           # If non-zero, will drop the minimum and maximum
           # values before computing statistics IF the number
           # of measurements is at least this limit.  So with
           # a value of 5 will leave 3 measurements.  Lowers
           # the stddev, should not affect avg/median (much).
           # Helpful in reducing cache effects.
           'min_max_drop_limit=i',

           'size');
my %OptO = map { my ($n) = /^(\w+)/; $_ => \$Opt{$n} } @Opt;
my @OptU = map { "--$_" } @Opt;

GetOptions(%OptO) or die "GetOptions: @OptU\n";

my $data;
my $blob;
my $size;
my $data_size;
my $blob_size;
my $dt;

if (defined $Opt{size}) {
    eval 'use Devel::Size qw[total_size]';
    if ($@) {
        die "$0: --size but Devel::Size=total_size not found\n";
    }
}

if (defined $Opt{build}) {
    die "$0: --input with --build makes no sense\n" if defined $Opt{input};
    $Opt{elem} //= 1e5;
} else {
    die "$0: --output without --build makes no sense\n" if defined $Opt{output};
    die "$0: --elem without --build makes no sense\n" if defined $Opt{elem};
    die "$0: Must specify either --build or --input\n" unless defined $Opt{input};
}
if (defined ($Opt{output})) {
    die "$0: --input with --output makes no sense\n" if defined $Opt{input};
}

$Opt{type} //= 'graph';
$Opt{repeat_encode} //= 1;
$Opt{repeat_decode} //= 5;
$Opt{min_max_drop_limit} //= 0;

my %TYPE = map { $_ => 1 } qw[aoi aoir aof aos hoi hof hos graph];

die "$0: Unexpected --type=$Opt{type}\n$0: Expected --type=@{[join('|', sort keys %TYPE)]}\n"
    unless exists $TYPE{$Opt{type}};

sub Times::new {
    my $t = Time::HiRes::time();
    my ($u, $s, $cu, $cs) = times();
    bless {
        wall => $t,
        usr  => $u,
        sys  => $s,
        cpu  => $u + $s,
        cusr => $cu,
        csys => $cs,
    }, $_[0];
}
sub Times::diff {
    die "Unexpected diff(@_)\n" unless ref $_[0] eq ref $_[1];
    bless { map { $_ => ($_[0]->{$_} - $_[1]->{$_}) } keys %{$_[0]} }, ref $_[0];
}
sub Times::wall { $_[0]->{wall} }
sub Times::usr  { $_[0]->{usr}  }
sub Times::sys  { $_[0]->{sys}  }
sub Times::cpu  { $_[0]->{cpu}  }
# times() can often sum just a tad higher than wallclock.
sub Times::pct { 100 * ($_[0]->cpu > $_[0]->wall ? 1 : $_[0]->cpu / $_[0]->wall) }

sub timeit {
    my $code = shift;
    my $t0 = Times->new();
    my @res = $code->(@_);
    my $t1 = Times->new();
    my $dt = $t1->diff($t0);
    return $dt;
}

sub __stats {
    # The caller is supposed to have done this sorting
    # already, but let's be wasteful and paranoid.
    my @v = sort { $a <=> $b } @_;
    my $min = $v[0];
    my $max = $v[-1];
    my $med = @v % 2 ? $v[@v/2] : ($v[@v/2-1] + $v[@v/2]) / 2;
    my $sum = 0;
    for my $t (@_) {
        $sum += $t;
    }
    my $avg = $sum / @_;
    my $sqsum = 0;
    for my $t (@_) {
        $sqsum += ($avg - $t) ** 2;
    }
    my $stddev = sqrt($sqsum / @_);
    return ( avg => $avg,
             stddev => $stddev,
             rstddev => $avg ? $stddev / $avg : undef,
             min => $min, med => $med, max => $max );
}

sub stats {
    my %stats;
    for my $k (qw(wall cpu)) {
        my @v = sort { $a <=> $b } map { $_->{$k} } @_;
        if ($Opt{min_max_drop_limit} > 0 &&
            @v >= $Opt{min_max_drop_limit}) {
            print "$k: dropping min and max ($v[0] and $v[-1])\n";
            shift @v;
            pop @v;
        }
        $stats{$k} = { __stats(@v) };
    }
    return %stats;
}

if (defined $Opt{build}) {
    print "building data\n";
    my $E;
    if ($Opt{type} eq 'graph') {
	print "building graph\n";
	my $V = $Opt{elem};
	$E = int($V * log($V)/log(2));
	printf("data of %d (%.1fM) vertices %d (%.1fM) edges\n",
	       $V, $V / MB, $E, $E / MB);
	$dt = timeit(
	    sub {
		for my $i (1..$E) {
		    my $a = int(rand($V));
		    my $b = int(rand($V));
		    $data->{$a}{$b}++;
		}
	    });
    } elsif ($Opt{type} eq 'aoi') {
	print "building aoi\n";
	$E = $Opt{elem};
	$dt = timeit(
	    sub {
		for my $i (1..$E) {
		    push @$data, $i;
		}
	    });
    } elsif ($Opt{type} eq 'aoir') {
	print "building aoir\n";
	$E = $Opt{elem};
	$dt = timeit(
	    sub {
		for my $i (shuffle 1..$E) {
		    push @$data, $i;
		}
	    });
    } elsif ($Opt{type} eq 'aof') {
	print "building aof\n";
	$E = $Opt{elem};
	$dt = timeit(
	    sub {
		for my $i (1..$E) {
		    push @$data, rand();
		}
	    });
    } elsif ($Opt{type} eq 'aos') {
	print "building aos\n";
	$E = $Opt{elem};
	$dt = timeit(
	    sub {
		for my $i (1..$E) {
		    push @$data, rand() . $$;
		}
	    });
    } elsif ($Opt{type} eq 'hoi') {
	print "building hoi\n";
	$E = $Opt{elem};
	$dt = timeit(
	    sub {
		for my $i (1..$E) {
		    $data->{$i} = $i;
		}
	    });
    } elsif ($Opt{type} eq 'hof') {
	print "building hof\n";
	$E = $Opt{elem};
	$dt = timeit(
	    sub {
		for my $i (1..$E) {
		    $data->{$i} = rand();
		}
	    });
    } elsif ($Opt{type} eq 'hos') {
	print "building hos\n";
	$E = $Opt{elem};
	$dt = timeit(
	    sub {
		for my $i (1..$E) {
		    $data->{$i} = "$i";
		}
	    });
    } else {
	die "$0: Unexpected type '$Opt{type}'\n";
    }
    printf("build %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f elements/sec)\n",
           $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct, $E / $dt->wall);
    if ($Opt{size}) {
	$dt = timeit(sub { $data_size = total_size($data);});
	printf("data size %d bytes (%.1fMB) %.1f sec\n",
	       $data_size, $data_size / MB, $dt->wall);
    }

    my $encoder = Sereal::Encoder->new;

    {
	print "encoding data\n";
        my @dt;
        for my $i (1..$Opt{repeat_encode}) {
            $dt = timeit(sub { $blob = $encoder->encode($data); });
            $blob_size = length($blob);
            printf("%d/%d: encode to %d bytes (%.1fMB) %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n",
                   $i, $Opt{repeat_encode}, $blob_size, $blob_size / MB, $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct,
                   $blob_size / (MB * $dt->wall));
            push @dt, $dt;
        }
        if (@dt) {
            my %stats = stats(@dt);
            for my $k (qw(wall cpu)) {
                my $avg = $stats{$k}{avg};
                printf("encode %-4s avg %.2f sec (%.1f MB/sec) stddev %.2f sec (%.2f) min %.2f med %.2f max %.2f\n",
                       $k,
                       $avg, $avg ? $blob_size / (MB * $avg) : 0, $stats{$k}{stddev}, $avg ? $stats{$k}{rstddev} : 0,
                       $stats{$k}{min}, $stats{$k}{med}, $stats{$k}{max});
            }
        }
    }

    if (defined $Opt{output}) {
	print "opening output\n";
	my $fh;
	sysopen($fh, $Opt{output}, O_WRONLY|O_CREAT|O_TRUNC)
	    or die qq[sysopen "$Opt{output}": $!\n];
	print "writing blob\n";
	$dt = timeit(
	    sub {
		syswrite($fh, $blob)
		    or die qq[syswrite "$Opt{otput}": $!\n] });
	$blob_size = length($blob);
	printf("wrote %d bytes (%.1f MB) %.2f sec  %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n",
	       $blob_size, $blob_size / MB, $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct,
               $blob_size / (MB * $dt->wall));
    }
} elsif (defined $Opt{input}) {
    print "opening input\n";
    my $fh;
    sysopen($fh, $Opt{input}, O_RDONLY) or die qq[sysopen "$Opt{input}": $!\n];
    print "reading blob\n";
    $dt = timeit(
	sub {
	    sysread($fh, $blob, -s $fh)
		or die qq[sysread "$Opt{input}": $!\n];
	});
    $blob_size = length($blob);
    printf("read %d bytes (%.1f MB) %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n",
	   $blob_size, $blob_size / MB, $dt->wall,  $dt->usr, $dt->sys, $dt->cpu, $dt->pct,
           $blob_size / (MB * $dt->wall));
}

my $decoder = Sereal::Decoder->new;

{
    print "decoding blob\n";
    $blob_size = length($blob);
    my @dt;
    for my $i (1..$Opt{repeat_decode}) {
	$dt = timeit(sub { $data = $decoder->decode($blob); });
	printf("%d/%d: decode from %d bytes (%.1fM) %.2f sec %.2f usr %.2f sys %.2f cpu %3d%% (%.1f MB/sec)\n",
	       $i, $Opt{repeat_decode}, $blob_size, $blob_size / MB,
	       $dt->wall, $dt->usr, $dt->sys, $dt->cpu, $dt->pct, $blob_size / (MB * $dt->wall));
	push @dt, $dt;
    }
    if (ref $data eq 'HASH') {
        printf("data is hashref of %d elements\n", scalar keys %{$data});
    } elsif (ref $data eq 'ARRAY') {
        printf("data is hashref of %d elements\n", scalar @{$data});
    } elsif (ref $data) {
        printf("data is ref of %s\n", ref $data);
    } else {
        printf("data is of unexpected type\n");
    }
    if (@dt) {
        my %stats = stats(@dt);
        for my $k (qw(wall cpu)) {
            my $avg = $stats{$k}{avg};
            printf("decode %-4s avg %.2f sec (%.1f MB/sec) stddev %.2f sec (%.2f) min %.2f med %.2f max %.2f\n",
                   $k,
                   $avg, $avg ? $blob_size / (MB * $stats{$k}{avg}) : 0, $stats{$k}{stddev}, $avg ? $stats{$k}{rstddev} : 0,
                   $stats{$k}{min}, $stats{$k}{med}, $stats{$k}{max});
        }
    }
    if ($Opt{size}) {
	$dt = timeit(sub { $data_size = total_size($data); });
	printf("data size %d bytes (%.1fMB) %.1f sec\n",
	       $data_size, $data_size / MB, $dt->wall);
    }
}

if ($Opt{size}) {
    if ($blob_size && $data_size) {
        printf("data size / blob size %.2f\n", $data_size / $blob_size);
    }
}

exit(0);