Skip to content

Instantly share code, notes, and snippets.

@7shi 7shi/ClifTensor.fsx
Last active Jan 7, 2020

Embed
What would you like to do?
[F#] Tensor product decomposition of Clifford algebra
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
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]]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.