Диалог моделей

coursework/part2/app/Main.hs

@@ -10,6 +10,18 @@ main =
     let sentences = splitText content in
     let dict = buildDictionary sentences in
     saveDictionary "dict.txt" dict >>
-    putStrLn "Введите слово или пару слов:" >>
+    putStrLn "Введите слово или пару слов для генерации фразы:" >>
     getLine >>= \input ->
-    processInput dict input
+    processInput dict input >>
+
+    putStrLn "Введите имя второго файла:" >>
+    getLine >>= \fileName2 ->
+    readFile fileName2 >>= \content2 ->
+    let dict2 = buildDictionary (splitText content2) in
+    saveDictionary "dict2.txt" dict2 >>
+    putStrLn "Введите начальное слово или пару слов для старта диалога:" >>
+    getLine >>= \input2 ->
+    putStrLn "Введите количество сообщений M:" >>
+    getLine >>= \ms ->
+    let m = read ms :: Int in
+    twoModelsDialog dict dict2 input2 m

coursework/part2/src/Lib.hs

@@ -71,3 +71,33 @@ processInput dict input =
         putStrLn $ unwords $ generatePhrase dict input gen
     else
         putStrLn "Нет в словаре"
+
+findKeyForResponse :: Map String [String] -> [String] -> Maybe String
+findKeyForResponse dict ws =
+    case dropWhile (\w -> Map.notMember w dict) (reverse ws) of
+        []    -> Nothing
+        (x:_) -> Just x
+
+dialogStep :: Map String [String] -> [String] -> IO [String]
+dialogStep dict prevPhrase =
+    case findKeyForResponse dict (words $ unwords prevPhrase) of
+        Nothing -> putStrLn "Нет в словаре" >> return []
+        Just key ->
+            newStdGen >>= \gen ->
+            let p = generatePhrase dict key gen
+            in putStrLn (unwords p) >> return p
+
+twoModelsDialog :: Map String [String] -> Map String [String] -> String -> Int -> IO ()
+twoModelsDialog dict1 dict2 start m =
+    newStdGen >>= \gen ->
+    let first = generatePhrase dict1 start gen
+    in putStrLn (unwords first) >>
+        loop dict1 dict2 first m
+  where
+    loop d1 d2 prev 0 = return ()
+    loop d1 d2 prev i =
+        dialogStep d2 prev >>= \resp ->
+        if null resp then return () else
+        dialogStep d1 resp >>= \resp2 ->
+        if null resp2 then return () else
+        loop d1 d2 resp2 (i-1)