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