DoubleTree -> DTree
This commit is contained in:
@@ -28,7 +28,7 @@ data LabelDoubleTreeNodeType a
|
|||||||
| LDTMidBelowNode a
|
| LDTMidBelowNode a
|
||||||
| LDTBottomNode a
|
| LDTBottomNode a
|
||||||
|
|
||||||
data DoubleTree a = DT {_dtValue :: a, _dtLeft :: [DoubleTree a], _dtRight :: [DoubleTree a]}
|
data DTree a = DT {_dtValue :: a, _dtLeft :: [DTree a], _dtRight :: [DTree a]}
|
||||||
deriving (Eq, Ord, Show, Read)
|
deriving (Eq, Ord, Show, Read)
|
||||||
|
|
||||||
data LDTree b a = LDT -- LabelDoubleTree
|
data LDTree b a = LDT -- LabelDoubleTree
|
||||||
@@ -63,10 +63,10 @@ data LocationLDT b a = LocLDT
|
|||||||
, _locLDT :: LDTree b a
|
, _locLDT :: LDTree b a
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Functor DoubleTree where
|
instance Functor DTree where
|
||||||
fmap f (DT x l r) = DT (f x) (fmap (fmap f) l) (fmap (fmap f) r)
|
fmap f (DT x l r) = DT (f x) (fmap (fmap f) l) (fmap (fmap f) r)
|
||||||
|
|
||||||
instance Foldable DoubleTree where
|
instance Foldable DTree where
|
||||||
foldMap f (DT x l r) = foldMap (foldMap f) l <> f x <> foldMap (foldMap f) r
|
foldMap f (DT x l r) = foldMap (foldMap f) l <> f x <> foldMap (foldMap f) r
|
||||||
|
|
||||||
instance Functor (LDTree b) where
|
instance Functor (LDTree b) where
|
||||||
@@ -85,25 +85,25 @@ data ContextDT a
|
|||||||
= TopDT
|
= TopDT
|
||||||
| LeftwardDT
|
| LeftwardDT
|
||||||
{ _cdtUp :: ContextDT a
|
{ _cdtUp :: ContextDT a
|
||||||
, _cdtCloseLeft :: [DoubleTree a]
|
, _cdtCloseLeft :: [DTree a]
|
||||||
, _cdtParent :: a
|
, _cdtParent :: a
|
||||||
, _cdtCloseRight :: [DoubleTree a]
|
, _cdtCloseRight :: [DTree a]
|
||||||
, _cdtFarRight :: [DoubleTree a]
|
, _cdtFarRight :: [DTree a]
|
||||||
}
|
}
|
||||||
| RightwardDT
|
| RightwardDT
|
||||||
{ _cdtUp :: ContextDT a
|
{ _cdtUp :: ContextDT a
|
||||||
, _cdtFarLeft :: [ DoubleTree a]
|
, _cdtFarLeft :: [ DTree a]
|
||||||
, _cdtCloseLeft :: [DoubleTree a]
|
, _cdtCloseLeft :: [DTree a]
|
||||||
, _cdtParent :: a
|
, _cdtParent :: a
|
||||||
, _cdtCloseRight :: [DoubleTree a]
|
, _cdtCloseRight :: [DTree a]
|
||||||
}
|
}
|
||||||
|
|
||||||
data LocationDT b a = LocDT
|
data LocationDT b a = LocDT
|
||||||
{ _locDtContext :: ContextDT a
|
{ _locDtContext :: ContextDT a
|
||||||
, _locDT :: DoubleTree a
|
, _locDT :: DTree a
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''DoubleTree
|
makeLenses ''DTree
|
||||||
makeLenses ''LDTree
|
makeLenses ''LDTree
|
||||||
makeLenses ''LocationLDT
|
makeLenses ''LocationLDT
|
||||||
makeLenses ''ContextLDT
|
makeLenses ''ContextLDT
|
||||||
|
|||||||
+13
-13
@@ -6,13 +6,13 @@ import qualified Data.IntMap.Strict as IM
|
|||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Dodge.Data.DoubleTree
|
import Dodge.Data.DoubleTree
|
||||||
|
|
||||||
singleDT :: a -> DoubleTree a
|
singleDT :: a -> DTree a
|
||||||
singleDT x = DT x [] []
|
singleDT x = DT x [] []
|
||||||
|
|
||||||
singleLDT :: a -> LDTree b a
|
singleLDT :: a -> LDTree b a
|
||||||
singleLDT x = LDT x [] []
|
singleLDT x = LDT x [] []
|
||||||
|
|
||||||
ldtToDT :: LDTree b a -> DoubleTree a
|
ldtToDT :: LDTree b a -> DTree a
|
||||||
ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
|
ldtToDT (LDT x l r) = DT x (map (ldtToDT . snd) l) (map (ldtToDT . snd) r)
|
||||||
|
|
||||||
ldtStartPropagate :: (a -> c) -> (c -> b -> a -> c) -> LDTree b a -> LDTree b c
|
ldtStartPropagate :: (a -> c) -> (c -> b -> a -> c) -> LDTree b a -> LDTree b c
|
||||||
@@ -92,10 +92,10 @@ ldtPropagateIndices (LDT x l r) = LDT (x, []) (imap (f Left) l) (imap (f Right)
|
|||||||
-- conceptually, in a tree growing from left to right,
|
-- conceptually, in a tree growing from left to right,
|
||||||
-- bottom -> top is equated with left -> right.
|
-- bottom -> top is equated with left -> right.
|
||||||
-- this does not match with thinking of a list as top -> bottom, so take care
|
-- this does not match with thinking of a list as top -> bottom, so take care
|
||||||
doubleTreeToIndentList :: DoubleTree a -> [(a, Int, DoubleTreeNodeType)]
|
doubleTreeToIndentList :: DTree a -> [(a, Int, DoubleTreeNodeType)]
|
||||||
doubleTreeToIndentList = dtIL DTRootNode
|
doubleTreeToIndentList = dtIL DTRootNode
|
||||||
|
|
||||||
dtIL :: DoubleTreeNodeType -> DoubleTree a -> [(a, Int, DoubleTreeNodeType)]
|
dtIL :: DoubleTreeNodeType -> DTree a -> [(a, Int, DoubleTreeNodeType)]
|
||||||
dtIL nt (DT x l r) =
|
dtIL nt (DT x l r) =
|
||||||
map doindent (concat (headMap (dtIL DTBottomNode) (dtIL DTMidBelowNode) l))
|
map doindent (concat (headMap (dtIL DTBottomNode) (dtIL DTMidBelowNode) l))
|
||||||
++ [(x, 0, nt)]
|
++ [(x, 0, nt)]
|
||||||
@@ -103,7 +103,7 @@ dtIL nt (DT x l r) =
|
|||||||
where
|
where
|
||||||
doindent (a, b, c) = (a, b + 1, c)
|
doindent (a, b, c) = (a, b + 1, c)
|
||||||
|
|
||||||
dtToAdjacency :: (a -> Int) -> DoubleTree a -> IM.IntMap [Int]
|
dtToAdjacency :: (a -> Int) -> DTree a -> IM.IntMap [Int]
|
||||||
dtToAdjacency f (DT x l r) =
|
dtToAdjacency f (DT x l r) =
|
||||||
IM.insert (f x) (map g l <> map g r)
|
IM.insert (f x) (map g l <> map g r)
|
||||||
. IM.unions
|
. IM.unions
|
||||||
@@ -111,17 +111,17 @@ dtToAdjacency f (DT x l r) =
|
|||||||
where
|
where
|
||||||
g = f . _dtValue
|
g = f . _dtValue
|
||||||
|
|
||||||
dtToIntMapWithRoot :: (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe Int, DoubleTree a)
|
dtToIntMapWithRoot :: (a -> Int) -> DTree a -> IM.IntMap (Maybe Int, DTree a)
|
||||||
dtToIntMapWithRoot f t@(DT x l r) =
|
dtToIntMapWithRoot f t@(DT x l r) =
|
||||||
IM.insert (f x) (Nothing, t) $
|
IM.insert (f x) (Nothing, t) $
|
||||||
foldMap (dtToRootIntMap' (f x) f) $ l <> r
|
foldMap (dtToRootIntMap' (f x) f) $ l <> r
|
||||||
|
|
||||||
dtToRootIntMap' :: Int -> (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe Int, DoubleTree a)
|
dtToRootIntMap' :: Int -> (a -> Int) -> DTree a -> IM.IntMap (Maybe Int, DTree a)
|
||||||
dtToRootIntMap' root f t@(DT x l r) =
|
dtToRootIntMap' root f t@(DT x l r) =
|
||||||
IM.insert (f x) (Just root, t) $
|
IM.insert (f x) (Just root, t) $
|
||||||
foldMap (dtToRootIntMap' root f) $ l <> r
|
foldMap (dtToRootIntMap' root f) $ l <> r
|
||||||
|
|
||||||
dtToUpDownAdj :: (a -> Int) -> DoubleTree a -> IM.IntMap ([Int], [Int])
|
dtToUpDownAdj :: (a -> Int) -> DTree a -> IM.IntMap ([Int], [Int])
|
||||||
dtToUpDownAdj f (DT x l r) =
|
dtToUpDownAdj f (DT x l r) =
|
||||||
IM.insert (f x) (map g l, map g r)
|
IM.insert (f x) (map g l, map g r)
|
||||||
. IM.unions
|
. IM.unions
|
||||||
@@ -131,7 +131,7 @@ dtToUpDownAdj f (DT x l r) =
|
|||||||
|
|
||||||
-- returns an adjacency map with oldest ancestor and direct parent if they exist
|
-- returns an adjacency map with oldest ancestor and direct parent if they exist
|
||||||
-- and any left and right children
|
-- and any left and right children
|
||||||
dtToLRAdj :: (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
dtToLRAdj :: (a -> Int) -> DTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
||||||
dtToLRAdj f (DT x l r) =
|
dtToLRAdj f (DT x l r) =
|
||||||
IM.insert i (Nothing, map g l, map g r)
|
IM.insert i (Nothing, map g l, map g r)
|
||||||
. IM.unions
|
. IM.unions
|
||||||
@@ -145,7 +145,7 @@ dtToLRAdj f (DT x l r) =
|
|||||||
-- allows to propagate failure in the index discovery
|
-- allows to propagate failure in the index discovery
|
||||||
dtToLRAdjEither ::
|
dtToLRAdjEither ::
|
||||||
(a -> Either String Int) ->
|
(a -> Either String Int) ->
|
||||||
DoubleTree a ->
|
DTree a ->
|
||||||
Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
|
Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
|
||||||
dtToLRAdjEither f (DT x l r) = do
|
dtToLRAdjEither f (DT x l r) = do
|
||||||
i <- f x
|
i <- f x
|
||||||
@@ -158,7 +158,7 @@ dtToLRAdjEither f (DT x l r) = do
|
|||||||
where
|
where
|
||||||
g = f . _dtValue
|
g = f . _dtValue
|
||||||
|
|
||||||
dtToAdjRootParent :: Int -> Int -> (a -> Int) -> DoubleTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
dtToAdjRootParent :: Int -> Int -> (a -> Int) -> DTree a -> IM.IntMap (Maybe (Int, Int), [Int], [Int])
|
||||||
dtToAdjRootParent root par f (DT x l r) =
|
dtToAdjRootParent root par f (DT x l r) =
|
||||||
IM.insert (f x) (Just (root, par), map g l, map g r)
|
IM.insert (f x) (Just (root, par), map g l, map g r)
|
||||||
. IM.unions
|
. IM.unions
|
||||||
@@ -170,7 +170,7 @@ dtToAdjRootParentEither ::
|
|||||||
Int ->
|
Int ->
|
||||||
Int ->
|
Int ->
|
||||||
(a -> Either String Int) ->
|
(a -> Either String Int) ->
|
||||||
DoubleTree a ->
|
DTree a ->
|
||||||
Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
|
Either String (IM.IntMap (Maybe (Int, Int), [Int], [Int]))
|
||||||
dtToAdjRootParentEither root par f (DT x l r) = do
|
dtToAdjRootParentEither root par f (DT x l r) = do
|
||||||
i <- f x
|
i <- f x
|
||||||
@@ -220,7 +220,7 @@ lastMap _ _ [] = []
|
|||||||
lastMap f _ [x] = [f x]
|
lastMap f _ [x] = [f x]
|
||||||
lastMap f g (x : xs) = g x : lastMap f g xs
|
lastMap f g (x : xs) = g x : lastMap f g xs
|
||||||
|
|
||||||
prettyDT :: (a -> String) -> DoubleTree a -> [String]
|
prettyDT :: (a -> String) -> DTree a -> [String]
|
||||||
prettyDT f (DT x l r) =
|
prettyDT f (DT x l r) =
|
||||||
concatMap (map ('/' :) . prettyDT f) r
|
concatMap (map ('/' :) . prettyDT f) r
|
||||||
++ (f x : concatMap (map ('\\' :) . prettyDT f) l)
|
++ (f x : concatMap (map ('\\' :) . prettyDT f) l)
|
||||||
|
|||||||
@@ -246,7 +246,7 @@ invLDT' = fmap propagateOrientation . invLDT
|
|||||||
-- location ids
|
-- location ids
|
||||||
-- consider explicitly reseting the inventory ids (but this probably really
|
-- consider explicitly reseting the inventory ids (but this probably really
|
||||||
-- should be done upstream anyway in the actually creature inventory)
|
-- should be done upstream anyway in the actually creature inventory)
|
||||||
invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DoubleTree Item)
|
invRootMap :: IM.IntMap Item -> IM.IntMap (Maybe Int, DTree Item)
|
||||||
invRootMap =
|
invRootMap =
|
||||||
foldMap
|
foldMap
|
||||||
(dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT)
|
(dtToIntMapWithRoot (^?! itLocation . ilInvID) . fmap (^. _1) . ldtToDT)
|
||||||
|
|||||||
Reference in New Issue
Block a user