Amida Lottery in Haskell (Sample Code)

amida-lottery.hs

import qualified Data.Map as Map
import Data.List
import Data.Tuple

type PermutationGroup = [Int]
type Cycle = [Int]
type Transposition = (Int,Int)
type CoxeterGenerator = [Transposition]

main = getLine >>= putStrLn . show . solve . (map read) . words

solve :: PermutationGroup -> CoxeterGenerator
solve pg = (concatMap transCoxeter)
           $ (map (sortTuple (\x y -> x < y)))
           $ (concatMap transTranspositions)
           $ getCycles pg

getCycles :: PermutationGroup -> [Cycle]
getCycles pg = loop [1..(length pg)] []
    where
      loop [] cycles = cycles
      loop left cycles = loop (left \\ cyc) (cyc : cycles)
          where
            cyc = getCycle pg [] (head left)
getCycle :: PermutationGroup -> Cycle -> Int -> Cycle
getCycle pg cyc next
    | elem next cyc = cyc
    | otherwise = getCycle pg (cyc++[next]) (pg!!(next-1))

transTranspositions :: Cycle -> [Transposition]
transTranspositions [c] = []
transTranspositions cs = zip cs (tail cs)

sortTuple :: (a -> a -> Bool) -> (a,a) -> (a,a)
sortTuple f t@(a,b) = if f a b then t else swap t

transCoxeter :: Transposition -> CoxeterGenerator
transCoxeter (a,b)
    | a == b = []
    | abs (a-b) == 1 = [(a,b)]
    | otherwise = (a,a+1):(transCoxeter (a+1,b)) ++ [(a,a+1)]

-- test code 
amida :: CoxeterGenerator -> Int -> Int
amida cg n = loop (reverse cg) n
    where
      loop [] n = n
      loop ((a,b):px) n
           | a == n = loop px b
           | b == n = loop px a
           | otherwise = loop px n