Учебник по Haskell

-- смещение положение по направдению

shift :: Vec -> Pos -> Pos

shift (Vec (va, vb)) (pa, pb) = (va + pa, vb + pb)

-- направление хода

orient :: Move -> Vec

orient m = Vec $ case m of

Up

-> (-1, 0)

Down

-> (1 , 0)

Left

-> (0 , -1)

Right

-> (0 , 1)

-- метка для пустой фишки

emptyLabel :: Label

emptyLabel = 15

Маленькие функции within, shift, orient, emptyLabel делают как раз то, что подписано в комментариях.

Думаю, что их определение не сложно понять. Но есть одна тонкость, поскольку в функции orient мы поль-

зуемся конструкторами Left и Right необходимо спрятать тип Either из Prelude. Мы ввели дополнительный

тип Vec для обозначения смещения, чтобы случайно не подставить вместо него индексы.

Разберёмся с функцией move. Сначала мы вычисляем положение фишки, которая пойдёт на пустое место

id’. Мы делаем это, сместив (shift) положение пустышки (id) по направлению хода (orient a).

Мы обновляем массив, который описывает доску с помощью специальной функции //. Посмотрим на её

тип:

Пятнашки | 211

(//) :: Ix i => Array i a -> [(i, a)]

-> Array i a

Она принимает массив и список обновлений в этом массиве. Обновления представлены в виде пары

индекс-значение. В охранном выражении мы проверяем, если индекс перемещаемой фишки в пределах дос-

ки, то мы возвращаем новое положение, в котором пустышка уже находится в положении id’ и массив об-

новлён. Мы составляем список обновлений updates bз двух элементов, это перемещения фишки и пустышки.

Если же фишка за пределами доски, то мы возвращаем исходное положение.

Перемешиваем фишки

Игра начинается с такого положения, в котором все фишки перемешаны. Но перемешивать фишки про-

извольным образом было бы не честно, поскольку известно, что в пятнашках половина расстановок не при-

водит к выигрышу. Поэтому мы будем перемешивать так: мы стартуем из начального положения и делаем

несколько ходов произвольным образом. Количество ходов определяет сложность игры:

shuffle :: Int -> IO Game

shuffle n = (iterate (shuffle1 =<< ) $ pure initGame) !! n

shuffle1 :: Game -> IO Game

shuffle1 = un

Функция shuffle1 перемешивает фишки один раз. С помощью функции iterate мы строим список рас-

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

n-тую позицию. Обратите внимание на то, что мы не можем просто написать:

iterate shuffle1 initGame

Так у нас не совпадут типы. Для функции iterate нужно чтобы вход и выход функции имели одинаковые

типы. Поэтому мы пользуемся в функции iterate методами классов Monad и Applicative (глава 6).

Теперь определим функцию shuffle1. Мы делаем ход в текущей позиции, который мы выбрали случай-

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

randomElem, а функция nextMoves будет возвращать список доступных ходов для данного положения:

shuffle1 :: Game -> IO Game

shuffle1 g = flip move g <$> (randomElem $ nextMoves g)

randomElem :: [a] -> IO a

randomElem = un

nextMoves :: Game -> [Move]

nextMoves = un

Нам осталось определить всего две функции, и всё готово для игры. Определим выбор случайного эле-

мента из списка:

import System.Random

...

randomElem :: [a] -> IO a

randomElem xs = (xs !! ) <$> randomRIO (0, length xs - 1)

Мы генерируем случайное число в диапазоне индексов списка и затем извлекаем элемент. Теперь функ-

ция определения ходов в текущем положении:

nextMoves g = filter (within . moveEmptyTo . orient) allMoves

where moveEmptyTo v = shift v (emtyField g)

allMoves = [Up, Down, Left, Right]

Мы выполняем схожие операции с теми, что были в функции move. Мы фильтруем из списка всех ходов

те, что выводят пустую фишку за пределы доски.

212 | Глава 13: Поиграем

Отображение положения

Я немного поторопился, нам осталась ещё одна функция. Это отображение позиции. Я не буду подробно

останавливаться на теле функции, скажу лишь то, что она составляет строку так как это показано в коммен-

тарии к функции.

--

+----+----+----+----+

--

|

1 |

2 |

3 |

4 |

--

+----+----+----+----+

--

|

5 |

6 |

7 |

8 |

--

+----+----+----+----+

--

|

9 | 10 | 11 | 12 |

--

+----+----+----+----+

--

| 13 | 14 | 15 |

|

--

+----+----+----+----+

--

instance Show Game where

show (Game _ board) = ”\n” ++ space ++ line ++

(foldr (\a b -> a ++ space ++ line ++ b) ”\n” $ map column [0 .. 3])

where post id = showLabel $ board ! id

showLabel n

= cell $ show $ case n of

15 -> 0

n

-> n+1

cell ”0”

= ”

”

cell [x]

= ’ ’:’ ’: x :’ ’:[]

cell [a,b] = ’ ’: a : b :’ ’:[]

line = ”+----+----+----+----+\n”

nums = ((space ++ ”|”) ++ ) . foldr (\a b -> a ++ ”|” ++ b) ”\n” .

map post

column i = nums $ map (\x -> (i, x)) [0 .. 3]

space = ”\t”

Теперь мы можем загрузить модуль Loop в интерпретатор и набрать play. Немного отвлечёмся и поигра-

ем.

Prelude> :l Loop

[1 of 2] Compiling Game

( Game. hs, interpreted )

[2 of 2] Compiling Loop