master
parent 1838543880
commit aa10f43dab
8 changed files with 237 additions and 160 deletions

#### 12 AStar.hs View File

 @ -10,9 +10,15 @@ import qualified Data.Map as M import Data.List (foldl') import Data.Maybe (fromJust) -- A* algorithm: Find a path from initial node to goal node using a heuristic function. -- Returns Nothing if no path found. Else returns Just (path cost, path). astar :: (Ord a, Ord b, Num b) => a -> a -> (a -> [(a, b)]) -> (a -> a -> b) -> Maybe (b, [a]) -- | A* algorithm: Finds a path from initial node to goal node using a heuristic function. astar :: (Ord a, Ord b, Num b) => a -- ^ The start node -> a -- ^ The goal node -> (a -> [(a, b)]) -- ^ The function to get the next nodes and their -- costs from a given node -> (a -> a -> b) -- ^ The heuristic function to estimate the cost of -- going from a give node to the target node -> Maybe (b, [a]) -- ^ Nothing if no path found. Else @Just (path cost, path)@ astar initNode goalNode nextNode hueristic = astar' (PQ.singleton (hueristic initNode goalNode) (initNode, 0)) S.empty (M.singleton initNode 0) M.empty

#### 104 AmazingMazes.hs View File

 @ -1,46 +1,48 @@ {- A solution to rubyquiz 31 (http://rubyquiz.com/quiz31.html). {-| A solution to rubyquiz 31 (). Generate a rectangular maze given its width and height. The maze should be solvable for any start and end positions and there should be only one possible solution for any pair of start and end positions. /Generate a rectangular maze given its width and height. The maze should be/ /solvable for any start and end positions and there should be only one possible/ /solution for any pair of start and end positions./ Generate the ASCII output representing the maze. /Generate the ASCII output representing the maze./ Find the solution of the maze. Produce ASCII output to visualize the solution. /Find the solution of the maze. Produce ASCII output to visualize the solution./ The maze generation algorithm used is recursive backtracking and the maze solution algorithm used is A*. solution algorithm used is A* (from "AStar" module). Usage: ./AmazingMazes Coordinates are zero based. Usage (Coordinates are zero based): abhinav@xj9:rubyquiz# bin/AmazingMazes 10 10 0 0 9 9 +---+---+---+---+---+---+---+---+---+---+ | s > v | | | +---+---+ +---+ + +---+ + +---+ | v < < | | | | | | + +---+---+---+---+---+ + + + + | v | | | | + +---+---+---+ + +---+---+---+ + | > > > v | | | > v | +---+---+---+ + + +---+---+ + + | | v < | | > > ^ | v | + + + +---+---+---+ +---+---+ + | | | > > > > ^ | | v | + +---+---+---+---+---+---+ +---+ + | | | | v < < | + + + + + + +---+ +---+---+ | | | | | | v < | | + + +---+---+ +---+ +---+ +---+ | | | | v < | | + +---+ + + + +---+---+---+ + | | | > > > > e | +---+---+---+---+---+---+---+---+---+---+ > ./AmazingMazes Copyright 2012 Abhinav Sarkar Example: > abhinav@xj9:rubyquiz# bin/AmazingMazes 10 10 0 0 9 9 > +---+---+---+---+---+---+---+---+---+---+ > | s > v | | | > +---+---+ +---+ + +---+ + +---+ > | v < < | | | | | | > + +---+---+---+---+---+ + + + + > | v | | | | > + +---+---+---+ + +---+---+---+ + > | > > > v | | | > v | > +---+---+---+ + + +---+---+ + + > | | v < | | > > ^ | v | > + + + +---+---+---+ +---+---+ + > | | | > > > > ^ | | v | > + +---+---+---+---+---+---+ +---+ + > | | | | v < < | > + + + + + + +---+ +---+---+ > | | | | | | v < | | > + + +---+---+ +---+ +---+ +---+ > | | | | v < | | > + +---+ + + + +---+---+---+ + > | | | > > > > e | > +---+---+---+---+---+---+---+---+---+---+ Copyright 2012 Abhinav Sarkar \ -} {-# LANGUAGE BangPatterns, TupleSections #-} module AmazingMazes (Cell(..), Maze(..), MazeSolution(..), @ -87,23 +89,23 @@ randomShuffle list = do -- maze -- -- a cell with x and y coordinates -- | A cell with x and y coordinates type Cell = (Int, Int) -- a maze with width, height and a map of cell paths -- | A maze with width, height and a map of cell paths data Maze = Maze Int Int (M.Map Cell [Cell]) -- a solution to a maze with the start and end cells and the path map -- | A solution to a maze with the start and end cells and the path map data MazeSolution = MazeSolution Cell Cell (M.Map Cell Cell) -- get the neighbour cells -- | Gets the neighbour cells nextCells :: Int -> Int -> Cell -> [Cell] nextCells width height (x, y) = filter (\(x', y') -> and [x' >= 0, x' < width, y' >= 0, y' < height]) . map (\(xd, yd) -> (x + xd, y + yd)) \$ [(0,-1), (1,0), (0,1), (-1,0)] -- generate a random maze given the start cell and an empty maze -- | Generates a random maze given the start cell and an empty maze generateMaze_ :: Cell -> Maze -> RandomState Maze generateMaze_ start maze@(Maze width height cellMap) = do !next <- randomShuffle . filter (not . flip M.member cellMap) \$ nextCells width height start @ -118,26 +120,28 @@ generateMaze_ start maze@(Maze width height cellMap) = do else return mz) maze next -- generate a random maze given the maze width and height using recursive backtracking generateMaze :: Int -> Int -> RandomState Maze -- | Generates a random maze given the maze width and height using recursive backtracking generateMaze :: Int -- ^ Maze width -> Int -- ^ Maze height -> State StdGen Maze -- ^ The generated maze inside a 'State' monad with a random generator generateMaze width height = do x <- getRandomR (0, width - 1) y <- getRandomR (0, height - 1) generateMaze_ (x, y) (Maze width height M.empty) -- render a maze and its solution as a string -- | Renders a maze and its solution as a string renderMaze :: Maze -> MazeSolution -> String renderMaze maze@(Maze width height _) solution = concatMap (renderMazeRow maze solution) [0 .. (height - 1)] ++ concat (replicate width "+---") ++ "+" -- render a row of a maze and the maze's solution as a string -- | Renders a row of a maze and the maze's solution as a string renderMazeRow :: Maze -> MazeSolution -> Int -> String renderMazeRow maze@(Maze width height _) solution rowIx = let (up, side) = unzip . map (renderMazeCell maze solution rowIx) \$ [0 .. (width - 1)] in concat up ++ "+" ++ "\n" ++ concat side ++ "|" ++ "\n" -- render a cell of a maze and the maze's solution as a pair of strings -- | Renders a cell of a maze and the maze's solution as a pair of strings renderMazeCell :: Maze -> MazeSolution -> Int -> Int -> (String, String) renderMazeCell (Maze _ _ cellMap) (MazeSolution start end solution) rowIx colIx = let cell = (colIx, rowIx) @ -155,12 +159,15 @@ renderMazeCell (Maze _ _ cellMap) (MazeSolution start end solution) rowIx colIx Nothing -> " " Just (x', y') -> fromMaybe " " \$ M.lookup (x' - x, y' - y) marks -- symbols to mark the solution path -- | Symbols to mark the solution path marks = M.fromList [((0,-1), "^"), ((1,0), ">"), ((0,1), "v"), ((-1,0), "<")] -- solve the maze using A* given the maze and the start and end cells using -- | Solves the maze using A* given the maze and the start and end cells using -- Manhattan distance as the heuristic solveMaze :: Maze -> Cell -> Cell -> MazeSolution solveMaze :: Maze -- ^ The maze to solve -> Cell -- ^ The start cell -> Cell -- ^ The end cell -> MazeSolution -- ^ The solution of the maze solveMaze maze@(Maze _ _ cellMap) start end = MazeSolution start end . M.fromList @ -171,6 +178,9 @@ solveMaze maze@(Maze _ _ cellMap) start end = . astar start end (map (,1) . fromMaybe [] . flip M.lookup cellMap) \$ (\(x, y) (x', y') -> abs (x - x') + abs (y - y')) -- | Reads the width, height, start and end cell co-ordinates from command -- line arguments, generates a maze using them, solves it and renders it -- with the solution. main = do (width : height : sx : sy : ex : ey : _) <- fmap (map read) getArgs g <- newStdGen

#### 50 BarrelOfMonkeys.hs View File

 @ -1,7 +1,16 @@ {- A solution to rubyquiz 30 (http://rubyquiz.com/quiz30.html). {-| A solution to rubyquiz 30 (http://rubyquiz.com/quiz30.html). Copyright 2012 Abhinav Sarkar /A "Barrel of Monkeys" playlist is when the next song in the playlist begins/ /with the same letter as the current song ended in./ /Given any starting and ending song, create a playlist that connects the two songs./ /Create playlists of specific durations and shortest and longest playlists by/ /the number of songs and the total duration./ /The song data is available at/ . Copyright 2012 Abhinav Sarkar \ -} {-# LANGUAGE Arrows, NoMonomorphismRestriction, RecordWildCards #-} @ -30,11 +39,12 @@ import Text.XML.HXT.Core hiding ((:->), when) --- types --- -- | A song with all the fields data Song = Song { songArtist :: T.Text, songId :: Int, songName :: T.Text, songDuration :: Int songArtist :: T.Text, -- ^ The song artist songId :: Int, -- ^ The song ID songName :: T.Text, -- ^ The song name songDuration :: Int -- ^ The song duration in milliseconds } instance Eq Song where @ -47,13 +57,18 @@ instance Show Song where show (Song {..}) = printf "%s. %s - %s (%sms)" (show songId) (T.unpack songArtist) (T.unpack songName) (show songDuration) -- | The whole song library data SongLibrary = SongLibrary { songIdMap :: M.Map Int Song, fstCharMap :: M.Map Char [Song], lstCharMap :: M.Map Char [Song] } data Playlist = Playlist { playlistSongs :: [Song], playlistDuration :: Int } -- | A playlist of songs data Playlist = Playlist { playlistSongs :: [Song], -- ^ The songs in the playlist playlistDuration :: Int -- ^ The total duration of the playlist in milliseconds } --- XML parsing --- @ -72,6 +87,7 @@ getSongs = atTag "Artist" >>> songs <- listA getSong -< a returnA -< map (uncurry3 \$ Song sArtist) songs -- | Reads the song library from the XML file given its path getSongsFromXml :: FilePath -> IO SongLibrary getSongsFromXml file = fmap (uncurry3 SongLibrary @ -104,8 +120,13 @@ playlist library nextSong startId endId = do let pl = concatMap snd . maybeToList . astar start end nextSong \$ (\_ _ -> 0) return \$ Playlist pl (playlistTime pl) -- | Creates the shortest and longest playlist by the number of song and -- the shortest and longest playlist by the length of the playlist shortestPlaylist, longestPlaylist, shortestTimePlaylist, longestTimePlaylist :: SongLibrary -> Int -> Int -> Maybe Playlist :: SongLibrary -- ^ The song library -> Int -- ^ The start song ID -> Int -- ^ The end song ID -> Maybe Playlist -- ^ (@Just@ resultant playlist) if it exists else @Nothing@ shortestPlaylist library = playlist library (\song -> map (\s -> (s, 1)) . nextSongs song \$ library) @ -156,7 +177,16 @@ playlistTimes library startId endId = let (distances, queue') prev in loop distances' queue'' timedPlaylist :: SongLibrary -> Int -> Int -> Int -> Int -> Maybe Playlist -- | Creates a playlist with its duration as close a possible to the given duration timedPlaylist :: SongLibrary -- ^ The song library -> Int -- ^ The required duration in milliseconds -> Int -- ^ The start song ID -> Int -- ^ The end song ID -> Int -- ^ Maximum number of child nodes to consider while -- traversing the graph to create the playlist. Used for -- tuning the runtime of the function -> Maybe Playlist -- ^ (@Just@ resultant playlist) if it exists else @Nothing@ timedPlaylist library time startId endId maxChild = fst \$ timedPlaylist_ library time startId endId S.empty M.empty (playlistTimes library startId endId) maxChild