Converted the modules to libraries

master
Abhinav Sarkar 2012-10-27 11:07:22 +05:30
parent 1f1cc1f33d
commit 1838543880
16 changed files with 95 additions and 38 deletions

1
.gitignore vendored
View File

@ -5,4 +5,5 @@
input input
bin bin
dist dist
lib
*.sublime-workspace *.sublime-workspace

View File

@ -2,7 +2,7 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
module AStar where module AStar (astar) where
import qualified Data.PQueue.Prio.Min as PQ import qualified Data.PQueue.Prio.Min as PQ
import qualified Data.Set as S import qualified Data.Set as S

View File

@ -43,7 +43,9 @@
{-# LANGUAGE BangPatterns, TupleSections #-} {-# LANGUAGE BangPatterns, TupleSections #-}
module Main where module AmazingMazes (Cell(..), Maze(..), MazeSolution(..),
generateMaze, renderMaze, solveMaze, main)
where
import qualified Data.Map as M import qualified Data.Map as M
import AStar import AStar
@ -89,7 +91,7 @@ randomShuffle list = do
type Cell = (Int, Int) 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]) deriving (Show) 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) data MazeSolution = MazeSolution Cell Cell (M.Map Cell Cell)

View File

@ -6,7 +6,11 @@
{-# LANGUAGE Arrows, NoMonomorphismRestriction, RecordWildCards #-} {-# LANGUAGE Arrows, NoMonomorphismRestriction, RecordWildCards #-}
module Main where module BarrelOfMonkeys
(Song(..), SongLibrary, Playlist(..), getSongsFromXml,
shortestPlaylist, longestPlaylist, shortestTimePlaylist, longestTimePlaylist,
timedPlaylist, main)
where
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.FingerTree.PSQueue as Q import qualified Data.FingerTree.PSQueue as Q
@ -47,10 +51,9 @@ data SongLibrary = SongLibrary {
songIdMap :: M.Map Int Song, songIdMap :: M.Map Int Song,
fstCharMap :: M.Map Char [Song], fstCharMap :: M.Map Char [Song],
lstCharMap :: M.Map Char [Song] lstCharMap :: M.Map Char [Song]
} deriving (Show) }
data Playlist = Playlist { playlistSongs :: [Song], playlistDuration :: Int } data Playlist = Playlist { playlistSongs :: [Song], playlistDuration :: Int }
deriving (Show)
--- XML parsing --- --- XML parsing ---

View File

@ -8,7 +8,9 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Main where module Cryptograms (Mapping, Dict, readDict, translateToken,
scoreMapping, findBestMappings, showMapping, main)
where
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
@ -26,14 +28,14 @@ trace _ x = x
type Mapping = M.Map Char Char type Mapping = M.Map Char Char
type Dict = M.Map Int (S.Set String) 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 -> IO Dict
readDict filePath = do readDict filePath = do
!dictWords <- fmap (filter (all isAlpha) . map (map toLower) . lines) !dictWords <- fmap (filter (all isAlpha) . map (map toLower) . lines)
$ readFile filePath $ readFile filePath
return $ return . Dict $
foldl' (\dict w -> M.insertWith S.union (length w) (S.singleton w) dict) foldl' (\dict w -> M.insertWith S.union (length w) (S.singleton w) dict)
M.empty dictWords M.empty dictWords
@ -52,7 +54,7 @@ translateTokens mapping =
-- checks if the given word is in the dictionary. -- checks if the given word is in the dictionary.
inDict :: Dict -> String -> Bool inDict :: Dict -> String -> Bool
inDict dict word = inDict (Dict dict) word =
case M.lookup (length word) dict of case M.lookup (length word) dict of
Nothing -> False Nothing -> False
Just ws -> word `S.member` ws Just ws -> word `S.member` ws
@ -123,7 +125,7 @@ mergeMappings mapping1 mapping2 =
-- creates mappings for a token by finding words of same form from the dictionary. -- creates mappings for a token by finding words of same form from the dictionary.
createMappingsForToken :: Dict -> String -> S.Set Mapping createMappingsForToken :: Dict -> String -> S.Set Mapping
createMappingsForToken dict token = createMappingsForToken (Dict dict) token =
case M.lookup (length token) dict of case M.lookup (length token) dict of
Nothing -> S.empty Nothing -> S.empty
Just words -> let Just words -> let

View File

@ -16,7 +16,7 @@
{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE NoMonomorphismRestriction #-}
module Main (main) where module DiceRoller (RandomState, Expr(..), eval, expr, main) where
import Control.Applicative ((<$>), (<*), (*>), (<|>)) import Control.Applicative ((<$>), (<*), (*>), (<|>))
import Control.Monad (foldM, liftM2, liftM, when) import Control.Monad (foldM, liftM2, liftM, when)

View File

@ -46,7 +46,8 @@
Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net> Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
-} -}
module Main where module EnglishNumerals (Basis, readBasis, toEnglishNumerals, firstOddByEnglishNumeral, main)
where
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Data.List (maximumBy, nub) import Data.List (maximumBy, nub)

View File

@ -3,9 +3,9 @@
-- Example GEDCOM document at -- Example GEDCOM document at
-- http://cpansearch.perl.org/src/PJCJ/Gedcom-1.16/royal.ged -- http://cpansearch.perl.org/src/PJCJ/Gedcom-1.16/royal.ged
{-# LANGUAGE NoMonomorphismRestriction, RecordWildCards #-} {-# LANGUAGE NoMonomorphismRestriction, RecordWildCards, FlexibleContexts #-}
module Main where module GedcomParser (Elem(..), Doc, document, documentToXml, main) where
import Text.Parsec hiding (spaces, Line) import Text.Parsec hiding (spaces, Line)
import System.IO import System.IO
@ -16,7 +16,7 @@ data Line = Line {
lineTag :: String, lineTag :: String,
lineValue :: Maybe String, lineValue :: Maybe String,
lineId :: Maybe String lineId :: Maybe String
} deriving (Show) }
-- an element in a GEDCOM document -- an element in a GEDCOM document
data Elem = Elem { data Elem = Elem {
@ -26,6 +26,8 @@ data Elem = Elem {
elemChildren :: [Elem] elemChildren :: [Elem]
} deriving (Show) } deriving (Show)
type Doc = [Elem]
indent n = concat . replicate n $ " " indent n = concat . replicate n $ " "
trimValue value = case value of trimValue value = case value of
@ -60,6 +62,7 @@ element level = do
return $ Elem lineTag lineValue lineId children return $ Elem lineTag lineValue lineId children
-- parses a document -- parses a document
document :: Stream s m Char => ParsecT s u m Doc
document = element 0 `endBy` whitespaces document = element 0 `endBy` whitespaces
-- normalizes an element by merging values of CONC and CONT -- normalizes an element by merging values of CONC and CONT
@ -96,9 +99,11 @@ elemToXml indentation Elem{..} =
++ indent indentation ++ "</" ++ elemTag ++ ">" ++ indent indentation ++ "</" ++ elemTag ++ ">"
-- converts a document to XML -- converts a document to XML
documentToXml :: Doc -> String
documentToXml doc = "<DOCUMENT>\n" documentToXml doc = "<DOCUMENT>\n"
++ (unlines . map (elemToXml 1) $ doc) ++ (unlines . map (elemToXml 1) $ doc')
++ "</DOCUMENT>" ++ "</DOCUMENT>"
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 -- and prints to STDOUT
@ -106,5 +111,5 @@ main = do
text <- getContents text <- getContents
case parse document "GEDCOM Parser" text of case parse document "GEDCOM Parser" text of
Right [] -> return () Right [] -> return ()
Right doc -> putStrLn $ documentToXml (normalizeDoc doc) Right doc -> putStrLn $ documentToXml doc
Left e -> print e Left e -> print e

View File

@ -20,7 +20,9 @@
{-# LANGUAGE MultiParamTypeClasses, RecordWildCards #-} {-# LANGUAGE MultiParamTypeClasses, RecordWildCards #-}
module Main where module KnightsTravails (Square, Board(..), fromNotation, toNotation, isValidNotation,
bfsSearch, astarSearch, main)
where
import qualified Data.Set as S import qualified Data.Set as S
import AStar import AStar

View File

@ -16,7 +16,7 @@
Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net> Copyright 2012 Abhinav Sarkar <abhinav@abhinavsarkar.net>
-} -}
module Main (main) where module NumericMaze (solve, main) where
import AStar import AStar
import Control.Monad (when) import Control.Monad (when)

View File

@ -15,7 +15,7 @@
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
module Main where module PhoneNumberWords(Dict, readDict, phoneNumberWords, main) where
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Map as M import qualified Data.Map as M
@ -24,7 +24,7 @@ import Data.List (foldl', sort, intercalate)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.Environment (getArgs) import System.Environment (getArgs)
type Dict = M.Map String (S.Set String) newtype Dict = Dict (M.Map String (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 -> IO Dict
@ -33,7 +33,7 @@ readDict filePath = do
. filter ((> 2) . length) . filter ((> 2) . length)
. map (map toUpper) . lines) . map (map toUpper) . lines)
$ readFile filePath $ readFile filePath
return $ return . Dict $
foldl' (\dict w -> M.insertWith S.union (translate w) (S.singleton w) dict) foldl' (\dict w -> M.insertWith S.union (translate w) (S.singleton w) dict)
M.empty dictWords M.empty dictWords
@ -69,7 +69,7 @@ wordsForSplit dict =
map (\k -> S.toList . fromMaybe (S.singleton k) . M.lookup k $ dict) map (\k -> S.toList . fromMaybe (S.singleton k) . M.lookup k $ dict)
-- find all phone number words for a phone number -- find all phone number words for a phone number
phoneNumberWords dict = phoneNumberWords (Dict dict) =
filter isValid . sort filter isValid . sort
. concatMap (map (drop 1) . concatMap (map (drop 1)
. foldl (\acc ws -> [a ++ "-" ++ w | a <- acc, w <- ws]) [[]] . foldl (\acc ws -> [a ++ "-" ++ w | a <- acc, w <- ws]) [[]]

View File

@ -1,4 +1,4 @@
module Main where module SolataireCipher (Card(..), Deck, encrypt, decrypt, main) where
import qualified Options.Applicative as Op import qualified Options.Applicative as Op
import Data.Char (toUpper, ord, chr) import Data.Char (toUpper, ord, chr)

View File

@ -22,7 +22,10 @@
{-# LANGUAGE BangPatterns, RecordWildCards #-} {-# LANGUAGE BangPatterns, RecordWildCards #-}
module Main (main) where module SudokuSolver (Cell(..), Board, emptyBoard, boardCells, cellValues,
isBoardSolved, readBoard, showBoard, prettyShowBoard,
solveSudoku, main)
where
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.HashMap.Strict as M import qualified Data.HashMap.Strict as M
@ -48,14 +51,14 @@ data Cell = Cell {-# UNPACK #-} !Int
-- ambCells is the set of cells which have not been solved yet. -- ambCells is the set of cells which have not been solved yet.
data Board = Board { ixMap :: !(M.HashMap Int Cell), data Board = Board { ixMap :: !(M.HashMap Int Cell),
ambCells :: !(S.Set Cell) ambCells :: !(S.Set Cell)
} deriving (Eq, Show) } deriving (Eq)
instance Eq Cell where instance Eq Cell where
{-# INLINE (==) #-} {-# INLINE (==) #-}
(Cell i1 v1 _) == (Cell i2 v2 _) = i1 == i2 && v1 == v2 (Cell i1 v1 _) == (Cell i2 v2 _) = i1 == i2 && v1 == v2
instance Show Cell where instance Show Cell where
show (Cell ix val _) = "<" ++ show ix ++ " " ++ show val ++ ">" show cell@(Cell ix val _) = "<" ++ show ix ++ " " ++ show (cellValues cell) ++ ">"
instance Ord Cell where instance Ord Cell where
(Cell i1 v1 vl1) `compare` (Cell i2 v2 vl2) = (Cell i1 v1 vl1) `compare` (Cell i2 v2 vl2) =
@ -63,6 +66,12 @@ instance Ord Cell where
then EQ then EQ
else (vl1, i1) `compare`(vl2, i2) else (vl1, i1) `compare`(vl2, i2)
cellValues :: Cell -> [Int]
cellValues (Cell _ val _) = filter (testBit val) [1..9]
boardCells :: Board -> [Cell]
boardCells = map snd . sortBy (comparing fst) . M.toList . ixMap
-- Gets the index of the lowest bit set as 1. -- Gets the index of the lowest bit set as 1.
firstSol :: Word16 -> Int firstSol :: Word16 -> Int
firstSol val = fromJust . find (testBit val) $ [1..9] firstSol val = fromJust . find (testBit val) $ [1..9]
@ -158,14 +167,13 @@ showBoard :: Board -> String
showBoard board = showBoard board =
zipWith (\(Cell _ val vl) dot -> zipWith (\(Cell _ val vl) dot ->
if vl == 1 then intToDigit . firstSol $ val else dot) if vl == 1 then intToDigit . firstSol $ val else dot)
(map snd . sortBy (comparing fst) . M.toList . ixMap $ board) (boardCells board)
(repeat '.') (repeat '.')
-- Pretty prints a Sudoku board. -- Pretty prints a Sudoku board.
printBoard :: Board -> IO () prettyShowBoard :: Board -> String
printBoard board = prettyShowBoard board =
putStrLn (\t -> line ++ "\n" ++ t ++ line ++ "\n")
. (\t -> line ++ "\n" ++ t ++ line ++ "\n")
. unlines . intercalate [line] . chunksOf 3 . unlines . intercalate [line] . chunksOf 3
. map ((\r -> "| " ++ r ++ " |") . map ((\r -> "| " ++ r ++ " |")
. intercalate " | " . map (intersperse ' ') . chunksOf 3) . intercalate " | " . map (intersperse ' ') . chunksOf 3)

View File

@ -12,7 +12,10 @@
{-# LANGUAGE BangPatterns, RecordWildCards #-} {-# LANGUAGE BangPatterns, RecordWildCards #-}
module Main where module TicTacToe (Move(..), CellState(..), Cell(..), Board(..), Run, Result(..),
Player(..), playMatch, playMatches, RandomPlayer(..),
LearningPlayer, learnedPlayer, playHuman, main)
where
import qualified Data.Map as M import qualified Data.Map as M
import Control.Monad.State (State, get, put, runState, evalState) import Control.Monad.State (State, get, put, runState, evalState)

View File

@ -1,4 +1,4 @@
name: RubyQuiz name: rubyquiz
version: 1.0 version: 1.0
synopsis: Solutions to RubyQuiz problems in Haskell synopsis: Solutions to RubyQuiz problems in Haskell
homepage: https://github.com/abhin4v/rubyquiz homepage: https://github.com/abhin4v/rubyquiz
@ -13,6 +13,25 @@ source-repository head
type: git type: git
location: git@github.com:abhin4v/rubyquiz.git location: git@github.com:abhin4v/rubyquiz.git
library
exposed-modules : AStar, TicTacToe, KnightsTravails, Cryptograms, EnglishNumerals,
GedcomParser, PhoneNumberWords, SolataireCipher,
BarrelOfMonkeys, AmazingMazes, SudokuSolver, NumericMaze,
DiceRoller
build-depends : base == 4.*,
containers == 0.4.*,
mtl == 2.1.*,
random == 1.0.*,
split == 0.2.1.*,
pqueue == 1.2.*,
parsec == 3.1.*,
optparse-applicative == 0.1.*,
hxt == 9.2.*,
fingertree-psqueue == 0.3.*,
text == 0.11.*,
unordered-containers == 0.2.1.*
default-language : Haskell2010
executable TicTacToe executable TicTacToe
build-depends : base == 4.*, build-depends : base == 4.*,
containers == 0.4.*, containers == 0.4.*,
@ -20,6 +39,7 @@ executable TicTacToe
random == 1.0.*, random == 1.0.*,
split == 0.2.1.* split == 0.2.1.*
main-is : TicTacToe.hs main-is : TicTacToe.hs
ghc-options : -main-is TicTacToe
default-language : Haskell2010 default-language : Haskell2010
executable KnightsTravails executable KnightsTravails
@ -27,12 +47,14 @@ executable KnightsTravails
containers == 0.4.*, containers == 0.4.*,
pqueue == 1.2.* pqueue == 1.2.*
main-is : KnightsTravails.hs main-is : KnightsTravails.hs
ghc-options : -main-is KnightsTravails
default-language : Haskell2010 default-language : Haskell2010
executable Cryptograms executable Cryptograms
build-depends : base == 4.*, build-depends : base == 4.*,
containers == 0.4.* containers == 0.4.*
main-is : Cryptograms.hs main-is : Cryptograms.hs
ghc-options : -main-is Cryptograms
default-language : Haskell2010 default-language : Haskell2010
executable EnglishNumerals executable EnglishNumerals
@ -40,24 +62,28 @@ executable EnglishNumerals
containers == 0.4.*, containers == 0.4.*,
split == 0.2.1.* split == 0.2.1.*
main-is : EnglishNumerals.hs main-is : EnglishNumerals.hs
ghc-options : -main-is EnglishNumerals
default-language : Haskell2010 default-language : Haskell2010
executable GedcomParser executable GedcomParser
build-depends : base == 4.*, build-depends : base == 4.*,
parsec == 3.1.* parsec == 3.1.*
main-is : GedcomParser.hs main-is : GedcomParser.hs
ghc-options : -main-is GedcomParser
default-language : Haskell2010 default-language : Haskell2010
executable PhoneNumberWords executable PhoneNumberWords
build-depends : base == 4.*, build-depends : base == 4.*,
containers == 0.4.* containers == 0.4.*
main-is : PhoneNumberWords.hs main-is : PhoneNumberWords.hs
ghc-options : -main-is PhoneNumberWords
default-language : Haskell2010 default-language : Haskell2010
executable SolataireCipher executable SolataireCipher
build-depends : base == 4.*, build-depends : base == 4.*,
optparse-applicative == 0.1.* optparse-applicative == 0.1.*
main-is : SolataireCipher.hs main-is : SolataireCipher.hs
ghc-options : -main-is SolataireCipher
default-language : Haskell2010 default-language : Haskell2010
executable BarrelOfMonkeys executable BarrelOfMonkeys
@ -69,6 +95,7 @@ executable BarrelOfMonkeys
text == 0.11.*, text == 0.11.*,
optparse-applicative == 0.1.* optparse-applicative == 0.1.*
main-is : BarrelOfMonkeys.hs main-is : BarrelOfMonkeys.hs
ghc-options : -main-is BarrelOfMonkeys
default-language : Haskell2010 default-language : Haskell2010
executable AmazingMazes executable AmazingMazes
@ -78,6 +105,7 @@ executable AmazingMazes
random == 1.0.*, random == 1.0.*,
pqueue == 1.2.* pqueue == 1.2.*
main-is : AmazingMazes.hs main-is : AmazingMazes.hs
ghc-options : -main-is AmazingMazes
default-language : Haskell2010 default-language : Haskell2010
executable SudokuSolver executable SudokuSolver
@ -87,7 +115,7 @@ executable SudokuSolver
split == 0.2.1.*, split == 0.2.1.*,
unordered-containers == 0.2.1.* unordered-containers == 0.2.1.*
main-is : SudokuSolver.hs main-is : SudokuSolver.hs
ghc-options : -threaded -rtsopts ghc-options : -threaded -rtsopts -main-is SudokuSolver
default-language : Haskell2010 default-language : Haskell2010
executable NumericMaze executable NumericMaze
@ -95,6 +123,7 @@ executable NumericMaze
containers == 0.4.*, containers == 0.4.*,
pqueue == 1.2.* pqueue == 1.2.*
main-is : NumericMaze.hs main-is : NumericMaze.hs
ghc-options : -main-is NumericMaze
default-language : Haskell2010 default-language : Haskell2010
executable DiceRoller executable DiceRoller
@ -103,4 +132,5 @@ executable DiceRoller
random == 1.0.*, random == 1.0.*,
parsec == 3.1.* parsec == 3.1.*
main-is : DiceRoller.hs main-is : DiceRoller.hs
ghc-options : -main-is DiceRoller
default-language : Haskell2010 default-language : Haskell2010

View File

@ -3,8 +3,8 @@
[ [
{ {
"path": "/home/abhinav/projects/rubyquiz", "path": "/home/abhinav/projects/rubyquiz",
"folder_exclude_patterns": ["bin", "dist"], "folder_exclude_patterns": ["bin", "dist"],
"file_exclude_patterns": ["*.hi", "*.o"] "file_exclude_patterns": ["*.hi", "*.o"]
} }
] ]
} }