#!/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 Chj::Backtrace;

# fibs :: [Integer]
# fibs = 1:1:zipWith (+) fibs (tail fibs)
# fib n = fibs!!n

our $fibs; $fibs=
  cons 1, cons 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 1, cons 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 1, cons 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
# *addc and look at $addc before and after the calculation:

my $addc=0;
sub addc {
    $addc++;
    $_[0]+$_[1]
}

TEST { $addc=0; local *add=*addc; [fibs->ref(80), $addc] }
  ['37889062373143906', 79];
TEST { $addc=0; local *add=*addc; [fibs2->ref(80), $addc] }
  ['37889062373143906', 3160]; # 3160 == 79*80/2



TEST { stream_to_array stream_take Keep($fibs), 10 }
        [
          1,
          1,
          2,
          3,
          5,
          8,
          13,
          21,
          34,
          55
        ];

TEST { fib 30 }
  1346269;

TEST { fibs->ref(30) }
  1346269;

TEST { fibs2->ref(30) }
  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) ? (0, 1)
      : do {
          my ($a,$b)= _fib(int $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 }
  1346269;


# With bigger inputs:

# we're not using a bignum library, thus we're restricted by Perl's
# floating point range and precision.

use Chj::time_this;

my $a= lazy{time_this{ fib (1400) } "fib"};
my $b= lazy{time_this{ fibonacci (1400) } "fibonacci"};

TEST {
    # Hack: stringify to drop invisible but different digits
    FORCE($a).""
}
  "2.7682097123729e+292";

TEST {
    # same hack
    $a."" == FORCE($b).""
}
  1;

TEST {
    # same as above but more properly:
    abs(($a - $b) / $b) < 1e-14
}
  1;


perhaps_run_tests "main" or do {
    require FP::Repl::Trap;
    FP::Repl::repl();
};
