Случайное и конечное состояние игры пятнашки
Вот и закончилась первая часть книги. Мы узнали основные конструкции языка Haskell. В этой главе мы напишем законченную программу для игры в пятнашки. Ну или почти законченную, глава венчается упражнениями.
Решение задачи начинается с описания проблемы и наброска решения. Мы хотим создать программу, в которой можно будет играть в пятнашки. Если вам не знакома это игра, то взгляните на рисунок. Игра начинается с позиции, в которой все фишки перемешаны. Необходимо, переставляя фишки, вернуться в исходное положение. Каждым ходом мы двигаем одну фишку на пустое поле. В исходном положении фишки идут по порядку.
Случайное и конечное состояние игры пятнашки
Программа будет перемешивать фишки и отображать поле для игры. Она будет спрашивать следующий ход и обновлять поле после хода. Если мы расставим все фишки по порядку, программа сообщит нам об этом и предложит начать новую игру. В каждый момент мы можем не только сделать ход, но и покинуть игру или начать всё заново. Известно, что не из любого положения можно расставить фишки по порядку. Поэтому наш алгоритм перемешивания должен генерировать только такие позиции, для которых решение возможно.
Программа, которую мы хотим написать, будет вести диалог с пользователем. Она показывает поле для игры и спрашивает следующий ход. Потом она распознаёт ход, и показывает обновлённое поле. И так далее. Нам нужно как-то организовать этот диалог.
При этом в программе можно выделить две независимые части. Одна отвечает за сам диалог. Она принимает реплики пользователя и отображает поле для игры. А другая часть отвечает за правила игры пятнашки: как ходы влияют на поле, какое положение является победным, как перемешивать фишки.
У нас будет два отдельных модуля: один для описания игры, назовём его Game, а другой для описания диалога с пользователем. Мы назовём его Loop (петля или цикл), поскольку диалог это зацикленная процедура получения реплики и реакции на реплику.
Такой вот набросок-ориентир. После этого можно приступать к реализации. Но с чего начать?
В Haskell программы обычно начинают строить с каркаса – с типов и классов. Нам нужно выделить основные сущности и подумать какие типы подходят для их описания лучше всего.
В нашей задаче есть поле с фишками и ходы. Мы делаем ходы и фишки двигаются. Поле – это матрица или двумерный массив. У нас есть два индекса, которые пробегают значения от нуля до трёх. В каждой ячейке массива хранятся фишки. Фишки обозначаются целыми числами:
type Pos = (Int, Int) type Label = Int type Board = Array Pos Label
Пустую фишку мы будем также обозначать числом. Физически когда мы ходим, мы меняем положение одной фишки. Но в нашем описании мы меняем местами две фишки, поскольку пустая фишка также обозначается номером. Когда мы ходим, мы меняем положение пустой фишки, одним ходом мы можем сместить её вверх, вниз, влево или вправо. Введём специальный тип для обозначения ходов:
data Move = Up | Down | Left | Right
Для того чтобы при каждом ходе не искать пустую клетку, давайте сохраним её текущее положение. Тип Game будет содержать текущее положение пустой клетки и положение фишек:
data Game = Game {
emptyField :: Pos,
gameBoard :: Board }
Вот и все типы для описания игры. Сохраним их в модуле Game. Теперь подумаем о типах для диалога с пользователем. В этом модуле наверняка будет много функций с типом IO, потому что в нём происходит взаимодействие с игроком. Но, что является каркасом для диалога?
Если мы хотим с кем-нибудь общаться, необходимо чтобы у нас был с собеседником общий язык, он и будет каркасом для диалога. Вспомним, что мы ожидаем от пользователя. Пользователь может:
Сделать ход
Начать новую игру
Выйти из игры
Если пользователь делает ход мы показываем новое положение поля, если он начинает новую игру мы показываем ему новую перемешанную позицию, давайте у нас будет разная степень перемешанности фигур. При перемешивании мы стартуем из победного положения и начинаем случайным образом делать ходы. Чем больше ходов мы сделаем тем сложнее будет собрать игру. Поэтому пользователь будет указывать число шагов для перемешивания при запросе новой игры. Если пользователь попросит закончить игру мы попрощаемся и выйдем из игры.
На основе этих рассуждений вырисовывается следующий тип для сообщений:
data Query = Quit | NewGame Int | Play Move
Значение типа Query (запрос) может быть константа Quit (выход), запрос новой игры NewGame с числом, которое указывает на сложность новой игры, также игрок может просто сделать ход Play Move.
А каков формат наших ответов? Все наши ответы на самом деле будут вызовами функции putStrLn мы будем отвечать пользователю изменениями экрана. Поэтому у нас нет специального типа для ответов. Итак у нас есть каркас, который можно начинать покрывать значениями. На этом этапе у нас есть два модуля. Это модуль Loop:
module Loop where import Game data Query = Quit | NewGame Int | Play Move
И модуль Game:
module Game where
import Data.Array
data Move = Up | Down | Left | Right
deriving (Enum)
type Label = Int
type Pos = (Int, Int)
type Board = Array Pos Label
data Game = Game {
emptyField :: Pos,
gameBoard :: Board }
Мы уже знаем как происходят ленивые вычисления. Мы принимаем выражение и начинаем очищать его от синонимов от корня к листьям или сверху вниз. Оказывается таким способом можно писать программы. Более того в функциональном программировании это очень распространённый подход. Мы начинаем со спецификации задачи (неформального описания) и потихоньку вытягиваем из него выражения языка Haskell. Начинаем мы с корня, с самой верхней функции. Эта функция будет состоять из подвыражений. Когда мы напишем верхнюю функцию, мы перейдём к подвыражениям. И так мы будем спускаться пока не напишем всю программу.
Кажется, что такой подход очень не надёжен. Ведь мы сможем запустить программу только когда напишем её целиком. На каждом промежуточном шаге у нас есть неопределённые подвыражения. Получается, что очень долгое время мы будем писать программу, не зная работает она или нет.
Оказывается, что в Haskell есть решение этой проблемы. Нам поможет значение undefined. Мы будем писать только тип функции (и мысленно будем говорить, пусть она делает то-то), а вместо определения будем писать undefined. При этом конечно мы не сможем выполнять программу, вычислитель подорвётся на первом же значении, но мы сможем узнать осмысленна ли наша программа с точки зрения компилятора, проходит ли она проверку типов. В Haskell это большой плюс. Если программа прошла проверку типов, то скорее всего она будет работать.
Такой подход написания программ называется написанием сверху вниз. Мы начинаем с самой верхней функции и потихоньку вычищаем все undefined. Если вспомнить ленивые вычисления, то там роль undefined выполняли отложенные вычисления.
В чём преимущества такого подхода? Посмотрим на дерево. Если мы идём сверху вниз, то в самом начале у нас лишь одна задача, потом их становится всё больше и больше. Они дробятся, но источник у них один. Мы всегда знаем, что нам нужно чтобы закончить нашу задачу. Написать это, это и это подвыражение. Беда только в том, что это подвыражение содержит ещё больше подвыражений. Но сложные подвыражения мы можем оставить на потом и заняться другими. А потом, когда мы их доделаем может вдруг оказаться, что это сложное выражение нам и не нужно.
Дерево задач
Если же мы начинаем идти из листьев, то у нас много отправных точек, которые должны сойтись в одной цели. При этом они могут и не сойтись, мы можем застрять в одной точке и потратить слишком много времени. И на остальные задачи у нас не хватит сил или мы можем потратить много времени на решение задачи, которая совсем не нужна для итогового решения. Также как и в вычислениях по значению, мы можем застрять на вычислении бесконечного значения, даже если в итоговом ответе нам понадобится лишь его малая часть.
Ещё один плюс решения сверху вниз состоит в экономии усилий. Мы можем написать всю программу в виде функций, которые состоят лишь из определений типов. И утрясти общую схему программы на типах. Также при реализации отдельных частей программы, мы можем воспользоваться упрощёнными алгоритмами, достаточными для тестирования приложения, оставив отрисовку деталей на потом. Мы не тратим время на реализацию, а смотрим как программа выглядит “в целом”. Если общий набросок нас устраивает мы можем начать заполнять дыры и детализировать отдельные выражения. Так мы будем детализировать-детализировать пока не придём к первоначальному решению. Далее если у нас останется время мы можем сменить реализацию некоторых частей. Но общая схема останется прежней, она уже устоялась на уровне типов. Часто такую стратегию разработки называют разработкой через прототипы (developing by prototyping). При этом процесс написания приложения можно представить как процесс сходимости, приближения к пределу. У нас есть серия промежуточных решений или прототипов, которые с каждым шагом всё точнее и точнее описывают итоговую программу. Также если мы работаем в команде, то дробление задачи на подзадачи происходит естественно, в ходе детализации, мы можем распределить нагрузку, распределив разные undefined между участниками проекта.
Слово undefined будет встречаться очень часто, буквально в каждом значении. Оно очень длинное, и часто писать его будет слишком утомительно. Определим удобный синоним. Я обычно использую un или lol (что-нибудь краткое и удобное для автоматического поиска):
un :: a un = undefined
Но давайте приступим к реализации нашей игры. Самая верхняя функция, будет запускать программу. Назовём её play. Это функция взаимодействия с пользователем она ведёт диалог, поэтому её тип будет IO ():
play :: IO () play = un
Итак у нас появилась корневая функция. Что мы будем в ней делать? Для начала мы поприветствуем игрока (функция greetings). Затем предложим ему начать игру (функция setup), после чего запустим цикл игры (функция gameLoop). Приветствие это просто надпись на экране, поэтому тип у него будет IO (). Предложение игры вернёт стартовую позицию для игры, поэтому тип будет IO Game. Цикл игры принимает состояние и продолжает диалог. В типах это выражается так:
play :: IO () play = greetings >> setup >>= gameLoop greetings :: IO () greetings = un setup :: IO Game setup = un gameLoop :: Game -> IO () gameLoop = un
Сохраним эти определения в модуле Loop и загрузим модуль с программой в интерпретатор:
Prelude> :l Loop [1 of 2] Compiling Game ( Game.hs, interpreted ) [2 of 2] Compiling Loop ( Loop.hs, interpreted ) Ok, modules loaded: Game, Loop. *Loop>
Модуль загрузился. Он потянул за собой модуль Game, потому что мы воспользовались типом Move из этого модуля. Программа прошла проверку типов, значит она осмысленна и мы можем двигаться дальше.
У нас три варианта дальнейшей детализации это функции greetings, setup и gameLoop. Мы пока пропустим greetings там мы напишем какое-нибудь приветствие и сообщим игроку куда он попал и как ходить.
В функции setup нам нужно начать первую игру. Для начала игры нам нужно узнать её сложность, на сколько ходов перемешивать позицию. Это значит, что нам нужно спросить у игрока целое число. Мы спросим число функцией getLine, а затем попробуем его распознать. Если пользователь ввёл не число, то мы попросим его повторить ввод. Функция readInt :: String -> Maybe Int распознаёт число. Она возвращает целое число завёрнутое в Maybe, потому что строка может оказаться не числом. Затем это число мы используем в функции shuffle (перемешать), которая будет возвращать позицию, которая перемешана с заданной глубиной.
-- в модуль Loop
setup :: IO Game
setup = putStrLn "Начнём новую игру?" >>
putStrLn "Укажите сложность (положительное целое число): " >>
getLine >>= maybe setup shuffle . readInt
readInt :: String -> Maybe Int
readInt = un
-- в модуль Game:
shuffle :: Int -> IO Game
shuffle = un
Функция shuffle возвращает состояние игры Game, которое завёрнуто в IO. Оно завёрнуто в IO, потому что перемешивать позицию мы будем случайным образом, это значит, что мы воспользуемся функциями из модуля Random. Мы хотим чтобы каждая новая игра начиналась с новой позиции, поэтому скорее всего где-то в недрах функции shuffle мы воспользуемся newStdGen, которая и потянет за собой тип IO.
Игра перемешивается согласно правилам, поэтому функцию shuffle мы поселим в модуле Game. А функция readInt это скорее элемент взаимодействия с пользователем, ведь в ней мы распознаём число в строчном ответе, она останется в модуле Loop.
Проверим работает ли наша программа:
*Loop> :r [1 of 2] Compiling Game ( Game.hs, interpreted ) [2 of 2] Compiling Loop ( Loop.hs, interpreted ) Ok, modules loaded: Game, Loop. *Loop>
Работает! Можно спускаться по дереву выражения ниже. Сейчас нам предстоит написать одну из самых сложных функций, это функция gameLoop.
Функция цикла игры принимает текущую позицию. При этом у нас два варианта. Возможно игра пришла в конечное положение (isGameOver) и мы можем сообщить игроку о том, что он победил (showResults), если это не так, то мы покажем текущее положение (showGame), спросим ход (askForMove) и среагируем на ход (reactOnMove).
-- в модуль Loop
gameLoop :: Game -> IO ()
gameLoop game
| isGameOver game = showResults game >> setup >>= gameLoop
| otherwise = showGame game >> askForMove >>= reactOnMove game
showResults :: Game -> IO ()
showResults = un
showGame :: Game -> IO ()
showGame = un
askForMove :: IO Query
askForMove = un
reactOnMove :: Game -> Query -> IO ()
reactOnMove = un
-- в модуль Game
isGameOver :: Game -> Bool
isGameOver = un
Как определить закончилась игра или нет это скорее дело модуля Game. Все остальные функции принадлежат модулю Loop. Функция askForMove возвращает реплику пользователя и тут же направляет её в функцию reactOnMove. Функции showGame и showResults ничего не возвращают, они только меняют состояния экрана. После того как игра закончится мы предложим игроку начать новую.
Обратите внимание на то, как даже не дав определение функции, мы всё же очерчиваем её смысл в объявлении типа. Так посмотрев на функцию askForMove и сопоставив тип с именем, мы можем понять, что эта функция предназначена для запроса значения типа Query, для запроса реплики пользователя. А по типу функции showGame мы можем понять, что она проводит какой-то побочный эффект, судя по имени что-то показывает, из типа видно что показывает значение типа Game или текущую позицию.
Определим функции отображения результата и позиции. Когда игра закончится мы покажем итоговое положение и объявим результат.
showResults :: Game -> IO () showResults g = showGame g >> putStrLn "Игра окончена."
Теперь определим функцию showGame. Если тип Game является экземпляром класса Show, то определение окажется совсем простым:
-- в модуль Loop
showGame :: Game -> IO ()
showGame = putStrLn . show
-- в модуль Game
instance Show Game where
show = un
Теперь нужно определить функции askForMove и reactOnMove. Первая функция требует установить протокол реплик пользователя, в каком виде он будет набирать значения типа Query. Нам пока лень об этом думать и мы перейдём к функции reactOnMove. Вспомним её тип:
reactOnMove :: Game -> Query -> IO ()
Функция принимает текущее положение и запрос пользователя. И ничего не возвращает, она продолжает игру. В любом случае в этой функции будет сопоставление с образцом по запросам пользователя так что можно написать:
reactOnMove :: Game -> Query -> IO ()
reactOnMove game query = case query of
Quit ->
NewGame n ->
Play m ->
Рассмотрим каждый из случаев. В первом случае пользователь говорит, что ему надоело и он уже наигрался. Что ж попрощаемся и вернём значение единичного типа.
...
Quit -> quit
...
quit :: IO ()
quit = putStrLn "До встречи." >> return ()
В следующем варианте пользователь хочет начать всё заново. Так начнём!
NewGame n -> gameLoop =<< shuffle n
Мы вызвали функцию перемешивания shuffle с заданным уровнем сложности. И рекурсивно вызвали цикл игры с новой позицией. Всё началось по новой. В третьей альтернативе пользователь делает ход, на это мы должны обновить позицию запустить цикл игры с новым значением:
-- в модуль Loop
Play m -> gameLoop $ move m game
-- в модуль Game
move :: Move -> Game -> Game
move = un
Функция move обновляет согласно правилам текущую позицию. Соберём все определения вместе:
reactOnMove :: Game -> Query -> IO ()
reactOnMove game query = case query of
Quit -> quit
NewGame n -> gameLoop =<< shuffle n
Play m -> gameLoop $ move m game
Теперь всё же вернёмся к функции askForMove, научимся слушать пользователя. Сначала мы скажем какую-нибудь вводную фразу, предложение ходить (showAsk) затем запросим строку стандартной функцией getLine, потом нам нужно будет распознать (parseQuery) в строке значение типа Query. Если распознать его нам не удастся, мы напомним пользователю как с нами общаться (remindMoves) и попросим сходить вновь:
askForMove :: IO Query
askForMove = showAsk >>
getLine >>= maybe askAgain return . parseQuery
where askAgain = wrongMove >> askForMove
parseQuery :: String -> Maybe Query
parseQuery = un
wrongMove :: IO ()
wrongMove = putStrLn "Не могу распознать ход." >> remindMoves
showAsk :: IO ()
showAsk = un
remindMoves :: IO ()
remindMoves = un
Механизм распознавания похож на случай с распознаванием числа. Значение завёрнуто в тип Maybe. И в самом деле функция определена лишь частично, ведь не все строки кодируют то, что нам нужно.
Функции parseQuery и remindMoves тесно связаны. В первой мы распознаём ввод пользователя, а во второй напоминаем пользователю как мы закодировали его запросы. Тут стоит остановиться и серьёзно подумать. Как закодировать значения типа Query, чтобы пользователю было удобно набирать их? Но давайте отвлечёмся от этой задачи, она слишком серьёзная. Оставим её на потом, а пока проверим не ушли ли мы слишком далеко, возможно наша программа потеряла смысл. Проверим типы!
*Loop> :r [1 of 2] Compiling Game ( Game.hs, interpreted ) [2 of 2] Compiling Loop ( Loop.hs, interpreted ) Ok, modules loaded: Game, Loop.
Нам осталось дописать функции распознавания запросов и несколько маленьких функций с фразами и модуль Loop будет готов. Но перед тем как сделать это давайте упорядочим функции. Видно, что у нас выделилось несколько задач по типу общения с пользователем. У нас есть задачи, в которых мы что-то показываем пользователю, меняем состояние экрана и есть задачи, в которых мы просим от пользователя какие-то данные, ожидаем запросы функцией getLine. Также в самом верху выражения программы у нас расположены функции, которые координируют действия остальных, это третья группа. Сгруппируем функции по этому принципу.
play :: IO ()
play = greetings >> setup >>= gameLoop
gameLoop :: Game -> IO ()
gameLoop game
| isGameOver game = showResults game >> setup >>= gameLoop
| otherwise = showGame game >> askForMove >>= reactOnMove game
setup :: IO Game
setup = putStrLn "Начнём новую игру?" >>
putStrLn "Укажите сложность (положительное целое число): " >>
getLine >>= maybe setup shuffle . readInt
getLine)reactOnMove :: Game -> Query -> IO ()
reactOnMove game query = case query of
Quit -> quit
NewGame n -> gameLoop =<< shuffle n
Play m -> gameLoop $ move m game
askForMove :: IO Query
askForMove = showAsk >>
getLine >>= maybe askAgain return . parseQuery
where askAgain = wrongMove >> askForMove
parseQuery :: String -> Maybe Query
parseQuery = un
readInt :: String -> Maybe Int
readInt = un
putStrLn)greetings :: IO () greetings = un showResults :: Game -> IO () showResults g = showGame g >> putStrLn "Игра окончена." showGame :: Game -> IO () showGame = putStrLn . show showAsk :: IO () showAsk = un quit :: IO () quit = putStrLn "До встречи." >> return ()
По этим функциям видно, что нам немного осталось. Теперь вернёмся к запросам пользователя.
Можно вывести с помощью deriving экземпляр класса Read для типа Query и читать их функцией read. Но это плохая идея, потому что пользователь нашей программы может и не знать Haskell. Лучше введём сокращённые имена для всех значений. Например такие:
left -- Play Left right -- Play Rigth up -- Play Up down -- Play Down quit -- Quit new n -- NewGame n
Можно обратить внимание на то, что все команды начинаются с разных букв. Воспользуемся этим и дадим пользователю возможность набирать команды одной буквой. Это приводит на с к таким определениям для функций разбора значения и напоминания ходов:
parseQuery :: String -> Maybe Query
parseQuery x = case x of
"up" -> Just $ Play Up
"u" -> Just $ Play Up
"down" -> Just $ Play Down
"d" -> Just $ Play Down
"left" -> Just $ Play Left
"l" -> Just $ Play Left
"right" -> Just $ Play Right
"r" -> Just $ Play Right
"quit" -> Just $ Quit
"q" -> Just $ Quit
'n':'e':'w':' ':n -> Just . NewGame =<< readInt n
'n':' ':n -> Just . NewGame =<< readInt n
_ -> Nothing
remindMoves :: IO ()
remindMoves = mapM_ putStrLn talk
where talk = [
"Возможные ходы пустой клетки:",
" left или l -- налево",
" right или r -- направо",
" up или u -- вверх",
" down или d -- вниз",
"Другие действия:",
" new int или n int -- начать новую игру, int - целое число,",
"указывающее на сложность",
" quit или q -- выход из игры"]
Проверим работоспособность:
Prelude> :l Loop
[1 of 2] Compiling Game ( Game.hs, interpreted )
[2 of 2] Compiling Loop ( Loop.hs, interpreted )
Loop.hs:46:28:
Ambiguous occurrence `Left'
It could refer to either `Prelude.Left',
imported from `Prelude' at Loop.hs:1:8-11
(and originally defined in `Data.Either')
or `Game.Left',
imported from `Game' at Loop.hs:5:1-11
(and originally defined at Game.hs:10:25-28)
Loop.hs:47:28:
Ambiguous occurrence `Left'
...
...
Failed, modules loaded: Game.
*Game>
По ошибкам видно, что произошёл конфликт имён. Конструкторы Left и Right уже определены в Prelude. Это конструкторы типа Either. Давайте скроем их, добавим в модуль такую строчку:
import Prelude hiding (Either(..))
Теперь проверим:
*Game> :r [2 of 2] Compiling Loop ( Loop.hs, interpreted ) Ok, modules loaded: Game, Loop. *Loop>
Всё работает, можно двигаться дальше.
В модуле Loop нам осталось определить несколько маленьких функций. Поиск по слову un говорит нам о том, что осталось определить функции ``
greetings :: IO () readInt :: String -> Maybe Int showAsk :: IO ()
Самая простая это функция showAsk, она приглашает игрока сделать ход:
showAsk :: IO () showAsk = putStrLn "Ваш ход: "
Теперь функция распознавания целого числа:
import Data.Char (isDigit)
...
readInt :: String -> Maybe Int
readInt n
| all isDigit n = Just $ read n
| otherwise = Nothing
В первой альтернативе мы с помощью стандартной функции isDigit :: Char -> Bool проверяем, что строка состоит из одних только чисел. Если все символы числа, то мы пользуемся функцией из модуля Read и читаем целое число, иначе возвращаем Nothing.
Последняя функция, это функция приветствия. Когда игрок входит в игру он сталкивается с её результатами. Определим её так:
-- в модуль Loop
greetings :: IO ()
greetings = putStrLn "Привет! Это игра пятнашки" >>
showGame initGame >>
remindMoves
-- в модуль Game
initGame :: Game
initGame = un
Сначала мы приветствуем игрока, затем показываем состояние (initGame), к которому ему нужно стремиться, и напоминаем как делаются ходы. На этом определении мы раскрыли все выражения в модуле Loop, нам остался лишь модуль Game.
Определим модуль Game, но мы будем определять его не с чистого листа. Те функции, которые нам нужны уже определились в ходе описания диалога с пользователем. Нам нужно уметь составлять начальное состояние initGame, уметь составлять перемешанное состояние игры shuffle, нам нужно уметь реагировать на ходы move, определять какая позиция является выигрышной isGameOver и уметь показывать фишки в красивом виде. Приступим!
initGame :: Game
shuffle :: Int -> IO Game
isGameOver :: Game -> Bool
move :: Move -> Game -> Game
instance Show Game where
show = un
Таков наш план.
Начнём с самой простой функции, составим начальное состояние:
initGame :: Game initGame = Game (3, 3) $ listArray ((0, 0), (3, 3)) $ [0 .. 15]
Мы будем кодировать фишки цифрами от нуля до 14, а пустая клетка будет равна 15. Это просто соглашения о внутреннем представлении фишек, показывать мы их будем совсем по-другому.
С этим значением мы можем легко определить функцию определения конца игры. Нам нужно только добавить deriving (Eq) к типу Game. Тогда функция isGameOver примет вид:
isGameOver :: Game -> Bool isGameOver = ( == initGame)
Напишем функцию:
move :: Move -> Game -> Game
Она обновляет позицию после хода. В пятнашках не во всех позициях доступны все ходы. Если пустышка находится на краю, мы не можем вывести её за пределы доски. Это необходимо как-то учесть. Каждый ход задаёт направление обмена фишками. Если у нас есть текущее положение пустышки и ход, то по ходу мы можем узнать направление, а по направлению ту фишку, которая займёт место пустышки после хода. При этом нам необходимо проверять находится ли та фишка, которую мы хотим поместить на пустое место в пределах доски. Например если пустышка расположена в самом верху и мы хотим сделать ход Up (передвинуть её ещё выше), то положение игры не должно измениться.
import Prelude hiding (Either(..))
newtype Vec = Vec (Int, Int)
move :: Move -> Game -> Game
move m (Game id board)
| within id' = Game id' $ board // updates
| otherwise = Game id board
where id' = shift (orient m) id
updates = [(id, board ! id'), (id', emptyLabel)]
-- определение того, что индексы внутри доски
within :: Pos -> Bool
within (a, b) = p a && p b
where p x = x >= 0 && x <= 3
-- смещение положение по направлению
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).
Мы обновляем массив, который описывает доску с помощью специальной функции //. Посмотрим на её тип:
(//) :: 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 (emptyField g)
allMoves = [Up, Down, Left, Right]
Мы выполняем схожие операции с теми, что были в функции move. Мы фильтруем из списка всех ходов те, что выводят пустую фишку за пределы доски.
Я немного поторопился, нам осталась ещё одна функция. Это отображение позиции. Я не буду подробно останавливаться на теле функции, скажу лишь то, что она составляет строку так как это показано в комментарии к функции.
-- +----+----+----+----+
-- | 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 ( Loop.hs, interpreted ) Ok, modules loaded: Loop, Game. *Loop> play Привет! Это игра пятнашки +----+----+----+----+ | 1 | 2 | 3 | 4 | +----+----+----+----+ | 5 | 6 | 7 | 8 | +----+----+----+----+ | 9 | 10 | 11 | 12 | +----+----+----+----+ | 13 | 14 | 15 | | +----+----+----+----+ Возможные ходы пустой клетки: left или l -- налево right или r -- направо up или u -- вверх down или d -- вниз Другие действия: new int или n int -- начать новую игру, int - целое число, указывающее на сложность quit или q -- выход из игры Начнём новую игру? Укажите сложность (положительное целое число): 5 +----+----+----+----+ | 1 | 2 | 3 | 4 | +----+----+----+----+ | 5 | 6 | 7 | 8 | +----+----+----+----+ | 9 | | 10 | 11 | +----+----+----+----+ | 13 | 14 | 15 | 12 | +----+----+----+----+ Ваш ход: r +----+----+----+----+ | 1 | 2 | 3 | 4 | +----+----+----+----+ | 5 | 6 | 7 | 8 | +----+----+----+----+ | 9 | 10 | | 11 | +----+----+----+----+ | 13 | 14 | 15 | 12 | +----+----+----+----+ Ваш ход: r +----+----+----+----+ | 1 | 2 | 3 | 4 | +----+----+----+----+ | 5 | 6 | 7 | 8 | +----+----+----+----+ | 9 | 10 | 11 | | +----+----+----+----+ | 13 | 14 | 15 | 12 | +----+----+----+----+ Ваш ход: d +----+----+----+----+ | 1 | 2 | 3 | 4 | +----+----+----+----+ | 5 | 6 | 7 | 8 | +----+----+----+----+ | 9 | 10 | 11 | 12 | +----+----+----+----+ | 13 | 14 | 15 | | +----+----+----+----+ Игра окончена.
Ураа, получилось. Мы так долго писали программу, проверяя лишь типы, и в самом конце, когда мы закончили определение, всё работает. Конечно не всё работает так гладко, я уже написал эту программу и объясняю готовое решение, но когда общая схема программы утряслась, возможные ошибки определяются на раз. Мы могли вызвать отображение позиции не в том порядке или забыть проверку конца игры, всё это несколько строчек изменений.
Самые неприятные ошибки происходят, когда в середине выясняется, что мы ошиблись с типами. Типы, которые мы выбрали не могут описать явление, возможно мы не можем делать какие-то операции, которые нам, как неожиданно выяснилось, очень нужны. Это значит, что нужно менять каркас. Менять каркас, это значит сносить весь дом и строить новый. Возможно разрушения окажутся локальными, мы строим не дом, а город. И сносить придётся не всё, а несколько кварталов. Но это тоже большие перемены. Поэтому шаг определения типов очень важен. Впрочем сносить кварталы в Haskell одно удовольствие, поскольку стоит нам изменить какой-нибудь тип, например убрать какой-нибудь тип или изменить имя, компилятор тут же подскажет нам какие функции стали бессмысленными. Более коварные изменения связаны с добавлением конструктора-альтернативы. Например нам вдруг не понравился тип Bool и мы решили сделать его более человечным. Мы решили добавить ещё одно значение:
data Bool = True | False | IDonTKnow
Это может привести к неполному рассмотрению альтернатив в case-выражениях и сопоставлениях с образцом в аргументах функции. Такие ошибки крайне неприятны, поскольку они происходят на этапе выполнения программы, когда новое значение IDonTKnow дойдёт до case. В этом случае нам на выручку может прийти функция свёртки, если мы вместе с типом изменим и функцию свёртки, это скажется на всех функциях, которые были определены через неё. Чем больше таких функций, тем больше ошибок мы поймаем.
Измените диалог с пользователем. Сделайте так чтобы у игры было главное меню, в котором игрок выбирает разные побочные функции, вроде выхода, начать новую игру, подсказка и игровое меню, в котором игрок только передвигает фишки. Когда игрок собирает игру он попадает в главное меню.
Добавьте в игру подсчёт статистики. Если игрок дошёл до победной позиции он узнаёт за сколько ходов ему удалось решить задачу. Также ведётся история предыдущих попыток, по которой пользователь может следить как изменяются его результаты.
Подумайте можно ли выделить интерфейс игры в отдельный класс так, чтобы модуль Loop не зависел от конкретной реализации игры. Чтобы можно было, опираясь на абстрактные методы, вроде show для Game, или реакции на ход, вести диалог с пользователем. Попробуйте переписать игру пятнашки с помощью такого класса.
Попробуйте написать другую игру, например игру раскладывания пасьянса, крестики-нолики или шашки, не меняя модуля Loop. Так чтобы вы сделали необходимые экземпляры для классов из предыдущего упражнения, а всё остальное поведение следовало из них.