module HCube.Theory (
displayColors,
displayOrientVecMapping,
displayOrientTransforms,
displayOrientMatrices,
displayColorToOrient,
displayOrientI,
displayOrientP,
displayColorTags,
displayFaceIds
) where
import Data.Monoid ( (<>) )
import Data.List (sort)
import HCube.Lib (getPos, consCubeInfo, solvedSurf, cubeIdsOfFace)
import HCube.Data (Side, Color, sideToColor,Size, Matrix)
import HCube.Utility
import HCube.Cons
import HCube.OrientGroup
import HCube.Common
displayColors :: IO ()
displayColors = putStrLn . unlines $ map f sides where
f sd = concat [prShow 8 sd, prShow 9 $ sideToVec sd, show $ sideToColor sd]
displayOrientVecMapping :: IO ()
displayOrientVecMapping = dispLis f $ spanDomain g where
f (id1,(id2,ch,v1,v2,rw, f1, f2, cl))
= concat [prShow 11 v1,
prShow 11 v2,
prShow 10 f1,
prShow 10 f2,
cl,
plShow 7 rw, " ",
plShow 4 id1, " ",
[ch] ]
g or@(Orient (v1:v2:[]))
= (h, eid or, v1, v2, rawOrientNum or,
vecToSide v1, vecToSide v2,
i v1 ++ i v2) where
h = rawToOrientNumber $ rawOrientNum or
i = show . vecToColor
displayOrientTransforms = putStrLn . unlines . twoPagesOnOne "\t\t" $ map f g where
f (oc,sf,st) = concat [oc, " ", i 8 sf, i 8 st]
g = map h [(or,sd) | or <- orientChrDomain, sd <- sides]
h (oi,sd) = ([oi],sd, vecToSide i) where
i = (to . cons $ oi) |*| (sideToVec sd)
i = prShow
displayOrientMatrices = putStrLn . unlines $ map f g where
f (oc, mx) = concat [oc, " ", showM mx, "\t", show $ det mx]
g = map h orientChrDomain
h oi = ([oi], to . cons $ oi)
displayColorToOrient :: IO ()
displayColorToOrient = writeFile "store/colorToOrient" $ unlines . twoPagesOnOne "\t\t"
. sort . map f $ map g sideColorDomain where
f (((fd1,cl1),(fd2,cl2)), vs)
= concat [show cl1 ++ show cl2, " ",
k 9 fd1,
k 8 fd2,
[eid $ Orient vs]]
g sc@(sc1,sc2) = (sc, getVec $ consOrient sc1 sc2)
i = "\t"
j = show . vecToColor
k = prShow
sideColorDomain :: [((Side, Color), (Side, Color))]
sideColorDomain = [(x,y) | x <-f, y <-f, x /=y, g x y] where
f = [(sd1, sideToColor sd2) | sd1 <- sides, sd2 <-sides]
g (sd1,cl1) (sd2,cl2) = h (i sd1) (j cl1) (i sd2) (j cl2)
h v1 u1 v2 u2 = v1 /= v2 && u1 /= u2 && v1 /= minus v2 && u1 /= minus u2
i = sideToVec
j = colorToVec
displayOrientI = putStrLn . unlines $ twoPagesOnOne "\t\t" [g e1 | e1 <- f] where
f = map cons ['a'..'x'] :: [Orient]
g e1 = concat ["inv ", [eid e1], " = ", [eid $ inv e1]]
displayOrientP = putStrLn . unlines $ h [g e1 e2 | e1 <- f, e2 <- f] where
f = map cons ['a'..'x'] :: [Orient]
g e1 e2 = concat [ [eid e1], " x ", [eid e2], " = ", [eid $ e1 <> e2]]
h = fourPagesOnOne "\t"
displayColorTags :: Size -> IO ()
displayColorTags n = putStrLn . unlines . twoPagesOnOne "\t\t"
. map f $ consCubeInfo n (solvedSurf n) where
f (a,b,c) = concat [plShow 3 a, "\t", prShow 8 $ getPos n a, "\t" ++ c]
displayFaceIds :: Size -> IO ()
displayFaceIds n = putStrLn . unlines . twoPagesOnOne "\t\t" $ concatMap f sides where
f sd = map g . zip [1..] $ cubeIdsOfFace n sd where
g (fi, cis) = concat [prShow 10 sd, prShow 10 fi, plShow 2 cis]
dispLis :: (a -> String) -> [a] -> IO ()
dispLis fu = putStrLn . unlines . map fu