Scientist

$ rakupp install Scientist

use Scientist;

my $s = Scientist.new(
    experiment => 'sum',
    use        => sub { (1..10).sum },
    try        => sub { 10 * 11 div 2 },
    context    => %( owner => 'spike' ),
);
say 'run returned : ', $s.run;
say '';
my %r = $s.result;
say 'result keys  : ', %r.keys.sort.join(', ');
say '  experiment : ', %r<experiment>.raku;
say '  mismatched : ', %r<mismatched>;
say '  context    : ', %r<context>.map({ .key ~ '=' ~ .value }).sort.join(', ');
say '  durations are Durations : ',
    so (%r<control><duration>, %r<candidate><duration>).all ~~ Duration;
say '';
say 'the value your program gets is always the CONTROL`s.';

use Scientist;

my $s = Scientist.new(
    experiment => 'disagree',
    use        => sub { 'old' },
    try        => sub { 'new' },
);
say 'run returned : ', $s.run.raku, '   <- the control`s value';
say 'mismatched   : ', $s.result<mismatched>;
say '';
say 'and note what is NOT recorded — neither value:';
say '  result keys : ', $s.result.keys.sort.join(', ');
say '';
my $t = Scientist.new(
    experiment => 'candidate throws',
    use        => sub { 'old' },
    try        => sub { die 'boom' },
);
say 'a candidate that THROWS:';
say '  run survived : ', ($t.run.defined ?? 'yes' !! 'no');
say '  returned     : ', $t.run.raku;
say '  mismatched   : ', $t.result<mismatched>;
say '';
say 'the exception is swallowed by an inner try, $candidate stays';
say 'undefined, mismatched becomes True, and nothing anywhere records';
say 'that an exception happened. A candidate that always throws is';
say 'indistinguishable from one that always returns the wrong answer.';
say '';
say 'the CONTROL`s exceptions propagate to your caller, which is right.';

use Scientist;

sub compare($label, &a, &b) {
    my $s = Scientist.new(experiment => $label, use => &a, try => &b);
    $s.run;
    sprintf('  %-28s mismatched = %s', $label, $s.result<mismatched>)
}
say compare('Int 42 vs Rat 42.0',  { 42 },        { 42.0 });
say compare('Int 42 vs Num 42e0',  { 42 },        { 42e0 });
say compare('Int 42 vs Str "42"',  { 42 },        { '42' });
say compare('List vs Array',       { (1, 2, 3) }, { [1, 2, 3] });
say compare('List vs Seq',         { (1, 2, 3) }, { (1, 2, 3).Seq });
say compare('Hash vs Map',         { %( a => 1 ) }, { Map.new(('a', 1)) });
say compare('identical Ints',      { 42 },        { 42 });
say compare('both return Nil',     { Nil },       { Nil });
say '';
say '42 versus 42.0 is a mismatch; (1,2,3) versus [1,2,3] is a mismatch.';
say 'In a real refactor those are the COMMON cases, and there is no hook';
say 'to supply your own comparator.';
say '';
say 'normalise inside the two callables:';
my $s = Scientist.new(experiment => 'normalised',
                      use => sub { (1, 2, 3).List },
                      try => sub { [1, 2, 3].List });
$s.run;
say '  both .List-ed -> mismatched = ', $s.result<mismatched>;

use Scientist;

my $s = Scientist.new(experiment => 'first', use => sub { 1 }, try => sub { 2 });
$s.run;
say 'after a run, result<experiment> : ', $s.result<experiment>.raku;
$s.enabled = False;
say 'run with enabled = False        : ', $s.run;
say 'result<experiment> is STILL     : ', $s.result<experiment>.raku;
say 'result<mismatched> is STILL     : ', $s.result<mismatched>;
say '';
say 'enabled = False short-circuits before %!result is touched, so result';
say 'keeps reporting the PREVIOUS run`s verdict, name and all.';
say '';
say 'and the order of the two calls is RANDOMISED per run — Bool.pick —';
say 'so a candidate with side effects, shared state or a warm cache will';
say 'produce unstable timings and results.';
say '';
say 'publish() is an empty method; the "publish your results" story needs';
say 'a subclass:';
class Loud is Scientist {
    method publish { note "  {$.experiment}: mismatched={$.result<mismatched>}" }
}
Loud.new(experiment => 'loud', use => sub { 1 }, try => sub { 2 }).run;
say '  (publish writes to stderr above; it is called on agreement too)';

use Scientist;

my %ctx = owner => 'spike';
my $s = Scientist.new(experiment => 'ctx', use => sub { 1 }, try => sub { 1 },
                      context => %ctx);
$s.run;
say 'copy the context before you touch it:';
my %mine = $s.result<context>;
%mine<owner> = 'someone else';
say '  my copy      : ', %mine<owner>;
say '  the object   : ', $s.result<context><owner>;
say '';
say 'the result Map is shallow, so its nested values are shared. Treat';
say 'everything that comes out of .result as read-only.';
say '';
say 'and `use` is required while `try` is not — leaving try unset is not';
say 'an error, it is a permanent mismatched => True.';