commit 3345d531beb949111c1647a83897030da4aee2f4 Author: gregorbednov Date: Thu Apr 9 21:51:40 2026 +0300 Загрузить файлы в «/» diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..ca6c23f --- /dev/null +++ b/Main.hs @@ -0,0 +1,88 @@ +import Control.Concurrent (threadDelay) + +data Tree = T Tree Tree | U Tree Tree | F Tree Tree | None deriving (Read, Eq) + +showv :: Tree -> String +showv (T _ _) = "T" +showv (F _ _) = "F" +showv (U _ _) = "U" +showv None = "" + +isNone None = True +isNone _ = False + +showRel b (a, c) + | isNone a = "" + | otherwise = b ++ " -> " ++ b ++ c + +surround l r m = l <> m <> r + +commas joiner [] = mempty +commas joiner [a] = a +commas joiner (a:b) = a <> joiner <> commas joiner b + +showGV _ (None, _) = "" +showGV b (a, c) = + let + ind = b ++ c + val = showv a + prefix = ((ind ++ " -> ") ++) + children = case a of + (T l r) -> [l, r] + (U l r) -> [l, r] + (F l r) -> [l, r] + in + commas "; " $ (ind ++ surround "[label=\"" "\"]" val): + [f ind subs + | f <- [showRel, showGV] + , subs <- (zip children ["L", "R"]) + , f ind subs /= ""] + +instance Show Tree where + show :: Tree -> String + show x = surround "digraph{" "}" $ showGV "Z" (x, "") + + +update :: Tree -> Tree +-- нисходящие нули +update (F (U a b) (U c d)) = F (update $ F a b) (update $ F c d) +update (F (F a b) (U c d)) = F (update $ F a b) (update $ F c d) +update (F (U a b) (F c d)) = F (update $ F a b) (update $ F c d) + +-- восходящие единицы +update (U (T a b) (U c d)) = T (update $ T a b) (update $ U c d) +update (U (U a b) (T c d)) = T (update $ U a b) (update $ T c d) +update (U (T a b) (F c d)) = T (update $ T a b) (update $ F c d) +update (U (F a b) (T c d)) = T (update $ F a b) (update $ T c d) + +-- обобщение нуля +update (U (F a b) (F c d)) = F (update $ F a b) (update $ F c d) + +-- частная единица +update (T (F a b) (U c d)) = T (update $ F a b) (update $ T c d) +update (T (U a b) (F c d)) = T (update $ T a b) (update $ F c d) + +-- контрадикторные правила +--update (U (T a b) c) = T (update $ U a b) (update c) +--update (F (T a b) c) = U (update $ U a b) (update c) +--update (U (T a b) (U c d)) = T (update $ T a b) (update $ U c d) +--update (U (U a b) (T c d)) = T (update $ U a b) (update $ T c d) + +-- универсальная рекурсия +update (T l r) = T (update l) (update r) +update (U l r) = U (update l) (update r) +update (F l r) = F (update l) (update r) +-- база рекурсии +update None = None + +iterateN :: Int -> Tree -> [Tree] +iterateN 0 t = [t] +iterateN i t = + let t' = update t + in if t' == t then [t] else t:(iterateN (i-1) t') + +main :: IO () +main = do + ln <- getLine + let tr = (read ln :: Tree) + mapM_ print $ iterateN 100 tr \ No newline at end of file