Add roots and parents to adjacency function from Double Trees

src/Dodge/DoubleTree.hs

@@ -3,6 +3,13 @@ module Dodge.DoubleTree where
 import Dodge.Data.DoubleTree
 import qualified Data.IntMap.Strict as IM
 
+singleDT :: a -> DoubleTree a
+singleDT x = DT x [] []
+
+singleLDT :: a -> LabelDoubleTree b a
+singleLDT x = LDT x [] []
+
+
 ldtToDT :: LabelDoubleTree b a -> DoubleTree a
 ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
 
@@ -31,6 +38,21 @@ dtToUpDownAdj f (DT x l r) = IM.insert (f x) (map g l , map g r)
   where 
     g = f . _dtValue
 
+-- returns an adjacency map with oldest ancestor and direct parent if they exist
+-- and any left and right children
+dtToLRAdj :: (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
+dtToLRAdj f (DT x l r) = IM.insert i (Nothing,map g l , map g r) 
+    . IM.unions $ map (dtToAdjRootParent i i f) $ l <> r
+  where 
+    i = f x
+    g = f . _dtValue
+
+dtToAdjRootParent :: Int -> Int -> (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe (Int,Int),[Int],[Int])
+dtToAdjRootParent root par f (DT x l r) = IM.insert (f x) (Just (root,par),map g l , map g r) 
+    . IM.unions $ map (dtToAdjRootParent root (f x) f) $ l <> r
+  where 
+    g = f . _dtValue
+
 ldtToIM :: (a -> Int) -> LabelDoubleTree b a -> IM.IntMap (LabelDoubleTree b a)
 ldtToIM f t@(LDT x l r) = IM.insert (f x) t $ IM.unions $ map (ldtToIM f . snd) $  l <> r