{-# LANGUAGE CPP #-}
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 qualified Data.Foldable as F
import Data.LCA.View
#if __GLASGOW_HASKELL__ < 710
import Data.Traversable
#endif
import qualified Prelude
import Prelude hiding
( drop
, length
, null
)
data Path a = Path {-# UNPACK #-} !Int [(Int,a)]
deriving (Int -> Path a -> ShowS
[Path a] -> ShowS
Path a -> String
(Int -> Path a -> ShowS)
-> (Path a -> String) -> ([Path a] -> ShowS) -> Show (Path a)
forall a. Show a => Int -> Path a -> ShowS
forall a. Show a => [Path a] -> ShowS
forall a. Show a => Path a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path a] -> ShowS
$cshowList :: forall a. Show a => [Path a] -> ShowS
show :: Path a -> String
$cshow :: forall a. Show a => Path a -> String
showsPrec :: Int -> Path a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Path a -> ShowS
Show, ReadPrec [Path a]
ReadPrec (Path a)
Int -> ReadS (Path a)
ReadS [Path a]
(Int -> ReadS (Path a))
-> ReadS [Path a]
-> ReadPrec (Path a)
-> ReadPrec [Path a]
-> Read (Path a)
forall a. Read a => ReadPrec [Path a]
forall a. Read a => ReadPrec (Path a)
forall a. Read a => Int -> ReadS (Path a)
forall a. Read a => ReadS [Path a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Path a]
$creadListPrec :: forall a. Read a => ReadPrec [Path a]
readPrec :: ReadPrec (Path a)
$creadPrec :: forall a. Read a => ReadPrec (Path a)
readList :: ReadS [Path a]
$creadList :: forall a. Read a => ReadS [Path a]
readsPrec :: Int -> ReadS (Path a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Path a)
Read)
toList :: Path a -> [(Int,a)]
toList :: Path a -> [(Int, a)]
toList (Path Int
_ [(Int, a)]
xs) = [(Int, a)]
xs
{-# INLINE toList #-}
fromList :: [(Int,a)] -> Path a
fromList :: [(Int, a)] -> Path a
fromList [(Int, a)]
xs = Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path ([(Int, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [(Int, a)]
xs) [(Int, a)]
xs
{-# INLINE fromList #-}
instance Functor Path where
fmap :: (a -> b) -> Path a -> Path b
fmap a -> b
f (Path Int
n [(Int, a)]
xs) = Int -> [(Int, b)] -> Path b
forall a. Int -> [(Int, a)] -> Path a
Path Int
n [ (Int
k, a -> b
f a
a) | (Int
k,a
a) <- [(Int, a)]
xs]
instance F.Foldable Path where
foldMap :: (a -> m) -> Path a -> m
foldMap a -> m
f (Path Int
_ [(Int, a)]
xs) = ((Int, a) -> m) -> [(Int, a)] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (a -> m
f (a -> m) -> ((Int, a) -> a) -> (Int, a) -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, a) -> a
forall a b. (a, b) -> b
snd) [(Int, a)]
xs
#if __GLASGOW_HASKELL__ >= 710
length :: Path a -> Int
length = Path a -> Int
forall a. Path a -> Int
length
null :: Path a -> Bool
null = Path a -> Bool
forall a. Path a -> Bool
null
#endif
length :: Path a -> Int
length :: Path a -> Int
length (Path Int
n [(Int, a)]
_) = Int
n
{-# INLINE length #-}
null :: Path a -> Bool
null :: Path a -> Bool
null (Path Int
n [(Int, a)]
_) = Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
{-# INLINE null #-}
instance Traversable Path where
traverse :: (a -> f b) -> Path a -> f (Path b)
traverse a -> f b
f (Path Int
n [(Int, a)]
xs) = Int -> [(Int, b)] -> Path b
forall a. Int -> [(Int, a)] -> Path a
Path Int
n ([(Int, b)] -> Path b) -> f [(Int, b)] -> f (Path b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, a) -> f (Int, b)) -> [(Int, a)] -> f [(Int, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Int
k,a
a) -> (,) Int
k (b -> (Int, b)) -> f b -> f (Int, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a) [(Int, a)]
xs
traverseWithKey :: Applicative f => (Int -> a -> f b) -> Path a -> f (Path b)
traverseWithKey :: (Int -> a -> f b) -> Path a -> f (Path b)
traverseWithKey Int -> a -> f b
f (Path Int
n [(Int, a)]
xs) = Int -> [(Int, b)] -> Path b
forall a. Int -> [(Int, a)] -> Path a
Path Int
n ([(Int, b)] -> Path b) -> f [(Int, b)] -> f (Path b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, a) -> f (Int, b)) -> [(Int, a)] -> f [(Int, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(Int
k,a
a) -> (,) Int
k (b -> (Int, b)) -> f b -> f (Int, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f b
f Int
k a
a) [(Int, a)]
xs
{-# INLINE traverseWithKey #-}
empty :: Path a
empty :: Path a
empty = Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path Int
0 []
cons :: Int -> a -> Path a -> Path a
cons :: Int -> a -> Path a -> Path a
cons Int
k a
a (Path Int
n [(Int, a)]
xs) = Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([(Int, a)] -> Path a) -> [(Int, a)] -> Path a
forall a b. (a -> b) -> a -> b
$ (Int
k,a
a)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
xs
{-# INLINE cons #-}
uncons :: Path a -> Maybe (Int, a, Path a)
uncons :: Path a -> Maybe (Int, a, Path a)
uncons (Path Int
_ []) = Maybe (Int, a, Path a)
forall a. Maybe a
Nothing
uncons (Path Int
n ((Int
k,a
a):[(Int, a)]
xs)) = (Int, a, Path a) -> Maybe (Int, a, Path a)
forall a. a -> Maybe a
Just (Int
k,a
a,Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(Int, a)]
xs)
{-# INLINE uncons #-}
view :: Path a -> View Path a
view :: Path a -> View Path a
view (Path Int
_ []) = View Path a
forall (f :: * -> *) a. View f a
Root
view (Path Int
n ((Int
k,a
a):[(Int, a)]
xs)) = Int -> a -> Path a -> View Path a
forall (f :: * -> *) a. Int -> a -> f a -> View f a
Node Int
k a
a (Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(Int, a)]
xs)
{-# INLINE view #-}
keep :: Int -> Path a -> Path a
keep :: Int -> Path a -> Path a
keep Int
k p :: Path a
p@(Path Int
n [(Int, a)]
xs)
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Path a
p
| Bool
otherwise = Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path Int
k ([(Int, a)] -> Path a) -> [(Int, a)] -> Path a
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, a)] -> [(Int, a)]
forall a. Int -> [a] -> [a]
Prelude.drop (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) [(Int, a)]
xs
{-# INLINE keep #-}
drop :: Int -> Path a -> Path a
drop :: Int -> Path a -> Path a
drop Int
k (Path Int
n [(Int, a)]
xs)
| Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = Path a
forall a. Path a
empty
| Bool
otherwise = Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k) (Int -> [(Int, a)] -> [(Int, a)]
forall a. Int -> [a] -> [a]
Prelude.drop Int
k [(Int, a)]
xs)
{-# INLINE drop #-}
isAncestorOf :: Path a -> Path b -> Bool
isAncestorOf :: Path a -> Path b -> Bool
isAncestorOf Path a
xs Path b
ys = Path a
xs Path a -> Path b -> Bool
forall a b. Path a -> Path b -> Bool
~= Int -> Path b -> Path b
forall a. Int -> Path a -> Path a
keep (Path a -> Int
forall a. Path a -> Int
length Path a
xs) Path b
ys
{-# INLINE isAncestorOf #-}
infix 4 ~=
(~=) :: Path a -> Path b -> Bool
Path Int
_ [] ~= :: Path a -> Path b -> Bool
~= Path Int
_ [] = Bool
True
Path Int
_ ((Int
i,a
_):[(Int, a)]
_) ~= Path Int
_ ((Int
j,b
_):[(Int, b)]
_) = Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j
Path a
_ ~= Path b
_ = Bool
False
{-# INLINE (~=) #-}
lca :: Path a -> Path b -> Path a
lca :: Path a -> Path b -> Path a
lca Path a
xs0 Path b
ys0 = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
nxs Int
nys of
Ordering
LT -> Int -> [(Int, a)] -> [(Int, b)] -> Path a
forall a b. Int -> [(Int, a)] -> [(Int, b)] -> Path a
go Int
nxs (Path a -> [(Int, a)]
forall a. Path a -> [(Int, a)]
toList Path a
xs0) (Path b -> [(Int, b)]
forall a. Path a -> [(Int, a)]
toList (Int -> Path b -> Path b
forall a. Int -> Path a -> Path a
keep Int
nxs Path b
ys0))
Ordering
EQ -> Int -> [(Int, a)] -> [(Int, b)] -> Path a
forall a b. Int -> [(Int, a)] -> [(Int, b)] -> Path a
go Int
nxs (Path a -> [(Int, a)]
forall a. Path a -> [(Int, a)]
toList Path a
xs0) (Path b -> [(Int, b)]
forall a. Path a -> [(Int, a)]
toList Path b
ys0)
Ordering
GT -> Int -> [(Int, a)] -> [(Int, b)] -> Path a
forall a b. Int -> [(Int, a)] -> [(Int, b)] -> Path a
go Int
nys (Path a -> [(Int, a)]
forall a. Path a -> [(Int, a)]
toList (Int -> Path a -> Path a
forall a. Int -> Path a -> Path a
keep Int
nys Path a
xs0)) (Path b -> [(Int, b)]
forall a. Path a -> [(Int, a)]
toList Path b
ys0)
where
nxs :: Int
nxs = Path a -> Int
forall a. Path a -> Int
length Path a
xs0
nys :: Int
nys = Path b -> Int
forall a. Path a -> Int
length Path b
ys0
go :: Int -> [(Int, a)] -> [(Int, b)] -> Path a
go Int
k xss :: [(Int, a)]
xss@((Int
i,a
_):[(Int, a)]
xs) ((Int
j,b
_):[(Int, b)]
ys)
| Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j = Int -> [(Int, a)] -> Path a
forall a. Int -> [(Int, a)] -> Path a
Path Int
k [(Int, a)]
xss
| Bool
otherwise = Int -> [(Int, a)] -> [(Int, b)] -> Path a
go (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [(Int, a)]
xs [(Int, b)]
ys
go Int
_ [(Int, a)]
_ [(Int, b)]
_ = Path a
forall a. Path a
empty
{-# INLINE lca #-}