module Data.LCA.Online.Naive
( Path
, empty
, cons
, null
, length
, isAncestorOf
, lca
, keep
, drop
, traverseWithKey
, toList
, fromList
, (~=)
) where
import Control.Applicative hiding (empty)
import Data.Foldable hiding (toList)
import Data.Traversable
import Prelude hiding (length, null, drop)
import qualified Prelude
data Path k a = Path !Int [(k,a)]
deriving (Show, Read)
toList :: Path k a -> [(k,a)]
toList (Path _ xs) = xs
fromList :: [(k,a)] -> Path k a
fromList xs = Path (Prelude.length xs) xs
instance Functor (Path k) where
fmap f (Path n xs) = Path n [ (k, f a) | (k,a) <- xs]
instance Foldable (Path k) where
foldMap f (Path _ xs) = foldMap (f . snd) xs
instance Traversable (Path k) where
traverse f (Path n xs) = Path n <$> traverse (\(k,a) -> (,) k <$> f a) xs
traverseWithKey :: Applicative f => (k -> a -> f b) -> Path k a -> f (Path k b)
traverseWithKey f (Path n xs) = Path n <$> traverse (\(k,a) -> (,) k <$> f k a) xs
empty :: Path k a
empty = Path 0 []
length :: Path k a -> Int
length (Path n _) = n
null :: Path k a -> Bool
null (Path n _) = n == 0
cons :: k -> a -> Path k a -> Path k a
cons k a (Path n xs) = Path (n + 1) $ (k,a):xs
keep :: Int -> Path k a -> Path k a
keep k p@(Path n xs)
| k >= n = p
| otherwise = Path k $ Prelude.drop (n k) xs
drop :: Int -> Path k a -> Path k a
drop k (Path n xs)
| k >= n = empty
| otherwise = Path (n k) (Prelude.drop k xs)
lca :: Eq k => Path k a -> Path k b -> Path k a
lca xs ys = case compare nxs nys of
LT -> lca' nxs (toList xs) (toList (keep nxs ys))
EQ -> lca' nxs (toList xs) (toList ys)
GT -> lca' nys (toList (keep nys xs)) (toList ys)
where
nxs = length xs
nys = length ys
lca' :: Eq k => Int -> [(k,a)] -> [(k,b)] -> Path k a
lca' k xss@((i,_):xs) ((j,_):ys)
| i == j = Path k xss
| otherwise = lca' (k 1) xs ys
lca' _ _ _ = empty
isAncestorOf :: Eq k => Path k a -> Path k b -> Bool
isAncestorOf xs ys = xs ~= keep (length xs) ys
infix 4 ~=
(~=) :: Eq k => Path k a -> Path k b -> Bool
Path _ [] ~= Path _ [] = True
Path _ ((i,_):_) ~= Path _ ((j,_):_) = i == j
_ ~= _ = False