#!/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";



# gracefully fail when run as a test and Method::Signatures is not
# available
use Chj::TEST
  use=> 'Method::Signatures';
use Chj::Backtrace;
use FP::List ":all";
use FP::Ops ":all";
use FP::Lazy ":all";
use FP::Stream ":all";


# Another translation of (a) Haskell example(s) (see also `fibs`).

# ------------------------------------------------------------------
# (A) From https://www.haskell.org/?new :

# Note that this is *not* an efficient algorithm to calculate primes;
# see https://news.ycombinator.com/item?id=9052514 and the solution
# further down in this file.

# primes = sieve [2..]
#   where sieve (p:xs) =
#           p : sieve [x | x <- xs, x `mod` p /= 0]

func primes_naive1 () {
    my $sieve; $sieve= func ($p_xs) {
        my ($p,$xs)= first_and_rest $p_xs;
        lazy {
            cons $p, &$sieve (stream_filter func ($x) {
                                  $x % $p != 0
                              }, $xs)
        }
    };
    # XXX Weakened($sieve)
    $sieve->(stream_iota 2)
}

# or simpler, by lifting `sieve` to the toplevel:

func primes_naive () {
    sieve (stream_iota 2)
}

func sieve ($p_xs) {
    my ($p,$xs)= first_and_rest $p_xs;
    lazy {
        cons $p, sieve (stream_filter func ($x) {
                            $x % $p != 0
                        }, $xs)
    }
}


func t_primes ($primes) {
    TEST { stream_to_array stream_take &$primes(), 10 }
      [2,3,5,7,11,13,17,19,23,29];
}

t_primes \&primes_naive1;
t_primes \&primes_naive;


# ------------------------------------------------------------------
# (B) Now let's use a better algorithm:

# http://en.literateprograms.org/Sieve_of_Eratosthenes_(Haskell)

# merge :: (Ord a) => [a] -> [a] -> [a]
# merge xs@(x:xt) ys@(y:yt) =
#   case compare x y of
#     LT -> x : (merge xt ys)
#     EQ -> x : (merge xt yt)
#     GT -> y : (merge xs yt)
#
# diff :: (Ord a) => [a] -> [a] -> [a]
# diff xs@(x:xt) ys@(y:yt) =
#   case compare x y of
#     LT -> x : (diff xt ys)
#     EQ -> diff xt yt
#     GT -> diff xs yt
#
# primes, nonprimes :: [Integer]
# primes    = [2, 3, 5] ++ (diff [7, 9 ..] nonprimes)
# nonprimes = foldr1 f $ map g $ tail primes
#   where
#     f (x:xt) ys = x : (merge xt ys)
#     g p         = [ n * p | n <- [p, p + 2 ..]]

func merge ($xs, $ys) {
    lazy {
        my ($x,$xt)= first_and_rest $xs;
        my ($y,$yt)= first_and_rest $ys;

        if ($x < $y) {
            cons($x, merge ($xt, $ys))
        } elsif ($x == $y) {
            cons($x, merge ($xt, $yt))
        } else {
            cons($y, merge ($xs, $yt))
        }
    }
}

func diff ($xs, $ys) {
    lazy {
        my ($x,$xt)= first_and_rest $xs;
        my ($y,$yt)= first_and_rest $ys;

        if ($x < $y) {
            cons ($x, diff ($xt, $ys))
        } elsif ($x == $y) {
            diff ($xt, $yt)
        } else {
            diff ($xs, $yt)
        }
    }
}

func primes () {
    stream_append (array_to_list ([2, 3, 5]),
                   diff (stream_map (func ($x) { $x*2 + 7 }, stream_iota),
                         lazy{nonprimes()} ))
}

func nonprimes () {
    my $f= func ($x_xt, $ys) {
        my ($x, $xt)= first_and_rest $x_xt;
        cons $x, merge ($xt, $ys)
    };
    my $g= func ($p) {
        stream_map (func ($n) { $n * $p },
                    stream_map (func ($q) { $p + $q * 2 }, stream_iota));
    };
    stream_foldr1 $f, stream_map $g, rest primes
}


# And tests...

# from http://en.literateprograms.org/Sieve_of_Eratosthenes_(Haskell) :

TEST { stream_to_array
         stream_take (diff (stream_iota (1),
                            stream_map func ($x) { $x * 2 }, stream_iota(1)),
                      10) }
  [1,3,5,7,9,11,13,15,17,19];

TEST { stream_to_array
         stream_take (diff (stream_iota (10),
                            stream_map func ($x) { $x * 2 }, stream_iota(1)),
                      10) }
  [11,13,15,17,19,21,23,25,27,29];

# merge:

func t_merge ($a1,$a2,$n) {
    stream_to_array
      stream_take (merge (array_to_stream ($a1),
                          array_to_stream ($a2),),
                   $n);
}

TEST { t_merge [1,2,99], [3,4,99], 4 }
  [1,2,3,4];

TEST { t_merge [1,3,99], [3,4,99], 4 }
  [1,3,4,99]; # not [1,3,3,4]

TEST { t_merge [1,3,99], [2,4,99], 4 }
  [1,2,3,4];

# and the whole thing:

t_primes \&primes;


# Benchmarking:
# [[times], stream_ref (primes_naive, 1000), [times]] -> 8.86 sec user time
#      also, the above prints many deep recursion warnings (why exactly?)
# [[times], stream_ref (primes, 1000), [times]] -> 0.78 sec user time

# [[times], stream_ref (primes, 10000), [times]] -> 17.46 sec user time
#      (versus ghc compiled code which takes 0.1 sec for the same)

# ------------------------------------------------------------------
# for the test suite:
perhaps_run_tests "main" or do {
    require FP::Repl; FP::Repl::repl();
}
