open System open System.Collections.Generic module Modular = let modulo n x = (x % n + n) % n let add n x y = modulo n (x + y) let subtract n x y = modulo n (x - y) let multiply n x y = modulo n (x * y) // let (+) = plus 7 // 10 + 10 //returns 6 let divide n x y = [0..n-1] |> List.find (fun z -> multiply n y z = x) type Permutation = int array module Permutation = let rec allListPermutations (lst:'T list) : 'T list list = match lst with | [] -> [[]] | _ -> lst |> List.collect (fun x -> lst |> List.filter ((<>) x) |> allListPermutations |> List.map (fun l -> x::l)) let all n : Permutation list = allListPermutations [1..n] |> List.map Array.ofList let compose (p1:Permutation) (p2:Permutation) = Array.map (fun i -> p1.[i-1]) p2 let invert n (p:Permutation) = let indexOf p i = Array.findIndex ((=) i) p [|1..n|] |> Array.map (indexOf p >> (+) 1) module Array = let transpose<'T> (xs:'T array array) = [|for i in 0..(xs.[0].Length-1) -> [| for row in xs -> row.[i] |] |] type Matrix<'T> = 'T array array module Matrix = let multiply<'T> (add:'T->'T->'T) (mult:'T->'T->'T) (a:'T Matrix) (b:'T Matrix) = [| for aRow in a -> [| for bCol in Array.transpose b -> Array.map2 mult aRow bCol |> Array.reduce add |] |] let diag<'T> (size:int) (onDiag:'T) (offDiag:'T) = [| for i in 1..size -> [| for j in 1..size -> if i = j then onDiag else offDiag |] |] type FiniteGroup<'T> = { Elts : 'T list // elements of the group Op : 'T -> 'T -> 'T // group operation Id : 'T // identity element Inv : 'T -> 'T // invert an element } module Test = // For all g,h test that gh is in grp.Elements let closure<'T when 'T:equality> (grp:FiniteGroup<'T>) = grp.Elts |> List.forall (fun g -> grp.Elts |> List.forall (fun h -> List.contains (grp.Op g h) grp.Elts)) // for all g,h,k, test g(hk) = (gh)k let associativity<'T when 'T:equality> (grp:FiniteGroup<'T>) = grp.Elts |> List.forall (fun g -> grp.Elts |> List.forall (fun h -> grp.Elts |> List.forall (fun k -> grp.Op g (grp.Op h k) = grp.Op (grp.Op g h) k))) // with identity e, test for all g that eg = ge = g let identity<'T when 'T:equality> (grp:FiniteGroup<'T>) = grp.Elts |> List.forall (fun g -> grp.Op grp.Id g = g && grp.Op g grp.Id = g ) // for any g, if h is the inverse of g then gh = hg = e let invert<'T when 'T:equality> (grp:FiniteGroup<'T>) = grp.Elts |> List.forall (fun g -> grp.Op grp.Id g = g && grp.Op g grp.Id = g ) let group grp = [closure; associativity; identity; invert] |> List.map (fun test -> test grp) let abelian grp = grp.Elts |> List.forall (fun g -> grp.Elts |> List.forall (fun h -> grp.Op g h = grp.Op h g)) let integersModN n = { Elts = [0..n-1] Op = Modular.add n Id = 0 Inv = Modular.subtract n 0 } let symmetricGroup n = { Elts = Permutation.all n Op = Permutation.compose Id = [|1..n|] Inv = Permutation.invert n } // multiplication table let multTableLaTeX (grp:FiniteGroup<'T>) (toString:'T->string) = // column headers let header = grp.Elts |> List.map toString |> String.concat " & " let rows = grp.Elts |> List.map (fun g -> toString g :: (grp.Elts |> List.map (fun h -> toString <| grp.Op g h)) |> String.concat " & ") |> String.concat @" \\ " // LaTeX row delimiter let cols = [for _ in grp.Elts -> "c"] |> String.concat "" // LaTeX table syntax sprintf @"\begin{array}{c|%s} & %s \\ \hline %s\end{array}" cols header rows multTableLaTeX (integersModN 7) string let permToString : Permutation -> string = (Array.map string >> String.concat "" >> sprintf "(%s)") multTableLaTeX (symmetricGroup 3) permToString // generate let rec generate<'T when 'T : equality and 'T : comparison> (operate:'T -> 'T -> 'T) (generators:'T list) = // get the next set of elements by composing all current elements let next = [for x in generators do for y in generators do yield operate x y] |> List.append generators |> List.distinct |> List.sort // if the set of elements hasn'te expanded, you're done if next = generators then next // otherwise, proceed recursively else generate operate next generate (Modular.add 6) [1] { Elts = [0;2;4] Op = Modular.add 6 Id = 0 Inv = Modular.subtract 6 0 } |> Test.group // [true; true; true; true] let generateFiniteGroup<'T when 'T : comparison> (operation:'T->'T->'T) (generators:'T list) : FiniteGroup<'T> = // get all the elements let elements = generate operation generators // find the identity let (*) = operation let identity = elements |> List.find (fun e -> elements |> List.forall (fun x -> e*x = x && x*e = x) ) // create a Map, element -> inverse let inverseMap = [for elt in elements -> let inverse = elements |> Seq.find (fun elt' -> elt * elt' = identity) elt, inverse] |> Map.ofList // create FiniteGroup from all relevant data { Elts = elements Op = operation Inv = fun elt -> inverseMap.[elt] Id = identity } [ [|2;1;3;4;5;6|] // "transposition" of 1 & 2 [|2;3;4;5;6;1|] // 6-cycle ] |> generateFiniteGroup Permutation.compose |> fun grp -> grp.Elts.Length // order, order of an element let order grp = grp.Elts.Length let eltOrder (grp:FiniteGroup<'T>) (g:'T) = Seq.unfold (fun x -> Some (grp.Op g x, grp.Op g x)) grp.Id |> Seq.findIndex ((=) grp.Id) |> ((+) 1) // abelian, center // compute all lists of length n with entries in given list let rec allLists<'T> (n:int) (entries:'T list) = match n with | 0 -> [[]] | _ -> entries |> List.collect (fun e -> allLists (n-1) entries |> List.map (fun lst -> e::lst)) // find lists of length size*size and shape them into matrices let allSquareMatrices size entries = allLists (size * size) entries |> List.map (Array.ofList >> Array.chunkBySize size) // for a matrix m, return the pair of m and its inverse // among the matrices, or None otherwise let withInverse n matrices p m = let id = Matrix.diag n 1 0 matrices |> Seq.tryFind (fun m' -> Matrix.multiply (Modular.add p) (Modular.multiply p) m m' = id) |> Option.map (fun m' -> m,m') // build the FiniteGroup by finding invertible matrices let gl (n:int) (p:int) = let matrices = allSquareMatrices n [0..p-1] let pairsOfInverses = matrices |> List.choose (withInverse n matrices p) let inverseLookup = pairsOfInverses |> Map.ofList { Elts = pairsOfInverses |> List.map fst Op = Matrix.multiply (Modular.add p) (Modular.multiply p) Id = Matrix.diag n 1 0 Inv = fun m -> inverseLookup.Item m } let center<'T when 'T:equality> (grp:FiniteGroup<'T>) = grp.Elts |> List.filter (fun g -> grp.Elts |> List.forall (fun h -> grp.Op g h = grp.Op h g)) // conjugacy classes, class equation // product of groups // is homomorphism // image // kernel // permutation representation