1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
-- (c) 2000 by Martin Erwig
-- | Inward directed trees as lists of paths.
module Data.Graph.Inductive.Internal.RootPath (
-- * Types
RTree,LRTree,
-- * Operations
getPath,getLPath,
getDistance
) where
import Data.Graph.Inductive.Graph
-- newtype LNode a = LN (a,Node)
-- deriving Show
--
-- type LPath a = [LNode a]
instance Eq a => Eq (LPath a) where
[] == [] = True
((_,x):_) == ((_,y):_) = x==y
_ == _ = False
instance Ord a => Ord (LPath a) where
compare [] [] = EQ
compare ((_,x):_) ((_,y):_) = compare x y
compare _ _ = error "LPath: cannot compare to empty path"
-- ((_,x):_) < ((_,y):_) = x<y
--------
type LRTree a = [LPath a]
type RTree = [Path]
first :: ([a] -> Bool) -> [[a]] -> [a]
first _ [[]] = []
first p xss = case filter p xss of
[] -> []
x:_ -> x
getPath :: Node -> RTree -> Path
getPath v = reverse . first (\(w:_)->w==v)
getLPath :: Node -> LRTree a -> LPath a
getLPath v = reverse . first (\((w,_):_)->w==v)
getDistance :: Node -> LRTree a -> a
getDistance v = snd . head . first (\((w,_):_)->w==v)
|
