#!/usr/bin/env perl

# Copyright (c) 2015-2019 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;
       [ 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(*string)->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();
};
