experiments with permutations in Haskell

perms.hs

{-# LANGUAGE NoMonomorphismRestriction #-}

-- Experiments with permutations

import Data.List
-- import qualified Math.Algebra.Group.PermutationGroup as PG

-- number of inversions in a permutation
inversions as = sum $ map go (tails as)
  where go [] = 0
        go (x:xs) = length $ filter (<x) xs

evenPerm as = even (inversions as)

parity as = if evenPerm as then 0 else 1

alternating n = [ p | p <- permutations [1..n], evenPerm p ]

factorial n = product [1..n]

holes xs = zip3 (inits xs) xs (tail $ tails xs)

-- list perms in lexigrapical order
lexPerms [] = [ [] ]
lexPerms as =  do (xs,x,ys) <- holes as
                  map (x:) (lexPerms (xs++ys))

-- kth lexigraphical permutation
kthPerm k [] = []
kthPerm k as =
  let n = length as
      f = factorial (n-1)
      (q,r) = divMod k f
      (xs, (x:ys)) = splitAt q as
  in x : kthPerm r (xs++ys)

invert blk = map (1-) blk
alternate n blk = concat (replicate n blk)
                    ++ concat (replicate n (invert blk))

blk0 = alternate 1 [0,1]              -- length 4          1 = 1*1
blk1 = alternate 6 [0,1,1,0]          -- length 24         6 = 2*3
blk2 = alternate 15 blk1              -- length 1440      15 = 3*5
blk3 = alternate 28 blk2              -- length 80640     27 = 4*7
blk4 = alternate 45 blk3              -- length 7257600   45 = 5*9

-- the pattern of the permutation parities when listed in
-- lexigraphical order -- good up to at least S_11
pattern = concat $ repeat blk4

-- perhaps the sequence continues...
blk5 = alternate (6*11) blk4
blk6 = alternate (7*13) blk5
-- ...

-- e.g.: checkPattern blk5 8
checkPattern expected n = 
  let perms = lexPerms [1..n] :: [[Int]]
      parities = map parity perms
      check = zipWith (==) parities expected
      groups = map length (group check)
  in groups