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 (x-1))) (Z (x-1)) ]
                                    | 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 .. n-1 ]