[F#] Tensor product decomposition of Clifford algebra

ClifTensor.fsx

let memoize (f: 'k -> 'v) =
    let cache = System.Collections.Generic.Dictionary<'k, 'v>()
    fun a ->
        let b, v = cache.TryGetValue a
        if b then v else
        let ret = f a
        cache.[a] <- ret
        ret

let   curry f = fun a  b  -> f(a, b)
let uncurry f = fun(a, b) -> f a  b

let combination =
    let rec f n = function
    | k when k < 1 -> []
    | 1 -> [ for i in 1..n -> [i] ]
    | k -> [ for c in g (n - 1) (k - 1) do
             for i in (List.max c) + 1 .. n -> List.append c [i] ]
    and g = f |> uncurry |> memoize |> curry
    g

let rec scombination n = function
| k when k < 1 -> Seq.empty
| 1 -> seq { for i in 1..n -> [i] }
| k -> seq { for c in scombination (n - 1) (k - 1) do
             for i in (List.max c) + 1 .. n -> List.append c [i] }

let clifford = memoize <| fun n ->
    [for i in 1..n do yield! combination n i]

let clifcont p xs =
    let rec f n a = function
    | [] -> n, a
    | xs ->
        let m = List.min xs
        let ys = Seq.zip (Seq.initInfinite id) xs
                 |> Seq.filter (snd >> (=) m)
                 |> Seq.map fst
                 |> Seq.toArray
        let l = ys.Length
        let xchg = (Array.sum ys) - ((l - 1) * l) / 2  // 0121 -> 1, 1021 -> 2, 1102
        let cntr = if m <= p then 0 else l / 2
        f (n + xchg + cntr) (if l % 2 = 0 then a else m::a) (List.filter ((<>) m) xs)
    let n, xs = f 0 [] xs
    (if n % 2 = 0 then 1 else -1), xs |> List.rev

let clifmul p a b = clifcont p (List.append a b)
let clifxchg a b = clifmul 0 a b = clifmul 0 b a

let equ xs ys =
    List.length xs = List.length ys && Set.ofList xs = Set.ofList ys

let isaxchg xs =
    let rec f x = function
    | [] -> true
    | y::ys -> if clifxchg x y then false else f x ys
    let rec g = function
    | [] -> true
    | x::xs -> if f x xs then g xs else false
    g xs

let getxchgs =
    Seq.fold (fun xs x -> xs |> Seq.filter (clifxchg x))

let decomp3 clif =
    let l = List.length clif
    if l < 3 then Seq.empty else
    let clif = clif |> Seq.toArray
    scombination l 3
    |> Seq.map (List.map (fun i -> clif.[i - 1]))
    |> Seq.filter isaxchg
    |> Seq.filter (function [a; b; c] -> clifmul 0 a b |> snd = c | _ -> false)
    |> Seq.map (fun xs -> xs, getxchgs clif xs |> Seq.toList)
    |> Seq.filter (fun(_, ys) ->
        let y = List.length ys
        3 + y + 3 * y = clif.Length)

let rec rdecomp3 = function
| [] -> []
| xs -> match decomp3 xs |> Seq.tryHead with
        | Some(xs, ys) -> xs :: rdecomp3 ys
        | _ -> [xs]

let dim = {3..8}
for n in dim do
    clifford n
    |> rdecomp3
    |> Seq.map (List.truncate 2 >> sprintf "%A")
    |> String.concat " (x) "
    |> printfn "dim %d: %s" n
for n in dim do
    clifford n
    |> List.filter (fun xs -> List.length xs % 2 = 0)
    |> rdecomp3
    |> Seq.map (List.truncate 2 >> sprintf "%A")
    |> String.concat " (x) "
    |> printfn "even %d: %s" n

Output.txt

dim 3: [[1]; [2]] (x) [[1; 2; 3]]
dim 4: [[1]; [2]] (x) [[3; 4]; [1; 2; 3]]
dim 5: [[1]; [2]] (x) [[3; 4]; [3; 5]] (x) [[1; 2; 3; 4; 5]]
dim 6: [[1]; [2]] (x) [[3; 4]; [3; 5]] (x) [[1; 2; 6]; [3; 4; 5; 6]]
dim 7: [[1]; [2]] (x) [[3; 4]; [3; 5]] (x) [[6; 7]; [1; 2; 6]] (x) [[1; 2; 3; 4; 5; 6; 7]]
dim 8: [[1]; [2]] (x) [[3; 4]; [3; 5]] (x) [[6; 7]; [6; 8]] (x) [[1; 2; 3; 4; 5]; [1; 2; 6; 7; 8]]
even 3: [[1; 2]; [1; 3]]
even 4: [[1; 2]; [1; 3]] (x) [[1; 2; 3; 4]]
even 5: [[1; 2]; [1; 3]] (x) [[4; 5]; [1; 2; 3; 4]]
even 6: [[1; 2]; [1; 3]] (x) [[4; 5]; [4; 6]] (x) [[1; 2; 3; 4; 5; 6]]
even 7: [[1; 2]; [1; 3]] (x) [[4; 5]; [4; 6]] (x) [[1; 2; 3; 7]; [4; 5; 6; 7]]
even 8: [[1; 2]; [1; 3]] (x) [[4; 5]; [4; 6]] (x) [[7; 8]; [1; 2; 3; 7]] (x) [[1; 2; 3; 4; 5; 6; 7; 8]]