-----------------------------------------------------------------------------
-- |
-- Module      :  HCube.OrientGroup
-- Copyright   :  (c) Todd Wegner 2012
-- License     :  BSD-style (see the LICENSE file)
-- 
-- Maintainer  :  echbar137@yahoo.co.in
-- Stability   :  provisional
-- Portability :  portable
--
-- Orientation group is used to represent orientation of cubies, and cube as a
-- whole. 
-----------------------------------------------------------------------------

{-# LANGUAGE Safe, MultiParamTypeClasses, FlexibleContexts #-}

module HCube.OrientGroup (
	Group(..), 
	Orient(..),
	cons,
	to,
	eid,
	getVec,
	vecToSide,
	sideToVec,
	rawToOrientNumber,
	orientNumberToRaw,
	rawOrientNum,
	spanDomain,
	vecToColor,
	colorToVec,
	orientChrDomain,
) where

import Data.Monoid
import Data.List (find,sort)
import Data.Char (ord, chr)
import HCube.Data
import HCube.Utility

-- | List of names for elements of the orientation group.
orientChrDomain		= ['a'..'x']

-- | Two vector representation of orientation.
getVec			:: Orient -> [Vec]
getVec (Orient vs)	= vs

-- | Logical extension of Monoid to a group.
class Monoid a => Group a where
    inv			:: a -> a

-- | Representation of Cubie orientation.
data Orient = Orient [Vec] deriving (Show, Read, Eq)

{-
instance Show Orient where
    show (Orient or)	= show or

instance Read Orient where
    readsPrec _ 	= \s -> [(Orient . rd $ s, s)] 
-}

instance Monoid Orient  where
    mempty 		= Orient [(1,0,0),(0,1,0)] 
    mappend lhs rhs 	= from $ (to lhs |**| to rhs)

instance Group Orient where
    inv 		= from . inverse . to

-- | Maps an element of the orientation group to a matrix.
-- Orient tranformation matrix is determined by specifing, (1,0,0) goes to v1 and (0,1,0) goes to v2.
to			:: Orient -> Matrix
to ori			= mapVec f (getVec ori) where
	f v1 v2		= Matrix v1 v2 g where
	    g		= multVec (vecDet v1 v2 h) h 
	    h		= cross v1 v2

-- | Maps a matrix representation of an element of the orientation group to
-- | a two vector representation.
from			:: Matrix -> Orient
from mx			= Orient $ map (mx |*|) (getVec $ mempty)

-- | Gives the name of an element of the orientation group.
eid			:: Orient -> Char
eid 			= f . rawToOrientNumber . rawOrientNum where
    f 0			= '-'
    f nm		= chr $ nm - 1 + ord 'a'

-- | Constructs an element of the orientation group from the name.
cons			:: Char -> Orient
cons 			= Orient . f . orientNumberToRaw . g where
    f cd		= [i . j $ (h 2, h 3, h 5), j (h 7, h 11,h 13)] where
	    h		= modNot cd
	    i		= gateMinus cd
	    j		= modMinus cd 17
    g ch		= ord ch + 1 - ord 'a' 

-- | Inverse of sideToVec.
vecToSide		:: Vec -> Side
vecToSide (1,0,0)	= RightS
vecToSide (-1,0,0)   	= LeftS
vecToSide (0,1,0)	= BackS
vecToSide (0,-1,0)	= FrontS
vecToSide (0,0,1)	= UpS
vecToSide (0,0,-1)	= DownS
vecToSide (0,0,0)	= NoSide

-- | Associates a side to a vector.
sideToVec		:: Side -> Vec
sideToVec RightS	= (1,0,0)
sideToVec LeftS		= (-1,0,0)
sideToVec BackS		= (0,1,0)
sideToVec FrontS	= (0,-1,0)
sideToVec UpS		= (0,0,1)
sideToVec DownS		= (0,0,-1)
sideToVec NoSide	= (0,0,0)

-- | Gives the color of the side identified by the vector, in a solved state.
colorToVec		:: Color -> Vec
colorToVec		= sideToVec . colorToSide 

-- | Inverse of colorToVec.
vecToColor		:: Vec -> Color
vecToColor		= sideToColor . vecToSide

-- | Raw number is an intermediate step in associating two vectors
-- to an orientation. The orientation number 1 corresponds to an orientation of ''a'' and so on.
rawToOrientNumber	:: Numb -> Numb
rawToOrientNumber nm	= maybe 0 fst f where
	f		= find (g nm) orientMap
	g nm el		= nm == snd el

-- | Inverse of rawToOrientNumber
orientNumberToRaw	:: Numb -> Numb
orientNumberToRaw nm	= maybe 0 snd f where 
	f		= find (g nm) orientMap
	g nm el		= nm == fst el 

-- | Maps a function of orientation over orient domain.
spanDomain 		:: (Enum a, Num a, Ord b) => (Orient -> b) -> [(a, b)]
spanDomain fn		= zip [1..] $ sort $ f where
	f		= [fn (Orient [a, b]) | a <- vecs, b <- vecs, a /=b, a /= minus b]

{-
[(1,-935),(2,-663),(3,-595),(4,-442),(5,-374),(6,-357),
 (7,-55),(8,-39),(9,-35),(10,-26),(11,-22),(12,-21),
(13,21),(14,22),(15,26),(16,35),(17,39),(18,55),
(19,357),(20,374),(21,442),(22,595),(23,663),(24,935)] -}
orientMap		:: [(Numb,Numb)]
orientMap		= spanDomain rawOrientNum

-- | Converts the orientation to the raw orientation number.
rawOrientNum		:: Orient -> Numb
rawOrientNum or		= mapVec f (getVec or) where
    f v1 v2		=  (dot v1 (2,3,5)) 
                           * (signDiscrim 17 $ dot v2 (7,11,13))

signDiscrim		:: Numb -> Numb -> Numb
signDiscrim sc	si
	| si < 0	= sc * si			
	| otherwise	= si