SHOW:
|
|
- or go back to the newest paste.
| 1 | -- As seen here: http://www.reddit.com/r/dailyprogrammer/comments/za9tu/9032012_challenge_95_intermediate_filler_text/c633fn2 | |
| 2 | ||
| 3 | module Intermediate95 where | |
| 4 | ||
| 5 | import Data.Char (toUpper) | |
| 6 | import Data.Random.Extras (choice) | |
| 7 | import Data.Random (runRVar) | |
| 8 | import Data.Random.Source.DevRandom (DevRandom (DevURandom)) | |
| 9 | import Data.RVar (RVar) | |
| 10 | import System.Environment (getArgs) | |
| 11 | import System.Random (randomRIO) | |
| 12 | ||
| 13 | -- Prints filler text given the number of sentences to be printed. | |
| 14 | main :: IO () | |
| 15 | main = fmap (read . head) getArgs >>= sentences >>= join >>= putStrLn | |
| 16 | ||
| 17 | -- Returns a list of n sentences. | |
| 18 | sentences :: Int -> IO [String] | |
| 19 | sentences 0 = return [] | |
| 20 | sentences n = do | |
| 21 | (s, l) <- sentence | |
| 22 | ||
| 23 | case compare n l of | |
| 24 | LT -> (return . take n) s | |
| 25 | _ -> do | |
| 26 | rest <- sentences (n - l) | |
| 27 | ||
| 28 | if null rest then | |
| 29 | (return . return . unwords) s | |
| 30 | else | |
| 31 | (return . (unwords s :)) rest | |
| 32 | ||
| 33 | -- Concats the list of sentences while inserting line breaks and paragraph breaks. | |
| 34 | -- There is a 15% chance of a line break to follow a sentence. | |
| 35 | -- There is a further 50% chance of those line breaks to be paragraph breaks instead. | |
| 36 | join :: [String] -> IO String | |
| 37 | - | join [] = return "" |
| 37 | + | join [] = return "" |
| 38 | - | join [x] = return $ x ++ "." |
| 38 | + | join [x] = return $ x ++ "." |
| 39 | - | join (x : xs) = do |
| 39 | + | join (x : xs) = do |
| 40 | rest <- join xs | |
| 41 | eol <- chance 15 | |
| 42 | eop <- chance 50 | |
| 43 | ||
| 44 | return $ x ++ ". " ++ | |
| 45 | if eol then | |
| 46 | "\n" ++ | |
| 47 | if eop then | |
| 48 | "\n" ++ rest | |
| 49 | else | |
| 50 | rest | |
| 51 | else | |
| 52 | rest | |
| 53 | ||
| 54 | -- Returns a boolean given a probability. | |
| 55 | chance :: Int -> IO Bool | |
| 56 | chance n = (rvar . choice . distribution) [ | |
| 57 | (True, n), | |
| 58 | (False, 100 - n)] | |
| 59 | ||
| 60 | -- Generates a tuple of a random sentence and its length. | |
| 61 | sentence :: IO ([String], Int) | |
| 62 | sentence = do | |
| 63 | n <- randomRIO (3, 8) | |
| 64 | (x : xs) <- randomWords n | |
| 65 | ||
| 66 | return (capitalise x : xs, n) | |
| 67 | ||
| 68 | capitalise :: String -> String | |
| 69 | capitalise (x : xs) = toUpper x : xs | |
| 70 | ||
| 71 | randomWords :: Int -> IO [String] | |
| 72 | randomWords 0 = return [] | |
| 73 | randomWords n = do | |
| 74 | w <- randomRIO (1, 12) >>= randomWord | |
| 75 | rest <- randomWords (n - 1) | |
| 76 | ||
| 77 | return (w : rest) | |
| 78 | ||
| 79 | randomWord :: Int -> IO String | |
| 80 | randomWord 0 = return [] | |
| 81 | randomWord n = do | |
| 82 | c <- randomChar | |
| 83 | rest <- randomWord (n - 1) | |
| 84 | ||
| 85 | return (c : rest) | |
| 86 | ||
| 87 | randomChar :: IO Char | |
| 88 | randomChar = (rvar . choice) english | |
| 89 | ||
| 90 | -- Source: http://en.wikipedia.org/wiki/Letter_frequency#Relative_frequencies_of_letters_in_the_English_language | |
| 91 | english :: String | |
| 92 | english = distribution [ | |
| 93 | ('a', 8167), ('n', 6749),
| |
| 94 | ('b', 1492), ('o', 7507),
| |
| 95 | ('c', 2782), ('p', 1929),
| |
| 96 | ('d', 4253), ('q', 95),
| |
| 97 | ('e', 12702), ('r', 5987),
| |
| 98 | ('f', 2228), ('s', 6327),
| |
| 99 | ('g', 2015), ('t', 9056),
| |
| 100 | ('h', 6094), ('u', 2758),
| |
| 101 | ('i', 6966), ('v', 1037),
| |
| 102 | ('j', 153), ('w', 2365),
| |
| 103 | ('k', 747), ('x', 150),
| |
| 104 | ('l', 4025), ('y', 1974),
| |
| 105 | ('m', 2406), ('z', 74)]
| |
| 106 | ||
| 107 | distribution :: [(a, Int)] -> [a] | |
| 108 | distribution = concatMap (uncurry (flip replicate)) | |
| 109 | ||
| 110 | rvar :: RVar a -> IO a | |
| 111 | rvar f = runRVar f DevURandom |