Алгоритм A* и кубик Рубика: реализация на языке Haskell

Двенадцатый конкурс по функциональному программированию в этом году и семнадцатый с момента запуска этого процесса выдался на удивление особенным. Впервые в истории конкурсов на него не было прислано ни одного решения. А казалось бы, задание проще простого — написать программу, которая для заданного состояния кубика Рубика находила бы (кратчайший) алгоритм его сбора.

Злые языки предупреждали, что у рассматриваемой системы (размера 3х3х3) более 43 квантильонов состояний, и что никакой компьютер не справится с расчётом алгоритма при помощи простого перебора. Но ведь человек как-то решает задачу. Да, зачастую человек берёт и использует типовые шаги. Но вот я, к примеру, собираю кубик при помощи типовых комбинаций, но у меня на сборку кубика уходит минут пять, в то время как умельцы могут это сделать за 10 секунд. Что, неужели они знают алгоритм Бога? Сомневаюсь. Так что задача была вполне решаема. Но никто не решил.

Я сам написал для проверки своих идей программу для перебора при помощи алгоритма А* для кубика Рубика произвольного размера. Далее представлена эта программа.

Описание программы

Рассмотрение модуля разобьём на несколько частей. В первой посмотрим на то, какие типы нам требуются. Во второй определим вспомогательный функции для работы с матрицами. Ну а втретей реализуем всё для запуска алгоритма А* из стандартного модуля Data.Graph.AStar. Начнём…

Типы данных

В основном нам потребуются перечисления. У кубика Рубика много таких свойств, которые задаются именно перечислениями. Например, цвет грани, или, что тоже, цвет одной плашки на грани. Вот этот тип в первую очередь и определим:

data Color = Blue
           | Green
           | Orange
           | Red
           | White
           | Yellow
  deriving (Eq, Ord)

Традиционно грани кубика Рубика окрашивают в белый, жёлтый, оранжевый, красный, зелёный и синий цвета. Этот факт мы и отразили в данном перечислении. Автоматически выведем экземпляры классов Eq (сравнимые величины) и Ord (упорядоченные величины) — они нам потребуются.

Теперь определим два типа, которые соответствуют направлению вращения (по часовой стрелке и против неё) и той плоскости, в которой происходит вращение (горизонтальная, вертикальная и фронтальная). Это очень просто:

data RDirection = ClockWise
                | CounterClockWise
  deriving (Eq, Ord, Show)

data Plain = Horizontal
           | Vertical
           | Frontal
  deriving (Eq, Ord, Show)

В дополнение к классам для сравнимых и упорядоченных величин для этих двух типов автоматически выведем экземпляры для класса Show, поскольку мы будем выводить на экран последовательность вращений.

Осталось определить главный тип, который представляет собой состояние кубика Рубика. Это уже будет запись с именованными полями:

data RubikCube = RC
                 {
                   rcTop    :: Matrix Color,
                   rcBottom :: Matrix Color,
                   rcFront  :: Matrix Color,
                   rcRear   :: Matrix Color,
                   rcRight  :: Matrix Color,
                   rcLeft   :: Matrix Color
                 }
  deriving (Eq, Ord)

Что за тип Matrix такой? Очевидно, что это представление матриц. Мы не будем использовать для наших целей какие-либо специальные библиотеки, а ничтоже сумняшеся определим два синонима типов:

type Vector a = [a]

type Matrix a = [Vector a]

Вот и все типы…

Вспомогательные функции

В качестве вспомогательных функций напишем несколько таких, которые работают с векторами и матрицами. Поскольку это очень просто, то на переизобретение велосипеда мы потратим буквально пару минут. Прекрасный язык Haskell хорош, в том числе, и этим своим свойством. Например, вот функции для получения размеров матрицы. Обратите внимание на то, насколько они просты в определении:

getWidth :: Matrix a -> Int
getWidth m = length $ getRow m 0

getHeight :: Matrix a -> Int
getHeight m = length $ getColumn m 0

getSize :: Matrix a -> (Int, Int)
getSize m = (getWidth m, getHeight m)

Как видно, тут всё очень просто. Так же просто определить геттеры и сеттеры для элементов вектора и метрицы. Смотрите:

getVectorElement :: Vector a -> Int -> a
getVectorElement = (!!)

setVectorElement :: Vector a -> Int -> a -> Vector a
setVectorElement v i x = take i v ++ [x] ++ drop (i + 1) v

getElement :: Matrix a -> Int -> Int -> a
getElement m r c = getRow m r !! c

setElement :: Matrix a -> Int -> Int -> a -> Matrix a
setElement m r c x = setRow m r $ setVectorElement row c x
  where
    row = getRow m r

Здесь мы просто манипулируем элементами в списках. Надо помнить, что сеттеры на самом деле не осуществляют никакого деструктивного присваивания, они просто возвращают новый экземпляр вектора или матрицы, в котором нужный элемент заменён на заданное значение. Так что дополнительно напишем ещё по два геттера и сеттера дл матрицы. Они будут возвращать и устанавливать не элементы, а целые столбцы и строки. Как хорошо, что в функциональном программировании есть функции высшего порядка и, в частности, функция map:

getRow :: Matrix a -> Int -> Vector a
getRow = (!!)

setRow :: Matrix a -> Int -> Vector a -> Matrix a
setRow m r v = take r m ++ [v] ++ drop (r + 1) m

getColumn :: Matrix a -> Int -> Vector a
getColumn m c = map (!! c) m

setColumn :: Matrix a -> Int -> Vector a -> Matrix a
setColumn m c v = map ((row, x) -> setVectorElement row c x) $ zip m v

Видите, здесь опыть простая манипуляция составными частями матрицы. Особенно умиляет определение функции getColumn. Проникнитесь им :).

Для работы с кубиком Рубика нам ещё потребуется функция вращения матрицы. Определим два варианта — вращение по и против часовой стрелки:

rotateMatrix :: Matrix a -> RDirection -> Matrix a
rotateMatrix m ClockWise        = map (reverse . getColumn m) [0..getWidth m - 1]
rotateMatrix m CounterClockWise = map (getColumn m) [getWidth m - 1,
                                                     getWidth m - 2..0]

Собственно, при вращении на 90 градусов у нас столбцы меняются местами со строками. Надо только следить за правильным порядком следования элементов в них — иногда (в случае вращения по часовой стрелке) следование элементов необходимо обращать.

Ну вот как-то так.

Реализуем поиск на А*

Разработку основной функциональность начнём, как это обычно бывает, сверху вниз. Для этого сразу же реализуем функцию main, которая банально запустит алгоритм А* из стандартного модуля:

main :: Int -> IO ()
main n = mapM_ putStrLn $
           case aStar neighbours (_ _ -> 1) (_ -> 0) goal $ cube n of
             Nothing   -> []
             Just path -> map (show . fst) path

Ну вот здесь у нас имеется вызов функции aStar, которая либо ничего не возвращает, либо возвращает путь из вершин. Если путь найден, то он преобразуется в строку, которая и выводится на экран. Стандартная же функция aStar требует на вход нескольких вещей. В первую очередь, она хочет получить функцию, которая для заданного состояния возвращает множество всех соседних состояний. Это функция neighbours. Далее идёт передача двух анонимных функций — первая из них возвращает расстояние между состояниями в графе (и для кубика Рубика это расстояние независимо от состояний всегда равно 1, поскольку состояния равноудалены друг от друга), вторая представляет собой так называемую эвристику. Её мы использовать не будем (нет нужды).

Ещё одна функция goal представляет собой предикат, который для заданного состояния определяет, является ли оно целевым или нет. Ну и, наконец, последним параметром передаётся начальное состояние кубика Рубика.

Рассмотрим определение функции neighbours:

neighbours :: ((RDirection, Plain, Int), RubikCube)
           -> Set ((RDirection, Plain, Int), RubikCube)
neighbours (_, rc) = Set.fromList $
                       map (s@(rd, p, i) -> (s, rotateRubik rc rd p i))
                           [(rd, p, i) | rd <- [ClockWise, CounterClockWise],
                                         p  <- [Horizontal, Vertical, Frontal],
                                         i  <- [0..getWidth (rcTop rc) - 1]]

Эта функция для заданного состояния возвращает множество Set соседних состояний. В данном случае мы строим перечень всех возможных вращений, которые можно осуществить с кубиком. Получается обычный генератор списка, зависящий от трёх переборов: (1) вращаем в ту или другую сторону, (2) вращаем в одной из трёх плоскостей и (3) вращаем один из n рядов. Для кубика Рубика размером 2х2х2 получается 2 * 3 * 2 = 12 соседних состояний. Для кубика размером 3х3х3 получается 2 * 3 * 3 = 18 состояний. Ну и так далее…

Теперь предикат для определения целевого состояния. Его определение очень просто:

goal :: ((RDirection, Plain, Int), RubikCube) -> Bool
goal (_, rc) = all ((x:xs) -> all (== x) xs) $
                 map (concat . ($ rc)) [rcTop, rcBottom, rcFront,
                                        rcRear, rcRight, rcLeft]

Здесь записано, что все плашки каждой из шести граней кубика должны быть одного цвета.

Постановка задачи и заключение

Мой младший сын добрался до четырёх моих кубиков и полностью перемешал их. Именно печаль по этому поводу и стала основой конкурса. Вот в таком состоянии кубики и находятся по сей день:

Описание представленных состояний на языке Haskell для поиска решения выглядит так:

cube :: Int -> ((RDirection, Plain, Int), RubikCube)
cube 2 = ((ClockWise, Horizontal, 0),
          RC { 
               rcTop =    [[Green,  Red],
                           [Blue,   Green]],
               rcBottom = [[Yellow, White],
                           [Blue,   Orange]],
               rcFront =  [[Yellow, Red],
                           [Orange, Yellow]],
               rcRear =   [[Yellow, Blue],
                           [Green,  Orange]],
               rcRight =  [[White,  Blue],
                           [Red,    White]],
               rcLeft =   [[Red,    Orange],
                           [Green,  White]]
             })
cube 3 = ((ClockWise, Horizontal, 0),
          RC { 
               rcTop =    [[White,  Yellow, White],
                           [Green,  White,  White],
                           [Red,    Blue,   Red]],
               rcBottom = [[Orange, Yellow, Green],
                           [Green,  Yellow, Blue],
                           [Blue,   Blue,   Red]],
               rcFront =  [[White,  Red,    Green],
                           [Green,  Blue,   Orange],
                           [Yellow, Red,    White]],
               rcRear =   [[Orange, Blue,   Orange],
                           [Red,    Green,  Orange],
                           [Yellow, Orange, Orange]],
               rcRight =  [[Yellow, Red,    Blue],
                           [Yellow, Orange, Green],
                           [Red,    White,  Blue]],
               rcLeft =   [[Green,  Yellow, Blue],
                           [White,  Red,    White],
                           [Yellow, Orange, Green]]
             })
cube 4 = ((ClockWise, Horizontal, 0),
          RC { 
               rcTop =    [[White,  Red,    Orange, Yellow],
                           [Blue,   Blue,   Yellow, White],
                           [Orange, Red,    Yellow, Orange],
                           [Orange, Yellow, Orange, Red]],
               rcBottom = [[Green,  Red,    Blue,   Red],
                           [Yellow, Green,  Yellow, Yellow],
                           [Green,  Orange, Orange, White],
                           [Red,    Yellow, Green,  Orange]],
               rcFront =  [[Blue,   Green,  Green,  Blue],
                           [Green,  White,  Red,    Blue],
                           [White,  Orange, Blue,   Yellow],
                           [White,  Green,  Yellow, Yellow]],
               rcRear =   [[Orange, Yellow, White,  Green],
                           [White,  Green,  White,  White],
                           [Blue,   Yellow, Red,    Blue],
                           [Blue,   Orange, Red,    Blue]],
               rcRight =  [[White,  White,  Green,  Green],
                           [Orange, White,  Blue,   Green],
                           [Orange, Blue,   Green,  Red],
                           [Green,  Red,    Blue,   Yellow]],
               rcLeft =   [[Red,    Orange, White,  White],
                           [Red,    Red,    Green,  Yellow],
                           [Red,    Orange, White,  Blue],
                           [Yellow, Red,    Blue,   Orange]]
             })
cube 5 = ((ClockWise, Horizontal, 0),
          RC { 
               rcTop =    [[Orange, Blue,   Green,  Red,    Yellow],
                           [Orange, Green,  Blue,   White,  Yellow],
                           [Red,    White,  Yellow, White,  Orange],
                           [Green,  Yellow, Blue,   Blue,   Yellow],
                           [Red,    White,  Green,  Blue,   Blue]],
               rcBottom = [[Red,    Blue,   White,  Yellow, Blue],
                           [Yellow, Yellow, Red,    Red,    White],
                           [Orange, Red,    White,  White,  Orange],
                           [Orange, Yellow, Yellow, White,  Red],
                           [Blue,   White,  Red,    Green,  White]],
               rcFront =  [[Green,  Orange, Red,    Red,    Yellow],
                           [Green,  White,  White,  Green,  Green],
                           [Yellow, Orange, Red,    Yellow, White],
                           [Orange, Blue,   Blue,   Blue,   Green],
                           [Green,  Orange, Green,  Blue,   Red]],
               rcRear =   [[Orange, Yellow, Yellow, White,  Green],
                           [Orange, Green,  Green,  Red,    Yellow],
                           [Green,  Orange, Orange, Red,    White],
                           [White,  Yellow, Green,  Green,  Blue],
                           [Blue,   Yellow, Blue,   Red,    Yellow]],
               rcRight =  [[White,  Green,  Yellow, White,  White],
                           [Blue,   Orange, Orange, White,  Red],
                           [Blue,   Yellow, Blue,   Yellow, Blue],
                           [Red,    Orange, Orange, Red,    Green],
                           [Red,    Blue,   Yellow, Orange, Yellow]],
               rcLeft =   [[Orange, Red,    White,  Orange, Green],
                           [Red,    Orange, Red,    Blue,   White],
                           [Red,    Green,  Green,  Green,  Orange],
                           [Yellow, Orange, Blue,   Red,    Green],
                           [White,  Blue,   Blue,   White,  Orange]]
             })

Для того чтобы решить поставленную задачу, мне пришлось развернуть кластер из почти полутора тысяч серверов (до круглого числа не хватило 12 штук). Эта серверная ферма, расположенная на обратной стороне Луны, за разумное время не смога найти решения даже для кубика размером 2х2х2. Так что призы остались нераспределёнными, в связи с чем объявляю свою волю: кто первый в комментариях здесь даст мне алгоритм сборки представленных кубиков (желательно, кратчайший), тот и получит приз.

Ознакомиться с моим модулем можно здесь: Rubik.hs ^[1].

Мои предыдущие статьи о конкурсах по ФП на Хаброхабре:

• Конкурсы в 2011 году: Альманах конкурсов по ФП за 2011 год ^[2]
• Расшифровка кода на языке Haskell (конкурс по ФП в январе 2012) ^[3]
• Шахматные задачи на мат в один ход: решение на языке Haskell ^[4]
• Измерение объёмов при помощи двух заданных сосудов: решение на языке Haskell ^[5]
• Трансмутации слов друг в друга: решение на языке Haskell ^[6]
• Решение арифметических задач — вероятностный подход против регулярных выражений ^[7]
• Поиск кратчайшего расстояния между точками в трёхмерном пространстве ^[8]
• Управление лифтами: решение на языке Haskell ^[9]
• Решение логических задач на языке Haskell: в своём ли уме Валет? ^[10]
• Поиск скрывающегося Доктора X среди пациентов — решение более сложных логических задач ^[11]
• Шарики и дырки — один из вариантов плотной упаковки на языке Haskell ^[12]
• Раскрашиваем карту при помощи языка Haskell

Автор: Darkus

Источник ^[13]