Fork me on GitHub

Code Snippet:

 1 #load @"Utils/ListLazy.fs"
 2 
 3 open Stermon.Research.Utils
 4 
 5 let corruptStartPoint l =
 6   let rec loopStart = function
 7     | Cons(h1,t1),Cons(h2,t2) -> (h1 = h2) |> function
 8       | true -> Some h1
 9       | false ->
10         loopStart (t1.Force(),t2.Force())
11     | _,_ -> None
12   let rec meetPoint = function
13     | Cons(h1,t1),Cons(h2,t2) -> (h1 = h2) |> function
14       | true -> loopStart (l,t2.Force())
15       | false ->
16         meetPoint (t1.Force(),(t2.Force() |> List.Lazy.skip 1I))
17     | _,_ -> None
18   meetPoint (l,(l |> List.Lazy.skip 1I))

Code output:

[Loading Utils/ListLazy.fs]

namespace FSI_0002.Stermon.Research.Utils
  type 'a ListLazy =
    | Cons of 'a * Lazy<'a ListLazy>
    | Nil
  module Lazy = begin
    val single : h:'a -> 'a ListLazy
    val cons : h:'a -> l:'a ListLazy -> 'a ListLazy
    val head : _arg1:'a ListLazy -> 'a
    val tail : _arg1:'a ListLazy -> 'a ListLazy
    val iter : f:('a -> unit) -> _arg1:'a ListLazy -> unit
    val map : f:('a -> 'b) -> _arg1:'a ListLazy -> 'b ListLazy
    val fold : f:('a -> 'b -> 'a) -> init:'a -> _arg1:'b ListLazy -> 'a
    val foldBack :
      f:('a -> Lazy<'b> -> 'b) -> init:'b -> _arg1:'a ListLazy -> 'b
    val unfold : f:('a -> ('b * 'a) option) -> init:'a -> 'b ListLazy
    val reduce : f:('a -> 'a -> 'a) -> _arg1:'a ListLazy -> 'a
    val reduceBack : f:('a -> Lazy<'a> -> 'a) -> _arg1:'a ListLazy -> 'a
    val skip :
      n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
    val take :
      n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
    val append : l1:'a ListLazy -> l2:'a ListLazy -> 'a ListLazy
    val concat : _arg1:'a ListLazy ListLazy -> 'a ListLazy
    val ofList : _arg1:'a list -> 'a ListLazy
    val toList : l:'a ListLazy -> 'a list
  end

val corruptStartPoint :
  l:'a Stermon.Research.Utils.ListLazy -> 'a option when 'a : equality

Non corrupt linked list

All

1 let example1 = List.Lazy.unfold(fun s -> Some(s,s+1)) 0 |> List.Lazy.take 26I
2 
3 example1
4 |> List.Lazy.iter(printf "%i ")
5 
6 corruptStartPoint example1
> val example1 : int ListLazy = Cons (0,Value is not created.)
> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 val it : unit = ()
> val it : int option = None

Corrupt linked list

All

 1 let corruptGenerator n =
 2   List.Lazy.unfold(
 3     fun s -> (s < n) |> function
 4     | false -> Some((s % n) + n,s+1)
 5     | true  -> Some(s,s+1)) 0
 6 
 7 let example2 = corruptGenerator 7
 8 
 9 example2
10 |> List.Lazy.take 28I
11 |> List.Lazy.iter(printf "%i ")
12 
13 corruptStartPoint example2
> val corruptGenerator : n:int -> int ListLazy
> val example2 : int ListLazy = Cons (0,Value is not created.)
> 0 1 2 3 4 5 6 7 8 9 10 11 12 13 7 8 9 10 11 12 13 7 8 9 10 11 12 13 val it : unit = ()
> val it : int option = Some 7

References:

All

Code Snippet:

 1 type 'a ListLazy = Cons of 'a * 'a ListLazy Lazy | Nil
 2 
 3 module List =
 4   module Lazy =
 5     let single h = Cons(h, lazy (Nil))
 6     let cons h l = Cons(h, lazy (l))
 7     let head = function | Nil -> failwith "empty list" | Cons(h,_) -> h
 8     let tail = function | Nil -> failwith "empty list" | Cons(_,t) -> t.Force()
 9     let rec iter f = function
10       | Nil -> () | Cons(h,t) -> f h; iter f (t.Force())
11     let rec map f = function
12       | Nil -> Nil | Cons(h,t) -> Cons(f h, lazy (map f (t.Force())))
13     let rec fold f init = function
14       | Nil -> init | Cons(h,t) -> fold f (f init h) (t.Force())
15     let rec foldBack f init = function
16       | Nil -> init | Cons(h,t) -> f h (lazy (foldBack f init (t.Force())))
17     let rec unfold f init = f init |> function
18       | None -> Nil | Some(a,s) -> Cons (a, lazy (unfold f s))
19     let rec reduce f = function
20       | Nil -> failwith "empty list" | Cons(h,t) -> fold f h (t.Force())
21     let rec reduceBack f = function
22       | Nil -> failwith "empty list" | Cons(h,t) -> foldBack f h (t.Force())
23     let rec skip n = function
24       | Nil -> Nil | Cons(h,t) -> (n = 0I) |> function
25         | true  -> cons h (t.Force())
26         | false -> skip (n-1I) (t.Force())
27     let rec take n = function
28       | Nil -> Nil | Cons(h,t) -> (n = 0I) |> function
29         | true  -> Nil
30         | false -> Cons(h, lazy (take (n-1I) (t.Force())))
31     let rec append l1 l2 = l1 |> function
32       | Nil -> l2 | Cons(h,t) -> Cons(h, lazy (append (t.Force()) l2))
33     let rec concat = function
34       | Nil -> Nil | Cons(h,t) -> append h (concat (t.Force()))
35     let rec ofList = function
36       | [] -> Nil | h :: t -> cons h (ofList t)
37     let toList l =
38       let rec toList' acc = function
39         | Nil -> List.rev acc
40         | Cons(h,t) -> toList' (h::acc) (t.Force())
41       toList' [] l

Code output:

> 
type 'a ListLazy =
  | Cons of 'a * Lazy<'a ListLazy>
  | Nil
module List = begin
  module Lazy = begin
    val single : h:'a -> 'a ListLazy
    val cons : h:'a -> l:'a ListLazy -> 'a ListLazy
    val head : _arg1:'a ListLazy -> 'a
    val tail : _arg1:'a ListLazy -> 'a ListLazy
    val iter : f:('a -> unit) -> _arg1:'a ListLazy -> unit
    val map : f:('a -> 'b) -> _arg1:'a ListLazy -> 'b ListLazy
    val fold : f:('a -> 'b -> 'a) -> init:'a -> _arg1:'b ListLazy -> 'a
    val foldBack :
      f:('a -> Lazy<'b> -> 'b) -> init:'b -> _arg1:'a ListLazy -> 'b
    val unfold : f:('a -> ('b * 'a) option) -> init:'a -> 'b ListLazy
    val reduce : f:('a -> 'a -> 'a) -> _arg1:'a ListLazy -> 'a
    val reduceBack : f:('a -> Lazy<'a> -> 'a) -> _arg1:'a ListLazy -> 'a
    val skip :
      n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
    val take :
      n:System.Numerics.BigInteger -> _arg1:'a ListLazy -> 'a ListLazy
    val append : l1:'a ListLazy -> l2:'a ListLazy -> 'a ListLazy
    val concat : _arg1:'a ListLazy ListLazy -> 'a ListLazy
    val ofList : _arg1:'a list -> 'a ListLazy
    val toList : l:'a ListLazy -> 'a list
  end
end

Infinite Fibonacci (and squared) sequence

 1 let fib =
 2   (List.Lazy.single 0I,
 3    List.Lazy.unfold(fun (a1,a2) -> Some(a1+a2,(a2,a1+a2))) (1I,0I))
 4   ||> List.Lazy.append
 5 
 6 let fibSquared =
 7   fib |> List.Lazy.foldBack(fun x l -> Cons(x*x,l)) Nil
 8 
 9 fib
10 |> List.Lazy.take 10I
11 |> List.Lazy.iter(printf "%A ")
12 
13 fibSquared
14 |> List.Lazy.take 10I
15 |> List.Lazy.iter(printf "%A ")
> 
val fib : System.Numerics.BigInteger ListLazy = Cons (0,Value is not created.)
val fibSquared : System.Numerics.BigInteger ListLazy =
  Cons (0,Value is not created.)

> 0 1 1 2 3 5 8 13 21 34 val it : unit = ()
> 0 1 1 4 9 25 64 169 441 1156 val it : unit = ()

Runtime errors when skipping/taking on empty sequences (F# Seq)

1 fib
2 |> List.Lazy.take 10I
3 |> List.Lazy.toList
4 |> List.toSeq
5 |> Seq.skip 20 
6 |> Seq.iter(printf "%A ")
> val it : seq<System.Numerics.BigInteger> =
  Error: The input sequence has an insufficient number of elements.
1 fib
2 |> List.Lazy.take 10I
3 |> List.Lazy.toList
4 |> List.toSeq
5 |> Seq.take 20
6 |> Seq.iter(printf "%A ")
> 0 1 1 2 3 5 8 13 21 34 System.InvalidOperationException: The input sequence has an insufficient number of elements.
  at Microsoft.FSharp.Collections.SeqModule+Take@999[System.Numerics.BigInteger].GenerateNext (IEnumerable`1& next) [0x00000] in <filename unknown>:0 
  at Microsoft.FSharp.Core.CompilerServices.GeneratedSequenceBase`1[System.Numerics.BigInteger].MoveNextImpl () [0x00000] in <filename unknown>:0 
  at Microsoft.FSharp.Core.CompilerServices.GeneratedSequenceBase`1[System.Numerics.BigInteger].System-Collections-IEnumerator-MoveNext () [0x00000] in <filename unknown>:0 
  at Microsoft.FSharp.Collections.SeqModule.Iterate[BigInteger] (Microsoft.FSharp.Core.FSharpFunc`2 action, IEnumerable`1 source) [0x00000] in <filename unknown>:0 
  at <StartupCode$FSI_0047>.$FSI_0047.main@ () [0x00000] in <filename unknown>:0 
  at (wrapper managed-to-native) System.Reflection.MonoMethod:InternalInvoke (System.Reflection.MonoMethod,object,object[],System.Exception&)
  at System.Reflection.MonoMethod.Invoke (System.Object obj, BindingFlags invokeAttr, System.Reflection.Binder binder, System.Object[] parameters, System.Globalization.CultureInfo culture) [0x00000] in <filename unknown>:0 
Stopped due to error

No runtime errors when skipping/taking on empty lists

1 fib
2 |> List.Lazy.take 10I
3 |> List.Lazy.skip 20I // Behave as C# Linq.Enumerable.Skip
4 |> List.Lazy.iter(printf "%A ")
5 
6 fib
7 |> List.Lazy.take 10I
8 |> List.Lazy.take 20I // Behave as C# Linq.Enumerable.Take (or F# Seq.truncate)
9 |> List.Lazy.iter(printf "%A ")
> val it : unit = ()
> 0 1 1 2 3 5 8 13 21 34 val it : unit = ()

References:

All

Code Snippet:

 1 module Helpers = 
 2   let permutations ls = 
 3     let rec insertions x = function
 4       | []             -> [[x]]
 5       | (y :: ys) as l -> (x::l)::(List.map (fun x -> y::x) (insertions x ys))
 6     let rec permutations' = function
 7       | []      -> seq [ [] ]
 8       | x :: xs -> Seq.concat (Seq.map (insertions x) (permutations' xs))
 9     ls |> permutations'
10     
11 module PrisonersHatsPuzzle =
12   type Hat = Red | Blue
13   type Prisoner = Hat
14   type Prisoners = Prisoner * Prisoner * Prisoner * Prisoner
15   type Guess = Prisoners -> Prisoner * Hat
16 
17   // Bullet-proof logic for the prisoners to always go free:
18   // 
19   // As the fourth prisoner is behind a screen, we don't care about him.
20   // If the last prisoner sees two equal colored hats, he knows he has the
21   // the opposite and hereby he can call out the color.
22   // In case the last prisoner doesn't call out his color, the second from
23   // behind will know that he doesn't have the same color hat as the prisoner
24   // in front of him, else the last one would have called it, hereby, he
25   // can safely call out the opposite color of the prisoners hat in 
26   // front of him.
27   // 
28   let guess : Guess =
29     fun prisoners ->
30       let a,b,c,d = prisoners
31       match a,b,c,d with
32         | (_,Red,Red,_)   -> a,Blue
33         | (_,Blue,Blue,_) -> a,Red
34         | (_,_,Blue,_)    -> b,Red
35         | (_,_,Red,_)     -> b,Blue
36 
37 open Helpers
38 open PrisonersHatsPuzzle
39 
40 let hats = [Hat.Red; Hat.Blue; Hat.Red; Hat.Blue;]
41 
42 let alwaysGoFree =
43   permutations hats
44   |> Seq.map(fun xs ->
45     match xs with
46       | a::b::c::d::[] -> a,b,c,d
47       | _ -> failwith "never")
48   |> Seq.map(fun x -> guess x)
49   |> Seq.toArray

Code output:

module Helpers = begin
  val permutations : ls:'a list -> seq<'a list>
end
module PrisonersHatsPuzzle = begin
  type Hat =
    | Red
    | Blue
  type Prisoner = Hat
  type Prisoners = Prisoner * Prisoner * Prisoner * Prisoner
  type Guess = Prisoners -> Prisoner * Hat
  val guess : Prisoner * Prisoner * Prisoner * Prisoner -> Prisoner * Hat
end

val hats : Hat list = [Red; Blue; Red; Blue]

val alwaysGoFree : (Prisoner * Hat) [] =
  [|(Blue, Blue); (Blue, Blue); (Blue, Blue); (Red, Red); (Red, Red);
    (Red, Red); (Blue, Blue); (Red, Red); (Red, Red); (Red, Red); (Blue, Blue);
    (Red, Red); (Red, Red); (Red, Red); (Blue, Blue); (Blue, Blue); (Red, Red);
    (Red, Red); (Blue, Blue); (Blue, Blue); (Blue, Blue); (Blue, Blue);
    (Blue, Blue); (Red, Red)|]

References: