-- 
-- This file Copyright 2001 Jeffrey B Putnam
-- Please Contact me - jefu@eou.edu - for information 
-- 
ulam x 
   | x `mod` 2 == 0   = x `div` 2
   | otherwise        = 3*x + 1 

ulamToOne 1 = [1] 
ulamToOne x = x : (ulamToOne (ulam x)) 

ulamBack x 0            = [x] 
ulamBack x count  
    |  x `mod` 6 == 4   = merge3 [x] (ulamBack ((x - 1) `div` 3) (count - 1))
	                             (ulamBack (2*x)             (count - 1))
    |  otherwise        = merge [x]  (ulamBack (2*x)             (count - 1)) 

merge [] y            = y 
merge x  []           = x 
merge xl@(x:xs) yl@(y:ys)   
     | x < y          = x:(merge xs yl) 
     | x == y         = x:(merge xs ys) 
     | otherwise      = y:(merge xl ys)

merge3 l1 l2 l3       = merge (merge l1 l2) l3 

------------------------------------------------------

data Memo        = Memo Int Int [Int] 
	           deriving (Show) 

instance Eq Memo where
   (Memo i j _) == (Memo i' j' _) = (i == i') && (j == j') 

instance Ord Memo where 
   (Memo i j _) < (Memo i' j' _) = if i < i' 
                                   then True 
                                   else j < j'             

value (Memo _ _ l) = l 

------------------------------------------------------

data BTree       = Leaf | Node Memo BTree BTree 

leftNode  (Node _ l _) = l 
rightNode (Node _ _ r) = r 

insert m Leaf    = Node m Leaf Leaf 
insert m n@(Node m1 l r) 
   | m < m1      = Node m1 (insert m l) r 
   | m > m1      = Node m1 l            (insert m r) 
   | otherwise   = n 

find m Leaf      = False 
find m (Node m1 l r) 
   | m == m1     = True 
   | m < m1      = find m l 
   | otherwise   = find m r 

findV m Leaf      = [] 
findV m (Node m1 l r) 
   | m == m1     = value m1 
   | m < m1      = findV m l
   | otherwise   = findV m r 

------------------------------------------------------

memoedUB x 0 t         = ([x], insert (Memo x 0 [x]) t)

memoedUB x y t =    res 
                 where 
	            v = findV (Memo x y []) t  
	            res = if v /= [] 
                          then (v, t) 
                          else ulamBackM x y t

	            
ulamBackM x count t 
    |  x `mod` 6 == 4   = let
	                      (m1, t1) = (memoedUB ((x - 1) `div` 3) (count - 1) t)
	                      (m2, t2) = (memoedUB (2*x)             (count - 1) t1)  
	                      l        = merge3 [x] m1 m2 
	                      t3       = insert (Memo x count l) t2 
	                  in  
                              (l, t3) 

    |  otherwise        = let 
	                      (m1, t1) = memoedUB (2*x) (count - 1) t 
	                  in 
	                      (merge [x] m1, t1) 
                             

xub i j = fst (memoedUB i j Leaf)