Генерация фраз

coursework/part2/app/Main.hs

@@ -1,7 +1,6 @@
 module Main (main) where
 
 import Lib
-import UnescapingPrint (uprint)
 
 main :: IO ()
 main =
@@ -9,6 +8,8 @@ main =
     getLine >>= \fileName ->
     readFile fileName >>= \content ->
     let sentences = splitText content in
-    uprint (take 10 sentences) >>
     let dict = buildDictionary sentences in
-    saveDictionary "dict.txt" dict
+    saveDictionary "dict.txt" dict >>
+    putStrLn "Введите слово или пару слов:" >>
+    getLine >>= \input ->
+    processInput dict input

coursework/part2/package.yaml

@@ -22,6 +22,7 @@ description:         Please see the README on GitHub at <https://github.com/gith
 dependencies:
 - base >= 4.7 && < 5
 - containers
+- random
 - unescaping-print
 
 ghc-options:

coursework/part2/part2.cabal

@@ -36,6 +36,7 @@ library
   build-depends:
       base >=4.7 && <5
     , containers
+    , random
     , unescaping-print
   default-language: Haskell2010
 
@@ -52,6 +53,7 @@ executable part2-exe
       base >=4.7 && <5
     , containers
     , part2
+    , random
     , unescaping-print
   default-language: Haskell2010
 
@@ -69,5 +71,6 @@ test-suite part2-test
       base >=4.7 && <5
     , containers
     , part2
+    , random
     , unescaping-print
   default-language: Haskell2010

coursework/part2/src/Lib.hs

@@ -5,6 +5,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.List (nub, tails)
 import System.IO
+import System.Random (StdGen, randomR, newStdGen) -- mkStdGen
 import UnescapingPrint (ushow)
 
 
@@ -41,4 +42,32 @@ buildDictionary sentences =
 
 saveDictionary :: FilePath -> Map String [String] -> IO ()
 saveDictionary filePath dict = withFile filePath WriteMode $ \h -> 
-    mapM_ (\(k,v) -> hPutStrLn h $ ushow k ++ ": " ++ ushow v) (Map.toList dict)
+    mapM_ (\(k,v) -> hPutStrLn h $ ushow k ++ ": " ++ ushow v) (Map.toList dict)
+
+generatePhrase :: Map String [String] -> String -> StdGen -> [String]
+generatePhrase dict start initGenState =
+    -- let (len, initGenState') = (2 :: Int, initGenState)
+    let (len, initGenState') = randomR (2,15 :: Int) initGenState
+    in reverse $ gp start [] len initGenState'
+    where
+        gp :: String -> [String] -> Int -> StdGen -> [String]
+        gp key acc n genState 
+            | n <= 0 = acc
+            | otherwise =
+                case Map.lookup key dict of
+                    Nothing -> acc
+                    Just [] -> acc
+                    Just vals ->
+                        let (i, newGenState) = randomR (0, length vals - 1) genState
+                            next = vals !! i
+                        in
+                            gp next (next:acc) (n - length (words next)) newGenState
+
+processInput :: Map String [String] -> String -> IO ()
+processInput dict input =
+    if Map.member input dict then
+        -- let gen = mkStdGen 42 in
+        newStdGen >>= \gen ->
+        putStrLn $ unwords $ generatePhrase dict input gen
+    else
+        putStrLn "Нет в словаре"