diff --git a/coursework/part2/app/Main.hs b/coursework/part2/app/Main.hs index fbb593c..cd51245 100644 --- a/coursework/part2/app/Main.hs +++ b/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 diff --git a/coursework/part2/src/Lib.hs b/coursework/part2/src/Lib.hs index 8c41880..816ace4 100644 --- a/coursework/part2/src/Lib.hs +++ b/coursework/part2/src/Lib.hs @@ -70,4 +70,34 @@ processInput dict input = newStdGen >>= \gen -> putStrLn $ unwords $ generatePhrase dict input gen else - putStrLn "Нет в словаре" \ No newline at end of file + 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) \ No newline at end of file