Life Goes On

まあまあだけど楽しんでる方です

ポケットキューブ(2×2×2キューブ)の最短手数

ルービックキューブを揃えるための最短手数は最大でも20手だそうです。3×3×3を解くには相当なリソースが必要ですが、2×2×2なら何とかなるんじゃないかと思い、プログラムを組んでみました。
結果は↓の通りで最大で11手でした。これくらい誰か既に計算してそうですが、見つかりません。我こそはという方は追試をお願いします。

距離
01
19
254
3321
41847
59992
650136
7227536
8870072
91887748
10623800
112644

プログラムはこんな感じです。
キューブの状態を表すのに、最初は展開図っぽいデータ構造にしていたのですが、けっこうメモリを食うので、8個のコーナーキューブ(a〜h)がどの場所にあってどっちを向いているかを保持するようにしました。
キューブの向きは厳密には各々24通りありますが、キューブの場所で向きが3通りに限定されるので、0〜2の整数で表現しています。
また左下奥のキューブ(h)を位置、向きとも固定することで、重複を排除しています。鏡像とかは特に考慮していません。

import Data.List (foldl')
import Data.Set (Set, singleton, member, insert)

data Axis = F | R | U
type Move = (Axis, Int)
type Cube = [Int]

rotate :: Move -> Cube -> Cube
rotate move [a,b,c,d,e,f,g,h] = case move of
  (F,1) -> [c%1,b,g%2,d,a%2,f,e%1,h]
  (F,2) -> [g,b,e,d,c,f,a,h]
  (F,3) -> [e%1,b,a%2,d,g%2,f,c%1,h]
  (R,1) -> [e%2,a%1,c,d,f%1,b%2,g,h]
  (R,2) -> [f,e,c,d,b,a,g,h]
  (R,3) -> [b%2,f%1,c,d,a%1,e%2,g,h]
  (U,1) -> [b,d,a,c,e,f,g,h]
  (U,2) -> [d,c,b,a,e,f,g,h]
  (U,3) -> [c,a,d,b,e,f,g,h]
  where
  x % i = let d=rem x 3 in x - d + rem(d+i)3

next :: (Set Cube, [Cube]) -> (Set Cube, [Cube])
next (vs0,xs) = foldl' add (vs0,[]) [rotate (a,r) x | x<-xs, a<-[F,R,U], r<-[1..3]]
  where
  add (vs,ys) y
    | member y vs = (vs, ys)
    | otherwise   = (insert y vs, y:ys)

ini :: Cube
ini = [0,3..21]

countAll :: [Int]
countAll = takeWhile (/=0) $ map (length.snd) $ iterate next (singleton ini, [ini])

main :: IO ()
main = print $ countAll