Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Word Problem for Braid Group
default (Int, Integer, Rational, Double)
if' :: Bool -> a -> a -> a
if' True x _ = x
if' False _ y = y
isBraidIdentity x n =
[1..n] == concat (map (braidReduce x) [[y] | y <- [1..n]])
braidReduce = flip (foldr homomorphism)
homomorphism :: Int -> [Int] -> [Int]
homomorphism i list =
(freeReduce . concat. (map func)) list
where func = if' (i>0) (sigma i) (invSigma (-i))
sign i
| i < 0 = -1
| otherwise = 1
sigma i j
| abs j == i+1 && j>0 = coef [i+1, i, -(i+1)]
| abs j == i+1 && j<0 = coef (reverse [i+1, i, -(i+1)])
| abs j == i = coef [i+1]
| otherwise = [j]
where coef = map (*(sign j))
invSigma i j
| abs j == i+1 = coef [i]
| abs j == i && j<0 = coef (reverse [-i, (i+1), i])
| abs j == i && j>0 = coef [-i, (i+1), i]
| otherwise = [j]
where coef = map (*(sign j))
freeReduce [] = []
freeReduce (x:xs)
| xs == [] || length reduced == 0 = [x]
| x == -(head reduced) = tail reduced
| otherwise = x:reduced
where reduced = freeReduce xs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment