{- Strategies for the Snake game. Copyright (C) 2020 Max Schröder This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . A strategy function is a function for deciding in which direction the snake should move next. A strategy can also use some object to keep track of information across multiple calls. This module exports the following strategies: - randomStrategyParams: Always returns a random direction. - hamiltonStrategyParams: Makes the snake follow a Hamiltonian cycle and sometimes take shortcuts. See more details below. -} module Wettbewerb.Strategy (randomStrategyParams, hamiltonStrategyParams) where import Prelude hiding (Either(..)) import System.Random (mkStdGen, randomR) import Data.Sequence (Seq((:<|), (:|>), Empty), (|>), (><), fromList, insertAt, elemIndexL) import qualified Data.Sequence as Seq (length, filter, drop, take, zip) import Data.Bifunctor (second) import Control.Applicative (liftA2) import Data.Maybe (listToMaybe, isJust, fromJust) import Wettbewerb.Types (Strategy, StrategyParams, foodPosition, snake, parts, isEating, Position, Board, Direction(..), whichDirection) type Path = Seq Position -- A strategy that returns a random direction. -- The returned direction might be invalid, i. e. it is the opposite of the previous direction. -- However, in this case the snake just keeps moving in the previous direction, thus the chance -- of a turn is decreased. randomStrategyParams :: StrategyParams () randomStrategyParams = (randomStrategy, ()) -- Random strategy function randomStrategy :: Strategy () randomStrategy _ _ seed _ = (toEnum (fst $ randomR (0, 3) (mkStdGen seed)), ()) {- An advanced strategy based on Hamiltonian cycles. NOTE: THE CONCEPT OF THIS STRATEGY IS BASED ON THOUGHTS FROM THESE TWO ARTICLES: - Surma, Greg (2018): Slitherin - Solving the Classic Game of Snake with AI, from: https://gsurma.medium.com/slitherin-solving-the-classic-game-of-snake-with-ai-part-1-domain-specific-solvers-d1f5a5ccd635 (last retrieved: January 28, 2021) - Tapsell, John (2015): Nokia 6110 Part 3 – Algorithms, from: https://johnflux.com/2015/05/02/nokia-6110-part-3-algorithms (last retrieved: January 28, 2021) This strategy constructs a Hamiltonian cycle when it is called for the first time. A Hamiltonian cycle is a cycle that visits each node in a graph exactly once. This way, it is ensured that the snake cannot collide with itself because all parts of the snake are always on different cells as long as there are enough cells to fit the whole snake. A Hamiltonian path is determined by generating the longest path from the head of the snake to the second part of the snake. If this path contains all cells of the game board, it is a Hamiltonian path. Closing it, makes it a Hamiltonian cycle. Otherwise, no Hamiltonian path can be constructed and this strategy cannot be used on the given board with the specified initial state. However, such a strategy would be very boring and the game would take long. Therefore, this strategy also searches for safe shortcuts. Instead of blindly following the Hamiltonian cycle all the time, the snake tries to skip a part of the cycle to be able to reach the food faster. This can only be done if there are no parts of the snake on the skipped cells, i. e. the snake does not overtake its tail on the Hamiltonian cycle. This strategy uses a sequence that contains the previously constructed Hamiltonian cycle as an information object. The front of the sequence is the next cell the snake would visit on the cycle. To preserve this property, the sequence is rotated after each round. -} hamiltonStrategyParams :: StrategyParams (Seq Position) hamiltonStrategyParams = (hamiltonStrategy, Empty) hamiltonStrategy :: Strategy Path -- Part 1 of the strategy: A Hamiltonian cycle has already been constructed. hamiltonStrategy (width, height) state _ cycle@(nextPos :<| remainingCycle) -- Do not take shortcuts if the snake covers more than two thirds of the game board | Seq.length snakeParts > 2 * width * height `div` 3 = defaultResult -- Do not take shortcuts while the snake is eating | isEating (snake state) = defaultResult -- Do not take "shortcuts" if the snake is already moving to the direction of the food | dir `elem` optimalDirs = defaultResult -- Otherwise, take a shortcut if there is one and correct the cycle sequence by rotating it | otherwise = case shortcut of Nothing -> defaultResult Just pos -> (whichDirection currentPos pos, rotate pos) where snakeParts @ (currentPos :<| (_ :|> tail)) = parts (snake state) dir = whichDirection currentPos nextPos -- default: follow the Hamiltonian cycle and move the next cell to the front of the cycle defaultResult = (dir, remainingCycle |> nextPos) foodPos = foodPosition state -- directions in which the snake should move optimally to reach the food as fast as possible optimalDirs = foodDirections currentPos foodPos (Just tailIndex) = tail `elemIndexL` cycle (Just foodIndex) = foodPos `elemIndexL` cycle -- try to find a shortcut shortcut = findShortcut cycle tailIndex foodIndex (map (whichPosition currentPos) optimalDirs) -- Rotates the specified position and all preceding positions to the rear of the cycle. rotate pos = let (Just index) = pos `elemIndexL` cycle in Seq.drop (index + 1) cycle >< Seq.take (index + 1) cycle -- Part 2 of the strategy: A Hamiltonian cycle needs to be constructed. hamiltonStrategy board@(width, height) state rand _ | Seq.length snakeParts < 2 = error "Cannot use this strategy with this initial state \ \because the snake must consist of at least two parts." | Seq.length longestPath < width * height = error "Cannot use this strategy on this board with this initial state \ \because no Hamiltonian cycle can be constructed." | otherwise = -- call part 1 of the strategy with the constructed cycle hamiltonStrategy board state rand cycle where snakeParts = parts (snake state) -- longest path from the head to the second part of the snake longestPath @ (currentPos :<| nextPositions) = extendPath (Seq.take 2 snakeParts) board cycle = nextPositions |> currentPos -- Extends a path to make it as long as possible. -- To extend a path, extend all pairs of consecutive nodes (see extendPair function for more -- information) as long as this is possible. extendPath :: Path -> Board -> Path extendPath nodes board = case extendedPairs of Empty -> nodes -- no extandable pairs ((i, (node1, node2)) :<| _) -> -- insert extension into the path let nodes' = insertAt i node1 nodes nodes'' = insertAt (i + 1) node2 nodes' in extendPath nodes'' board where -- enumerate all pairs of consecutive nodes pairs :: Seq (Int, -- number of the pair (starting from 1) (Position, Position)) -- pair pairs = Seq.zip (fromList [1..Seq.length nodes]) (Seq.zip nodes (Seq.drop 1 nodes)) -- extend all pairs (unextendable pairs result in Nothing values) extendedMaybePairs = fmap (second $ extendPair board nodes) pairs -- remove unextendable pairs extendedPairs = fmap (second fromJust) (Seq.filter (isJust . snd) extendedMaybePairs) -- Extends a pair of consecutive nodes. -- A path through two consecutive nodes n1, n2 can be extended by nodes e1 and e2 that are not -- already part of the path if n1 and e1, e1 and e2, e2 and n2 are adjacent nodes: -- -- n1 n1 –– e1 -- | == extendPair ==> | -- n2 n2 –– e2 extendPair :: Board -- board dimensions -> Path -- complete path -> (Position, Position) -- positions of n1 and n2 -> Maybe (Position, Position) -- positions of e1 and e2 or Nothing if there are no -- such nodes extendPair board nodes (pos1, pos2) = listToMaybe possibleExtensions where neighbors1 = filter (`notElem` nodes) (neighbors board pos1) neighbors2 = filter (`notElem` nodes) (neighbors board pos2) -- determine combinations of neighbors of both nodes neighborsCombinations = liftA2 (,) neighbors1 neighbors2 -- a neighbor combination is a valid extension if both neighbors are also adjacent possibleExtensions = filter (uncurry $ areNeighbors board) neighborsCombinations -- Determines the neighbors of a cell. neighbors :: Board -> Position -> [Position] neighbors (width, height) (x, y) = filter isValid [(x - 1, y), (x, y - 1), (x + 1, y), (x, y + 1)] where isValid (x, y) = x >= 0 && x < width && y >= 0 && y < height -- Checks whether two cells are adjacent. areNeighbors :: Board -> Position -> Position -> Bool areNeighbors board pos1 pos2 = pos1 `elem` neighbors board pos2 -- Determines to which position one arrives when moving from a cell in a certain direction. whichPosition :: Position -> Direction -> Position whichPosition (x, y) Left = (x - 1, y) whichPosition (x, y) Right = (x + 1, y) whichPosition (x, y) Up = (x, y - 1) whichPosition (x, y) Down = (x, y + 1) -- Determines the directions in which the snake should move optimally to reach the food as fast as -- possible. This can be one direction (the current position already has the same x or y coordinate -- as the food position), two directions (x and y coordinates of current position and food position -- are different) or no direction (current position and food position are equal). If there are two -- directions, the first direction in the list is the direction in which more steps need to be -- taken. foodDirections :: Position -- current position -> Position -- food position -> [Direction] -- optimal directions foodDirections (x1, y1) (x2, y2) | horizDiff >= vertDiff = horiz ++ vert | otherwise = vert ++ horiz where horizDiff = abs (x1 - x2) vertDiff = abs (y1 - y2) horiz | x2 < x1 = [Left] | x2 > x1 = [Right] | otherwise = [] vert | y2 < y1 = [Up] | y2 > y1 = [Down] | otherwise = [] -- Tries to find a shortcut. findShortcut :: Seq Position -- Hamiltonian cycle -> Int -- index of the tail position in the cycle -> Int -- index of the food position in the cycle -> [Position] -- positions to which the snake should move optimally to reach the -- food as fast as possible -> Maybe Position -- position of the shortcut or Nothing if there is no shortcut findShortcut _ _ _ [] = Nothing findShortcut cycle tailIndex foodIndex (optimalPos : oPs) -- Only take a shortcut if the snake does not overtake its tail or the food on the -- Hamiltonian cycle. | shortcutIndex < tailIndex && shortcutIndex < foodIndex = Just optimalPos | otherwise = findShortcut cycle tailIndex foodIndex oPs where (Just shortcutIndex) = optimalPos `elemIndexL` cycle