// An F# implementation of Java-style Streams
// F# has something equivalent called sequences, but I think Java streams
// are better organized.
module Streams
open System
open System.Collections.Generic;;

//////// some aliases and utilities ...
type Vec<'T> = ResizeArray<'T>;;  // type alias
let omap = Option.map
let is_some = Option.isSome
let is_none = Option.isNone
let unwrap_or = Option.defaultValue
let if_some f = function
  | Some(x) -> f x
  | _ -> ()
let if_else f g = function
  | Some(x) -> f(x)
  | None -> g()

///// main type implemented as a record:
type stream<'T> =
  {
     mutable generator : unit -> 'T option;  
  }
  //////////////// operations on streams
  member this.map<'U> (f: 'T -> 'U) =
    {
      stream.generator = fun () -> this.generator() |> omap f
    }
  member this.append(other:stream<'T>) = 
    let gen = this.generator;
    this.generator <- fun () ->
       let ax = gen()
       if Option.isSome ax then ax
       else other.generator()
    this
  member this.bind<'U>(bf:'T -> stream<'U>) =
    let mutable ustream = this.generator() |> omap bf
    {
       stream.generator = fun () ->
         let mutable next = None
         let mutable breakout = is_none ustream
         while not(breakout) do
           next <- ustream |> omap (fun s -> s.generator())
           if (is_none next) then
             ustream <- this.generator() |> omap bf
             breakout <- is_none ustream
           else
             breakout <- true
         //while
         next
    }
  member this.filter(p : 'T -> bool) =
    let gen = this.generator;
    this.generator <- fun () ->
      let mutable ax = gen()
      let mutable breakout = false
      while not(breakout) do
         match ax with
           | None -> breakout <- true   // stream has ended
           | Some(x) when (p x) -> breakout <- true  // keep
           | _ -> ax <- gen()                        // try next
      ax
    // this.generator
    this
  member this.limit n =
    let gen = this.generator
    let mutable counter = n
    this.generator <- fun () -> 
       if counter < 1 then None
       else (counter<-counter-1; gen())
    this
  member this.take_while (p: 'T -> bool) =
    let gen = this.generator
    this.generator <- fun strm ->
       let ax = gen()
       match ax with
         | Some x when (p x) -> ax
         | _ -> None
    this
  member this.until (p: 'T -> bool) =   // keep the last one
    let gen = this.generator
    let mutable ended = false
    this.generator <- fun strm ->
       let ax = gen()
       match (ended, ax) with
         | (false, Some x) when (p x) ->
              ended <- true
              ax
         | (false, _) -> ax
         | _ -> None
    this
  ////////////////////////////////////// running the stream
  member this.foreach (act : 'T -> unit) : unit =
    let mutable ax = this.generator()
    while Option.isSome ax do
      if_some act ax
      ax <- this.generator()
  member this.for_all (p: 'T -> bool) =
    let mutable answer = true
    let mutable ax = this.generator()
    while answer && Option.isSome ax do
      if not(p (Option.get ax)) then answer <- false
      else ax <- this.generator();
    answer
  member this.there_exists(p: 'T -> bool) = not(this.for_all(fun x -> not(p x)))
  member this.find_first(p: 'T -> bool) = // returns 'T option
    let mutable answer = None
    let mutable ax = this.generator();
    while (Option.isNone answer) && (Option.isSome ax) do
      if (p (Option.get ax)) then answer <- ax
      else ax <- this.generator()
    ax
  member this.nth n =
    let mutable i = 0
    let mutable ax = this.generator()
    while (is_some ax) && i<n do
      ax <- this.generator()
      i <- i+1
    ax
  member this.get_nth n = this.nth(n) |> Option.get
  member this.find_last(p: 'T -> bool) =
    let mutable answer = None
    let mutable next = this.generator()
    while (is_some next) do
      if unwrap_or false (omap p next) then answer <- next;
      next <- this.generator()
    answer
  member this.last() = this.find_last(fun _ -> true)
  member this.get_last() = this.last() |> Option.get


//// independent flatten function, s.bind f = flatten(s.map f)
let flatten<'T> (srcstream:stream<stream<'T>>) =
  let mutable current = srcstream.generator()
  {
     stream.generator = fun () ->
       let mutable next = None
       let mutable breakout = is_none current
       while not(breakout) do
         next <- current |> omap (fun s -> s.generator())
         if (is_none next) then
           current <- srcstream.generator()
           breakout <- is_none current
         else
           breakout <- true
       //while
       next
  }


//////// constructors

let vector_stream<'T>(v:Vec<'T>) =
  let n = v.Count
  let mutable internal_cx = 0;
  {
     generator = fun () ->
        if internal_cx < n then 
          internal_cx <- internal_cx + 1
          Some(v.[internal_cx - 1]);
        else
          None
  }

let finite_stream<'T>(v:'T list) =
  let n = v.Length
  let mutable internal_cx = 0;
  {
     generator = fun () ->
        if internal_cx < n then 
          internal_cx <- internal_cx + 1
          Some(v.[internal_cx - 1]);
        else
          None
  };;

let seeded_induction<'T>(seeds:'T list, gen_next: Vec<'T> -> 'T) =
  let vec = Vec<'T>()
  for x in seeds do
    vec.Add(x)
  let mutable index = 0
  {  
     generator = fun () ->
        if index < vec.Count then
           index <- index+1
           Some(vec.[index-1])
        else
           let next = gen_next vec
           vec.Add(next)
           index <- index + 1
           Some(next)
  };;

let induction<'T>(base_case:'T, inductive_case:'T -> 'T) =
  let mutable next = base_case
  let mutable is_first = true
  {
    stream.generator = fun () ->
      if is_first then is_first <- false
      else next <- inductive_case next
      Some(next)
  };;

// create stream by providing generator
let generate_stream<'T> (genfun:unit -> 'T) =
  {
     stream.generator = fun () -> Some(genfun());
  }

let empty_stream<'T> () = 
  {
     stream.generator = fun () -> None
  }

let option_stream opt =
  (Option.map (fun x -> finite_stream([x])) opt)
  |> unwrap_or(empty_stream())

let results_stream<'T,'E> (results:Result<'T,'E> list) =
  let rv = Vec<'T>();
  for r in results do 
    match r with
      | Ok x -> rv.Add(x)
      | _ -> ()
  vector_stream(rv)


//////////////////////////////////////// DEMO

let evens = induction(0, fun n -> n+2)
evens
  .filter(fun x -> x%4=0)
  .map(fun x -> float(x)/2.0)
  .until(fun x -> x>99.0)
  .foreach(printf "%.2f ")
printfn ""

let next_prime (known_primes:Vec<uint64>) =
  if known_primes.Count < 2 then uint64(known_primes.Count + 2) 
  else
    let last_prime = known_primes.[known_primes.Count - 1]
    let candidates = induction(last_prime+2UL, fun c -> c+2UL)
    candidates
      .find_first(fun candidate ->
          (vector_stream known_primes)
            .until(fun p -> float(p) >= 1.0+Math.Sqrt(float(candidate)))
            .for_all(fun p -> candidate % p <> 0UL))
      |> Option.get  // know it will exist (until overflow)

let primes known_primes = seeded_induction(known_primes, next_prime);

primes([]).limit(100).foreach(printf "%d ")   //%d prints without UL
printfn ""

// prime factorization: collect all prime factors of a number into a vector
let prime_factors n =
  let factors = Vec<int>();
  primes([for x in [2;3;5;7;11] do uint64(x)])
    .until(fun p -> p >= n)
    .filter(fun p -> n%p = uint64(0))
    .foreach(fun f -> factors.Add(int(f)))
  factors

let on_behalf f =
  try
    Some(f())
  with | e -> None

printf "\nEnter a number for prime factorization: "
let nopt = on_behalf (fun () -> uint64(Console.ReadLine()))
nopt |> if_some (fun n -> printfn "prime factors of %d: %A" n (prime_factors n))

// n!: inductive hypothesis (n,nf) means "nf is n!"
let factorial n =
  induction( (0,1), fun (n,nf) -> (n+1, (n+1)*nf) )
    .map(fun (_,y) -> y)
    .get_nth(n)

printfn "6! is  %d" (factorial 6)

// 2x2 matrix multiplication
type M2x2 = (uint64*uint64*uint64*uint64)

let mmult(A:M2x2) (B:M2x2) = 
  let ((a, b,
        c, d), (q, r,
                s, t)) = (A,B)
  (a*q+b*s, a*r+b*t,
   c*q+d*s, c*r+d*t)

// ID matrix and Fibonacci matrix
let IDM = (1, 0,
           0, 1)
let FIBM = (1, 1,
            1, 0)

// convert to uint64 matrix (avoids ugly syntax)
let Mu64(a,b,c,d) = (uint64(a), uint64(b), uint64(c), uint64(d))

// basis**exponent by binary factorization of exponent:
let power(basis, exponent, multiplier, identity) =  // "base" is a keyword
   let next(ax,factor,n) =
     let newfactor = multiplier factor factor
     ((if n%2=1 then (multiplier ax factor) else ax), newfactor, n/2)
   induction((identity, basis, exponent), next)
      .until(fun (_,_,e) -> e=0)
      .map(fun(ax,_,_) -> ax)
      .get_last()

printfn "2**9 is %d" ( power(2,9,(*),1) )

// nth Fibonacci number in log n steps:
let Fib n  =
  let (a,_,_,_) = power((Mu64 FIBM), n-1, mmult, (Mu64 IDM))
  a

printfn "Fib(9): %d"  (Fib 9)
printfn "Fib(10): %d" (Fib 10)
printfn "Fib(11): %d" (Fib 11)
printfn "Fib(100): %d" (Fib 100)

//// defining an infinite series to approximate PI
(*
Pi is sqrt(12) * series from k=0 of -1**k/(3**k * 2k+1)
*)

// define (k, kth element of series)
let taylor(n) :float  =   // n is how many terms
  let nth(k) =
    let f = float(k)
    (-1.0)**f / (3.0**f * (2.0*f+1.0))
  induction((0,1.0),fun (k,sk) -> (k+1, sk + nth(k+1)))
    .limit(n)
    .map(fun (_,b) -> b)
    .get_last()

printfn "taylor(20): %A" (taylor(20) * 12.0**0.5)  // should be pi