23 Algebraic Identities — A Verification Suite
This notebook systematically verifies the fundamental identities of group theory and representation theory across every group type in the library. Each identity is tested on diverse inputs, serving as both documentation and a thorough regression test.
(ns harmonica-book.algebraic-identities
(:require
[scicloj.harmonica :as hm]
[scicloj.harmonica.protocols :as p]
[scicloj.harmonica.analysis.representations :as rep]
[scicloj.harmonica.linalg.complex :as cx]
[fastmath.matrix :as fm]
[scicloj.kindly.v4.kind :as kind]))Test Groups
We verify identities on a diverse collection of groups covering all implemented types: cyclic, symmetric, dihedral, and product.
(def test-groups
"A collection of groups for systematic testing."
[{:label "Z/2Z" :group (hm/cyclic-group 2) :has-ct? true}
{:label "Z/5Z" :group (hm/cyclic-group 5) :has-ct? true}
{:label "Z/7Z" :group (hm/cyclic-group 7) :has-ct? true}
{:label "Z/12Z" :group (hm/cyclic-group 12) :has-ct? true}
{:label "S_3" :group (hm/symmetric-group 3) :has-ct? true}
{:label "S_4" :group (hm/symmetric-group 4) :has-ct? true}
{:label "S_5" :group (hm/symmetric-group 5) :has-ct? true}
{:label "D_3" :group (hm/dihedral-group 3) :has-ct? true}
{:label "D_4" :group (hm/dihedral-group 4) :has-ct? true}
{:label "D_5" :group (hm/dihedral-group 5) :has-ct? true}
{:label "D_6" :group (hm/dihedral-group 6) :has-ct? true}
{:label "D_8" :group (hm/dihedral-group 8) :has-ct? true}
{:label "Z/2Z × Z/3Z" :group (hm/product-group
(hm/cyclic-group 2)
(hm/cyclic-group 3)) :has-ct? false}
{:label "Z/2Z × Z/2Z" :group (hm/product-group
(hm/cyclic-group 2)
(hm/cyclic-group 2)) :has-ct? false}
{:label "Z/3Z × Z/4Z" :group (hm/product-group
(hm/cyclic-group 3)
(hm/cyclic-group 4)) :has-ct? false}])(def ct-groups
"Groups that have character-table implementations."
(filterv :has-ct? test-groups))Group Axioms
Every group must satisfy: identity, inverses, and associativity.
Identity: \(e \cdot g = g \cdot e = g\)
(let [results
(mapv (fn [{:keys [label group]}]
(let [e (hm/id group)
ok? (every? (fn [g]
(and (= (hm/op group e g) g)
(= (hm/op group g e) g)))
(hm/elements group))]
{:group label :pass? ok?}))
test-groups)]
(every? :pass? results))trueInverses: \(g \cdot g^{-1} = g^{-1} \cdot g = e\)
(let [results
(mapv (fn [{:keys [label group]}]
(let [e (hm/id group)
ok? (every? (fn [g]
(let [gi (hm/inv group g)]
(and (= (hm/op group g gi) e)
(= (hm/op group gi g) e))))
(hm/elements group))]
{:group label :pass? ok?}))
test-groups)]
(every? :pass? results))trueAssociativity: \((g \cdot h) \cdot k = g \cdot (h \cdot k)\)
We test a random sample of triples for larger groups.
(let [results
(mapv (fn [{:keys [label group]}]
(let [elts (vec (hm/elements group))
;; For groups up to order 24, test all triples
;; For larger groups, sample
triples (if (<= (count elts) 24)
(for [a elts b elts c elts] [a b c])
(let [rng (java.util.Random. 42)]
(repeatedly 500
(fn [] [(elts (.nextInt rng (count elts)))
(elts (.nextInt rng (count elts)))
(elts (.nextInt rng (count elts)))]))))
ok? (every? (fn [[a b c]]
(= (hm/op group (hm/op group a b) c)
(hm/op group a (hm/op group b c))))
triples)]
{:group label :pass? ok?}))
test-groups)]
(every? :pass? results))trueConjugacy Class Properties
Classes partition the group: sizes sum to |G|
(let [results
(mapv (fn [{:keys [label group]}]
(let [classes (hm/conjugacy-classes group)
total (reduce + (map :size classes))]
{:group label :pass? (= total (hm/order group))}))
test-groups)]
(every? :pass? results))trueClass elements are disjoint and form a partition
(let [results
(mapv (fn [{:keys [label group]}]
(let [classes (hm/conjugacy-classes group)
all-elts (mapcat :elements classes)
group-set (set (hm/elements group))]
{:group label
:pass? (and (= (count all-elts) (count (set all-elts)))
(= (set all-elts) group-set))}))
test-groups)]
(every? :pass? results))trueCharacter Table Properties
The character table of a finite group encodes all irreducible representations. It satisfies several fundamental orthogonality relations.
Row orthogonality
\[\sum_{C} |C| \, \chi_i(C) \, \overline{\chi_j(C)} = |G| \, \delta_{ij}\]
Different irreps are orthogonal; same irrep has norm \(|G|\).
(defn row-orthogonality-check
"Check row orthogonality for all pairs of irreps."
[{:keys [label group]}]
(let [ct (hm/character-table group)
{:keys [table class-sizes]} ct
n-irreps (count table)
order (hm/order group)
tol 1e-8]
(every? identity
(for [i (range n-irreps)
j (range n-irreps)]
(let [ip (reduce + (map-indexed
(fn [k sz]
(let [ci (nth (nth table i) k)
cj (nth (nth table j) k)]
(* (double sz)
(+ (* (cx/re ci) (cx/re cj))
(* (cx/im ci) (cx/im cj))))))
class-sizes))
expected (if (= i j) (double order) 0.0)]
(< (Math/abs (- ip expected)) tol))))))(every? row-orthogonality-check ct-groups)trueColumn orthogonality
\[\sum_{\rho} \chi_\rho(C_i) \, \overline{\chi_\rho(C_j)} = \frac{|G|}{|C_i|} \, \delta_{ij}\]
(defn column-orthogonality-check
"Check column orthogonality for all pairs of conjugacy classes."
[{:keys [label group]}]
(let [ct (hm/character-table group)
{:keys [table class-sizes]} ct
n-classes (count class-sizes)
order (hm/order group)
tol 1e-8]
(every? identity
(for [i (range n-classes)
j (range n-classes)]
(let [ip (reduce + (map (fn [row]
(let [ci (nth row i)
cj (nth row j)]
(+ (* (cx/re ci) (cx/re cj))
(* (cx/im ci) (cx/im cj)))))
table))
expected (if (= i j)
(/ (double order) (double (nth class-sizes i)))
0.0)]
(< (Math/abs (- ip expected)) tol))))))(every? column-orthogonality-check ct-groups)trueDimension sum: \(\sum_\rho d_\rho^2 = |G|\)
(let [results
(mapv (fn [{:keys [label group]}]
(let [ct (hm/character-table group)
dims (mapv (fn [row]
(let [d (first row)]
(cx/re d)))
(:table ct))
dim-sq-sum (reduce + (map #(* % %) dims))]
{:group label
:pass? (< (Math/abs (- dim-sq-sum (double (hm/order group)))) 1e-8)}))
ct-groups)]
(every? :pass? results))trueNumber of irreps equals number of conjugacy classes
(let [results
(mapv (fn [{:keys [label group]}]
(let [ct (hm/character-table group)
n-irreps (count (:table ct))
n-classes (count (hm/conjugacy-classes group))]
{:group label :pass? (= n-irreps n-classes)}))
ct-groups)]
(every? :pass? results))trueTrivial character: \(\chi_{\text{trivial}}(g) = 1\) for all \(g\)
(let [results
(mapv (fn [{:keys [label group]}]
(let [ct (hm/character-table group)
;; The first irrep should be trivial
trivial-row (first (:table ct))
ok? (every? (fn [chi-val]
(< (cx/cabs (cx/csub chi-val (cx/complex 1.0 0.0))) 1e-8))
trivial-row)]
{:group label :pass? ok?}))
ct-groups)]
(every? :pass? results))trueCharacter values at identity equal dimensions
(let [results
(mapv (fn [{:keys [label group]}]
(let [ct (hm/character-table group)
;; Identity is the first class
ok? (every? (fn [row]
(let [d (cx/re (first row))]
(< (Math/abs (- d (Math/round d))) 1e-8)))
(:table ct))]
{:group label :pass? ok?}))
ct-groups)]
(every? :pass? results))trueFourier Transform Properties (Abelian Groups)
For abelian groups, the Fourier transform satisfies Parseval’s theorem, the convolution theorem, and perfect round-tripping.
(def abelian-groups
"Abelian groups for Fourier testing."
[{:label "Z/5Z" :group (hm/cyclic-group 5)}
{:label "Z/7Z" :group (hm/cyclic-group 7)}
{:label "Z/12Z" :group (hm/cyclic-group 12)}
{:label "Z/16Z" :group (hm/cyclic-group 16)}])Round-trip: inverse(transform(f)) ≈ f
(let [results
(mapv (fn [{:keys [label group]}]
(let [n (hm/order group)
ct (hm/character-table group)
f-vals (cx/complex-tensor-real (mapv (fn [i] (double (inc i))) (range n)))
f-hat (hm/fourier-transform ct f-vals)
f-back (hm/inverse-fourier-transform ct f-hat)
max-err (apply max (vec (cx/cabs (cx/csub f-back f-vals))))]
{:group label :pass? (< max-err 1e-10)}))
abelian-groups)]
(every? :pass? results))trueParseval’s theorem: \(\sum |f(g)|^2 = \frac{1}{|G|} \sum |\hat{f}(k)|^2\)
(let [results
(mapv (fn [{:keys [label group]}]
(let [n (hm/order group)
ct (hm/character-table group)
f-vals (cx/complex-tensor-real (mapv (fn [i] (Math/sin (* 2.0 Math/PI (/ i (double n))))) (range n)))
f-hat (hm/fourier-transform ct f-vals)
mag-f (cx/cabs f-vals)
mag-fh (cx/cabs f-hat)
lhs (apply + (map #(* % %) (vec mag-f)))
rhs (* (/ 1.0 (double n))
(apply + (map #(* % %) (vec mag-fh))))]
{:group label :pass? (< (Math/abs (- lhs rhs)) 1e-8)}))
abelian-groups)]
(every? :pass? results))trueConvolution theorem: \(\widehat{f * g} = \hat{f} \cdot \hat{g}\)
(let [results
(mapv (fn [{:keys [label group]}]
(let [n (hm/order group)
ct (hm/character-table group)
f (cx/complex-tensor-real (mapv (fn [i] (if (< i 3) 1.0 0.0)) (range n)))
g (cx/complex-tensor-real (mapv (fn [i] (/ 1.0 (inc (double i)))) (range n)))
conv (hm/convolve ct f g)
f-hat (hm/fourier-transform ct f)
g-hat (hm/fourier-transform ct g)
conv-hat (hm/fourier-transform ct conv)
pointwise (cx/cmul f-hat g-hat)
max-err (apply max (vec (cx/cabs (cx/csub conv-hat pointwise))))]
{:group label :pass? (< max-err 1e-8)}))
abelian-groups)]
(every? :pass? results))trueRepresentation Theory (S_n)
Young’s orthogonal form provides explicit matrix representations for S_n. We verify the key properties.
Homomorphism: \(\rho(\sigma \tau) = \rho(\sigma) \rho(\tau)\)
(let [results
(for [n [3 4 5]
lambda (hm/partitions n)]
(let [G (hm/symmetric-group n)
ir (hm/irrep lambda)
elts (vec (hm/elements G))
;; Test all pairs for small groups
pairs (if (<= (count elts) 24)
(for [a elts b elts] [a b])
(let [rng (java.util.Random. 42)]
(repeatedly 200 (fn [] [(elts (.nextInt rng (count elts)))
(elts (.nextInt rng (count elts)))]))))
ok? (every? (fn [[s t]]
(let [st (hm/op G s t)
rho-st (hm/rep-matrix ir st)
rho-s-rho-t (fm/mulm (hm/rep-matrix ir s)
(hm/rep-matrix ir t))
diff (fm/sub rho-st rho-s-rho-t)
err (Math/sqrt (fm/trace (fm/mulm diff (fm/transpose diff))))]
(< err 1e-10)))
pairs)]
ok?))]
(every? identity results))trueOrthogonality: representation matrices are orthogonal
\(\rho(\sigma)^T = \rho(\sigma)^{-1} = \rho(\sigma^{-1})\)
(let [results
(for [n [3 4 5]
lambda (hm/partitions n)]
(let [G (hm/symmetric-group n)
ir (hm/irrep lambda)
d (hm/rep-dimension ir)
I (fm/rows->mat (mapv (fn [i]
(mapv (fn [j] (if (= i j) 1.0 0.0))
(range d)))
(range d)))]
(every? (fn [sigma]
(let [M (hm/rep-matrix ir sigma)
MtM (fm/mulm (fm/transpose M) M)
diff (fm/sub MtM I)
err (Math/sqrt (fm/trace (fm/mulm diff (fm/transpose diff))))]
(< err 1e-10)))
(hm/elements G))))]
(every? identity results))trueTrace matches character table
\(\text{tr}(\rho_\lambda(\sigma)) = \chi_\lambda(\text{cycle-type}(\sigma))\)
(let [results
(for [n [3 4 5]]
(let [G (hm/symmetric-group n)
ct (hm/character-table G)
parts (hm/partitions n)
classes (:classes ct)
class-idx (into {} (map-indexed (fn [i c] [c i]) classes))]
(every? identity
(for [lambda parts]
(let [ir (hm/irrep lambda)
lambda-idx (.indexOf (:irrep-labels ct) lambda)
row (nth (:table ct) lambda-idx)]
(every? (fn [sigma]
(let [ct-idx (class-idx (hm/cycle-type sigma))
chi-val (cx/re (nth row ct-idx))
trace-val (hm/rep-character ir sigma)]
(< (Math/abs (- chi-val trace-val)) 1e-8)))
(hm/elements G)))))))]
(every? identity results))truePlancherel identity
\[\sum_{\sigma \in G} |f(\sigma)|^2 = \frac{1}{|G|} \sum_\rho d_\rho \|\hat{f}(\rho)\|_F^2\]
(let [results
(for [n [3 4]]
(let [G (hm/symmetric-group n)
parts (hm/partitions n)
irreps (mapv hm/irrep parts)
;; Use a non-trivial test function
elts (vec (hm/elements G))
f (into {} (map-indexed (fn [i sigma]
[sigma (/ 1.0 (inc (double i)))])
elts))
lhs (rep/plancherel-lhs G f)
f-hats (rep/matrix-fourier-transform-all G f irreps)
rhs (rep/plancherel-rhs G f-hats irreps)]
(< (Math/abs (- lhs rhs)) 1e-8)))]
(every? identity results))trueGroup Action Identities
Orbit-stabilizer theorem: \(|G| = |\text{Orb}(x)| \cdot |\text{Stab}(x)|\)
(let [results
(for [n [4 5 6]]
(let [G (hm/dihedral-group n)
act (fn [[t k] x]
(case t
:r (mod (+ x k) n)
:s (mod (- k x) n)))
order (hm/order G)]
(every? (fn [x]
(let [orb (hm/orbit G act x)
stab (hm/stabilizer G act x)]
(= order (* (count orb) (count stab)))))
(range n))))]
(every? identity results))trueBurnside equals orbit count
(let [results
(for [n [3 4 5 6]
k [2 3]]
(let [G (hm/cyclic-group n)
domain (loop [i 0 d [[]]]
(if (= i n) d
(recur (inc i) (for [prev d c (range k)] (conj prev c)))))
act (fn [g coloring]
(mapv #(coloring (mod (+ % g) n)) (range n)))
orbit-count (count (hm/orbits G act domain))
burnside (hm/burnside-count G act domain)]
(= orbit-count burnside)))]
(every? identity results))
ImportantNo implementation of method: :elements of protocol: #’scicloj.harmonica.protocols/FiniteGroup found for class: scicloj.harmonica.group.cyclic.CyclicGroup
clojure.core/eval core.clj: 3232
...
harmonica-book.algebraic-identities/eval126051 REPL Input:
clojure.core/every? core.clj: 2696
clojure.core/seq core.clj: 139
...
harmonica-book.algebraic-identities/eval126051/iter/fn REPL Input:
clojure.core/seq core.clj: 139
...
harmonica-book.algebraic-identities/eval126051/iter/fn/iter/fn REPL Input:
harmonica-book.algebraic-identities/eval126051/iter/fn/iter/fn{x2} REPL Input:
scicloj.harmonica.action/orbits action.clj: 35
scicloj.harmonica.action/orbit action.clj: 24
scicloj.harmonica.protocols/eval102277/fn/G protocols.clj: 14
clojure.core/-cache-protocol-fn core_deftype.clj: 585
java.lang.IllegalArgumentException: No implementation of method: :elements of protocol: #'scicloj.harmonica.protocols/FiniteGroup found for class: scicloj.harmonica.group.cyclic.CyclicGroup