Rubiks Cube

Rubik's Cube represented with faces

Here is a simple model for a Rubik's Cube.

The basic idea is that you only need to keep track of the corners and edges. Each corner has three faces. Each edge has two faces. Keeping track of a face means telling where it was before any moves were made and where it is in the current state.

Choose, as a convention, the ordering, right, up, front. (Math/Physics folk: this is in anology to the "right hand rule" convention which assigns an ordering to the "x y and z" axes and determines that z will be "out of" rather than "into" the plane)

For example, the lower left front corner would be represented as (Left Left) (Down Down) (Front Front) before any moves are made Then, after a rotation about the Front face, the same corner, now in the right down front position would be represented as (Left Down) (Down Right) (Front Front).

Edit by somebody else: I'm not the author of this, however I think there are some erros in the definition of all the datas below. I think they all are missing the constructor, when you're reading the code keep that in mind. also:

You can read the paper by Richard E. Korf named "Finding Optimal Solutions to Rubik's Cube Using Pattern Databases."[1] to have a better understanding of the Edged/Corners approach

#!/usr/bin/runhugs
module Main (main) where
main                    :: IO ()
main =  do putStr "Not your ordinary language"

data Cube = Edges Corners

type Edges = [Edge]
-- or Edges = Edge Edge Edge Edge Edge Edge Edge Edge Edge Edge Edge Edge

type Corners = [Corner]

data Edge = Face Face

data Corner = Face Face Face

data Face = Was Is

data Was = R|L|U|D|F|B
data Is =  R|L|U|D|F|B

Rubik's Cube as space transformation, with a solver

by Péter Diviánszky

A Rubik's Cube configuration can be seen as a space transformation, which tells how to transform the space such that the faces of original cube are moved onto the faces of the current configuration.

type CubeFun = (Int, Int, Int) -> (Int, Int, Int)

The identity function represents the original cube.

The vertices of original cube are (+-10,+-10,+-10). The cube is magnified by 10, because I wanted to avoid floating point calculation. The smaller lengths are used to explore how the space transformation alters directions around a point in space.

The colors are represented with space directions. For example, the direction (1,0,0) is the color of the face (10,-10,-10)-(10,10,-10)-(10,10,10)-(10,-10,10) of the original cube. This direction is called 'x'. 'X' is the opposite direction. 'y', 'Y', 'z', 'Z' corresponds to the other colors, respectively.

The rotations are also represented with space directions. For example 'x' represents one quarter move of the top face around the 'x' axis in positive direction. 'X' represents one quarter move of the opposite face around the 'x' axis in negative direction. 'y', 'Y', 'z', 'Z' corresponds to other rotations, respectively.

Here is the full source code implementing the moves, a solver, a reader and a pretty printer:

import Data.List
import Data.Maybe
import System.Environment

div10 x = (x + 5) `div` 10
mod10 x = (x + 5) `mod` 10 - 5

map3 f (x, y, z) = (f x, f y, f z)
zipW3 (*) (x, y, z) (x', y', z') = (x * x', y * y', z * z')
inner p q = x + y + z where (x, y, z) = zipW3 (*) p q
rot3 [a, b, c] p = map3 (inner p . dirVec) (a, b, c)

dirVec 'x' = ( 1, 0, 0)
dirVec 'y' = ( 0, 1, 0)
dirVec 'z' = ( 0, 0, 1)
dirVec 'X' = (-1, 0, 0)
dirVec 'Y' = ( 0,-1, 0)
dirVec 'Z' = ( 0, 0,-1)
dirVec '-' = ( 0, 0, 0)

type CubeFun = (Int, Int, Int) -> (Int, Int, Int)

cubeAt p x | map3 div10 x == p = x
cubeAt _ x = map3 ((10*) . div10) x

faces = map words [" -  Zyx  -   - "
                  ,"yXz xyz Yxz XYz"
                  ," -  zyX  -   - "]

readCube :: String -> CubeFun
readCube s p = foldr1 (zipW3 (+))
    [ map3 (* if dirVec q == map3 mod10 p then 11 else 10) $
        dirVec $ lines s !! (4*l - y + 1) !! (7*c + 2*(x + 1))
    | (l, face) <- zip [2,1,0] faces
    , (c, m@[q,_,_]) <- zip [2,1,0,3] face
    , (1, x, y) <- [rot3 m $ map3 div10 p] ]

showCube :: CubeFun -> String
showCube c = unlines $ map (unlines . map unwords . transpose . map face) faces
  where
    face "-" = replicate 3 "      "
    face f = [ unwords [ filter ((== map3 mod10 (c $ rot3 f (11, x, y))) . dirVec) "xyzXYZ-"
                       | x <- [-10,0,10]] ++ " "
             | y <- [10,0,-10]]

decodeCube :: [Char] -> CubeFun
decodeCube = foldr (.) id . map rot
  where
    rot d p | div10 (dirVec d `inner` p) <= 0 = p
    rot d p = rot3 (fromJust $ lookup d $ zip "xyzXYZ" $ words "xZy zyX Yxz xzY Zyx yXz") p

encodeCube :: CubeFun -> Maybe [Char]
encodeCube cfun = listToMaybe $ filter (\c -> showCube (cfun . decodeCube c) == showCube id)
  $ foldl (flip $ concatMap . solvePiece) [""] $ map unzip $ init $ tails
    [(( 1,-1, 1),"x")
    ,(( 1,-1,-1),"Z")
    ,(( 1, 1, 1),"y")
    ,(( 1, 1,-1),"yyzzxxyyXXzzzXXyyxxzzyZyyyZZyyyZyyy")
    ,(( 0, 1,-1),"yyZZyyZZzxxYYZYYzzzYzzYYYxxZZyXX")
    ,(( 0, 1, 1),"zzzYYxxyyZXXyyxxzz")
    ,((-1,-1,-1),"X")
    ,(( 1, 1, 0),"zxxZzXXZZYXXzzxxyyyZZZ")
    ,((-1, 1,-1),"ZZzxxyyzyyZZZxxYYzXzzzXXXYYYzzXXYYYXXZZZzzz")
    ,(( 0,-1,-1),"ZZyyzzzYYyyZyyzzyyyZYYyyzzzy")
    ,(( 1, 0,-1),"zzzyyXXyyzzYYxxyyZZZyyyZYYyyzzzy")
    ,((-1,-1, 1),"XXZXXZZZyyzyyyzzzXXzzzXXzyyy zzxxZZZYYzXXZZZXXYYzzzxxxyyxxxZzzzyXXyyyzzz")
    ,((-1,-1, 0),"yyxxZZyyzzXYYzzyyxxxyy")
    ,((-1, 0,-1),"YYZZZXXZYYyyzzzxxzYYyyyZYYyyzzzy")
    ,((-1, 1, 0),"ZZZYYXXyyzzYYxxZZZzzzyxxzzxxyz")
    ,(( 0,-1, 1),"xxzzzyyXXYYZYYXXyyzzxx")
    ,(( 1,-1, 0),"ZyyxxYYZZYYxxZZZzzzyzzxxzzyzzz")
    ,(( 1, 0, 1),"YyyyxYyyyZYyyyXXYYYyZYYYyxYYYyzz")]
  where
    solvePiece (fixed: _, moves) p = try [] [""]
      where
        try _ [] = []
        try acc (p': cs)
            | sc `elem` acc = try acc cs
            | sc == showCube (cubeAt fixed) = [p' ++ p]
            | otherwise = try (sc: acc) $ cs ++ map (p' ++) (moves >>= words)
          where
            sc = showCube $ cubeAt fixed . decodeCube p' . decodeCube p . cfun

main = do
    args <- getArgs
    c <- case args of
      [s] | all (`elem` "xyzXYZ") s -> pure $ decodeCube s
          | otherwise -> readCube <$> readFile s
    putStr $ showCube c
    putStrLn $ maybe "not solvable" ("solution: " ++) $ encodeCube c

A sample input file:

       Z x x               
       x z y               
       z Y Y               

X Y x  y X Z  x Z Z  y y Y 
z Y Y  Z x X  z y z  x X y 
x x Y  X y Z  y Z X  y Y z 

       z X X               
       Z Z X               
       Y z z               

The corresponding output (the solution is not normalized):

solution: YyyyxYyyyZYyyyXXYYYyZYYYyxYYYyzzxxzzzyyXXYYZYYXXyyzzxxZZZYYXXyyzzYYxxZZZzzzyxxzzxxyzZZZYYXXyyzzYYxxZZZzzzyxxzzxxyzZyyxxYYZZYYxxZZZzzzyzzxxzzyzzzYYZZZXXZYYyyzzzxxzYYyyyZYYyyzzzyxxzzzyyXXYYZYYXXyyzzxxyyxxZZyyzzXYYzzyyxxxyyYYZZZXXZYYyyzzzxxzYYyyyZYYyyzzzyXXZXXZZZyyzyyyzzzXXzzzXXzyyyzzzyyXXyyzzYYxxyyZZZyyyZYYyyzzzyZZyyzzzYYyyZyyzzyyyZYYyyzzzyyyxxZZyyzzXYYzzyyxxxyyyyxxZZyyzzXYYzzyyxxxyyZZzxxyyzyyZZZxxYYzXzzzXXXYYYzzXXYYYXXZZZzzzXXZXXZZZyyzyyyzzzXXzzzXXzyyyXXZXXZZZyyzyyyzzzXXzzzXXzyyyzxxZzXXZZYXXzzxxyyyZZZZZzxxyyzyyZZZxxYYzXzzzXXXYYYzzXXYYYXXZZZzzzZZzxxyyzyyZZZxxYYzXzzzXXXYYYzzXXYYYXXZZZzzzXZZzxxyyzyyZZZxxYYzXzzzXXXYYYzzXXYYYXXZZZzzzzzzYYxxyyZXXyyxxzzXzxxZzXXZZYXXzzxxyyyZZZyyZZyyZZzxxYYZYYzzzYzzYYYxxZZyXXzxxZzXXZZYXXzzxxyyyZZZXyyzzxxyyXXzzzXXyyxxzzyZyyyZZyyyZyyyyyzzxxyyXXzzzXXyyxxzzyZyyyZZyyyZyyyyyZZyyZZzxxYYZYYzzzYzzYYYxxZZyXXyZZyyzzxxyyXXzzzXXyyxxzzyZyyyZZyyyZyyyXxyyyzzxxyyXXzzzXXyyxxzzyZyyyZZyyyZyyyy