You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
68 lines
3.0 KiB
68 lines
3.0 KiB
import Data.List
|
|
import Data.Map.Strict as Map
|
|
import System.Environment
|
|
import System.Random
|
|
|
|
-- The Markov Chain consists of a map where the key represents a word from the text file and a list of values which come after this specific key word.
|
|
type MarkovChain = Map.Map String [String]
|
|
|
|
-- Takes a key (k) and a value (v) and adds it to the Markov Chain. If the key already exists in the chain then the value gets added to the existing list of values.
|
|
-- If not then a new key gets added to the Markov Chain.
|
|
addPair :: String -> String -> MarkovChain -> MarkovChain
|
|
addPair k v chain =
|
|
case Map.lookup k chain of
|
|
Just vs -> Map.insert k (v : vs) chain
|
|
Nothing -> Map.insert k [v] chain
|
|
|
|
-- Takes a list of words and creates a list of word pairs with adjacent words.
|
|
-- Then we use a helper function (addPair') which takes these pairs and then add each of those pairs to the Markov Chain.
|
|
buildChain :: [String] -> MarkovChain
|
|
buildChain xs =
|
|
let pairs = zip xs (tail xs)
|
|
addPair' (k, v) chain = addPair k v chain
|
|
in Data.List.foldr addPair' Map.empty pairs
|
|
|
|
-- Takes a list of values and returns a random element inside it.
|
|
randomChoice :: [a] -> IO a
|
|
randomChoice xs = do
|
|
i <- randomRIO (0, length xs - 1)
|
|
return (xs !! i)
|
|
|
|
generateSentence :: MarkovChain -> Int -> IO String
|
|
generateSentence chain maxLength = do
|
|
-- We retrieve the keys from the Markov Chain
|
|
let keys = Map.keys chain
|
|
-- And then determine a random key as a starting point from the list of all keys
|
|
start <- randomChoice keys
|
|
loop start start 1
|
|
where
|
|
-- Loop through as long as n is smaller than the given length and use the accumulator (current sentence) and the current word (current) to add to the sentence.
|
|
loop acc current n
|
|
| n >= maxLength = return acc
|
|
| otherwise =
|
|
-- A key lookup to retrieve the corresponding values happens.
|
|
case Map.lookup current chain of
|
|
Just xs -> do
|
|
-- And then we retrieve a random value from the list of given values
|
|
next <- randomChoice xs
|
|
-- And then we add it to the accumulator to generate a part of our sentence and increase the loop index n
|
|
loop (acc ++ " " ++ next) next (n + 1)
|
|
-- If no values exit we end the sentence prematurly
|
|
Nothing -> return acc
|
|
|
|
-- Helper function to retrieve the integer command line argument
|
|
getIntArg :: IO Int
|
|
getIntArg = fmap (read . head) getArgs
|
|
|
|
main :: IO ()
|
|
main = do
|
|
-- We first retrieve the sentence length
|
|
sentenceLength <- getIntArg
|
|
-- Then the words from the given text, which serve as a basis for the Markov Chain
|
|
contents <- readFile "text.txt"
|
|
-- To generate our sentence we use our text content, build a Markov Chain, and then use it to generate our random sentence by using the chain to repeatedly add random words from our Markov Chain.
|
|
let text = words contents
|
|
chain = buildChain text
|
|
sentence <- generateSentence chain sentenceLength
|
|
-- And then we output our sentence.
|
|
putStrLn sentence
|