Maze Solving Algorithm using LogicT

mazerunner.hs

module Main where

import Control.Monad
import Control.Monad.Logic
import Control.Monad.Logic.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Reader
import Control.Applicative

import Data.List
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map(..))

import Lib

-- NonDeterminism Example from Lyxia
f :: Int
f =
  let search xs
        | sum xs < 37 = ([1,5,10,25,50]) >>= \n -> search (n : xs)
        | sum xs == 37 = [xs]
        | otherwise = []
  in length (search [] :: [[Int]])

data BoundaryType = Entrance | Exit | Door deriving Show

type Cell a = Location -> Maybe a



type Maze = Map Location (Logic Location)
type Location = (Int, Int)

weave :: (Foldable t) => t a -> Logic a
weave = foldl' (\b a -> b `interleave` pure a) empty

maze :: Maze
maze = M.fromList $
  [ ((0,0), weave [(1,0),(0,1)])
  , ((0,1), weave [(0,0),(1,1)])
  , ((1,0), weave [(0,0),(1,1),(2,0)])
  , ((1,1), weave [(1,0),(1,2),(0,1)])
  , ((1,2), weave [(1,1),(1,3)])
  , ((1,3), weave [(1,2)])
  , ((2,0), weave [(1,0),(2,1)])
  , ((2,1), weave [(2,0),(2,2)])
  , ((2,2), weave [(2,1)])
  ]
{-
___ ___
|_|f| |
|   | |
|s    |
- -----
solution1 = [(1,3),(1,2),(1,1),(1,0),(0,0)]
solution2 = [(1,3),(1,2),(1,1),(0,1),(0,0)]
-}

isExit :: Location -> Bool
isExit (1,3) = True
isExit _     = False

findDoors :: Location -> Logic Location
findDoors = maybe empty id . (flip M.lookup maze)

type MazeRunner = ReaderT [Location] Logic [Location]

runMaze :: Location -> MazeRunner
runMaze loc = do
  visitedRooms <- ask
  if isExit loc
    then return visitedRooms
    else do
    newDoor <- lift $ findDoors loc
    if not (elem newDoor visitedRooms)
      then local (const (newDoor : visitedRooms)) (runMaze newDoor)
      else empty