Бинарное дерево с помеченными вершинами

data BinTree = BinTree Bool BinTree BinTree | Empty
 
onePath :: BinTree -> Bool
onePath (Empty) = False
onePath (BinTree False _ _) = False
onePath (BinTree _ Empty Empty) = True
onePath (BinTree _ l r) = onePath l /= onePath r
 
main = print $ onePath $ BinTree True (BinTree False Empty Empty)
                                      (BinTree True (BinTree False Empty Empty)
                                                    (BinTree True Empty (BinTree True Empty Empty)))

data T a = T a (T a) (T a) | N
 
-- не отдерайвился такой-сякой, пришлось руками писать
myfold f N = 0
myfold f (T v l r) = f v (myfold f l) (myfold f r)
 
f v l r = case (l+r) of
    0 -> fromEnum v
    1 -> 1
    _ -> 2
 
test t = case myfold f t of
    0 -> "No mark nodes"
    1 -> "All marked nodes are on one path"
    _ -> "There are marked nodes on different paths"
 
t1 = T True (T False N N)
            (T False (T True N N)
                     (T True N (T True N N)))
t2 = T True (T False N N)
            (T False (T False N N)
                     (T True N (T True N N)))
main = do
    print $ test t1
    print $ test t2
 
"There are marked nodes on different paths"
"All marked nodes are on one path"

data T a = T a (T a) (T a) | N
 
type TreeAlgebra a r = (r, a -> r -> r -> r)
 
foldTree :: TreeAlgebra a r -> T a -> r
foldTree (f, g) N         = f
foldTree (f, g) (T x l r) = g x (foldTree (f, g) l) (foldTree (f, g) r)
 
testMarkPath :: TreeAlgebra Bool Int
testMarkPath = (0, \v l r -> if l+r==0 then fromEnum v else l+r)
 
test t = case foldTree testMarkPath t of
    0 -> "No mark nodes"
    1 -> "All marked nodes are on one path"
    _ -> "There are marked nodes on different paths"
 
t1 = T True (T False N N)
            (T False (T True N N)
                     (T False N (T True N N)))
t2 = T True (T False N N)
            (T False (T False N N)
                     (T True N (T True N N)))
main = do
    print $ test t1
    print $ test t2

import Control.Applicative
 
data T a = T a (T a) (T a) | N
 
myfold f N = Just False
myfold f (T v l r) = f v (myfold f l) (myfold f r)
 
f2 v l r = (||v) <$> case liftA2 (&&) l r of { Just True -> Nothing; _ -> liftA2 (||) l r }
 
g1 a b = if a && b then Nothing else Just (a || b)
g2 v l r = maybe Nothing ((||v) <$>) $ g1 <$> l <*> r
 
t1 = T True (T False N N)
            (T False (T True N N)
                     (T True N (T True N N)))
t2 = T True (T False N N)
            (T False (T False N N)
                     (T True N (T True N N)))
main = do
    print $ myfold f2 t1
    print $ myfold f2 t2
    print $ myfold g2 t1
    print $ myfold g2 t2

import Control.Monad 
 
lift2':: Monad m => (a -> b -> m c) -> m a -> m b -> m c
lift2' f a1 a2 = join $ liftM2 f a1 a2

data PassState = Pass | NoPass | Hmm

f1:: a -> b
f1 = undefined
 
f2:: a -> b -> c
f2 = undefined
 
f:: a -> b -> c
f = f1 . f2

f1:: Int -> Int
f1 = undefined
 
f2:: Int -> Int -> Int
f2 = undefined
 
f:: Int -> Int -> Int
f = f1 . f2

f = (f1 .) . f2

f = (.) f1 . f2