```-- |
-- Module      : Math.Sym.D8
-- Copyright   : (c) Anders Claesson 2012
-- License     : BSD-style
-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
--
-- The dihedral group of order 8 acting on permutations.
--
-- To avoid name clashes this module is best imported @qualified@;
-- e.g.
--
-- > import qualified Math.Sym.D8 as D8
--

module Math.Sym.D8
(
-- * The group elements
r0, r1, r2, r3
, s0, s1, s2, s3

-- * D8, the klein four-group, and orbits
, d8
, klein4
, orbit
, symmetryClasses
, d8Classes
, klein4Classes

-- * Aliases
, id
, rotate
, complement
, reverse
, inverse
) where

import Prelude hiding (reverse, id)
import Data.List (insert)
import Math.Sym (Perm (size), fromVector, act, normalize)
import qualified Math.Sym (inverse)
import Math.Sym.Internal (revIdperm)

-- The group elements
-- ------------------

-- | Ration by 0 degrees, i.e. the identity map.
r0 :: Perm a => a -> a
r0 w = w

-- | Ration by 90 degrees clockwise.
r1 :: Perm a => a -> a
r1 = s2 . s1

-- | Ration by 2*90 = 180 degrees clockwise.
r2 :: Perm a => a -> a
r2 = r1 . r1

-- | Ration by 3*90 = 270 degrees clockwise.
r3 :: Perm a => a -> a
r3 = r2 . r1

-- | Reflection through a horizontal axis (also called 'complement').
s0 :: Perm a => a -> a
s0 = r1 . s2

-- | Reflection through a vertical axis (also called 'reverse').
s1 :: Perm a => a -> a
s1 w = (fromVector . revIdperm . size) w `act` w

-- | Reflection through the main diagonal (also called 'inverse').
s2 :: Perm a => a -> a
s2 = Math.Sym.inverse

-- | Reflection through the anti-diagonal.
s3 :: Perm a => a -> a
s3 = s1 . r1

-- D8, the klein four-group, and orbits
-- ------------------------------------

-- | The dihedral group of order 8 (the symmetries of a square); that is,
--
-- > d8 = [r0, r1, r2, r3, s0, s1, s2, s3]
--
d8 :: Perm a => [a -> a]
d8 = [r0, r1, r2, r3, s0, s1, s2, s3]

-- | The Klein four-group (the symmetries of a non-equilateral
-- rectangle); that is,
--
-- > klein4 = [r0, r2, s0, s1]
--
klein4 :: Perm a => [a -> a]
klein4 = [r0, r2, s0, s1]

-- | @orbit fs x@ is the orbit of @x@ under the /group/ of function @fs@. E.g.,
--
-- > orbit klein4 "2314" == ["1423","2314","3241","4132"]
--
orbit :: (Ord a, Perm a) => [a -> a] -> a -> [a]
orbit fs x = normalize [ f x | f <- fs ]

-- | @symmetryClasses fs xs@ is the list of equivalence classes under
-- the action of the /group/ of functions @fs@.
symmetryClasses :: (Ord a, Perm a) => [a -> a] -> [a] -> [[a]]
symmetryClasses _  [] = []
symmetryClasses fs xs@(x:xt) = insert orb \$ symmetryClasses fs ys
where
orb = [ w | w <- orbit fs x, w `elem` xs ]
ys  = [ y | y <- xt, y `notElem` orb ]

-- | Symmetry classes with respect to D8.
d8Classes :: (Ord a, Perm a) => [a] -> [[a]]
d8Classes = symmetryClasses d8

-- | Symmetry classes with respect to Klein4
klein4Classes :: (Ord a, Perm a) => [a] -> [[a]]
klein4Classes = symmetryClasses klein4

-- Aliases
-- -------

-- | @id = r0@
id :: Perm a => a -> a
id = r0

-- | @rotate = r1@
rotate :: Perm a => a -> a
rotate = r1

-- | @complement = s0@
complement :: Perm a => a -> a
complement = s0

-- | @reverse = s1@
reverse :: Perm a => a -> a
reverse = s1

-- | @inverse = s2@
inverse :: Perm a => a -> a
inverse = s2
```