module Knots.Braid where
import Knots.PD
import Knots.Util
data Braid = Braid { braidWidth :: Int
, braidWord :: [Int]
}
deriving (Eq,Show,Read)
data N a = Z a | S (N a)
deriving (Eq,Show,Read,Ord)
the :: N a -> a
the (Z a) = a
the (S x) = the x
fromBraid :: Braid -> PD (N Int)
fromBraid (Braid n xs) = let (end, pd) = fromBraid' n xs
in foldr (\x -> (map . fmap) (replace x (Z (the x)))) pd end
fromBraid' :: Int -> [Int] -> ([N Int], PD (N Int))
fromBraid' n [] = (map Z [1..n], [])
fromBraid' n (x:xs) = let (end, pd) = fromBraid' n xs
x' = abs x
rename | x == 0 = id
| otherwise = renameShift x' . renameShift (x' 1)
crossing | x == 0 = []
| x > 0 = [ N (Z x) (S (Z x)) (S (Z (x1))) (Z (x1)) ]
| x < 0 = [ N (Z (x'1)) (Z x') (S (Z x')) (S (Z (x'1))) ]
in (map rename end, crossing ++ (map . fmap) rename pd)
renameShift :: Int -> N Int -> N Int
renameShift x y | the y == x = S y
| otherwise = y
torusBraid :: Int -> Int -> Braid
torusBraid m n = Braid (abs m) . concat . replicate n $ torusTurn m
mirrorBraid :: Braid -> Braid
mirrorBraid (Braid n xs) = Braid n (map negate xs)
torusTurn :: Int -> [Int]
torusTurn n | n < 0 = map negate (torusTurn ( n))
torusTurn n | n >= 0 = [ 1 .. n1 ]