#!/usr/bin/env perl
# Copyright (c) 2015-2020 Christian Jaeger, copying@christianjaeger.ch
# This is free software. See the file COPYING.md that came bundled
# with this file.
use strict;
use warnings;
use warnings FATAL => 'uninitialized';
# find modules from functional-perl working directory (not installed)
use Cwd 'abs_path';
our ($mydir, $myname);
BEGIN {
    my $location = (-l $0) ? abs_path($0) : $0;
    $location =~ /(.*?)([^\/]+?)_?\z/s or die "?";
    ($mydir, $myname) = ($1, $2);
}
use lib "$mydir/../lib";
use Chj::TEST use => "PadWalker";
use FP::List ":all";
use FP::Ops ":all";
use FP::Lazy ":all";
use FP::Stream ":all";
use FP::BigInt;
use Chj::Backtrace;
# fibs :: [Integer]
# fibs = 1:1:zipWith (+) fibs (tail fibs)
# fib n = fibs!!n
our $fibs;
$fibs = cons bigint(1), cons bigint(1),
    lazy { stream_zip_with \&add, Keep($fibs), rest $fibs };
sub fib {
    my ($n) = @_;
    stream_ref Keep($fibs), $n
}
# The above code creates the sequence only once per program run and
# then keeps it around in the $fibs global; there's no provision to
# set $fibs again thus it has to be protected with Keep() from being
# deleted. While this works, and is arguably efficient since multiple
# calls to fib() do not need to recalculate the stream, it also means
# that the whole stream up to the highest $n ever calculated are kept
# in memory until program exit.
# Here is an alternative definition that doesn't keep the stream tied
# to a global, but instead returns a fresh copy each time fibs() is
# called:
sub fibs {
    my $fibs;
    $fibs = cons bigint(1), cons bigint(1),
        lazy { stream_zip_with \&add, $fibs, rest $fibs };
    $fibs
}
# Note that while it creates a reference cycle, it won't leak, as the
# cycle is broken by stream_zip_with weakening its arguments, which we
# don't protect here (we do not use a Keep() wrapper).
# Here's a variant that relies on self-referencing the subroutine (a
# package variable) instead of mutating a lexical variable:
sub fibs2 {
    cons bigint(1), cons bigint(1), lazy {
        my $fibs = fibs2();
        stream_zip_with \&add, $fibs, rest $fibs
    }
}
# But it's less efficient: it recalculates parts multiple times, as
# can be seen with CPU timings, or with the number of times that it
# calls \&add; you can check for the latter by replacing \&add with
# \&counting_add and look at $addcount before and after the
# calculation:
my $addcount = 0;
sub counting_add {
    $addcount++;
    $_[0] + $_[1]
}
TEST {
    $addcount = 0;
    # local *add = \&counting_add;
    # to avoid redefinition warnings, use the glob (alternatively
    # disable the warning):
    local *add = *counting_add;
    [fibs->ref(80), $addcount]
}
[bigint('37889062373143906'), 79];
TEST {
    $addcount = 0;
    local *add = *counting_add;
    [fibs2->ref(80), $addcount]
}
[bigint('37889062373143906'), 3160];    # 3160 == 79*80/2
# This is because the recursive call to `fibs2` is creating a second,
# independently calculated sequence, which itself at the second
# position again is creating another (third), independently calculated
# sequence, etc. We want to calculate the same sequence only once,
# which `fibs` achieves.
TEST { Keep($fibs)->take(10)->map(\&stringify)->array }
[1, 1, 2, 3, 5, 8, 13, 21, 34, 55];
TEST { fib 30 }
bigint(1346269);
TEST { fibs->ref(30) }
bigint(1346269);
TEST { fibs2->ref(30) }
bigint(1346269);
# ------------------------------------------------------------------
# Alright, so there are not only the stupidly slow naive recursive and
# the above widespread O(n) algorithm (as well as the fibs2 variant
# which is inbetween), but also better ones:
# http://www.nayuki.io/page/fast-fibonacci-algorithms
# Thus if we wanted something really fast, we'd diverge from standard
# examples and instead implement the following:
# http://www.nayuki.io/res/fast-fibonacci-algorithms/fastfibonacci.hs
# (we're adding this for completeness and some perspective on the
# topic of performance, not as a demo of functional-perl)
sub _fib {
    my ($n) = @_;
    ($n == 0) ? (bigint(0), bigint(1)) : do {
        no warnings 'recursion';
        my ($a, $b) = _fib($n / 2);
        my $c = $a * ($b * 2 - $a);
        my $d = $a * $a + $b * $b;
        ($n % 2) == 0 ? ($c, $d) : ($d, $c + $d)
    };
}
sub _fibonacci {
    my ($n) = @_;
    ($n >= 0) ? (_fib $n)[0] : die "n < 0";
}
sub fibonacci {
    my ($n) = @_;
    _fibonacci($n + 1)
}
TEST { fibonacci 30 }
bigint(1346269);
# With bigger inputs:
use Chj::time_this;
my $a = lazy {
    time_this { fib(1400) } "fib"
};
my $b = lazy {
    time_this { fibonacci(1400) } "fibonacci"
};
TEST { FORCE($a) . "" }
"27682097123729003105677626449505746191732174241149462650923690069660131404640833946850969379619575819465246124164576690629246144675379393573106211382631761722558988596174542778374560842981861789646519389087106627252306193512024601313327314953992743800841043870569935864482663072626507327493026";
TEST { FORCE($b) } $a;
perhaps_run_tests "main" or do {
    require FP::Repl::Trap;
    FP::Repl::repl();
};