I came up with a Guid-to-hash function in F# as shown below, but I think it is too verbose. How can I make it more concise?
let digits = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
let nbase = bigint digits.Length
let zero = bigint.Zero
let hash (g: System.Guid) =
(g.ToByteArray(), [| 0x00uy |])
||> Array.append
|> bigint
|> Array.unfold (fun d ->
if d = zero then
None
else
let (n, r) = bigint.DivRem(d, nbase)
Some (r, n))
|> Array.rev
|> Array.skipWhile ((=) zero)
|> Array.map (fun b -> digits.[int b])
|> System.String
There's a little bit of cleanup you can do like so:
let hash (g: System.Guid) =
[| yield! g.ToByteArray(); 0x00uy |]
|> bigint
|> Array.unfold (fun d ->
if d = zero then
None
else
let (n, r) = bigint.DivRem(d, nbase)
Some (r, n))
|> Array.choose (fun b -> if b = zero then None else Some digits[int b])
|> System.String
But in general I'm not sure how to make this more succinct based on how I understand you want your hash function to operate.
That being said, if I wanted to hash a guid I'd just use the built-in hash function.
I wouldn't call this a hash function, as its output is usually fixed length and does not uniquely identify keys (but still has good uniformity over the key space). It's more like a conversion of the data type nigint to and from other data types, System.Guid and string (with an encoding added).
For conciseness, it appears that recursion with a list accumulator is quite suitable, as it does also the reversal to get the most significant character into the first position.
module Bigint =
let toString alphabet input =
let nbase = bigint(String.length alphabet)
let rec aux acc x =
if x = 0I then acc
else aux (alphabet.[int(x % nbase)]::acc) (x / nbase)
System.String(Array.ofList(aux [] input))
let fromString alphabet (input : string) =
let nbase = bigint(String.length alphabet)
let d = alphabet |> Seq.mapi (fun i c -> c, bigint i) |> dict
input.ToCharArray()
|> Array.rev
|> Array.mapi (fun i c -> pown nbase i * d.[c])
|> Array.sum
let fromGuid (g : System.Guid) =
bigint[| yield! g.ToByteArray(); yield 0uy |]
let toGuid (bi : bigint) =
let b = bi.ToByteArray()
if Array.length b > 16 then b.[..15]
else Array.append (Array.zeroCreate (16 - Array.length b)) b
|> fun a -> System.Guid a
The output is variable length, the zero Guid will give you an empty string. Testing:
let alphabet2 = "01"
Bigint.toString alphabet2 (bigint 0x181) // 385
// val it : System.String = "110000001"
|> Bigint.fromString alphabet2
// val it : System.Numerics.BigInteger = 385
let alphabet16 =
System.String(Array.concat[|[|'0'..'9'|];[|'A'..'F'|]|])
Bigint.toString alphabet16 (bigint 0x181) // 385
// val it : System.String = "181"
|> Bigint.fromString alphabet16
// val it : System.Numerics.BigInteger = 385
let alphabet62 =
System.String(Array.concat[[|'0'..'9'|];[|'A'..'Z'|];[|'a'..'z'|]])
let guid0 = System.Guid()
// val guid : System.Guid = 00000000-0000-0000-0000-000000000000
Bigint.fromGuid guid0
|> Bigint.toString alphabet62
// val it : System.String = ""
|> Bigint.fromString alphabet62
// val it : System.Numerics.BigInteger = 0
|> Bigint.toGuid
// val guid : System.Guid = 00000000-0000-0000-0000-000000000000
let guid1 = System.Guid.NewGuid()
// val guid1 : System.Guid = bf9f89db-e307-4dcb-b734-a4bbb61a8365
Bigint.fromGuid guid1
|> Bigint.toString alphabet62
// val it : System.String = "35Y8fherqxCBOydJ1VN9UR"
|> Bigint.fromString alphabet62
// val it : System.Numerics.BigInteger =
// 134932760282992047737587898291171854811
|> Bigint.toGuid
// val it : System.Guid = bf9f89db-e307-4dcb-b734-a4bbb61a8365
If you want the conversion with a fixed length, Base64 encoding might be an alternative:
System.Convert.ToBase64String(guid1.ToByteArray()).[..21]
// val it : string = "24mfvwfjy023NKS7thqDZQ"
|> fun s -> System.Guid(System.Convert.FromBase64String(s + "=="))
// val it : System.Guid = bf9f89db-e307-4dcb-b734-a4bbb61a8365
Let's says I have a string of a length N that contains only 0 or 1. I want to split that string in multiples strings and each string should contains only one digit.
Example:
00011010111
Should be split into:
000
11
0
1
0
111
The only solution I can think of if using a for loop with a string builder (Written in pseudo code below, more c# like sorry):
result = new list<string>
tmpChar = ""
tmpString = ""
for each character c in MyString
if tmpchar != c
if tmpsString != ""
result.add tmpString
tmpString = ""
endIf
tmpchar = c
endIf
tmpString += tmpChar
endFor
Do you have any other solution and maybe a clever solution that use a more functional approach?
I think Seq.scan would be a good fit for this, this is a very procedural problem in nature, preserving the order like that. But here is code that I believe does what you are asking.
"00011010111"
|> Seq.scan (fun (s, i) x ->
match s with
| Some p when p = x -> Some x, i
| _ -> Some x, i + 1 ) (None, 0)
|> Seq.countBy id
|> Seq.choose (function
| (Some t, _), n -> Some(t, n)
| _ -> None )
|> Seq.toList
Perhaps something along the lines of:
let result =
let rec groupWhileSame xs result =
match xs with
| a when a |> Seq.isEmpty -> result
| _ ->
let head = xs |> Seq.head
let str = xs |> Seq.takeWhile ((=) head)
let rest = xs |> Seq.skipWhile ((=) head)
groupWhileSame rest (Seq.append result [str])
groupWhileSame (myStr) []
Seq.fold (fun (acc:(string list)) x ->
match acc with
| y::rst when y.StartsWith(string x) -> (string x) + y::rst
| _ -> (string x)::acc)
[]
"00011010111"
Consider this function (which is generic):
let chunk s =
if Seq.isEmpty s then []
else
let rec chunk items chunks =
if Seq.isEmpty items then chunks
else
let chunks' =
match chunks with
| [] -> [(Seq.head items, 1)]
| x::xs ->
let c,n = x in let c' = Seq.head items in
if c = c' then (c, n + 1) :: xs else (c', 1) :: x :: xs
chunk (Seq.tail items) chunks'
chunk s [] |> List.rev
It returns a list of tuples, where each tuple represents an item and its repetitions.
So
"00011010111" |> Seq.toList |> chunk
actually returns
[('0', 3); ('1', 2); ('0', 1); ('1', 1); ('0', 1); ('1', 3)]
Basically, we're doing run length encoding (which is admittedly a bit wasteful in the case of your example string).
To get the list of strings that you want, we use code like following:
"00011010111"
|> Seq.toList
|> chunk
|> List.map (fun x -> let c,n = x in new string(c, n))
Here's a working version of OP's proposal with light syntax:
let chunk (s: string) =
let result = System.Collections.Generic.List<string>()
let mutable tmpChar = ""
let mutable tmpString = ""
for c in s do
if tmpChar <> string c then
if tmpString <> "" then
result.Add tmpString
tmpString <- ""
tmpChar <- string c
tmpString <- tmpString + tmpChar
result.Add tmpString
result
No attempt was made to follow a functional style.
While reading up this question, I wondered why no one would "simply" iterate all the possible paths on the boggle grid and have the word-tries follow and then cancel the path if there is no match in the word-trie. Cannot be that many paths on a tiny 4 by 4 grid, right? How many paths are there? So I set out to code a path-counter function in F#. The results yield what no one stated on that other page: Way more paths on the grid than I would have guessed (more paths than words in the word-set, actually).
While all that is pretty much the back story to my question, the code I ended up with was running rather slow and I found that I could not give good answers to a few aspects of the code. So here, the code first, then below it, you will find points which I think deserve explanations...
let moves n state square =
let allSquares = [0..n*n-1] |> Set.ofList
let right = Set.difference allSquares (Set.ofList [n-1..n..n*n])
let left = Set.difference allSquares (Set.ofList [0..n..n*n-1])
let up = Set.difference allSquares (Set.ofList [0..n-1])
let down = Set.difference allSquares (Set.ofList [n*n-n..n*n-1])
let downRight = Set.intersect right down
let downLeft = Set.intersect left down
let upRight = Set.intersect right up
let upLeft = Set.intersect left up
let appendIfInSet se v res =
if Set.contains square se then res # v else res
[]
|> appendIfInSet right [square + 1]
|> appendIfInSet left [square - 1]
|> appendIfInSet up [square - n]
|> appendIfInSet down [square + n]
|> appendIfInSet downRight [square + n + 1]
|> appendIfInSet downLeft [square + n - 1]
|> appendIfInSet upRight [square - n + 1]
|> appendIfInSet upLeft [square - n - 1]
|> List.choose (fun s -> if ((uint64 1 <<< s) &&& state) = 0UL then Some s else None )
let block state square =
state ||| (uint64 1 <<< square)
let countAllPaths n lmin lmax =
let mov = moves n // line 30
let rec count l state sq c =
let state' = block state sq
let m = mov state' sq
match l with
| x when x <= lmax && x >= lmin ->
List.fold (fun acc s -> count (l+1) state' s acc) (c+1) m
| x when x < lmin ->
List.fold (fun acc s -> count (l+1) state' s acc) (c) m
| _ ->
c
List.fold (fun acc s -> count 0 (block 0UL s) s acc) 0 [0..n*n-1]
[<EntryPoint>]
let main args =
printfn "%d: %A" (Array.length args) args
if 3 = Array.length args then
let n = int args.[0]
let lmin = int args.[1]
let lmax = int args.[2]
printfn "%d %d %d -> %d" n lmin lmax (countAllPaths n lmin lmax)
else
printfn "usage: wordgames.exe n lmin lmax"
0
In line 30, I curried the moves function with the first argument, hoping that maybe code optimization would benefit from it. Maybe optimizing the 9 sets I create in move which are only a function of n. After all, they need not be generated over and over again, right? On the other hand, I would not really bet on it actually happening.
So, question #1 is: How could I enforce this optimization in an as little code bloating way as possible? (I could of course create a type with 9 members and then an array of that type for each possible n and then do a look up table like usage of the pre-computed sets but that would be code bloat in my opinion).
Many sources hint that parallel folds are considered critical. How could I create a parallel version of the counting function (which runs on multiple cores)?
Does anyone have clever ideas how to speed this up? Maybe some pruning or memoization etc?
At first, when I ran the function for n=4 lmin=3 lmax=8 I thought it takes so long because I ran it in fsi. But then I compiled the code with -O and it still took about the same time...
UPDATE
While waiting for input from you guys, I did the code bloated manual optimization version (runs much faster) and then found a way to make it run on multiple cores.
All in all those 2 changes yielded about a speed up by a factor of 30. Here the (bloated) version I came up with (still looking for a way to avoid the bloat):
let squareSet n =
let allSquares = [0..n*n-1] |> Set.ofList
let right = Set.difference allSquares (Set.ofList [n-1..n..n*n])
let left = Set.difference allSquares (Set.ofList [0..n..n*n-1])
let up = Set.difference allSquares (Set.ofList [0..n-1])
let down = Set.difference allSquares (Set.ofList [n*n-n..n*n-1])
let downRight = Set.intersect right down
let downLeft = Set.intersect left down
let upRight = Set.intersect right up
let upLeft = Set.intersect left up
[|right;left;up;down;upRight;upLeft;downRight;downLeft|]
let RIGHT,LEFT,UP,DOWN = 0,1,2,3
let UPRIGHT,UPLEFT,DOWNRIGHT,DOWNLEFT = 4,5,6,7
let squareSets =
[|Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;|]
::
[ for i in 1..8 do
yield squareSet i
]
|> Array.ofList
let moves n state square =
let appendIfInSet se v res =
if Set.contains square se then res # v else res
[]
|> appendIfInSet squareSets.[n].[RIGHT] [square + 1]
|> appendIfInSet squareSets.[n].[LEFT] [square - 1]
|> appendIfInSet squareSets.[n].[UP] [square - n]
|> appendIfInSet squareSets.[n].[DOWN] [square + n]
|> appendIfInSet squareSets.[n].[DOWNRIGHT] [square + n + 1]
|> appendIfInSet squareSets.[n].[DOWNLEFT] [square + n - 1]
|> appendIfInSet squareSets.[n].[UPRIGHT] [square - n + 1]
|> appendIfInSet squareSets.[n].[UPLEFT] [square - n - 1]
|> List.choose (fun s -> if ((uint64 1 <<< s) &&& state) = 0UL then Some s else None )
let block state square =
state ||| (uint64 1 <<< square)
let countAllPaths n lmin lmax =
let mov = moves n
let rec count l state sq c =
let state' = block state sq
let m = mov state' sq
match l with
| x when x <= lmax && x >= lmin ->
List.fold (fun acc s -> count (l+1) state' s acc) (c+1) m
| x when x < lmin ->
List.fold (fun acc s -> count (l+1) state' s acc) (c) m
| _ ->
c
//List.fold (fun acc s -> count 0 (block 0UL s) s acc) 0 [0..n*n-1]
[0..n*n-1]
|> Array.ofList
|> Array.Parallel.map (fun start -> count 0 (block 0UL start) start 0)
|> Array.sum
[<EntryPoint>]
let main args =
printfn "%d: %A" (Array.length args) args
if 3 = Array.length args then
let n = int args.[0]
let lmin = int args.[1]
let lmax = int args.[2]
printfn "%d %d %d -> %d" n lmin lmax (countAllPaths n lmin lmax)
else
printfn "usage: wordgames.exe n lmin lmax"
0
As for the non-optimization of the generation of sets.
The second version posted in the update to the question showed, that this is actually the case (not optimized by compiler) and it yielded a significant speed up. The final version (posted below in this answer) carries that approach even further and speeds up the path counting (and the solving of a boggle puzzle) even further.
Combined with parallel execution on multiple cores, the initially really slow (maybe 30s) version could be sped up to only around 100ms for the n=4 lmin=3 lmax=8 case.
For n=6 class of problems, the parallel and hand tuned implementation solves a puzzle in around 60ms on my machine. It makes sense, that this is faster than the path counting, as the word list probing (used a dictionary with around 80000 words) along with the dynamic programming approach pointed out by #GuyCoder renders the solution of the puzzle a less complex problem than the (brute force) path counting.
Lesson learned
The f# compiler does not seem to be all too mystical and magical if it comes to code optimizations. Hand tuning is worth the effort if performance is really required.
Turning a single threaded recursive search function into a parallel (concurrent) function was not really hard in this case.
The final version of the code
Compiled with:
fsc --optimize+ --tailcalls+ wordgames.fs
(Microsoft (R) F# Compiler version 14.0.23413.0)
let wordListPath = #"E:\temp\12dicts-6.0.2\International\3of6all.txt"
let acceptableWord (s : string) : bool =
let s' = s.Trim()
if s'.Length > 2
then
if System.Char.IsLower(s'.[0]) && System.Char.IsLetter(s'.[0]) then true
else false
else
false
let words =
System.IO.File.ReadAllLines(wordListPath)
|> Array.filter acceptableWord
let squareSet n =
let allSquares = [0..n*n-1] |> Set.ofList
let right = Set.difference allSquares (Set.ofList [n-1..n..n*n])
let left = Set.difference allSquares (Set.ofList [0..n..n*n-1])
let up = Set.difference allSquares (Set.ofList [0..n-1])
let down = Set.difference allSquares (Set.ofList [n*n-n..n*n-1])
let downRight = Set.intersect right down
let downLeft = Set.intersect left down
let upRight = Set.intersect right up
let upLeft = Set.intersect left up
[|right;left;up;down;upRight;upLeft;downRight;downLeft|]
let RIGHT,LEFT,UP,DOWN = 0,1,2,3
let UPRIGHT,UPLEFT,DOWNRIGHT,DOWNLEFT = 4,5,6,7
let squareSets =
[|Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;Set.empty;|]
::
[ for i in 1..8 do
yield squareSet i
]
|> Array.ofList
let movesFromSquare n square =
let appendIfInSet se v res =
if Set.contains square se then v :: res else res
[]
|> appendIfInSet squareSets.[n].[RIGHT] (square + 1)
|> appendIfInSet squareSets.[n].[LEFT] (square - 1)
|> appendIfInSet squareSets.[n].[UP] (square - n)
|> appendIfInSet squareSets.[n].[DOWN] (square + n)
|> appendIfInSet squareSets.[n].[DOWNRIGHT] (square + n + 1)
|> appendIfInSet squareSets.[n].[DOWNLEFT] (square + n - 1)
|> appendIfInSet squareSets.[n].[UPRIGHT] (square - n + 1)
|> appendIfInSet squareSets.[n].[UPLEFT] (square - n - 1)
let lutMovesN n =
Array.init n (fun i -> if i > 0 then Array.init (n*n-1) (fun j -> movesFromSquare i j) else Array.empty)
let lutMoves =
lutMovesN 8
let moves n state square =
let appendIfInSet se v res =
if Set.contains square se then v :: res else res
lutMoves.[n].[square]
|> List.filter (fun s -> ((uint64 1 <<< s) &&& state) = 0UL)
let block state square =
state ||| (uint64 1 <<< square)
let countAllPaths n lmin lmax =
let mov = moves n
let rec count l state sq c =
let state' = block state sq
let m = mov state' sq
match l with
| x when x <= lmax && x >= lmin ->
List.fold (fun acc s -> count (l+1) state' s acc) (c+1) m
| x when x < lmin ->
List.fold (fun acc s -> count (l+1) state' s acc) (c) m
| _ ->
c
//List.fold (fun acc s -> count 0 (block 0UL s) s acc) 0 [0..n*n-1]
[|0..n*n-1|]
|> Array.Parallel.map (fun start -> count 0 (block 0UL start) start 0)
|> Array.sum
//printfn "%d " (words |> Array.distinct |> Array.length)
let usage() =
printfn "usage: wordgames.exe [--gen n count problemPath | --count n lmin lmax | --solve problemPath ]"
let rng = System.Random()
let genProblem n (sb : System.Text.StringBuilder) =
let a = Array.init (n*n) (fun _ -> char (rng.Next(26) + int 'a'))
sb.Append(a) |> ignore
sb.AppendLine()
let genProblems nproblems n (sb : System.Text.StringBuilder) : System.Text.StringBuilder =
for i in 1..nproblems do
genProblem n sb |> ignore
sb
let solve n (board : System.String) =
let ba = board.ToCharArray()
let testWord (w : string) : bool =
let testChar k sq = (ba.[sq] = w.[k])
let rec testSquare state k sq =
match k with
| 0 -> testChar 0 sq
| x ->
if testChar x sq
then
let state' = block state x
moves n state' x
|> List.exists (testSquare state' (x-1))
else
false
[0..n*n-1]
|> List.exists (testSquare 0UL (String.length w - 1))
words
|> Array.splitInto 32
|> Array.Parallel.map (Array.filter testWord)
|> Array.concat
[<EntryPoint>]
let main args =
printfn "%d: %A" (Array.length args) args
let nargs = Array.length args
let sw = System.Diagnostics.Stopwatch()
match nargs with
| x when x >= 2 ->
match args.[0] with
| "--gen" ->
if nargs = 4
then
let n = int args.[1]
let nproblems = int args.[2]
let outpath = args.[3]
let problems = genProblems nproblems n (System.Text.StringBuilder())
System.IO.File.WriteAllText (outpath,problems.ToString())
0
else
usage()
0
| "--count" ->
if nargs = 4
then
let n = int args.[1]
let lmin = int args.[2]
let lmax = int args.[3]
sw.Start()
let count = countAllPaths n lmin lmax
sw.Stop()
printfn "%d %d %d -> %d (took: %d)" n lmin lmax count (sw.ElapsedMilliseconds)
0
else
usage ()
0
| "--solve" ->
if nargs = 2
then
let problems = System.IO.File.ReadAllLines(args.[1])
problems
|> Array.iter
(fun (p : string) ->
let n = int (sqrt (float (String.length p)))
sw.Reset()
sw.Start()
let found = solve n p
sw.Stop()
printfn "%s\n%A\n%dms" p found (sw.ElapsedMilliseconds)
)
0
else
usage ()
0
| _ ->
usage ()
0
| _ ->
usage ()
0
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.
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.
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
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.
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