Performance of F# code terrible - performance

Question

This is my very first F# programme. I thought I would implement Conway's Game of Life as a first exercise.
Please help me understand why the following code has such terrible performance.
let GetNeighbours (p : int, w : int, h : int) : seq<int> =
let (f1, f2, f3, f4) = (p > w, p % w <> 1, p % w <> 0, p < w * (h - 1))
[
(p - w - 1, f1 && f2);
(p - w, f1);
(p - w + 1, f1 && f3);
(p - 1, f2);
(p + 1, f3);
(p + w - 1, f4 && f2);
(p + w, f4);
(p + w + 1, f4 && f3)
]
|> List.filter (fun (s, t) -> t)
|> List.map (fun (s, t) -> s)
|> Seq.cast
let rec Evolve (B : seq<int>, S : seq<int>, CC : seq<int>, g : int) : unit =
let w = 10
let h = 10
let OutputStr = (sprintf "Generation %d: %A" g CC) // LINE_MARKER_1
printfn "%s" OutputStr
let CCN = CC |> Seq.map (fun s -> (s, GetNeighbours (s, w, h)))
let Survivors =
CCN
|> Seq.map (fun (s, t) -> (s, t |> Seq.map (fun u -> (CC |> Seq.exists (fun v -> u = v)))))
|> Seq.map (fun (s, t) -> (s, t |> Seq.filter (fun u -> u)))
|> Seq.map (fun (s, t) -> (s, Seq.length t))
|> Seq.filter (fun (s, t) -> (S |> Seq.exists (fun u -> t = u)))
|> Seq.map (fun (s, t) -> s)
let NewBorns =
CCN
|> Seq.map (fun (s, t) -> t)
|> Seq.concat
|> Seq.filter (fun s -> not (CC |> Seq.exists (fun t -> t = s)))
|> Seq.groupBy (fun s -> s)
|> Seq.map (fun (s, t) -> (s, Seq.length t))
|> Seq.filter (fun (s, t) -> B |> Seq.exists (fun u -> u = t))
|> Seq.map (fun (s, t) -> s)
let NC = Seq.append Survivors NewBorns
let SWt = new System.Threading.SpinWait ()
SWt.SpinOnce ()
if System.Console.KeyAvailable then
match (System.Console.ReadKey ()).Key with
| System.ConsoleKey.Q -> ()
| _ -> Evolve (B, S, NC, (g + 1))
else
Evolve (B, S, NC, (g + 1))
let B = [3]
let S = [2; 3]
let IC = [4; 13; 14]
let g = 0
Evolve (B, S, IC, g)
The first five iterations, i.e. generations 0, 1, 2, 3, 4, happen without a problem. Then, after a brief pause of about 100 milliseconds, generation 5 is completed. But after that, the programme hangs at the line marked "LINE_MARKER_1," as revealed by breakpoints Visual Studio. It never reaches the printfn line.
The strange thing is, already by generation 2, the CC sequence in the function Evolve has already stabilised to the sequence [4; 13; 14; 3] so I see no reason why generation 6 should fail to evolve.
I understand that it is generally considered opprobrious to paste large segments of code and ask for help in debugging, but I don't know how to reduce this to a minimum working example. Any pointers that would help me debug would be gratefully acknowledged.
Thanks in advance for your help.
EDIT
I really believe that anyone wishing to help me may pretty much ignore the GetNeighbours function. I included it only for the sake of completeness.

Answer 1

The simplest way to fix your performance is by using Seq.cache:
let GetNeighbours (p : int, w : int, h : int) : seq<int> =
let (f1, f2, f3, f4) = (p > w, p % w <> 1, p % w <> 0, p < w * (h - 1))
[
(p - w - 1, f1 && f2);
(p - w, f1);
(p - w + 1, f1 && f3);
(p - 1, f2);
(p + 1, f3);
(p + w - 1, f4 && f2);
(p + w, f4);
(p + w + 1, f4 && f3)
]
|> List.filter (fun (s, t) -> t)
|> List.map (fun (s, t) -> s)
:> seq<_> // <<<<<<<<<<<<<<<<<<<<<<<< MINOR EDIT, avoid boxing
let rec Evolve (B : seq<int>, S : seq<int>, CC : seq<int>, g : int) : unit =
let w = 10
let h = 10
let OutputStr = (sprintf "Generation %d: %A" g CC) // LINE_MARKER_1
printfn "%s" OutputStr
let CCN =
CC
|> Seq.map (fun s -> (s, GetNeighbours (s, w, h)))
|> Seq.cache // <<<<<<<<<<<<<<<<<< EDIT
let Survivors =
CCN
|> Seq.map (fun (s, t) -> (s, t |> Seq.map (fun u -> (CC |> Seq.exists (fun v -> u = v)))))
|> Seq.map (fun (s, t) -> (s, t |> Seq.filter (fun u -> u)))
|> Seq.map (fun (s, t) -> (s, Seq.length t))
|> Seq.filter (fun (s, t) -> (S |> Seq.exists (fun u -> t = u)))
|> Seq.map (fun (s, t) -> s)
let NewBorns =
CCN
|> Seq.map (fun (s, t) -> t)
|> Seq.concat
|> Seq.filter (fun s -> not (CC |> Seq.exists (fun t -> t = s)))
|> Seq.groupBy (fun s -> s)
|> Seq.map (fun (s, t) -> (s, Seq.length t))
|> Seq.filter (fun (s, t) -> B |> Seq.exists (fun u -> u = t))
|> Seq.map (fun (s, t) -> s)
let NC =
Seq.append Survivors NewBorns
|> Seq.cache // <<<<<<<<<<<<<<<<<< EDIT
let SWt = new System.Threading.SpinWait ()
SWt.SpinOnce ()
if System.Console.KeyAvailable then
match (System.Console.ReadKey ()).Key with
| System.ConsoleKey.Q -> ()
| _ -> Evolve (B, S, NC, (g + 1))
else
Evolve (B, S, NC, (g + 1))
let B = [3]
let S = [2; 3]
let IC = [4; 13; 14]
let g = 0
Evolve (B, S, IC, g)
The big problem is not using Seq per se, the problem is using it correctly. By default sequences are not lazy, instead they define computations that are re-evaluated on every traversal. This means that unless you do something about it (such as Seq.cache), re-evaluating the sequence may screw up the algorithmic complexity of your program.
Your original program has exponential complexity. To see that, note that it doubles the number of traversed elements with each iteration.
Also note that with your style of programming using Seq operators followed by Seq.cache has a small advantage over using List or Array operators: this avoids allocating intermediate data structures, which reduces GC pressure and may speed things up a bit.

Answer 2

See comments and all, but this code runs like hell - with both List.* and some other smaller optimisations:
let GetNeighbours p w h =
let (f1, f2, f3, f4) = p > w, p % w <> 1, p % w <> 0, p < w * (h - 1)
[
p - w - 1, f1 && f2
p - w, f1
p - w + 1, f1 && f3
p - 1, f2
p + 1, f3
p + w - 1, f4 && f2
p + w, f4
p + w + 1, f4 && f3
]
|> List.choose (fun (s, t) -> if t then Some s else None)
let rec Evolve B S CC g =
let w = 10
let h = 10
let OutputStr = sprintf "Generation %d: %A" g CC // LINE_MARKER_1
printfn "%s" OutputStr
let CCN = CC |> List.map (fun s -> s, GetNeighbours s w h)
let Survivors =
CCN
|> List.choose (fun (s, t) ->
let t =
t
|> List.filter (fun u -> CC |> List.exists ((=) u))
|> List.length
if S |> List.exists ((=) t) then
Some s
else None)
let NewBorns =
CCN
|> List.collect snd
|> List.filter (not << fun s -> CC |> List.exists ((=) s))
|> Seq.countBy id
|> List.ofSeq
|> List.choose (fun (s, t) ->
if B |> List.exists ((=) t) then
Some s
else None)
let NC = List.append Survivors NewBorns
let SWt = new System.Threading.SpinWait()
SWt.SpinOnce()
if System.Console.KeyAvailable then
match (System.Console.ReadKey()).Key with
| System.ConsoleKey.Q -> ()
| _ -> Evolve B S NC (g + 1)
else
Evolve B S NC (g + 1)
let B = [3]
let S = [2; 3]
let IC = [4; 13; 14]
let g = 0
Evolve B S IC g

Answer 3

Just thought I would add a simple answer, in case other beginners like me run into the same problem.
As advised by Ramon Snir, ildjarn and pad above, I changed the Seq.X calls to List.X. I had to add a simple extra casting step to account for the fact that List does not have groupBy, but having done that, the code now runs like a charm!
Thanks a lot.

Answer 4

One of the most amazing characteristics of the ML family of languages is that short code is often fast code and this applies to F# too.
Compare your implementation with the much faster one I blogged here:
let count (a: _ [,]) x y =
let m, n = a.GetLength 0, a.GetLength 1
let mutable c = 0
for x=x-1 to x+1 do
for y=y-1 to y+1 do
if x>=0 && x<m && y>=0 && y<n && a.[x, y] then
c <- c + 1
if a.[x, y] then c-1 else c
let rule (a: _ [,]) x y =
match a.[x, y], count a x y with
| true, (2 | 3) | false, 3 -> true
| _ -> false