algorithm - Boggle - N*N グリッド上のすべての可能なパスをカウントします。パフォーマンス

Question

この質問を読んでいる間、ボグルグリッドで可能なすべてのパスを「単純に」反復し、ワードトライをたどってから、ワードトライに一致がない場合にパスをキャンセルしないのはなぜだろうかと思いました。小さな 4 x 4 のグリッドに多くのパスを配置することはできませんよね? パスはいくつありますか？そこで、F# でパス カウンター関数をコーディングすることにしました。結果は、その他のページで誰も述べていないことをもたらします。グリッド上のパスは、私が推測したよりもはるかに多くなります (実際には、単語セット内の単語よりも多くのパス)。

以上が私の質問の裏話ですが、最終的にコードの実行がかなり遅くなり、コードのいくつかの側面に対して適切な答えを出すことができないことがわかりました。ここでは、最初にコードを示し、次にその下に、説明に値すると思われるポイントを示します...

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

1. moves30 行目で、コードの最適化に役立つことを期待して、最初の引数で関数をカリー化しました。の関数にすぎない、move で作成した 9 つのセットを最適化するかもしれませんn。結局のところ、何度も何度も生成する必要はありませんよね? 一方で、私はそれが実際に起こることに賭けるつもりはありません。
   したがって、質問 1 は次のとおりです。この最適化を、できるだけコードの肥大化を最小限に抑える方法で実施するにはどうすればよいでしょうか? （もちろん、9つのメンバーを持つ型を作成し、可能なnごとにその型の配列を作成してから、事前に計算されたセットの使用のようなルックアップテーブルを実行できますが、私の意見ではコードが肥大化します）。

2. 多くの情報源は、平行な折り畳みが重要であると考えられていることをほのめかしています。(複数のコアで実行される) カウント関数の並列バージョンを作成するにはどうすればよいですか?

3. これをスピードアップする賢いアイデアを持っている人はいますか? たぶん、剪定やメモ化などですか？

最初、関数を実行したときn=4 lmin=3 lmax=8、fsi で実行したため、時間がかかると思いました。しかし、その後、コードを -O でコンパイルしましたが、それでもほぼ同じ時間がかかりました...

アップデート

皆さんからの入力を待っている間に、コードを肥大化させた手動最適化バージョン (実行速度が大幅に向上) を実行し、それを複数のコアで実行する方法を見つけました。
全体として、これら 2 つの変更により、約 30 倍の速度向上が得られました。ここで、私が思いついた (肥大化した) バージョンを示します (肥大化を回避する方法をまだ探しています):

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