hcube-0.1.1: HCube/Utility.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  HCube.Utility
-- Copyright   :  (c) Todd Wegner 2012
-- License     :  BSD-style (see the LICENSE file)
-- 
-- Maintainer  :  echbar137@yahoo.co.in
-- Stability   :  provisional
-- Portability :  portable
--
-- Common utility functions, simple linear algebra. 
-----------------------------------------------------------------------------
{-# LANGUAGE Safe #-}

module HCube.Utility where

import Control.Monad (foldM, (>=>), liftM, liftM2)
import Data.List
import HCube.Data
import HCube.Common(padL)

-- | Returns square root of argument if argument is a perfect square. 
squareRoot		:: Int -> Maybe Int
squareRoot nn		= f 1 nn where
    f lo hi | lo > hi	= Nothing
	    | nn == h	= Just g
	    | nn < h	= f lo (g - 1)
	    | otherwise = f (g + 1) h where
	g		= (hi + lo) `div` 2
	h		= g * g

-- | Multiple a matrix on the left side of a vector.
(|*|)		:: Matrix -> Vec -> Vec
(|*|)(Matrix (a,d,g) (b,e,h) (c,f,i)) (x,y,z) = (a*x + b*y + c*z,
						 d*x + e*y + f*z,
						 g*x + h*y + i*z)

-- | Multiple two matrices.
(|**|)		:: Matrix -> Matrix -> Matrix
(|**|)(Matrix (a,d,g) (b,e,h) (c,f,i))
      (Matrix (j,m,p) (k,n,q) (l,o,r)) = Matrix (a*j + b*m + c*p, d*j + e*m + f*p, g*j + h*m + i*p)
						(a*k + b*n + c*q, d*k + e*n + f*q, g*k + h*n + i*q)
						(a*l + b*l + c*r, d*l + e*o + f*r, g*l + h*o + i*r )

-- | Multiple a matrix by a scalar.
multMatrix	:: Numb -> Matrix -> Matrix
multMatrix nm (Matrix (a,d,g) (b,e,h) (c,f,i)) = Matrix (nm*a,nm*d,nm*g)
							(nm*b,nm*e,h)
							(nm*c,nm*f,nm*i)
-- | The cofactor of a matrix.
cofactors	:: Matrix -> Matrix
cofactors (Matrix (a,d,g) (b,e,h) (c,f,i))
					= Matrix (e*i-f*h, c*h-b*i, b*f-c*e)
						 (f*g-d*i, a*i-c*g, c*d-a*f)
						 (d*h-e*g, b*g-a*h, a*e-b*d) 
-- | Transpose of a matrix.
transposeM	:: Matrix -> Matrix
transposeM (Matrix (a,d,g) (b,e,h) (c,f,i))  = Matrix (a,b,c) (d,e,f) (g,h,i)

-- | Inverse of a matrix.
inverse		:: Matrix -> Matrix
inverse mx	= multMatrix (det mx) . transposeM $ cofactors mx 

-- | Display a matrix.
showM			:: Matrix -> String
showM (Matrix (a,d,g) (b,e,h) (c,f,i)) = concat y where
    y		= [z a, z d, z g, "   ", z b, z e, z h, "   ", z c, z f, z i]
    z 		= padL 3 . show

doM			:: Monad m => (a -> Bool) -> (a -> m a) -> a -> m a
doM te lp		= lp >=> \s-> if te s then doM te lp s else return s

-- Inject operator
infixl 1 ~>
(~>)			:: Monad m => m a -> (a -> b -> m b) -> b -> m b
(~>) op fu st		= op >>= \s -> fu s st

(~|)			:: Monad m => (a -> m b) -> a -> m a
(~|) fu a		= fu a >> return a

infixl 4 <*
(<*)			:: Monad m => m a -> m b -> m a
(<*)			= liftM2 const

concatMapM		:: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM bbf		= liftM concat . mapM bbf

listToMaybe           :: [a] -> Maybe a
listToMaybe []        =  Nothing
listToMaybe (a:_)     =  Just a

-- | A safe form of read.
maybeRead :: String -> Maybe Int
maybeRead = fmap fst . listToMaybe . reads

-- | Applies a function on the domain of Side x Side.
spanFaces 		:: (Enum a, Num a, Ord b) =>
			   (Side -> Side -> b) -> [(a, b)]
spanFaces fn		= zip [1..] $ sort $ f where
	f		= [fn a b | a <- sides, b <- sides, a /=b]
-- | List of the sides.
sides			= [UpS,DownS,FrontS,BackS,LeftS,RightS]

-- | List of the vectors.
vecs			= [(1,0,0),(0,1,0),(0,0,1),(-1,0,0),(0,-1,0),(0,0,-1)] :: [Vec]

-- | Multiple a vector by a scalar.
multVec			:: Numb -> Vec -> Vec
multVec nm (v1,v2,v3)	= (nm*v1, nm*v2, nm*v3)

-- | Convert a function with two vector arguments to one accepting a list of vectors.
mapVec			:: (Vec -> Vec -> a) -> [Vec] -> a
mapVec fu (v1:v2:[]) 	= fu v1 v2

-- | The determinate of a matrix.
det			:: Matrix -> Int
det (Matrix (a,d,g) (b,e,h) (c,f,i)) = a*e*i + b*f*g + c*d*h - c*e*g - b*d*i - a*f*h

-- | Calculate the determinate of a matrix constructed by three column vectors.
vecDet			:: Vec -> Vec -> Vec -> Int
vecDet v1 v2 v3		= det $ Matrix v1 v2 v3

-- | Multiple a matrix by a scalar.
matrixMult		:: Matrix -> Int -> Matrix
matrixMult (Matrix v1 v2 v3) ct = Matrix (f v1) (f v2) (f v3) where
    f			= multVec ct

-- |The cross product of two vectors.
cross			:: Vec -> Vec -> Vec
cross (a,b,c) (x,y,z)	= (b*z-y*c,a*z-c*x,a*y-b*x)

-- |Vector multipled by scalar -1.
minus			:: Vec -> Vec
minus (a,b,c)		= (-a,-b,-c)

-- |Vectors we are interested in only have one non zero component. 
vcomp			:: Vec -> Int
vcomp (vl,0,0)		= vl
vcomp (0,vl,0)		= vl
vcomp (0,0,vl)		= vl
vcomp bd		= error . show $ bd

-- |Position of non-zero vector component.
vpos			:: Vec -> Int
vpos (_,0,0)		= 1
vpos (0,_,0)		= 2
vpos (0,0,_)		= 3
vpos bd			= error . show $ bd

-- | The dot product of two vectors.
dot			:: Vec -> Vec -> Numb
dot (a,b,c) (x,y,z)     = a*x + b*y + c*z
	
gateMinus		:: Numb -> Vec -> Vec
gateMinus ct		= f $ ct < 0 where
	f True		= minus
	f False		= id


modMinus		:: Numb -> Numb -> Vec -> Vec
modMinus cd ts 		= f $ cd `mod` ts where
	f 0		= minus
	f _		= id

modNot			:: Numb -> Numb -> Numb
modNot cd ts		= f $ cd `mod` ts where
	f 0		= 1
	f _		= 0