Execute a Markov algorithm: Difference between revisions

→‎{{header|Haskell}}: Made the necessary improvements.
m (Placed the task description and test cases before the table of contents, as per convention. (IMO, this is a very useful convention; it ensures every top-level section in the ToC is an implementation.))
(→‎{{header|Haskell}}: Made the necessary improvements.)
Line 162:
 
=={{header|Haskell}}==
This program expects a source file as an argument and uses the standard input and output devices for the algorithm's I/O.
<!-- This is essentially correct, but it could use some prettifying and a better interface. I'll make these changes sometime in the next few days (if nobody beats me to it). -->
 
<lang haskell>import Data.List (isPrefixOf)
import Data.Maybe (catMaybes)
import Control.Monad
import Text.ParserCombinators.Parsec
import System.IO
import System.Environment (getArgs)
 
main = do
args <- getArgs
unless (length args == 1) $
fail "Please provide exactly one source file as an argument."
let sourcePath = head args
source <- readFile sourcePath
input <- getContents
case parse markovParser sourcePath source of
Right rules -> putStrLn $ runMarkov rules input
Left err -> hPutStrLn stderr $ "Parse error at " ++ show err
 
data Rule = Rule
{from :: String, terminating :: Bool, to :: String} deriving Show
 
main = case parse algorithm "foo" $ unlines l2 of
Right rs -> putStrLn $ run rs $ "I bought a B of As W my Bgage from T S."
Left e -> print e
where l =
["# This rules file is extracted from Wikipedia:",
"# http://en.wikipedia.org/wiki/Markov_Algorithm",
"A -> apple",
"B -> bag",
"S -> shop",
"T -> the",
"the shop -> my brother",
"a never used -> .terminating rule"]
l2 =
["# BNF Syntax testing rules",
"A -> apple",
"WWWW -> with",
"Bgage -> ->.*",
"B -> bag",
"->.* -> money",
"W -> WW",
"S -> .shop",
"T -> the",
"the shop -> my brother",
"a never used -> .terminating rule"]
 
algorithm :: Parser [Rule]
algorithm = liftM catMaybes $
(comment' <|> rule') `sepEndBy` (many1 newline)
where comment' = comment >> return Nothing
rule' = (liftM Just rule) <?> "rule"
 
comment = char '#' >> skipMany nonnl
 
rule :: Parser Rule
rule = liftM3 Rule
(manyTill nonnl $ try $ ws >> string "->" >> ws)
(option False $ char '.' >> return True)
(many nonnl)
 
 
nonnl = noneOf "\n"
ws = many1 $ oneOf " \t"
 
algorithmmarkovParser :: Parser [Rule]
algorithmmarkovParser = liftM catMaybes $
(comment' <|> rule') `sepEndBy` (many1 newline)
where comment' = commentchar '#' >> skipMany nonnl >> return Nothing
rule' = (liftM Just rule)$ <?>liftM3 "rule"Rule
(manyTill (nonnl <?> "pattern character") $ try arrow)
(succeeds $ char '.')
"A -> apple",(many nonnl)
arrow = ws >> string "->" >> ws <?> "whitespace-delimited arrow"
nonnl = noneOf "\n"
ws = many1 $ oneOf " \t"
( succeeds p = option False $ char '.'p >> return True)
 
runrunMarkov :: [Rule] -> String -> String
runrunMarkov rules s = f rules s
where f [] s = s
f ((Rule from terminating to) : rs) s = g "" s
where g _ "" = f rs s
g before ahead@(a : as) = if from `isPrefixOf` ahead
then let new = (reverse before) ++ to ++ drop (length from) ahead
in if terminating then new else f rules new
else g (a : before) as</lang>
845

edits