The Funny Cube: Some Solutions
Vector 17:2, page 35
Transcribed from the printed issue; not yet reviewed. Read it in the PDF of the issue, page 35
Introduction¶
The puzzle, proposed by Bernard Legrand and printed both on Vector Vol. 16 No. 3 and Les Nouvelles D’APL No. 32, is a simple yet interesting challenge. The attempts at cracking the problem of three French readers, including Mr. Legrand himself, have already been published by Les Nouvelles D’APL Vol. 33. It is our intention to review a few solutions from the readers of Vector.
Mr. Coquidé calculates the number of all the configurations admitted by the problem to be 122.880 in the simple case and 3.932.160 in the case where flipping of the pieces is allowed. Since these numbers are quite small for modern CPUs, it is possible to attempt a complete search of the configuration space. This strategy has in fact been followed by Mr. Legrand and by an unpublished attempt by Mr. Coquidé.
It is of course possible and easy, not to mention more efficient in terms of space and time used, to prune the search tree by removing early on impossible combinations (like 1 0 for Piece A and 3 0 for piece B in Mr. Legrand’s notation), and this is the strategy used by almost all the other solvers with one noticeable exception.
Mike Day’s solution [reviewed by S. Lanzavecchia]¶
The solver presented by Mr. Day is written in Dyalog APL, in a mixture of traditional APL2 code and Dyadic’s Dynamic functions.
As the author points out, the code should be general enough to deal with more complex symmetries than the 3D cube, since the dependency on the geometry is only in the auxiliary functions GetSides and AdjPlaceSides and not in the solver itself. These claims were not actually verified by the author but the code looks nicely supportive.
The pieces are laid down one by one and before trying the next piece, all the impossible solutions are removed from the search tree to reduce the search space.
Because of this generality, which reflects itself in a clear, well structured code and compact code, if I had to choose a favourite solution, I would choose this one.
With its 440 milliseconds to solve the simple problem and 3400 milliseconds for the case with flipping allowed (on a PII 233 MHz running Dyalog APL 8.x), the solver shows that going for general code does not necessarily mean to compromise performance.
The listing¶
The code is written to run in ⎕IO←⎕ML←0.
Solve←{⍝ Bin is 6 5 5 array of sides
⎕IO←0 ⋄ ⍺←0 ⍝ default to no flips allowed
canflip Bin←⍺ ⍵
npieces nsides←6 4
sides←↑canflip GetSides Bin ⍝ l m f n array
adjplacesides placeids←AdjPlaceSides 1
⍝ build place adjacency array
A B C D E F←placeids
⍝ from here on the method is general for arbitrary npieces nsides
(places placeflips placeturns)←(0 3)(1 4)(2 5)
⍝ names for column indexes
placesandflips←places,[0.5]placeflips
⍝ column indexes in adjplacesides
match←canflip MatchArray sides
⍝ build array of matching piece sides
possiblestates←⍉sk⊤⍳×/sk←npieces,(canflip+1),nsides
⍝ really all possible state ROWS
(pieces pieceflips pieceturns)←0 1 2
piecesandflips←0 1 ⍝ column indexes in possiblestates
r←adjplacesides SolveAll possiblestates
r←(1,canflip,1)/↑r
r←r[;placeids;]
r[⍋r[;;0];;]
}
r←adjplacesides SolveAll possiblestates;statessofar;Check;remainingpieces;newstates;newstate;stateid;state;nnew;adj;place;npieces
statessofar←1 1 3⍴A,0 0 ⋄ npieces←⍴adjplacesides
Check←{
adj←⍺
state←⍵[adj[;places];]
adj[;placeturns]←nsides|adj[;placeturns]+state[;;pieceturns]
adj[;placesandflips]←state[;;piecesandflips]
∧/match[↓adj]
}
:For place :In 1↓⍳npieces ⍝ [A] B D F C E seems best ordering
newstates←statessofar,[1]0 ⍝ newstates array needs one more set of rows
nnew←0
adj←↑↑adjplacesides[place]
:For stateid :In ⍳⊃⍴statessofar
remainingpieces←(⍳npieces)~statessofar[stateid;;pieces]
newstate←statessofar[stateid;;]⍪0
:For state :In {⍵/⍳⍴⍵}possiblestates[;pieces]∊remainingpieces
newstate[place;]←possiblestates[state;]
:If adj Check newstate
:If nnew=⊃r←⍴newstates ⋄ newstates⍪←newstates
⍝ +++ expand newstates array if necessary
:EndIf
newstates[nnew;;]←newstate ⋄ nnew+←1
:EndIf ⍝ Check
:EndFor ⍝ state
:EndFor ⍝ stateid
statessofar←newstates[⍳nnew;;]
:EndFor ⍝ place
r←statessofar
MatchArray←{⍝ given l m f n array of sides
⍝ (ie l objects each with m sides
⍝ f flips (1 or 2) and n items)
⍝ calculate (l m f)∧2 Boolean array
flip sides←⍺ ⍵
length←3⊃⍴↑sides
corners←0,length-1
insides←1↓¯1↓⍳length
mask←(⍳1↑⍴⍵)∘.+0×⊃↑⍵
sidematch←{
⍺[insides]∧.=⍵[⌽insides]:0 ⍝ no match if lugs equal
⍺[corners]∧.⍲⍵[⌽corners]:1 ⍝ then corners mustn't double up
0 ⍝ else fail
}
sides∘.sidematch sides
}
GetSides←{⍺←0
flip Bin←⍺ ⍵
length←1⊃⍴Bin
up←Bin[;0;]
down←⌽Bin[;length-1;]
right←Bin[;;length-1]
left←⌽Bin[;;0]
r←up,[1]right,[1]down,[0.5]left
×flip:r,[0.5]⌽r[;⌽1⌽⍳4;]
r⍴⍨¯1⌽1 0 1 1\⍴r
}
AdjPlaceSides←{
⍝ list pairs of adjacent sides in layout
⍝ eg B3 adj A1
⍝ with layout 0
⍝ 3 ⎕ 1
⍝ 2
⍝ NB backward looking (ie B to A but not A to B)
⍝ - can't check D:E if only done A B C
(A B D F C E)←⍳6 ⍝ was A B C D E F) ← ⍳6
⍝ this ordering seems better than ⍳6 as it
⍝ eliminates more failures earlier in search
Adj←6⍴⍬
Adj[1]←⊂,⊂(B 3 A 1)
Adj[2]←⊂(D 1 A 0)(D 0 B 0)
Adj[3]←⊂(F 1 A 2)(F 2 B 2)
Adj[4]←⊂(C 3 B 1)(C 0 D 3)(C 2 F 3)
Adj[5]←⊂(E 1 A 3)(E 3 C 1)(E 0 D 2)(E 2 F 0)
Adj←{1 0 1 1 0 1\⍵}¨¨Adj
Adj(A B C D E F)
}
Example of execution¶
Notice that the solution set is given in origin zero for the index of the pieces.
Adrian’s solution [reviewed by S. Lanzavecchia]¶
Adrian proposes a solution written in ISO APL. Unfortunately he only attempts to solve the simple case and leaves as an exercise for the reader the extension of his code to cope with the general problem.
The strong point of his solution is speed: less than 100 milliseconds on a PII 233 running Dyalog APL version 8.x.
The weak points, in my opinion, are the use of various global variables (which could easily become semi-globals) and its verbosity. Considering the very short time it took him to come up with the solution and the fact that elegance on its own wasn’t one of his goals, I must say that I am impressed.
If any of our readers think that they have a faster solution, please do not hesitate to send it for publication.
The listing¶
solutions←tiles bm
⍝ Start with the obvious stuff - match edges ignoring the corners
⍝ This makes an integer encoding of the edges to speed comparisons and save
WS
⍝ The corners get used when we have 4 or more tiles down
∆e←2 3 4 edges bm
∆c←corners bm
⍝ Put them down in ABC... order to save thinking
⍝ We could do a little better with ABDCEF as this tests a corner sooner!
cube1
cube2
cube3
cube4
cube5
cube6
⍝ Return the result as required ...
solutions←1 3 2⍉((1↑⍴∆cn),2 6)⍴∆cn,∆cr
⍝ Now how about an OpenGL representation (spinning of course) ....
r←cube1;ok
⍝ Place first tile ... 6 choices, 4 rotations
⍝ Array ∆c holds the possibilities
∆cc←24 4⍴∆e[1;;(0 1 2 3⌽4 4⍴⍳4)]
∆ca←24 4⍴∆e[2;;(0 1 2 3⌽4 4⍴⍳4)]
∆ce←24 4⍴∆c[;(0 1 2 3⌽4 4⍴⍳4)]
∆cn←,⍉4 6⍴⍳6
∆cr←,6 4⍴0 1 2 3
r←'After placing first tile, there could be ',(⍕1↑⍴∆cc),' possibilities'
⍝ Arbitrarily choose the first one as canonical example ...
ok←24↑1
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
r←cube2;cc;ca;cn;cr;ce;ok
⍝ Place Tile-B ... all options, then check valid combinations
⍝ and match on A2-B4 boundary
cc←24 4⍴∆e[1;;(0 1 2 3⌽4 4⍴⍳4)]
ca←24 4⍴∆e[2;;(0 1 2 3⌽4 4⍴⍳4)]
ce←24 4⍴∆c[;(0 1 2 3⌽4 4⍴⍳4)]
cn←,⍉4 6⍴⍳6 ⋄ ∆cn←∆cn comb cn
cr←,6 4⍴0 1 2 3 ⋄ ∆cr←∆cr comb cr
ok←≠/∆cn
∆cc←∆cc mcomb cc
∆ca←∆ca mcomb ca
∆ce←∆ce mcomb ce
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
⍝ Now the boundary check ...
ok←∆cc[;2]=∆ca[;8]
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
r←'After placing 2nd tile, there are ',(⍕1↑⍴∆cn),' possibilities'
r←cube3;cc;ca;cn;cr;ce;ok
⍝ Place Tile-C ... all options, then check valid combinations
⍝ and match on B2-C4 boundary
cc←24 4⍴∆e[1;;(0 1 2 3⌽4 4⍴⍳4)]
ca←24 4⍴∆e[2;;(0 1 2 3⌽4 4⍴⍳4)]
ce←24 4⍴∆c[;(0 1 2 3⌽4 4⍴⍳4)]
cn←,⍉4 6⍴⍳6 ⋄ ∆cn←∆cn mcomb cn
cr←,6 4⍴0 1 2 3 ⋄ ∆cr←∆cr mcomb cr
ok←∧/∆cn[;1 2]≠∆cn[;2⍴3]
∆cc←∆cc mcomb cc
∆ca←∆ca mcomb ca
∆ce←∆ce mcomb ce
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
⍝ Now the boundary check ...
ok←∆cc[;6]=∆ca[;12]
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
r←'After placing 3rd tile, there are ',(⍕1↑⍴∆cn),' possibilities'
r←cube4;cc;ca;cn;cr;ce;ok
⍝ Place Tile-D ... all options, then check valid combinations
⍝ and match on several boundaries
cc←24 4⍴∆e[1;;(0 1 2 3⌽4 4⍴⍳4)]
ca←24 4⍴∆e[2;;(0 1 2 3⌽4 4⍴⍳4)]
ce←24 4⍴∆c[;(0 1 2 3⌽4 4⍴⍳4)]
cn←,⍉4 6⍴⍳6 ⋄ ∆cn←∆cn mcomb cn
cr←,6 4⍴0 1 2 3 ⋄ ∆cr←∆cr mcomb cr
ok←∧/∆cn[;1 2 3]≠∆cn[;3⍴4]
∆cc←∆cc mcomb cc
∆ca←∆ca mcomb ca
∆ce←∆ce mcomb ce
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
⍝ Now the boundary check ...
ok←∆cc[;1]=∆ca[;14] ⍝ A1 == D2
ok←ok∧∆cc[;5]=∆ca[;13] ⍝ B1 == D1
ok←ok∧∆cc[;9]=∆ca[;16] ⍝ C1 == D4
⍝ Finally we can check two corners .....
ok←ok∧1=+/∆ce[;2 5 14]
ok←ok∧1=+/∆ce[;6 9 13]
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
r←'After placing 4th tile, there are ',(⍕1↑⍴∆cn),' possibilities'
r←cube5;cc;ca;cn;cr;ce;ok
⍝ Place Tile-E ... all options, then check valid combinations
⍝ and match on several boundaries
cc←24 4⍴∆e[1;;(0 1 2 3⌽4 4⍴⍳4)]
ca←24 4⍴∆e[2;;(0 1 2 3⌽4 4⍴⍳4)]
ce←24 4⍴∆c[;(0 1 2 3⌽4 4⍴⍳4)]
cn←,⍉4 6⍴⍳6 ⋄ ∆cn←∆cn mcomb cn
cr←,6 4⍴0 1 2 3 ⋄ ∆cr←∆cr mcomb cr
ok←∧/∆cn[;1 2 3 4]≠∆cn[;4⍴5]
∆cc←∆cc mcomb cc
∆ca←∆ca mcomb ca
∆ce←∆ce mcomb ce
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
⍝ Now the boundary checks ...
ok←∆cc[;4]=∆ca[;18] ⍝ A4 == E2
ok←ok∧∆cc[;17]=∆ca[;15] ⍝ E1 == D3
ok←ok∧∆cc[;10]=∆ca[;20] ⍝ C2 == E4
⍝ ... and remaining edge checks around the top
ok←ok∧1=+/∆ce[;10 17 16]
ok←ok∧1=+/∆ce[;18 1 15]
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
r←'After placing 5th tile, there are ',(⍕1↑⍴∆cn),' possibilities'
r←cube6;cc;ca;cn;cr;ce;ok
⍝ Place Tile-F ... all options, then check valid combinations
⍝ and match on several boundaries
cc←24 4⍴∆e[1;;(0 1 2 3⌽4 4⍴⍳4)]
ca←24 4⍴∆e[2;;(0 1 2 3⌽4 4⍴⍳4)]
ce←24 4⍴∆c[;(0 1 2 3⌽4 4⍴⍳4)]
cn←,⍉4 6⍴⍳6 ⋄ ∆cn←∆cn mcomb cn
cr←,6 4⍴0 1 2 3 ⋄ ∆cr←∆cr mcomb cr
ok←∧/∆cn[;1 2 3 4 5]≠∆cn[;5⍴6]
∆cc←∆cc mcomb cc
∆ca←∆ca mcomb ca
∆ce←∆ce mcomb ce
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
⍝ Now the boundary checks ...
ok←∆cc[;21]=∆ca[;19] ⍝ F1 == E3
ok←ok∧∆cc[;22]=∆ca[;3] ⍝ F2 == A3
ok←ok∧∆cc[;23]=∆ca[;7] ⍝ F3 == B3
ok←ok∧∆cc[;24]=∆ca[;11] ⍝ F4 == C3
⍝ All 4 corners must be happy this time!
ok←ok∧1=+/∆ce[;21 11 20]
ok←ok∧1=+/∆ce[;22 19 4]
ok←ok∧1=+/∆ce[;23 3 8]
ok←ok∧1=+/∆ce[;24 12 7]
∆cn←ok⌿∆cn ⋄ ∆cr←ok⌿∆cr ⋄ ∆cc←ok⌿∆cc ⋄ ∆ca←ok⌿∆ca ⋄ ∆ce←ok⌿∆ce
r←'After placing 6th tile, there are ',(⍕1↑⍴∆cn),' possibilities'
em←inx edges cd
⍝ Take cube data and code the 24 edges so we can match them quickly
⍝ <inx> gives the notes to check - initially we just use the middle three
⍝ We need both clockwise and anti-clockwise mappings
⍝ Now we just need to match integers on each boundary!
em←2 6 4⍴0
⍝ Work around top,left,bottom,right recording the +ve direction
em[1;;1]←2⊥⍉cd[;1;inx] ⍝ Top
em[1;;2]←2⊥⍉cd[;inx;5] ⍝ Right
em[1;;3]←2⊥⍉cd[;5;⌽inx] ⍝ Bottom
em[1;;4]←2⊥⍉cd[;⌽inx;1] ⍝ Left
⍝ Now the same ordering of edges but encoded not-backwards ...
em[2;;1]←2⊥~⍉cd[;1;⌽inx] ⍝ Top
em[2;;2]←2⊥~⍉cd[;⌽inx;5] ⍝ Right
em[2;;3]←2⊥~⍉cd[;5;inx] ⍝ Bottom
em[2;;4]←2⊥~⍉cd[;inx;1] ⍝ Left
cm←corners cd
⍝ Take cube data and grab the 8 corners so we can match them quickly
cm←6 4⍴0
⍝ Work around top,left,bottom,right recording the +ve direction
cm[;1]←cd[;1;1] ⍝ Top left
cm[;2]←cd[;1;5] ⍝ Top Right
cm[;3]←cd[;5;5] ⍝ Bottom Righr
cm[;4]←cd[;5;1] ⍝ Bottom Left
m←x comb y;s
s←(⍴,x)×⍴,y
m←((⍴,y)/x),[1.5]s⍴y
m←x mcomb y;s
s←(1↑⍴x)×1↑⍴y
m←((1↑⍴y)⌿x),(s,1↓⍴y)⍴y
Example of execution¶
tiles cubedata ⍝ Solves the 'this way up' case of the cube puzzle
After placing first tile, there could be 24 possibilities
After placing 2nd tile, there are 11 possibilities
After placing 3rd tile, there are 90 possibilities
After placing 4th tile, there are 44 possibilities
After placing 5th tile, there are 12 possibilities
After placing 6th tile, there are 2 possibilities
1 0
2 1
4 1
5 1
3 0
6 1
1 0
2 1
6 1
5 1
3 0
4 1
Stefano’s solution [presented by the author]¶
Since this is my very first attempt at writing a program in K, language that I attempted to learn in the very process of solving the puzzle, I will not claim that my K coding style is typical, efficient or that, in general, it gives a good example of a K program. In fact I would appreciate if some K expert could send in his solution to the puzzle or at least send comments about my code.
My first attempt at solving the puzzle had been done in APL, in purely functional style using Dyadic APL’s dynamic functions and it wasn’t very efficient, nor elegant. A few months later I decided to try another array oriented language and I rewrote the original algorithm in K. Since the differences between K and APL are fundamental and I had lost the workspace anyway, this is not a translation of the APL code, but more a rethinking.
The strategy¶
Internally the pieces are represented as a four-element list containing the position of the ones of the top, right, bottom and left edge respectively. The local variable rffaces contains a representation of the pieces in all the possible states of rotation and flipping for fast access.
Instead of exploring the entire search tree I decided to cut impossible branches as soon as possible, by imposing edge and corner conditions. The two Boolean-valued functions pfe and pfc are used to identify and remove with the aid of the operator filter the invalid combinations. The function newfs prepares a new set of possible solutions by adding to all the partial solutions a yet unused piece in all its rotation and flip states.
The main execution loop is written in terms of a reduction of list of function applications to the initial state 0 0 0, which in the internal zero-origin notation corresponds to piece A, non-flipped, not-rotated. A new piece is placed and then all the non-conformant solutions are removed by applying conditions at the edges and at the corners.
Please notice that the solver can be used also for given sets of pieces with a bigger or smaller side, since nowhere in the code there is an explicit reference to 5. When I wrote my solver I hadn’t seen Mike Day’s submission. The strategy is similar, but his code is more general. It would be a good challenge to try and adapt his ideas to my framework written in K.
No global variables or global utility functions are used.
Speed¶
To solve the general problem, with flipping of the pieces, my code takes a bit less than 1500 milliseconds on a PII 233 running K’s interpreter version 2.8t (don’t miss your free download from http://www.kx.com/). This is likely to be the fastest execution time among all the solvers collected by Vector and Les Nouvelles D’APL for the general problem. If Adrian’s code were adapted to solve the general problem, it would most likely be faster by at least a factor of 5. My code seems to be the most compact of all, as well.
The listing¶
Since the solutions in the case where flipping is not allowed are a subset of the general case, I only show the code to solve the general case. It would be trivial to specialise to code to solve the simplified version of the problem.
/ Solve the Funny Cube Puzzle by Bernard Legrand
littlecube: {[pieces]
abs: { (x*x>0) + (-x<0)*x }
filter: {[f;y] y[& f'y]}
newfs: {
try: {
tryflip: { ,/((!6) _dv/ x),\:/:!2 }
:,/(tryflip x),\:/:!4
}
:,/{x{x,,y}/:try x[;0]}'x
}
n: -1 + *1 _ ^pieces
fcs: { (&:'y[0,x;],+y[;0,x])[0 3 1 2] }
faces: n fcs'pieces
rfaces: n {(y;abs (x,0,x,0)-y[0 3 2 1])}'faces
rffaces: n {3 (abs (0,x,0,x)-1!)\ y}''rfaces
pfe: {[y;e1;e2;fl] (#k)~#?k:(rffaces . y[e1[0]],e1[1]),abs fl - rffaces . y[e2[0]],e2[1] }
pfc: {[y;c1;c2;c3;m] 1=+/m _in'(rffaces . y[c1[0]],c1[1];rffaces . y[c2[0]],c2[1];rffaces . y[c3[0]],c3[1])}
fitedge: {[fs;e1;e2;fl] filter[pfe[;e1;e2;fl];fs] }
fitcorn: {[fs;c1;c2;c3;m] filter[pfc[;c1;c2;c3;m];fs]}
y: (,,0 0 0) {y@x}/ ( newfs
fitedge[;0 1;1 3;0]
newfs
fitedge[;1 1;2 3;0]
newfs
fitedge[;2 0;3 3;0]
fitedge[;0 0;3 1;n]
fitedge[;1 0;3 0;n]
newfs
fitedge[;0 3;4 1;0]
fitedge[;3 2;4 0;0]
fitedge[;2 1;4 3;0]
fitcorn[;3 2;4 0;2 1;0 0 0]
fitcorn[;4 0;3 1;0 0;n,n,0]
fitcorn[;0 0;1 0;3 0;n,0,n]
fitcorn[;1 0;3 0;2 0;n,0 0]
newfs
fitedge[;0 2;5 1;0]
fitedge[;1 2;5 2;n]
fitedge[;2 2;5 3;n]
fitedge[;4 2;5 0;0]
fitcorn[;4 2;5 1;0 2;n,0 0]
fitcorn[;2 1;5 3;4 3;n,0,n]
fitcorn[;1 1;2 2;5 2;n,0 0]
fitcorn[;0 1;1 3;5 1;n,n,n])
:1 0 0+/:/:y
}
Example of execution¶
Instead of showing all the solutions, which would take up a lot of space, we calculate their number.
Let’s check the first solution in the solution set:
Finally, let’s extract the subset of solutions that do not require flipping of the pieces and verify that they match Mr. Legrand’s proposed solution:
A Solution from Jacques Grenot [notes by Adrian Smith]¶
This solution arrived as an ATF file, so I guess it came from an APL2 original. I no longer have easy access to APL2, but fortunately APL+Win comes with ]IN as standard and was able to read and run the code with no problems. The timing was run on an AMD K6, running at 200MHz, so we are fairly comparable. The folowing are Jaques own notes on the strategy.
Strategy¶
Face A is fixed. From the remaining 5 faces (10 if flipping) find an E such that column 5 of E locks into column 1 of A. From the remaining faces, find a D and an F such that they match E above and below (they are then in the agreed conventional state). Find a C matching E to the left, and check whether the remaining face meets the requirements for B. Note the condition at corners, where 3 edges meet -one tooth and two notches!
Of course this is NOT the only way. Is it a reasonable way? Have I failed to see the obvious? That much, at least, is now out of my system. I hope you will have as much fun taking it apart as I had putting it together.
Jacques Grenot
The Code¶
Function LeCube is invoqued with a FLIP left argument (No flip if 0) and the array Abin, defining the 6 notched faces, in state 0, with which to build a cube.
∇ Z←Flip LeCube Abin;FACE;STATE;S16;S4x5;S4x9;S4x13;S4x16;Slist;A;No_Flip;Ix;Bix;Cix;Lix;Six;Zix;C_n;C_sol;Cbin;Vbin;EDGE1;EDGE2;EDGE3;EDGE4;Sel_E;Sel_D;Sel_F;Sel_C;Sel_B;Msk_E;Msk_D;Msk_F;Msk_C;Msk_B;E_vec;D_vec;F_vec;C_vec;B_vec;B;BI;BJ;BIJ;C;CI;CJ;CIJ;D;DI;DJ;DIJ;E;EI;EJ;EIJ;F;FI;FJ;FIJ
[1] ⍝ Le petit cube de Monsieur Legrand (Vector V16 No.3)
[2] ⍝
[3] ⍝ Fix utility functions
[4] ⍝
[5] ⎕IO←1
[6] ⎕FX¨⊃¨1↓¨2↓(1++/'∆¯_'⍷⎕CR 'LeCube')⊂⊂[⎕IO+1]⎕CR 'LeCube'
[7] A←1(⍳5)(⍳5)⌷Abin
[8] No_Flip←Flip=0
[9] Six←1+⍳(5+5×Flip)
[10] C_n←0
[11] Cbin←Abin
[12] Z←''
[13] →No_Flip/L00
[14] ⍝
[15] Lix←7 8 9 10 11 2 3 4 5 6
[16] Zix←⊂[2]10 2⍴2 0 3 0 4 0 5 0 6 0 2 1 3 1 4 1 5 1 6 1
[17] Cbin←Cbin,[1](1+⍳5)(⍳5)(⍳5)⌷⌽Abin
[18] ⍝
[19] L00:
[20] Vbin←FACE¨⍳(6+5×Flip)
[21] EDGE1←S4x5¨Six
[22] EDGE2←S4x9¨Six
[23] ⍝
[24] Sel_E←⊂A[;1]
[25] Msk_E←(0∨A[1;1]),1 1 1,0∨A[5;1] ⍝ mask possible zero corners
[26] E_vec←Slist∧/¨Msk_E/¨Sel_E≠¨⊃EDGE1
[27] →(0<⍴E_vec)/NEXT_EI
[28] ⍝
[29] NEXT_EI:
[30] →(0=⍴E_vec)/DONE ⍝ DONE - we have processed all possible E edges
[31] EIJ←↑E_vec ⍝ take edge list for next face
[32] E_vec←1↓E_vec ⍝ Adjust E_list
[33] EI←↑EIJ ⍝ Face index
[34] EIJ←1↓EIJ ⍝ List of edges on this face
[35] NEXT_EJ:
[36] →(0=⍴EIJ)/NEXT_EI ⍝ We have exhausted this side
[37] EJ←4|¯1+↑EIJ ⍝ *** Adjust to state
[38] EIJ←1↓EIJ ⍝ Udate remaining edges list
[39] E←EI STATE EJ
[40] ⍝ **********
[41] ⍝
[42] ⍝ For this E_A pair, find possible D and F matches
[43] ⍝
[44] ⍝ Now form Sel_D and scan for potential D
[45] Sel_D←A[1;5 4 3 2],(A[1;1]∨E[1;5]),E[1;4 3 2 1] ⍝ match for D
[46] Msk_D←(0∨Sel_D[1]),(7⍴1),(0∨Sel_D[9])
[47] D_vec←Slist∧/¨Msk_D/¨(⊂Sel_D)≠¨⊃EDGE2
[48] →(0<⍴D_vec)/NEXT_DI
[49] ⍝
[50] NEXT_DI:
[51] →(0=⍴D_vec)/NEXT_EJ
[52] DIJ←↑D_vec
[53] D_vec←1↓D_vec
[54] DI←↑DIJ
[55] Ix←EI
[56] →No_Flip/L01
[57] Ix←Ix,Lix[Ix-1]
[58] L01:
[59] →(0<+/DI=Ix)/NEXT_DI ⍝ Face already selected
[60] DIJ←1↓DIJ
[61] NEXT_DJ:
[62] →(0=⍴DIJ)/NEXT_DI
[63] ⍝ final D state is DJ←4|DJ-1
[64] DJ←4|¯1+↑DIJ ⍝ *** Adjust to state
[65] DIJ←1↓DIJ
[66] D←DI STATE DJ
[67] ⍝ **********
[68] ⍝
[69] ⍝ Now form Sel_F and scan for potential F
[70] ⍝
[71] Sel_F←E[5;1 2 3 4],(E[5;5]∨A[5;1]),A[5;2 3 4 5] ⍝ match for D
[72] Msk_F←(0∨Sel_F[1]),(7⍴1),(0∨Sel_F[9])
[73] F_vec←Slist∧/¨Msk_F/¨(⊂Sel_F)≠¨⊃EDGE2
[74] →(0<⍴F_vec)/NEXT_FI
[75] ⍝
[76] NEXT_FI:
[77] →(0=⍴F_vec)/NEXT_DJ
[78] FIJ←↑F_vec
[79] F_vec←1↓F_vec
[80] FI←↑FIJ
[81] Ix←EI DI
[82] →No_Flip/L02
[83] Ix←Ix,Lix[Ix-1]
[84] L02:
[85] →(0<+/FI=Ix)/NEXT_FI
[86] FIJ←1↓FIJ
[87] NEXT_FJ:
[88] →(0=⍴FIJ)/NEXT_FI
[89] ⍝ Final F state is FJ
[90] FJ←↑FIJ ⍝ *** No adjustment required to state
[91] FIJ←1↓FIJ
[92] F←FI STATE FJ
[93] ⍝ **********
[94] ⍝
[95] Sel_C←D[⍳4;1],(D[5;1]∨E[1;1]),E[2 3 4;1],(E[5;1]∨F[1;1]),F[2 3 4 5;1]
[96] Msk_C←(0∨Sel_C[1]),(11⍴1),(0∨Sel_C[13])
[97] Ix←DI EI FI
[98] →No_Flip/L03
[99] Ix←Ix,Lix[Ix-1]
[100] L03:
[101] Cix←Six~Ix
[102] EDGE3←S4x13¨Cix
[103] C_vec←Slist∧/¨Msk_C/¨(⊂Sel_C)≠¨⊃EDGE3
[104] →(0<⍴C_vec)/NEXT_CI
[105] ⍝
[106] NEXT_CI:
[107] →(0=⍴C_vec)/NEXT_FJ
[108] CIJ←↑C_vec
[109] C_vec←1↓C_vec
[110] CI←Cix[¯1+↑CIJ]
[111] CIJ←1↓CIJ
[112] NEXT_CJ:
[113] →(0=⍴CIJ)/NEXT_CI
[114] CJ←↑CIJ ⍝ *** No adjustment required to state
[115] CIJ←1↓CIJ
[116] C←CI STATE CJ
[117] ⍝ **********
[118] ⍝
[119] Sel_B←(D[1;5]∨A[1;5]),D[1;4 3 2],(D[1;1]∨C[1;1]),C[2 3 4;1]
[120] Sel_B←Sel_B,(C[5;1]∨F[5;1]),F[5;2 3 4],(F[5;5]∨A[5;5]),A[4 3 2;5]
[121] Ix←CI
[122] →No_Flip/L04
[123] Ix←Ix,Lix[Ix-1]
[124] L04:
[125] EDGE4←S4x16¨Bix←Cix~Ix
[126] B_vec←Slist∧/¨(⊂Sel_B)≠¨⊃EDGE4
[127] →(0=⍴B_vec)/NEXT_CJ
[128] BIJ←↑B_vec
[129] B_vec←1↓B_vec
[130] BI←Bix[¯1+↑BIJ]
[131] BIJ←1↓BIJ
[132] NEXT_BJ:
[133] →(0=⍴BIJ)/NEXT_CJ
[134] BJ←↑BIJ
[135] BIJ←1↓BIJ
[136] C_n←C_n+1
[137] →No_Flip/L05
[138] C_sol←(2 3⍴' ' ' ' ' ' 1 0 0),[1](⊃Zix[¯1+BI CI DI EI FI]),BJ CJ DJ EJ FJ
[139] →L06
[140] L05:
[141] C_sol←7 2⍴' ' ' ' 1 0 BI BJ CI CJ DI DJ EI EJ FI FJ
[142] L06:
[143] ⍝ ⎕←C_n C_sol
[144] Z←Z,⊂C_n C_sol
[145] →NEXT_FJ
[146] ⍝
[147] DONE:
[148] 'All E matches exhausted...I think!...'
[149] Z←⊃Z
[150] →0
[151] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[152] ∆¯_01:
[153] Z←S16 I
[154] U←I⊃Vbin
[155] Z←U[1;],U[1+⍳4;5],(⌽U[5;⍳4]),U[4 3 2;1]
[156] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[157] ∆¯_02:
[158] Z←S4x5 I;U
[159] ⍝ Returns four borders in clockwise sequence
[160] U←S16 I
[161] Z←5↑¨U(4⌽U)(8⌽U)(12⌽U)
[162] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[163] ∆¯_03:
[164] Z←S4x9 I;U
[165] ⍝ Four string of two consecutive borders
[166] U←U,U←S16 I
[167] Z←(9↑U)(9↑4↓U)(9↑8↓U)(9↑12↓U)
[168] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[169] ∆¯_04:
[170] Z←S4x13 I;U
[171] ⍝ Four string of three consecutive borders
[172] U←U,U←S16 I
[173] Z←(13↑U)(13↑4↓U)(13↑8↓U)(13↑12↓U)
[174] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[175] ∆¯_05:
[176] Z←S4x16 I;U
[177] ⍝ Four string of all four borders shifted one at a time
[178] U←U,U←S16 I
[179] Z←(16↑U)(16↑4↓U)(16↑8↓U)(16↑12↓U)
[180] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[181] ∆¯_06:
[182] Z←FACE I
[183] Z←I(⍳5)(⍳5)⌷Cbin ⍝ No_Flip 6 faces --- Flip 11 faces
[184] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[185] ∆¯_07:
[186] Z←I STATE J;U;T
[187] U←FACE I
[188] T←0
[189] ROTATE:
[190] →(T=J)/END
[191] T←T+1
[192] U←⍉⌽U
[193] →ROTATE
[194] END:
[195] Z←U
[196] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
[197] ∆¯_08:
[198] Z←Slist M;K;L;ZL
[199] ⍝ from the 5x4 matrix of matching edges per side,
[200] ⍝ produce the vector list of (Side,Edge list)
[201] Z←''
[202] K←1
[203] L←0 1 2 3
[204] →(2=⍴⍴M)/Enc_M
[205] M←1(↑⍴M)⍴M
[206] Enc_M:
[207] M←⊂[2]M
[208] Next:
[209] →(0=⍴M)/0
[210] K←K+1
[211] ZL←(↑M)/L
[212] M←1↓M
[213] →(0=⍴ZL)/Next
[214] Z←Z,⊂K,ZL
[215] →Next
[216] ⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
∇
Monsieur Legrand has provided a set of conventions for the representation of solutions. Two programs are suggested; a basic one, monadic, which does not allow the flipping of faces, and a more general program which uses a left argument to determine whether flipping is allowed. As the second program includes the first as a subset, I have dispensed with its transmission. If I have correctly interpreted the instructions, and if my logic is both correct and correctly programmed, there are two solutions to the No-flip case and 43 solutions if flipping is allowed. Note that FACE 4 flipped is equivalent to FACE 4 in STATE 2... The results are presented as by Mr Legrand’s conventions, but preceded by a solution number.
tt←⎕wcall 'GetTickCount' ⋄ qq←0 LeCube Abin ⋄ (⎕wcall 'GetTickCount')-tt
All E matches exhausted...I think!...
169
qq
1
1 0
2 1
6 1
5 1
3 0
4 1
2
1 0
2 1
4 1
5 1
3 0
6 1
Speed¶
As you can see, the function runs in around 170ms, and the corresponding solution for the ‘Flip’ case runs in 734ms, making it one of the faster examples we have. Just for interest, I took out the bizarre ‘hide the subfunctions’ approach (delocalise the subfunctions, run it, kill line-6 and the bottom of the listing) and the times came down to 106ms and 680ms respectively. Maybe APL2 has a much faster ⎕FX, but even so it is hard to see the benefit of this approach.