88 lines
2.6 KiB
Haskell
88 lines
2.6 KiB
Haskell
|
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
|