Return to Snippet

Revision: 17259
at August 29, 2009 05:09 by u1ik


Initial Code
data Tree a = Empty | Node a (Tree a) (Tree a) deriving (Show)

data Result a = Equal | NotEqual | RemainsLeft a | RemainsRight a deriving (Show, Eq)

cmp Empty Empty = Equal

cmp Empty t2    = RemainsRight t2

cmp t1 Empty    = RemainsLeft t1

cmp t1@(Node v1 l1 r1) t2@(Node v2 l2 r2) 
          | v1 == v2  = case (cmp l1 l2) of
                        Equal -> (cmp r1 r2)
                        _     -> NotEqual

          | v1 < v2   = if l2 == Empty then NotEqual
                        else case (cmp t1 l2) of
                             Equal            -> RemainsRight (Node v2 Empty r2)
                             NotEqual         -> NotEqual
                             RemainsLeft t1'  -> cmp t1' (Node v2 Empty r2)
                             RemainsRight l2' -> RemainsRight (Node v2 l2' r2)

          | otherwise = if l1 == Empty then NotEqual
                        else case (cmp l1 t2) of
                             Equal            -> RemainsLeft (Node v1 Empty r1)
                             NotEqual         -> NotEqual
                             RemainsLeft l1'  -> RemainsLeft (Node v1 l1' r1)
                             RemainsRight t2' -> cmp (Node v1 Empty r1) t2'

instance (Ord a) => Eq (Tree a) where
   t1 == t2 = (cmp t1 t2) == Equal

test1 = 
   let t213 = Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty) in
   let t657 = Node 6 (Node 5 Empty Empty) (Node 7 Empty Empty) in
   let t1 = Node 4 t213 (Node 8 t657 (Node 9 Empty Empty)) in
   let t2 = Node 8 (Node 4 t213 t657) (Node 9 Empty Empty) in
   t1 == t2

test2 = 
   let t213 = Node 2 (Node 1 Empty Empty) (Node 3 Empty Empty) in
   let t657 = Node 6 (Node 5 Empty Empty) (Node 7 Empty Empty) in
   let t1 = Node 4 t213 (Node 8 t657 (Node 9 Empty Empty)) in
   let t2 = Node 8 (Node 4 t213 t657) (Node 9 Empty (Node 10 Empty Empty)) in
   t1 /= t2

Initial URL
http://antilamer.livejournal.com/289527.html

Initial Description


Initial Title
Compare Binary Search Trees

Initial Tags


Initial Language
Haskell