HappyCube Puzzle Solver

Question

This challenge is inspired by a puzzle I played, consisting of foam pieces like these:

which have to be assembled into 3D cubes, like these:

The puzzle pieces can be viewed as grids of 5 * 5 squares, whose middle 3 * 3 squares are always solid, while the 16 squares on the edges can be solid or empty.

A piece will be described using a string of 16 characters (0s and 1s), representing the configuration of its edges (0=empty, 1=solid), in clockwise order, starting from the top left corner.

For example, the string:

0101001000101101

represents this piece:

 # #
####
 ####
####
# #

In order to fit the pieces together to form the cube, every piece can be rotated in any direction. For example, these are the valid rotations of the piece shown above:

 # #    # #     #    ## # 
 ####  ####    ####   ####
####    ####  ####   #### 
 ####  ####    ####   ####
  # #  # #    ## #     #  

# #      # #   # ##    #  
####    ####  ####   #### 
 ####  ####    ####   ####
####    ####  ####   #### 
 # #    # #     #     # ##

Challenge

Write a program or function that takes as input 6 puzzle pieces and prints or returns a 2D representation of the solved cube.

Input

The input will be a string of 6 rows, where each row consists of 16 0 or 1 characters, representing a piece's edges (in the format described above).

It can be assumed that there is a solution for the input.

The trailing newline is optional.

Output

The result will be an ASCII representation of the solved cube, unfolded in 2D, like this (the diagram uses Rubik's Cube notation for side names):

    +---+
    |BA |
    |CK |
    |   |
+---+---+---+---+
|LE |DO |RI |UP |
|FT |WN |GHT|   |
|   |   |   |   |
+---+---+---+---+
    |FR |
    |ONT|
    |   |
    +---+

To avoid the possibility of presenting the solution in multiple ways, the piece placed DOWN will always be the first piece present in the input, in the same rotation as it is specified there.

Every piece will be represented graphically as a 5 * 5 matrix, using spaces to denote empty squares. For solid squares you can use whatever non-space character you wish, as long as:

• any piece of the puzzle will have its solid squares represented using the same character
• any two adjacent pieces use different characters

Space padding to the right and the trailing newline are optional.

Test Cases

1.

Input:

0010010101010101
0010001011011010
0101001001010010
0010110100101101
0010110110101101
0010001011010101

Output:

     @ @         
     @@@         
    @@@@@        
     @@@         
** **@#@** *# #  
 ***#####***#####
*****###*****### 
 ***#####***#####
  * @#@#** ** # #
    @@@@         
     @@@@        
    @@@@         
     @ @         

2.

Input:

0001110110101101
1010010111011101
0101010101010010
1010001000100011
1010001001010001
0110010100100010

Output:

      @          
     @@@@        
    @@@@         
     @@@@        
** **@@## * *# # 
****#####****### 
 ****###*****####
****#####***#### 
** *#@#@# * # #  
     @@@@        
    @@@@         
     @@@@        
     @ @         

3.

Input:

0101001011011010
0010001000100010
0101001011010010
0101010101011010
0101101001011101
1010001001011101

Output:

     @ @@        
    @@@@@        
     @@@         
    @@@@@        
* * @#@#* *   #  
*****###*****### 
 ***#####***#####
*****###*****### 
  * ##@##* *  #  
    @@@@         
     @@@@        
    @@@@         
    @@ @@        

This is codegolf, so the shortest program in bytes wins.

Answer 1

Haskell, 1007 One Thousand and One Bytes 923 900 830 bytes

I happened to have already made a happycube solver, now I just need to golf it. Taking a ten byte penalty for using fancy block elements:

import Data.List
r=reverse;z=zipWith;f=foldl1;t=take;g=t 4;d=drop;m=map
n x=t 5x:n(d 4x)
u v a b=init a++v max(last a)(b!!0):d 1b
a!b|k<- \x y->last$' ':[a|b!!x!!y>0]=(k 0<$>[0..4]):((\i->k 3(4-i):[a,a,a]++[k 1i])<$>[1..3])++[k 2<$>[4,3..0]]
p y|(e:v)<-m(g.n.cycle.m(read.pure))$"0":(lines$y),[j,k,l,x,y,r]<-x v=mapM putStrLn$f(u z)$f(z(u id))<$>z(z(!))[a,"▒█▒█",a][[e,k,e,e],[l,j,x,r],[e,y,e,e]];a=" ░  "
x(p:q)=[p:u|x<-permutations q,u@[e,g,y,k,l]<-sequence$(\c->nub$[c,r.m r$c]>>=g.m g.tails.cycle)<$>x,and$zipWith4(\a n b m->all(==1).init.d 1$z(+)(a!!n)$r$b!!m)([l,e,p,p,p,p,e]++u)[3,3,0,3,1,2,0,1,2,2,2,1](y:g:u++[y,k,k,l,g])[1,0,2,1,3,0,0,0,3,1,2,3]++z((((==1).sum.m(!!0)).).z(!!))[[p,e,g],[y,p,e],[k,p,g],[k,p,y],[l,y,e],[l,y,k],[l,g,e],[l,g,k]][[0,3,1],[0..2],[0,3,2],[1..3],[0,1,1],[3,2,2],[1,0,0],[2,3,3]]]!!0

That's a mouthful. Usage:

*Main> mapM_ (\s->p s>>putStrLn"")["0010010101010101\n0010001011011010\n0101001001010010\n0010110100101101\n0010110110101101\n0010001011010101","0001110110101101\n1010010111011101\n0101010101010010\n1010001000100011\n1010001001010001\n0110010100100010","0101001011011010\n0010001000100010\n0101001011010010\n0101010101011010\n0101101001011101\n1010001001011101"]
     ░ ░      
     ░░░      
    ░░░░░     
     ░░░      
▒▒ ▒▒░█░▒▒ ▒█ █
 ▒▒▒█████▒▒▒█████
▒▒▒▒▒███▒▒▒▒▒███
 ▒▒▒█████▒▒▒█████
  ▒ ░█░█▒▒ ▒▒ █ █
    ░░░░      
     ░░░░     
    ░░░░      
     ░ ░      

      ░       
     ░░░░     
    ░░░░      
     ░░░░     
▒▒ ▒▒░░██ ▒ ▒█ █
▒▒▒▒█████▒▒▒▒███
 ▒▒▒▒███▒▒▒▒▒████
▒▒▒▒█████▒▒▒████
▒▒ ▒█░█░█ ▒ █ █
     ░░░░     
    ░░░░      
     ░░░░     
     ░ ░      

    ░░ ░      
    ░░░░░     
     ░░░      
    ░░░░░     
  ▒ ▒█░█░ ▒ ▒ █
▒▒▒▒▒███▒▒▒▒▒███
 ▒▒▒█████▒▒▒█████
▒▒▒▒▒███▒▒▒▒▒███
 ▒ ▒██░██ ▒   █
     ░░░░     
    ░░░░      
     ░░░░     
    ░░ ░░     

Some of the examples have more than one solutions, that's why some of the outputs look different. Ungolfed:

import Data.List (nub, transpose, (\\))
import Control.Monad (guard)

newtype CubePiece = CubePiece [[Int]] deriving Eq
newtype Solution = Solution [CubePiece]

side :: Int -> CubePiece -> [Int]
side n (CubePiece c) = c!!n

corner :: Int -> CubePiece -> Int
corner n (CubePiece c) = head $ c!!n

strToCube str = CubePiece $ hs' . (\x@(a:_)->x++[a]) $ l
  where
    l = map (read.pure) str
    hs' [a] = []
    hs' x = take 5 x : hs' (drop 4 x)

orientations :: CubePiece -> [CubePiece]
orientations (CubePiece cube) = map CubePiece $ nub $ (take 4 . iterate rotate $ cube) ++
  (take 4 . iterate rotate . reverse . map reverse $ cube)
  where
  rotate (a:as) = as++[a]

sideFits ::  (CubePiece, Int) -> (CubePiece, Int) -> Bool
sideFits (c1,n1) (c2,n2) = case (zipWith (+) a b) of
  [_,1,1,1,_] -> True
  _ -> False
  where
  a = side n1 c1
  b = reverse $ side n2 c2

cornerFits :: (CubePiece, Int) -> (CubePiece, Int) -> (CubePiece, Int) -> Bool
cornerFits (c1,n1) (c2,n2) (c3,n3) = a + b + c == 1
  where
  a = corner n1 c1
  b = corner n2 c2
  c = corner n3 c3

printSolution str = putStrLn . specialUnlines . map rivi $
  [[empty,gshow '░' c2,empty,empty],[gshow '▒' c3,gshow '█'c1,gshow '▒'c4,gshow '█'c6],[empty,gshow '░'c5,empty,empty]]
  where
  Solution [c1,c2,c3,c4,c5,c6] = solve . map strToCube . lines $ str
  empty = replicate 5 "     "
  rivi = map (foldl1 specialConcat) . transpose
  specialUnlines = unlines . foldl1(\a b->init a++[zipWith max(last a)(head b)]++tail b)
  specialConcat a b
    | last a==' '=init a++b
    | otherwise = a++tail b

gshow char (CubePiece c) =
  [ map (k 0) [0..4]
  , (k 3 3) : m ++ [(k 1 1)]
  , (k 3 2) : m ++ [(k 1 2)]
  , (k 3 1) : m ++ [(k 1 3)]
  , map (k 2)[4,3..0]
  ]
  where
  k n1 n2 = if (c!!n1)!!n2 == 1 then char else ' '
  m=replicate 3 char

solve :: [CubePiece] -> Solution
solve pieces = Solution $ head $ do
  let c1' = pieces!!0
  let c1 = c1'

  c2'  <- pieces \\ [c1']
  c2   <- orientations c2'
  guard $ sideFits (c1,0) (c2,2)

  c3'  <- pieces \\ [c1',c2']
  c3   <- orientations c3'
  guard $ sideFits (c1,3) (c3,1)
  guard $ sideFits (c2,3) (c3,0)
  guard $ cornerFits (c1,0) (c2,3) (c3,1)

  c4'  <- pieces \\ [c1',c2',c3']
  c4   <- orientations c4'
  guard $ sideFits (c1,1) (c4,3)
  guard $ sideFits (c2,1) (c4,0)
  guard $ cornerFits (c1,1) (c2,2) (c4,0)
  c5' <- pieces \\ [c1',c2',c3',c4']
  c5 <- orientations c5'
  guard $ sideFits (c1,2) (c5,0)
  guard $ sideFits (c4,2) (c5,1)
  guard $ sideFits (c3,2) (c5,3)
  guard $ cornerFits (c5,0) (c1,3) (c3,2)
  guard $ cornerFits (c5,1) (c1,2) (c4,3)

  c6' <- pieces \\ [c1',c2',c3',c4',c5']
  c6 <- orientations c6'
  guard $ sideFits (c6,0) (c2,0)
  guard $ sideFits (c6,1) (c3,3)
  guard $ sideFits (c6,2) (c5,2)
  guard $ sideFits (c6,3) (c4,1)
  guard $ cornerFits (c6,0) (c4,1) (c2,1)
  guard $ cornerFits (c6,3) (c4,2) (c5,2)
  guard $ cornerFits (c6,1) (c3,0) (c2,0)
  guard $ cornerFits (c6,2) (c3,3) (c5,3)
  return $ [c1,c2,c3,c4,c5,c6]

main = mapM_ printSolution ["0010010101010101\n0010001011011010\n0101001001010010\n0010110100101101\n0010110110101101\n0010001011010101","0001110110101101\n1010010111011101\n0101010101010010\n1010001000100011\n1010001001010001\n0110010100100010","0101001011011010\n0010001000100010\n0101001011010010\n0101010101011010\n0101101001011101\n1010001001011101"]

Answer 2

Python3, 1098 bytes:

E=enumerate
H=range
R=lambda x,n=4:set()if n==0 else{str(x),*R([i[::-1]for i in zip(*x)],n-1)}
def B(i):k=[[[' ','#'][int(j)]for j in i[t:t+4]]for t in H(0,16,4)];return[k[0]+[k[1][0]],*[[a,*('#'*3),b]for a,b in zip(k[3][::-1][:-1],k[1][1:])],[k[3][::-1][-1]]+k[2][::-1]]
V=lambda U,x,y,r,i,R,I:all((0<I<4 and A!=B)or(I in[0,4]and(A!=B or(A==' 'and B==' ')))for I,(A,B)in E(zip([U[x],[*zip(*U[x])]][r][i],[U[y],[*zip(*U[y])]][R][I])))
def L(M):
 b=[[' 'for _ in H(17)]for _ in H(13)]
 for P,(x,y),C in zip(M,[(4,4),(4,0),(0,4),(4,8),(8,4),(4,12)],'#@*&$%'):
  for X in H(5):
   for Y in H(5):b[x+X][y+Y]=[C,b[x+X][y+Y]][P[X][Y]==' ']
 return b
def f(p):
 s,*p=[B(i)for i in p.split('\n')]
 q=[([s],p)]
 while q:
  M,p=q.pop(0)
  if len(M)==6:
   for i in M:return L(M)
  for i,a in E(p):
   for P in{*R(a),*R([j[::-1]for j in a])}:
    U=M+[eval(P)]
    if all(V(U,*j)for j in[(1,0,1,4,1,0),(2,0,0,4,0,0),(3,0,1,0,1,4),(4,0,0,0,0,4),(5,3,1,0,1,4),(1,2,0,0,1,0),(2,3,1,4,0,0),(3,4,0,4,1,4),(1,4,0,4,1,0),(1,5,1,0,1,4),(2,5,0,0,0,0),(4,5,0,4,0,4)]if j[0]<len(U)and j[1]<len(U)):q+=[(U,p[:i]+p[i+1:])]

Try it online!