module HCube.Utility where
import Control.Monad (foldM, (>=>), liftM, liftM2)
import Data.List
import HCube.Data
import HCube.Common(padL)
(|*|) :: 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)
(|**|) :: 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 )
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)
cofactors :: Matrix -> Matrix
cofactors (Matrix (a,d,g) (b,e,h) (c,f,i))
= Matrix (e*if*h, c*hb*i, b*fc*e)
(f*gd*i, a*ic*g, c*da*f)
(d*he*g, b*ga*h, a*eb*d)
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 :: Matrix -> Matrix
inverse mx = multMatrix (det mx) . transposeM $ cofactors mx
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
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
maybeRead :: String -> Maybe Int
maybeRead = fmap fst . listToMaybe . reads
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]
sides = [UpS,DownS,FrontS,BackS,LeftS,RightS]
vecs = [(1,0,0),(0,1,0),(0,0,1),(1,0,0),(0,1,0),(0,0,1)] :: [Vec]
multVec :: Numb -> Vec -> Vec
multVec nm (v1,v2,v3) = (nm*v1, nm*v2, nm*v3)
mapVec :: (Vec -> Vec -> a) -> [Vec] -> a
mapVec fu (v1:v2:[]) = fu v1 v2
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
vecDet :: Vec -> Vec -> Vec -> Int
vecDet v1 v2 v3 = det $ Matrix v1 v2 v3
matrixMult :: Matrix -> Int -> Matrix
matrixMult (Matrix v1 v2 v3) ct = Matrix (f v1) (f v2) (f v3) where
f = multVec ct
cross :: Vec -> Vec -> Vec
cross (a,b,c) (x,y,z) = (b*zy*c,a*zc*x,a*yb*x)
minus :: Vec -> Vec
minus (a,b,c) = (a,b,c)
vcomp :: Vec -> Int
vcomp (vl,0,0) = vl
vcomp (0,vl,0) = vl
vcomp (0,0,vl) = vl
vcomp bd = error . show $ bd
vpos :: Vec -> Int
vpos (_,0,0) = 1
vpos (0,_,0) = 2
vpos (0,0,_) = 3
vpos bd = error . show $ bd
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