module Geometry.Trajectory.ReassembleLines (reassembleLines) where



import           Data.Foldable
import           Data.Map      (Map)
import qualified Data.Map      as M
import           Data.Ord
import           Data.Sequence (Seq, (|>))
import qualified Data.Sequence as Seq
import           Prelude       hiding (lines)



-- | Contains at most two neighbours of a point. Can be seen as representing the
-- locations we can travel to on a line – one neighbour this way, or one neighbour
-- the other way.
--
-- It is undirected in the sense that we don’t know where the neighbours are (left
-- or right), only that they’re there.
newtype UndirectedNeighbourMap a = UndirectedNeighbourMap (Map a (OneTwo a))
    deriving (UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
(UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool)
-> (UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool)
-> Eq (UndirectedNeighbourMap a)
forall a.
Eq a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a.
Eq a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
== :: UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
$c/= :: forall a.
Eq a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
/= :: UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
Eq, Eq (UndirectedNeighbourMap a)
Eq (UndirectedNeighbourMap a)
-> (UndirectedNeighbourMap a
    -> UndirectedNeighbourMap a -> Ordering)
-> (UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool)
-> (UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool)
-> (UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool)
-> (UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool)
-> (UndirectedNeighbourMap a
    -> UndirectedNeighbourMap a -> UndirectedNeighbourMap a)
-> (UndirectedNeighbourMap a
    -> UndirectedNeighbourMap a -> UndirectedNeighbourMap a)
-> Ord (UndirectedNeighbourMap a)
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Ordering
UndirectedNeighbourMap a
-> UndirectedNeighbourMap a -> UndirectedNeighbourMap a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (UndirectedNeighbourMap a)
forall a.
Ord a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
forall a.
Ord a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Ordering
forall a.
Ord a =>
UndirectedNeighbourMap a
-> UndirectedNeighbourMap a -> UndirectedNeighbourMap a
$ccompare :: forall a.
Ord a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Ordering
compare :: UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Ordering
$c< :: forall a.
Ord a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
< :: UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
$c<= :: forall a.
Ord a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
<= :: UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
$c> :: forall a.
Ord a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
> :: UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
$c>= :: forall a.
Ord a =>
UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
>= :: UndirectedNeighbourMap a -> UndirectedNeighbourMap a -> Bool
$cmax :: forall a.
Ord a =>
UndirectedNeighbourMap a
-> UndirectedNeighbourMap a -> UndirectedNeighbourMap a
max :: UndirectedNeighbourMap a
-> UndirectedNeighbourMap a -> UndirectedNeighbourMap a
$cmin :: forall a.
Ord a =>
UndirectedNeighbourMap a
-> UndirectedNeighbourMap a -> UndirectedNeighbourMap a
min :: UndirectedNeighbourMap a
-> UndirectedNeighbourMap a -> UndirectedNeighbourMap a
Ord, Int -> UndirectedNeighbourMap a -> ShowS
[UndirectedNeighbourMap a] -> ShowS
UndirectedNeighbourMap a -> String
(Int -> UndirectedNeighbourMap a -> ShowS)
-> (UndirectedNeighbourMap a -> String)
-> ([UndirectedNeighbourMap a] -> ShowS)
-> Show (UndirectedNeighbourMap a)
forall a. Show a => Int -> UndirectedNeighbourMap a -> ShowS
forall a. Show a => [UndirectedNeighbourMap a] -> ShowS
forall a. Show a => UndirectedNeighbourMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> UndirectedNeighbourMap a -> ShowS
showsPrec :: Int -> UndirectedNeighbourMap a -> ShowS
$cshow :: forall a. Show a => UndirectedNeighbourMap a -> String
show :: UndirectedNeighbourMap a -> String
$cshowList :: forall a. Show a => [UndirectedNeighbourMap a] -> ShowS
showList :: [UndirectedNeighbourMap a] -> ShowS
Show)

data OneTwo a = One !a | Two !a !a
    deriving (OneTwo a -> OneTwo a -> Bool
(OneTwo a -> OneTwo a -> Bool)
-> (OneTwo a -> OneTwo a -> Bool) -> Eq (OneTwo a)
forall a. Eq a => OneTwo a -> OneTwo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => OneTwo a -> OneTwo a -> Bool
== :: OneTwo a -> OneTwo a -> Bool
$c/= :: forall a. Eq a => OneTwo a -> OneTwo a -> Bool
/= :: OneTwo a -> OneTwo a -> Bool
Eq, Eq (OneTwo a)
Eq (OneTwo a)
-> (OneTwo a -> OneTwo a -> Ordering)
-> (OneTwo a -> OneTwo a -> Bool)
-> (OneTwo a -> OneTwo a -> Bool)
-> (OneTwo a -> OneTwo a -> Bool)
-> (OneTwo a -> OneTwo a -> Bool)
-> (OneTwo a -> OneTwo a -> OneTwo a)
-> (OneTwo a -> OneTwo a -> OneTwo a)
-> Ord (OneTwo a)
OneTwo a -> OneTwo a -> Bool
OneTwo a -> OneTwo a -> Ordering
OneTwo a -> OneTwo a -> OneTwo a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (OneTwo a)
forall a. Ord a => OneTwo a -> OneTwo a -> Bool
forall a. Ord a => OneTwo a -> OneTwo a -> Ordering
forall a. Ord a => OneTwo a -> OneTwo a -> OneTwo a
$ccompare :: forall a. Ord a => OneTwo a -> OneTwo a -> Ordering
compare :: OneTwo a -> OneTwo a -> Ordering
$c< :: forall a. Ord a => OneTwo a -> OneTwo a -> Bool
< :: OneTwo a -> OneTwo a -> Bool
$c<= :: forall a. Ord a => OneTwo a -> OneTwo a -> Bool
<= :: OneTwo a -> OneTwo a -> Bool
$c> :: forall a. Ord a => OneTwo a -> OneTwo a -> Bool
> :: OneTwo a -> OneTwo a -> Bool
$c>= :: forall a. Ord a => OneTwo a -> OneTwo a -> Bool
>= :: OneTwo a -> OneTwo a -> Bool
$cmax :: forall a. Ord a => OneTwo a -> OneTwo a -> OneTwo a
max :: OneTwo a -> OneTwo a -> OneTwo a
$cmin :: forall a. Ord a => OneTwo a -> OneTwo a -> OneTwo a
min :: OneTwo a -> OneTwo a -> OneTwo a
Ord, Int -> OneTwo a -> ShowS
[OneTwo a] -> ShowS
OneTwo a -> String
(Int -> OneTwo a -> ShowS)
-> (OneTwo a -> String) -> ([OneTwo a] -> ShowS) -> Show (OneTwo a)
forall a. Show a => Int -> OneTwo a -> ShowS
forall a. Show a => [OneTwo a] -> ShowS
forall a. Show a => OneTwo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OneTwo a -> ShowS
showsPrec :: Int -> OneTwo a -> ShowS
$cshow :: forall a. Show a => OneTwo a -> String
show :: OneTwo a -> String
$cshowList :: forall a. Show a => [OneTwo a] -> ShowS
showList :: [OneTwo a] -> ShowS
Show)

-- | This instance crashes when
instance Ord a => Semigroup (UndirectedNeighbourMap a) where
    UndirectedNeighbourMap Map a (OneTwo a)
x <> :: UndirectedNeighbourMap a
-> UndirectedNeighbourMap a -> UndirectedNeighbourMap a
<> UndirectedNeighbourMap Map a (OneTwo a)
y = Map a (OneTwo a) -> UndirectedNeighbourMap a
forall a. Map a (OneTwo a) -> UndirectedNeighbourMap a
UndirectedNeighbourMap (Map a (OneTwo a) -> UndirectedNeighbourMap a)
-> Map a (OneTwo a) -> UndirectedNeighbourMap a
forall a b. (a -> b) -> a -> b
$
        (OneTwo a -> OneTwo a -> OneTwo a)
-> Map a (OneTwo a) -> Map a (OneTwo a) -> Map a (OneTwo a)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith
            (\OneTwo a
a OneTwo a
b -> case (OneTwo a
a,OneTwo a
b) of
                (One a
a', One a
b') -> a -> a -> OneTwo a
forall a. a -> a -> OneTwo a
Two a
a' a
b'
                (OneTwo a, OneTwo a)
_otherwise -> String -> OneTwo a
forall a. HasCallStack => String -> a
error (String -> OneTwo a)
-> ([String] -> String) -> [String] -> OneTwo a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unwords ([String] -> OneTwo a) -> [String] -> OneTwo a
forall a b. (a -> b) -> a -> b
$
                    [ String
"Insertion of more than two neighbours in a UndirectedNeighbourMap."
                    , String
"Are you sure all your points have at most two neighbours?" ]
            )
            Map a (OneTwo a)
x
            Map a (OneTwo a)
y

instance Ord a => Monoid (UndirectedNeighbourMap a) where
    mempty :: UndirectedNeighbourMap a
mempty = Map a (OneTwo a) -> UndirectedNeighbourMap a
forall a. Map a (OneTwo a) -> UndirectedNeighbourMap a
UndirectedNeighbourMap Map a (OneTwo a)
forall a. Monoid a => a
mempty

-- | Yield of the points the neighbour map points to, and take it out of the map
-- so we don’t follow this direction again.
--
-- Unlike when we walk in the backwards direction, we can simply pick an arbitrary
-- target to go to if we have two neighbours.
lnmLookupDeleteForward :: Ord a => a -> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDeleteForward :: forall a.
Ord a =>
a
-> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDeleteForward a
x (UndirectedNeighbourMap Map a (OneTwo a)
m) = case a -> Map a (OneTwo a) -> Maybe (OneTwo a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
x Map a (OneTwo a)
m of
    Maybe (OneTwo a)
Nothing        -> Maybe (a, UndirectedNeighbourMap a)
forall a. Maybe a
Nothing
    Just (One a
a)   -> (a, UndirectedNeighbourMap a)
-> Maybe (a, UndirectedNeighbourMap a)
forall a. a -> Maybe a
Just (a
a, Map a (OneTwo a) -> UndirectedNeighbourMap a
forall a. Map a (OneTwo a) -> UndirectedNeighbourMap a
UndirectedNeighbourMap (a -> Map a (OneTwo a) -> Map a (OneTwo a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete a
x Map a (OneTwo a)
m))
    Just (Two a
a a
b) -> (a, UndirectedNeighbourMap a)
-> Maybe (a, UndirectedNeighbourMap a)
forall a. a -> Maybe a
Just (a
a, Map a (OneTwo a) -> UndirectedNeighbourMap a
forall a. Map a (OneTwo a) -> UndirectedNeighbourMap a
UndirectedNeighbourMap (a -> OneTwo a -> Map a (OneTwo a) -> Map a (OneTwo a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
x (a -> OneTwo a
forall a. a -> OneTwo a
One a
b) Map a (OneTwo a)
m))

-- | Like 'lnmLookupDeleteForward', but when deleting the backwards direction, we
-- have to make sure we don’t arbitrarily delete a point we might have come from,
-- but the very point we did.
lnmLookupDeleteBackward :: Ord a => a -> a -> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDeleteBackward :: forall a.
Ord a =>
a
-> a
-> UndirectedNeighbourMap a
-> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDeleteBackward a
from a
x (UndirectedNeighbourMap Map a (OneTwo a)
m) = case a -> Map a (OneTwo a) -> Maybe (OneTwo a)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup a
x Map a (OneTwo a)
m of
    Maybe (OneTwo a)
Nothing        -> Maybe (a, UndirectedNeighbourMap a)
forall a. Maybe a
Nothing
    Just (One a
a)   -> (a, UndirectedNeighbourMap a)
-> Maybe (a, UndirectedNeighbourMap a)
forall a. a -> Maybe a
Just (a
a, Map a (OneTwo a) -> UndirectedNeighbourMap a
forall a. Map a (OneTwo a) -> UndirectedNeighbourMap a
UndirectedNeighbourMap (a -> Map a (OneTwo a) -> Map a (OneTwo a)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete a
x Map a (OneTwo a)
m))
    Just (Two a
a a
b) ->
        let (a
extract, a
keep)
                | a
from a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a = (a
a,a
b)
                | Bool
otherwise = (a
b,a
a)
        in (a, UndirectedNeighbourMap a)
-> Maybe (a, UndirectedNeighbourMap a)
forall a. a -> Maybe a
Just (a
extract, Map a (OneTwo a) -> UndirectedNeighbourMap a
forall a. Map a (OneTwo a) -> UndirectedNeighbourMap a
UndirectedNeighbourMap (a -> OneTwo a -> Map a (OneTwo a) -> Map a (OneTwo a)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert a
x (a -> OneTwo a
forall a. a -> OneTwo a
One a
keep) Map a (OneTwo a)
m))

-- | Delete what the current point points to, and Afterwards, take out the reverse
-- direction so we don’t walk in cycles.
lnmLookupDelete :: Ord a => a -> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDelete :: forall a.
Ord a =>
a
-> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDelete a
start UndirectedNeighbourMap a
lnm = case a
-> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
forall a.
Ord a =>
a
-> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDeleteForward a
start UndirectedNeighbourMap a
lnm of
    Maybe (a, UndirectedNeighbourMap a)
Nothing -> Maybe (a, UndirectedNeighbourMap a)
forall a. Maybe a
Nothing
    Just (a
target, UndirectedNeighbourMap a
lnm') -> case a
-> a
-> UndirectedNeighbourMap a
-> Maybe (a, UndirectedNeighbourMap a)
forall a.
Ord a =>
a
-> a
-> UndirectedNeighbourMap a
-> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDeleteBackward a
start a
target UndirectedNeighbourMap a
lnm' of
        Maybe (a, UndirectedNeighbourMap a)
Nothing -> (a, UndirectedNeighbourMap a)
-> Maybe (a, UndirectedNeighbourMap a)
forall a. a -> Maybe a
Just (a
target, UndirectedNeighbourMap a
lnm')
        Just (a
_xPointedToByNeighbour, UndirectedNeighbourMap a
lnm'') -> (a, UndirectedNeighbourMap a)
-> Maybe (a, UndirectedNeighbourMap a)
forall a. a -> Maybe a
Just (a
target, UndirectedNeighbourMap a
lnm'')

-- lnmArbitraryElement :: UndirectedNeighbourMap a -> Maybe a
lnmArbitraryElement :: UndirectedNeighbourMap a -> Maybe a
lnmArbitraryElement :: forall a. UndirectedNeighbourMap a -> Maybe a
lnmArbitraryElement (UndirectedNeighbourMap Map a (OneTwo a)
m) = ((a, OneTwo a) -> a) -> Maybe (a, OneTwo a) -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, OneTwo a) -> a
forall a b. (a, b) -> a
fst (Map a (OneTwo a) -> Maybe (a, OneTwo a)
forall k a. Map k a -> Maybe (k, a)
M.lookupMin Map a (OneTwo a)
m)

-- | Given a collection of lines that fit together back-to-back (as in '=='),
-- reassemble them to extract the underlying points in order. This works even for
-- collections of multiple cut-up trajectories, as long as they do not share
-- any points.
--
-- In a way, this can be seen as the inverse of pairing up points to line segments,
--
-- @
-- 'reassembleLines' ('zipWith' 'Line' xs ('tail' xs)) '==' xs
-- @
--
-- __Unsafety warning:__ This algorithm wasn’t tested for cases when multiple
-- trajectories share points. I have no idea what happens in that case, but
-- certainly nothing useful.
reassembleLines
    :: (Ord point, Foldable f)
    => (line -> (point, point)) -- ^ How to extract two neighbouring points from the data given
    -> f line                   -- ^ Collection of neighbouring points
    -> [[point]]                -- ^ List of trajectories consisting of points
reassembleLines :: forall point (f :: * -> *) line.
(Ord point, Foldable f) =>
(line -> (point, point)) -> f line -> [[point]]
reassembleLines line -> (point, point)
neighbour = (Seq point -> [point]) -> [Seq point] -> [[point]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq point -> [point]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([Seq point] -> [[point]])
-> (f line -> [Seq point]) -> f line -> [[point]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UndirectedNeighbourMap point -> [Seq point]
forall a. Ord a => UndirectedNeighbourMap a -> [Seq a]
extractAllTrajectories (UndirectedNeighbourMap point -> [Seq point])
-> (f line -> UndirectedNeighbourMap point)
-> f line
-> [Seq point]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (line -> (point, point)) -> f line -> UndirectedNeighbourMap point
forall (f :: * -> *) point line.
(Foldable f, Ord point) =>
(line -> (point, point)) -> f line -> UndirectedNeighbourMap point
buildUndirectedNeighbourMap line -> (point, point)
neighbour

-- | Split a collection of line segments into a Map of ascending and descending
-- values. This is the basis for later reconnecting the line segments to extract
-- trajectories.
buildUndirectedNeighbourMap :: (Foldable f, Ord point) => (line -> (point, point)) -> f line -> UndirectedNeighbourMap point
buildUndirectedNeighbourMap :: forall (f :: * -> *) point line.
(Foldable f, Ord point) =>
(line -> (point, point)) -> f line -> UndirectedNeighbourMap point
buildUndirectedNeighbourMap line -> (point, point)
neighbours = (line -> UndirectedNeighbourMap point)
-> f line -> UndirectedNeighbourMap point
forall m a. Monoid m => (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((line -> UndirectedNeighbourMap point)
 -> f line -> UndirectedNeighbourMap point)
-> (line -> UndirectedNeighbourMap point)
-> f line
-> UndirectedNeighbourMap point
forall a b. (a -> b) -> a -> b
$ \line
line ->
    let (point
a,point
b) = line -> (point, point)
neighbours line
line
    in Map point (OneTwo point) -> UndirectedNeighbourMap point
forall a. Map a (OneTwo a) -> UndirectedNeighbourMap a
UndirectedNeighbourMap ([(point, OneTwo point)] -> Map point (OneTwo point)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(point
a, point -> OneTwo point
forall a. a -> OneTwo a
One point
b), (point
b, point -> OneTwo point
forall a. a -> OneTwo a
One point
a)])

-- | Follow the entries in a neighbour map, starting at a point.
-- Doing this twice will grow the trajectory in both directions.
extractSingleTrajectoryPass
    :: Ord a
    => UndirectedNeighbourMap a
    -> a
    -> Seq a
    -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectoryPass :: forall a.
Ord a =>
UndirectedNeighbourMap a
-> a -> Seq a -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectoryPass UndirectedNeighbourMap a
lnm a
start Seq a
result
    | Just (a
next, UndirectedNeighbourMap a
lnm') <- a
-> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
forall a.
Ord a =>
a
-> UndirectedNeighbourMap a -> Maybe (a, UndirectedNeighbourMap a)
lnmLookupDelete a
start UndirectedNeighbourMap a
lnm = UndirectedNeighbourMap a
-> a -> Seq a -> (UndirectedNeighbourMap a, Seq a)
forall a.
Ord a =>
UndirectedNeighbourMap a
-> a -> Seq a -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectoryPass UndirectedNeighbourMap a
lnm' a
next (Seq a
result Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
next)
    | Bool
otherwise = (UndirectedNeighbourMap a
lnm, Seq a
result)

-- | Follow the entries in a neighbour map from a starting point twice, to extend
-- it backwards and forwards as much as possible.
extractSingleTrajectory
    :: Ord a
    => UndirectedNeighbourMap a
    -> a
    -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectory :: forall a.
Ord a =>
UndirectedNeighbourMap a -> a -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectory UndirectedNeighbourMap a
nMap a
start =
    let (UndirectedNeighbourMap a
nMapA, Seq a
trajectoryPass1) = UndirectedNeighbourMap a
-> a -> Seq a -> (UndirectedNeighbourMap a, Seq a)
forall a.
Ord a =>
UndirectedNeighbourMap a
-> a -> Seq a -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectoryPass UndirectedNeighbourMap a
nMap a
start Seq a
forall a. Monoid a => a
mempty
        (UndirectedNeighbourMap a
nMapB, Seq a
trajectoryPass2) = UndirectedNeighbourMap a
-> a -> Seq a -> (UndirectedNeighbourMap a, Seq a)
forall a.
Ord a =>
UndirectedNeighbourMap a
-> a -> Seq a -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectoryPass UndirectedNeighbourMap a
nMapA a
start Seq a
forall a. Monoid a => a
mempty
    in (UndirectedNeighbourMap a
nMapB, Seq a -> Seq a
forall a. Seq a -> Seq a
Seq.reverse Seq a
trajectoryPass2 Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> a -> Seq a
forall a. a -> Seq a
Seq.singleton a
start Seq a -> Seq a -> Seq a
forall a. Semigroup a => a -> a -> a
<> Seq a
trajectoryPass1)

-- | Repeatedly extract a trajectory, until the neighbour map is exhausted.
extractAllTrajectories :: Ord a => UndirectedNeighbourMap a -> [Seq a]
extractAllTrajectories :: forall a. Ord a => UndirectedNeighbourMap a -> [Seq a]
extractAllTrajectories UndirectedNeighbourMap a
lnm
    | Just a
start <- UndirectedNeighbourMap a -> Maybe a
forall a. UndirectedNeighbourMap a -> Maybe a
lnmArbitraryElement UndirectedNeighbourMap a
lnm =
        let (UndirectedNeighbourMap a
lnm', Seq a
trajectory) = UndirectedNeighbourMap a -> a -> (UndirectedNeighbourMap a, Seq a)
forall a.
Ord a =>
UndirectedNeighbourMap a -> a -> (UndirectedNeighbourMap a, Seq a)
extractSingleTrajectory UndirectedNeighbourMap a
lnm a
start
        in Seq a
trajectory Seq a -> [Seq a] -> [Seq a]
forall a. a -> [a] -> [a]
: UndirectedNeighbourMap a -> [Seq a]
forall a. Ord a => UndirectedNeighbourMap a -> [Seq a]
extractAllTrajectories UndirectedNeighbourMap a
lnm'
    | Bool
otherwise = []