From aa10f43dab5f28ddc42dcfcef903691533d46ec0 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sat, 27 Oct 2012 13:36:30 +0530 Subject: [PATCH] Added Haddock documentation --- AStar.hs | 12 ++++-- AmazingMazes.hs | 104 +++++++++++++++++++++++++-------------------- BarrelOfMonkeys.hs | 50 +++++++++++++++++----- Cryptograms.hs | 83 +++++++++++++++++++++++------------- DiceRoller.hs | 51 +++++++++++----------- EnglishNumerals.hs | 23 +++++----- GedcomParser.hs | 18 +++++--- KnightsTravails.hs | 56 ++++++++++++------------ 8 files changed, 237 insertions(+), 160 deletions(-) diff --git a/AStar.hs b/AStar.hs index 29a4e1c..440c072 100644 --- a/AStar.hs +++ b/AStar.hs @@ -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 diff --git a/AmazingMazes.hs b/AmazingMazes.hs index 79e0feb..4c27697 100644 --- a/AmazingMazes.hs +++ b/AmazingMazes.hs @@ -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 diff --git a/BarrelOfMonkeys.hs b/BarrelOfMonkeys.hs index 46a2ee0..dd0982b 100644 --- a/BarrelOfMonkeys.hs +++ b/BarrelOfMonkeys.hs @@ -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 diff --git a/Cryptograms.hs b/Cryptograms.hs index 6964743..ffe245a 100644 --- a/Cryptograms.hs +++ b/Cryptograms.hs @@ -1,14 +1,26 @@ -{- - Decrypts a cryptogram (a substitution cypher). - A solution to rubyquiz 13 (http://rubyquiz.com/quiz13.html). - Usage: ./Cryptograms dictionary_file encrypted_file num_max_mappings +{-| + A solution to rubyquiz 13 (). - Copyright 2012 Abhinav Sarkar + Decrypts a cryptogram (a substitution cypher). + + The decryption mapping is created by finding the words from the dictionary which have + the same form as the given token to translates, using the words to create partial + mappings and then merging these partial mappings to get more complete mappings. + + Similarly, the partial mappings for all tokens are merged together to get the + complete mapping. The mappings are scored by how many tokens they are able to + translated successfully into dictionary words. + + Usage: + + > ./Cryptograms + + Copyright 2012 Abhinav Sarkar \ -} {-# LANGUAGE BangPatterns #-} -module Cryptograms (Mapping, Dict, readDict, translateToken, +module Cryptograms (Mapping, Token, Dict, readDict, translateToken, scoreMapping, findBestMappings, showMapping, main) where @@ -26,11 +38,16 @@ import Text.Printf (printf) trace :: String -> a -> a trace _ x = x +-- | A mapping between two alphabets. type Mapping = M.Map Char Char +-- | An encrypted token. +type Token = String + +-- | The dictionary of words. newtype Dict = Dict (M.Map Int (S.Set String)) --- reads the dictionary from the given file. must contain one word per line. +-- | Reads the dictionary from the given file. Must contain one word per line. readDict :: FilePath -> IO Dict readDict filePath = do !dictWords <- fmap (filter (all isAlpha) . map (map toLower) . lines) @@ -39,40 +56,46 @@ readDict filePath = do foldl' (\dict w -> M.insertWith S.union (length w) (S.singleton w) dict) M.empty dictWords --- translates the token using the given mapping. --- return Nothing if unable to translate. -translateToken :: Mapping -> String -> Maybe String +-- | Translates the token using the given mapping. +-- Returns @Nothing@ if unable to translate. +translateToken :: Mapping -> Token -> Maybe String translateToken mapping = fmap reverse . foldM (\acc char -> M.lookup char mapping >>= Just . (:acc)) "" --- translates all tokens using the given mapping. --- translates the token to '---' if unable to translate. -translateTokens :: Mapping -> [String] -> [String] +-- Translates all tokens using the given mapping. +-- Translates the token to '---' if unable to translate. +translateTokens :: Mapping -> [Token] -> [String] translateTokens mapping = map (\token -> fromMaybe (replicate (length token ) '-') . translateToken mapping $ token) --- checks if the given word is in the dictionary. +-- Checks if the given word is in the dictionary. inDict :: Dict -> String -> Bool inDict (Dict dict) word = case M.lookup (length word) dict of Nothing -> False Just ws -> word `S.member` ws --- scores a mapping by counting the number of translated tokens that are +-- | Scores a mapping by counting the number of translated tokens that are -- in the dictionary. -scoreMapping :: Dict -> Mapping -> [String] -> Int +scoreMapping :: Dict -- ^ The dictionary + -> Mapping -- ^ The mapping to score + -> [Token] -- ^ The tokens to translate + -> Int -- ^ The score of the mapping scoreMapping dict mapping = length . filter (inDict dict) . mapMaybe (translateToken mapping) --- scores multiple mappings and returns an assoc list sorted by descending score. -scoreMappings :: Dict -> [String] -> [Mapping] -> [(Mapping, Int)] +-- Scores multiple mappings and returns an assoc list sorted by descending score. +scoreMappings :: Dict -> [Token] -> [Mapping] -> [(Mapping, Int)] scoreMappings dict tokens = reverse . sortBy (comparing snd) . map (\mapping -> (mapping, scoreMapping dict mapping tokens)) --- finds maximum num mappings which have best scores for the given tokens. -findBestMappings :: Dict -> Int -> [String] -> [Mapping] +-- | Finds n best mappings which have best scores for the given tokens. +findBestMappings :: Dict -- ^ The dictionary + -> Int -- ^ Maximum number of mappings to consider + -> [Token] -- ^ The tokens to translate + -> [Mapping] -- ^ The mappings with best scores findBestMappings dict num tokens = let mappings = scoreMappings dict tokens . S.toList @@ -86,8 +109,8 @@ findBestMappings dict num tokens = let maxScore = if not (null mappings) then snd . head $ mappings else 0 in map fst . takeWhile ((== maxScore) . snd) $ mappings --- finds the merged mappings for a token -findMappingsForToken :: Dict -> S.Set Mapping -> String -> S.Set Mapping +-- Finds the merged mappings for a token +findMappingsForToken :: Dict -> S.Set Mapping -> Token -> S.Set Mapping findMappingsForToken dict mappings token = case find (inDict dict) . mapMaybe (flip translateToken token) . reverse . sortBy (comparing M.size) @@ -99,7 +122,7 @@ findMappingsForToken dict mappings token = -- with the mappings for the token. Nothing -> mergeMappingLists mappings (createMappingsForToken dict token) --- merges mapping lists. discards conflicting mappings while merging. +-- Merges mapping lists. discards conflicting mappings while merging. mergeMappingLists :: S.Set Mapping -> S.Set Mapping -> S.Set Mapping mergeMappingLists mappings1 mappings2 | mappings1 == S.empty = mappings2 @@ -113,7 +136,7 @@ mergeMappingLists mappings1 mappings2 [mergeMappings m1 m2 | m1 <- S.toList mappings1, m2 <- S.toList mappings2]] in trace (printf "Merged to %s mappings" (show $ S.size merged)) merged --- merges two mappings. returns Nothing if mappings conflict. +-- Merges two mappings. returns Nothing if mappings conflict. mergeMappings :: Mapping -> Mapping -> Maybe Mapping mergeMappings mapping1 mapping2 = foldM @@ -123,8 +146,8 @@ mergeMappings mapping1 mapping2 = else Just $ M.insert k v acc) mapping1 $ M.toList mapping2 --- creates mappings for a token by finding words of same form from the dictionary. -createMappingsForToken :: Dict -> String -> S.Set Mapping +-- Creates mappings for a token by finding words of same form from the dictionary. +createMappingsForToken :: Dict -> Token -> S.Set Mapping createMappingsForToken (Dict dict) token = case M.lookup (length token) dict of Nothing -> S.empty @@ -134,9 +157,9 @@ createMappingsForToken (Dict dict) token = . filter ((== tokenF) . tokenForm) . S.toList $ words in trace (printf "%s -> %s matches" token (show . S.size $ matches)) matches --- returns form of a token. for example, the form of "abc" is [1,2,3] +-- Returns form of a token. for example, the form of "abc" is [1,2,3] -- while the form of "aba" is [1,2,1]. -tokenForm :: String -> [Int] +tokenForm :: Token -> [Int] tokenForm token = let (_, form, _) = foldl' (\(formMap, form, lf) char -> @@ -146,11 +169,11 @@ tokenForm token = let (M.empty, [], 0) token in reverse form --- creates the mapping between two strings of same length. +-- Creates the mapping between two strings of same length. getMapping :: String -> String -> Mapping getMapping t1 t2 = M.fromList $ zip t1 t2 --- returns text representation of a mapping. +-- | Returns text representation of a mapping. showMapping :: Mapping -> String showMapping mapping = map snd . sortBy (comparing fst) . M.toList diff --git a/DiceRoller.hs b/DiceRoller.hs index 297fe62..6ffda22 100644 --- a/DiceRoller.hs +++ b/DiceRoller.hs @@ -1,22 +1,24 @@ -{- - A solution to rubyquiz 61 (http://rubyquiz.com/quiz61.html). +{-| + A solution to rubyquiz 61 (). - The task for this Quiz is to write a dice roller. The program should take - two arguments: a dice expression followed by the number of times to roll it - (being optional, with a default of 1). + /The task for this Quiz is to write a dice roller. The program should take/ + /two arguments: a dice expression followed by the number of times to roll it/ + /(being optional, with a default of 1)./ - The solution is done using Parsec for parsing the expression into an AST and + The solution is done using 'Parsec' for parsing the expression into an AST and then evaluating it recursively. - Usage: bin/DiceRoller "(5d5-4)d(16/d4)+3" 10 - bin/DiceRoller 3d3 + Usage: - Copyright 2012 Abhinav Sarkar + > bin/DiceRoller "(5d5-4)d(16/d4)+3" 10 + > bin/DiceRoller 3d3 + + Copyright 2012 Abhinav Sarkar \ -} {-# LANGUAGE NoMonomorphismRestriction #-} -module DiceRoller (RandomState, Expr(..), eval, expr, main) where +module DiceRoller (Expr(..), eval, expr, main) where import Control.Applicative ((<$>), (<*), (*>), (<|>)) import Control.Monad (foldM, liftM2, liftM, when) @@ -28,9 +30,7 @@ import System.Environment (getArgs) -- Randomness setup for dice roll -- -type RandomState = State StdGen - -getRandomR :: Random a => (a, a) -> RandomState a +getRandomR :: Random a => (a, a) -> State StdGen a getRandomR limits = do gen <- get let (val, gen') = randomR limits gen @@ -39,18 +39,19 @@ getRandomR limits = do -- AST -- --- Expression AST types -data Expr = Lit Int | -- An integer literal - Add Expr Expr | -- Binary addition - Sub Expr Expr | -- Binary subtraction - Mul Expr Expr | -- Binary multiplication - Div Expr Expr | -- Binary integer division - Rol Expr | -- Unary single dice roll - MRol Expr Expr -- Binary multiple dice rolls +-- | Expression AST types +data Expr = Lit Int | -- ^ An integer literal + Add Expr Expr | -- ^ Binary addition + Sub Expr Expr | -- ^ Binary subtraction + Mul Expr Expr | -- ^ Binary multiplication + Div Expr Expr | -- ^ Binary integer division + Rol Expr | -- ^ Unary single dice roll + MRol Expr Expr -- ^ Binary multiple dice rolls deriving (Show) --- Recursively evaluates the AST to get its value -eval :: Expr -> RandomState Int +-- | Recursively evaluates the AST to its value inside a 'State' monad with +-- a random generator +eval :: Expr -> State StdGen Int eval (Lit i) = return i eval (Add e1 e2) = liftM2 (+) (eval e1) (eval e2) eval (Sub e1 e2) = liftM2 (-) (eval e1) (eval e2) @@ -90,12 +91,12 @@ table = [[bop 'd' MRol AssocLeft], -- multiple rolls [bop '+' Add AssocLeft, bop '-' Sub AssocLeft]] -- addition and subtraction where bop c f = Infix (spaced (char c) *> return f) -- binary operators --- A parser to parse the full expression +-- | A parser to parse the dice roll expression expr = buildExpressionParser table factor -- Main -- --- Reads the expression from program arguments, parses it and if successful, +-- | Reads the expression from program arguments, parses it and if successful, -- evaluates the AST and displays the resultant values main = do args <- getArgs diff --git a/EnglishNumerals.hs b/EnglishNumerals.hs index c96b556..10b9ab7 100644 --- a/EnglishNumerals.hs +++ b/EnglishNumerals.hs @@ -1,10 +1,12 @@ -{- - A solution to rubyquiz 25 (http://rubyquiz.com/quiz25.html). +{-| + A solution to rubyquiz 25 (). - When the integers 1 to 10_000_000_000 are written in the English language, - then sorted as strings, which odd number appears first in the list? + /When the integers 1 to 10_000_000_000 are written in the English language,/ + /then sorted as strings, which odd number appears first in the list?/ - Usage: ./EnglishNumerals basis-file max_num + Usage: + + > ./EnglishNumerals Example basis file for English numerals: @@ -43,7 +45,7 @@ > 2, two > 1, one - Copyright 2012 Abhinav Sarkar + Copyright 2012 Abhinav Sarkar \ -} module EnglishNumerals (Basis, readBasis, toEnglishNumerals, firstOddByEnglishNumeral, main) @@ -56,12 +58,13 @@ import Data.Maybe (fromMaybe) import Data.List.Split (splitOn) import System.Environment (getArgs) +-- | A basis is a list of basic numeral translations into a languages. type Basis = [(Integer, String)] isPowerOfTen :: Integer -> Bool isPowerOfTen = (== "10") . nub . show --- reads the basis of the numeral system +-- | Reads the basis of the numeral system readBasis :: FilePath -> IO Basis readBasis = fmap (map (\line -> let (n:en:_) = splitOn "," line in (read n, en)) . lines) . readFile @@ -74,7 +77,7 @@ toEnglishNumeralsMemo basis n = then cache basis `Seq.index` (fromIntegral n -1) else toEnglishNumerals basis n --- converts a number to its numeral representation in the given basis +-- | Converts a number to its numeral representation in the given basis toEnglishNumerals :: Basis -> Integer -> String toEnglishNumerals basis n = unwords . words . go n (dropWhile ((> n) . fst) basis) $ "" @@ -102,8 +105,8 @@ minEnglish basis start end step = maximumBy (flip $ comparing fst) . map (\x -> (toEnglishNumerals basis x, x)) $ [start, start + step .. end] --- finds the first odd number and its representation between 1 and n which is --- minimum by the lexicographically sorted representations +-- | Finds the first odd number and its representation between 1 and the given number +-- which is minimum by the lexicographically sorted representations firstOddByEnglishNumeral :: Basis -> Integer -> (String, Integer) firstOddByEnglishNumeral basis n = (\(eng, en) -> (unwords . words $ eng, en)) diff --git a/GedcomParser.hs b/GedcomParser.hs index d017d5b..357319d 100644 --- a/GedcomParser.hs +++ b/GedcomParser.hs @@ -1,7 +1,10 @@ --- A GEDCOM to XML converter written using Parsec as a --- solution for rubyquiz 6 (http://rubyquiz.com/quiz6.html). +-- | A GEDCOM to XML converter written using Parsec as a +-- solution for rubyquiz 6 (). +-- -- Example GEDCOM document at --- http://cpansearch.perl.org/src/PJCJ/Gedcom-1.16/royal.ged +-- +-- +-- Copyright 2012 Abhinav Sarkar \ {-# LANGUAGE NoMonomorphismRestriction, RecordWildCards, FlexibleContexts #-} @@ -18,7 +21,7 @@ data Line = Line { lineId :: Maybe String } --- an element in a GEDCOM document +-- | An element in a GEDCOM document data Elem = Elem { elemTag :: String, elemValue :: Maybe String, @@ -26,6 +29,7 @@ data Elem = Elem { elemChildren :: [Elem] } deriving (Show) +-- | A GEDCOM document type Doc = [Elem] indent n = concat . replicate n $ " " @@ -61,7 +65,7 @@ element level = do children <- many (element $ level + 1) return $ Elem lineTag lineValue lineId children --- parses a document +-- | Parser to parse a GEDCOM document from a 'String' document :: Stream s m Char => ParsecT s u m Doc document = element 0 `endBy` whitespaces @@ -98,14 +102,14 @@ elemToXml indentation Elem{..} = ++ unlines (map (elemToXml (indentation + 1)) elemChildren) ++ indent indentation ++ "" --- converts a document to XML +-- | Converts a GEDCOM document to XML documentToXml :: Doc -> String documentToXml doc = "\n" ++ (unlines . map (elemToXml 1) $ doc') ++ "" where doc' = normalizeDoc doc --- converts a GEDCOM document supplied through STDIN into XML +-- | Converts a GEDCOM document supplied through STDIN into XML -- and prints to STDOUT main = do text <- getContents diff --git a/KnightsTravails.hs b/KnightsTravails.hs index d6e383b..1c6f595 100644 --- a/KnightsTravails.hs +++ b/KnightsTravails.hs @@ -1,27 +1,28 @@ -{- - A solution to rubyquiz 27 (http://rubyquiz.com/quiz27.html). +{-| + A solution to rubyquiz 27 (). - Given a standard 8 x 8 chessboard where each position is indicated in algebraic - notation (with the lower left corner being a1), design a script that accepts - two or more arguments. + /Given a standard 8 x 8 chessboard where each position is indicated in algebraic/ + /notation (with the lower left corner being a1), design a script that accepts/ + /two or more arguments./ - The first argument indicates the starting position of the knight. The second - argument indicates the ending position of the knight. Any additional arguments - indicate positions that are forbidden to the knight. + /The first argument indicates the starting position of the knight. The second/ + /argument indicates the ending position of the knight. Any additional arguments/ + /indicate positions that are forbidden to the knight./ - Return an array indicating the shortest path that the knight must travel to - get to the end position without landing on one of the forbidden squares. - If there is no valid path to the destination return nil. + /Return an array indicating the shortest path that the knight must travel to/ + /get to the end position without landing on one of the forbidden squares./ + /If there is no valid path to the destination return nil./ - Usage: ./KnightsTravails start_pos target_pos [blocked_pos]* + Usage: - Copyright 2012 Abhinav Sarkar + > ./KnightsTravails start_pos target_pos [blocked_pos]* + + Copyright 2012 Abhinav Sarkar \ -} {-# LANGUAGE MultiParamTypeClasses, RecordWildCards #-} -module KnightsTravails (Square, Board(..), fromNotation, toNotation, isValidNotation, - bfsSearch, astarSearch, main) +module KnightsTravails (Square, fromNotation, toNotation, isValidNotation, search, main) where import qualified Data.Set as S @@ -31,22 +32,22 @@ import Data.Maybe (fromJust) import Control.Arrow (second) import System.Environment (getArgs) --- A square on the chess board +-- | A square on the chess board type Square = (Int, Int) -- A chess board with the knight's current position and a set of blocked squares data Board = Board { knightPos :: Square, blockedSquares :: S.Set Square } deriving (Ord, Eq) --- Converts a string in chess notation to a square. eg. a1 -> (1,1) +-- | Converts a string in chess notation to a square. eg. a1 -> (1,1) fromNotation :: String -> Square fromNotation (x : y) = (fromJust (x `elemIndex` ['a'..'h']) + 1, read y) --- Converts a square to a string in chess notation. eg. (1,1) -> a1 +-- | Converts a square to a string in chess notation. eg. (1,1) -> a1 toNotation :: Square -> String toNotation (x, y) = ((['a'..'h'] !! (x - 1)) : "") ++ show y --- Checks if a string is a valid chess notation +-- | Checks if a string is a valid chess notation isValidNotation notation = and [length notation == 2, head notation `elem` ['a'..'h'], @@ -71,14 +72,13 @@ knightAstar heuristic blockedSquares start target = $ astar (Board start blockedSquares) (Board target blockedSquares) nextKnightPos heuristic --- Finds a path from a start square to an end square using BFS -bfsSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square]) -bfsSearch = knightAstar (\_ _ -> 0) - --- Finds a path from a start square to an end square using AStar with --- half of the max of coordinate deltas as the heuristic -astarSearch :: S.Set Square -> Square -> Square -> Maybe (Int, [Square]) -astarSearch = +-- | Finds a path from a start square to an end square using A* with +-- half of the max of coordinate deltas as the heuristic function +search :: S.Set Square -- ^ The set of blocked squares + -> Square -- ^ The start square + -> Square -- ^ The target square + -> Maybe (Int, [Square]) -- ^ The solution cost and path if found else 'Nothing' +search = knightAstar (\(Board (x1,y1) _) (Board (x2,y2) _) -> max (abs (x1-x2)) (abs (y1-y2)) `div` 2) @@ -90,7 +90,7 @@ main = do then error "Invalid board position" else let (start : target : blocked) = args - in case astarSearch (S.fromList . map fromNotation $ blocked) + in case search (S.fromList . map fromNotation $ blocked) (fromNotation start) (fromNotation target) of Just (_, path) -> putStrLn . unwords . map toNotation $ path Nothing -> putStrLn "No path found" \ No newline at end of file