-- |
-- Module      : Data.Manifold.Web.Internal
-- Copyright   : (c) Justus Sagemüller 2017
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE UnicodeSyntax              #-}


module Data.Manifold.Web.Internal where


import Prelude hiding ((^))

import qualified Data.Vector.Unboxed as UArr

import Data.Manifold.Types
import Data.Manifold.Types.Primitive
import Data.Manifold.PseudoAffine
import Data.Manifold.Shade
import Data.Manifold.TreeCover
import Data.Function.Affine
import Data.VectorSpace (Scalar, (^+^), (^/), (^*), sumV)
import Math.LinearMap.Category ( SimpleSpace, LSpace, DualVector, Norm, Variance
                               , (<.>^), dualNorm, (<$|), (|$|), normSq
                               , dualSpaceWitness, DualSpaceWitness(..)
                               , FiniteDimensional (..) )
    
import qualified Data.Foldable       as Hask
import qualified Data.Traversable as Hask
import Data.List (sortBy)
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.Map as Map
import qualified Data.Foldable.Constrained as CCt
import Data.Functor.Identity
import Data.Function ((&))
import Data.Ord (comparing)
import Data.List.FastNub (fastNub)
import qualified Data.IntSet as ℤSet
import Data.IntSet (IntSet)
import Data.Maybe (isNothing)
import Control.Arrow
import Control.Monad (guard, forM_)
import Control.Comonad
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer

import Data.Semigroup

import Control.DeepSeq

import GHC.Generics (Generic)

import Control.Lens
import Control.Lens.TH

import Data.CallStack (HasCallStack)


type WebNodeId = Int
type WebNodeIdOffset = Int

data Neighbourhood x y = Neighbourhood {
     Neighbourhood x y -> y
_dataAtNode :: y
   , Neighbourhood x y -> Vector WebNodeIdOffset
_neighbours :: UArr.Vector WebNodeIdOffset
   , Neighbourhood x y -> Metric x
_localScalarProduct :: Metric x
   , Neighbourhood x y -> Maybe (Needle' x)
_webBoundaryAtNode :: Maybe (Needle' x)
   }
  deriving ((forall x. Neighbourhood x y -> Rep (Neighbourhood x y) x)
-> (forall x. Rep (Neighbourhood x y) x -> Neighbourhood x y)
-> Generic (Neighbourhood x y)
forall x. Rep (Neighbourhood x y) x -> Neighbourhood x y
forall x. Neighbourhood x y -> Rep (Neighbourhood x y) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x y x. Rep (Neighbourhood x y) x -> Neighbourhood x y
forall x y x. Neighbourhood x y -> Rep (Neighbourhood x y) x
$cto :: forall x y x. Rep (Neighbourhood x y) x -> Neighbourhood x y
$cfrom :: forall x y x. Neighbourhood x y -> Rep (Neighbourhood x y) x
Generic, a -> Neighbourhood x b -> Neighbourhood x a
(a -> b) -> Neighbourhood x a -> Neighbourhood x b
(forall a b. (a -> b) -> Neighbourhood x a -> Neighbourhood x b)
-> (forall a b. a -> Neighbourhood x b -> Neighbourhood x a)
-> Functor (Neighbourhood x)
forall a b. a -> Neighbourhood x b -> Neighbourhood x a
forall a b. (a -> b) -> Neighbourhood x a -> Neighbourhood x b
forall x a b. a -> Neighbourhood x b -> Neighbourhood x a
forall x a b. (a -> b) -> Neighbourhood x a -> Neighbourhood x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Neighbourhood x b -> Neighbourhood x a
$c<$ :: forall x a b. a -> Neighbourhood x b -> Neighbourhood x a
fmap :: (a -> b) -> Neighbourhood x a -> Neighbourhood x b
$cfmap :: forall x a b. (a -> b) -> Neighbourhood x a -> Neighbourhood x b
Functor, Neighbourhood x a -> Bool
(a -> m) -> Neighbourhood x a -> m
(a -> b -> b) -> b -> Neighbourhood x a -> b
(forall m. Monoid m => Neighbourhood x m -> m)
-> (forall m a. Monoid m => (a -> m) -> Neighbourhood x a -> m)
-> (forall m a. Monoid m => (a -> m) -> Neighbourhood x a -> m)
-> (forall a b. (a -> b -> b) -> b -> Neighbourhood x a -> b)
-> (forall a b. (a -> b -> b) -> b -> Neighbourhood x a -> b)
-> (forall b a. (b -> a -> b) -> b -> Neighbourhood x a -> b)
-> (forall b a. (b -> a -> b) -> b -> Neighbourhood x a -> b)
-> (forall a. (a -> a -> a) -> Neighbourhood x a -> a)
-> (forall a. (a -> a -> a) -> Neighbourhood x a -> a)
-> (forall a. Neighbourhood x a -> [a])
-> (forall a. Neighbourhood x a -> Bool)
-> (forall a. Neighbourhood x a -> WebNodeIdOffset)
-> (forall a. Eq a => a -> Neighbourhood x a -> Bool)
-> (forall a. Ord a => Neighbourhood x a -> a)
-> (forall a. Ord a => Neighbourhood x a -> a)
-> (forall a. Num a => Neighbourhood x a -> a)
-> (forall a. Num a => Neighbourhood x a -> a)
-> Foldable (Neighbourhood x)
forall a. Eq a => a -> Neighbourhood x a -> Bool
forall a. Num a => Neighbourhood x a -> a
forall a. Ord a => Neighbourhood x a -> a
forall m. Monoid m => Neighbourhood x m -> m
forall a. Neighbourhood x a -> Bool
forall a. Neighbourhood x a -> WebNodeIdOffset
forall a. Neighbourhood x a -> [a]
forall a. (a -> a -> a) -> Neighbourhood x a -> a
forall x a. Eq a => a -> Neighbourhood x a -> Bool
forall x a. Num a => Neighbourhood x a -> a
forall x a. Ord a => Neighbourhood x a -> a
forall m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
forall x m. Monoid m => Neighbourhood x m -> m
forall x a. Neighbourhood x a -> Bool
forall x a. Neighbourhood x a -> WebNodeIdOffset
forall x a. Neighbourhood x a -> [a]
forall b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
forall x a. (a -> a -> a) -> Neighbourhood x a -> a
forall a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
forall x m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
forall x b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
forall x a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> WebNodeIdOffset)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Neighbourhood x a -> a
$cproduct :: forall x a. Num a => Neighbourhood x a -> a
sum :: Neighbourhood x a -> a
$csum :: forall x a. Num a => Neighbourhood x a -> a
minimum :: Neighbourhood x a -> a
$cminimum :: forall x a. Ord a => Neighbourhood x a -> a
maximum :: Neighbourhood x a -> a
$cmaximum :: forall x a. Ord a => Neighbourhood x a -> a
elem :: a -> Neighbourhood x a -> Bool
$celem :: forall x a. Eq a => a -> Neighbourhood x a -> Bool
length :: Neighbourhood x a -> WebNodeIdOffset
$clength :: forall x a. Neighbourhood x a -> WebNodeIdOffset
null :: Neighbourhood x a -> Bool
$cnull :: forall x a. Neighbourhood x a -> Bool
toList :: Neighbourhood x a -> [a]
$ctoList :: forall x a. Neighbourhood x a -> [a]
foldl1 :: (a -> a -> a) -> Neighbourhood x a -> a
$cfoldl1 :: forall x a. (a -> a -> a) -> Neighbourhood x a -> a
foldr1 :: (a -> a -> a) -> Neighbourhood x a -> a
$cfoldr1 :: forall x a. (a -> a -> a) -> Neighbourhood x a -> a
foldl' :: (b -> a -> b) -> b -> Neighbourhood x a -> b
$cfoldl' :: forall x b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
foldl :: (b -> a -> b) -> b -> Neighbourhood x a -> b
$cfoldl :: forall x b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
foldr' :: (a -> b -> b) -> b -> Neighbourhood x a -> b
$cfoldr' :: forall x a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
foldr :: (a -> b -> b) -> b -> Neighbourhood x a -> b
$cfoldr :: forall x a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
foldMap' :: (a -> m) -> Neighbourhood x a -> m
$cfoldMap' :: forall x m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
foldMap :: (a -> m) -> Neighbourhood x a -> m
$cfoldMap :: forall x m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
fold :: Neighbourhood x m -> m
$cfold :: forall x m. Monoid m => Neighbourhood x m -> m
Foldable, Functor (Neighbourhood x)
Foldable (Neighbourhood x)
Functor (Neighbourhood x)
-> Foldable (Neighbourhood x)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Neighbourhood x a -> f (Neighbourhood x b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Neighbourhood x (f a) -> f (Neighbourhood x a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Neighbourhood x a -> m (Neighbourhood x b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Neighbourhood x (m a) -> m (Neighbourhood x a))
-> Traversable (Neighbourhood x)
(a -> f b) -> Neighbourhood x a -> f (Neighbourhood x b)
forall x. Functor (Neighbourhood x)
forall x. Foldable (Neighbourhood x)
forall x (m :: * -> *) a.
Monad m =>
Neighbourhood x (m a) -> m (Neighbourhood x a)
forall x (f :: * -> *) a.
Applicative f =>
Neighbourhood x (f a) -> f (Neighbourhood x a)
forall x (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Neighbourhood x a -> m (Neighbourhood x b)
forall x (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Neighbourhood x a -> f (Neighbourhood x b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Neighbourhood x (m a) -> m (Neighbourhood x a)
forall (f :: * -> *) a.
Applicative f =>
Neighbourhood x (f a) -> f (Neighbourhood x a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Neighbourhood x a -> m (Neighbourhood x b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Neighbourhood x a -> f (Neighbourhood x b)
sequence :: Neighbourhood x (m a) -> m (Neighbourhood x a)
$csequence :: forall x (m :: * -> *) a.
Monad m =>
Neighbourhood x (m a) -> m (Neighbourhood x a)
mapM :: (a -> m b) -> Neighbourhood x a -> m (Neighbourhood x b)
$cmapM :: forall x (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Neighbourhood x a -> m (Neighbourhood x b)
sequenceA :: Neighbourhood x (f a) -> f (Neighbourhood x a)
$csequenceA :: forall x (f :: * -> *) a.
Applicative f =>
Neighbourhood x (f a) -> f (Neighbourhood x a)
traverse :: (a -> f b) -> Neighbourhood x a -> f (Neighbourhood x b)
$ctraverse :: forall x (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Neighbourhood x a -> f (Neighbourhood x b)
$cp2Traversable :: forall x. Foldable (Neighbourhood x)
$cp1Traversable :: forall x. Functor (Neighbourhood x)
Traversable)
makeLenses ''Neighbourhood

deriving instance ( WithField ℝ PseudoAffine x
                  , SimpleSpace (Needle x), Show (Needle' x), Show y )
             => Show (Neighbourhood x y)

data WebLocally x y = LocalWebInfo {
      WebLocally x y -> x
_thisNodeCoord :: x
    , WebLocally x y -> y
_thisNodeData :: y
    , WebLocally x y -> WebNodeIdOffset
_thisNodeId :: WebNodeId
    , WebLocally x y -> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
_nodeNeighbours :: [(WebNodeId, (Needle x, WebLocally x y))]
    , WebLocally x y -> Metric x
_nodeLocalScalarProduct :: Metric x
    , WebLocally x y -> Maybe (Needle' x)
_webBoundingPlane :: Maybe (Needle' x)
    } deriving ((forall x. WebLocally x y -> Rep (WebLocally x y) x)
-> (forall x. Rep (WebLocally x y) x -> WebLocally x y)
-> Generic (WebLocally x y)
forall x. Rep (WebLocally x y) x -> WebLocally x y
forall x. WebLocally x y -> Rep (WebLocally x y) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x y x. Rep (WebLocally x y) x -> WebLocally x y
forall x y x. WebLocally x y -> Rep (WebLocally x y) x
$cto :: forall x y x. Rep (WebLocally x y) x -> WebLocally x y
$cfrom :: forall x y x. WebLocally x y -> Rep (WebLocally x y) x
Generic)
makeLenses ''WebLocally

data NeighbourhoodVector x = NeighbourhoodVector
          { NeighbourhoodVector x -> WebNodeIdOffset
_nvectId :: Int
          , NeighbourhoodVector x -> Needle x
_theNVect :: Needle x
          , NeighbourhoodVector x -> Needle' x
_nvectNormal :: Needle' x
          , NeighbourhoodVector x -> Scalar (Needle x)
_nvectLength :: Scalar (Needle x)
          , NeighbourhoodVector x -> Scalar (Needle x)
_otherNeighboursOverlap :: Scalar (Needle x)
          }
makeLenses ''NeighbourhoodVector

data PropagationInconsistency x υ = PropagationInconsistency {
      PropagationInconsistency x υ -> [(x, υ)]
_inconsistentPropagatedData :: [(x,υ)]
    , PropagationInconsistency x υ -> υ
_inconsistentAPrioriData :: υ }
  | PropagationInconsistencies [PropagationInconsistency x υ]
 deriving (WebNodeIdOffset -> PropagationInconsistency x υ -> ShowS
[PropagationInconsistency x υ] -> ShowS
PropagationInconsistency x υ -> String
(WebNodeIdOffset -> PropagationInconsistency x υ -> ShowS)
-> (PropagationInconsistency x υ -> String)
-> ([PropagationInconsistency x υ] -> ShowS)
-> Show (PropagationInconsistency x υ)
forall a.
(WebNodeIdOffset -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
forall x υ.
(Show x, Show υ) =>
WebNodeIdOffset -> PropagationInconsistency x υ -> ShowS
forall x υ.
(Show x, Show υ) =>
[PropagationInconsistency x υ] -> ShowS
forall x υ.
(Show x, Show υ) =>
PropagationInconsistency x υ -> String
showList :: [PropagationInconsistency x υ] -> ShowS
$cshowList :: forall x υ.
(Show x, Show υ) =>
[PropagationInconsistency x υ] -> ShowS
show :: PropagationInconsistency x υ -> String
$cshow :: forall x υ.
(Show x, Show υ) =>
PropagationInconsistency x υ -> String
showsPrec :: WebNodeIdOffset -> PropagationInconsistency x υ -> ShowS
$cshowsPrec :: forall x υ.
(Show x, Show υ) =>
WebNodeIdOffset -> PropagationInconsistency x υ -> ShowS
Show)
makeLenses ''PropagationInconsistency

instance Semigroup (PropagationInconsistency x υ) where
  PropagationInconsistency x υ
p<> :: PropagationInconsistency x υ
-> PropagationInconsistency x υ -> PropagationInconsistency x υ
<>PropagationInconsistency x υ
q = [PropagationInconsistency x υ] -> PropagationInconsistency x υ
forall a. Monoid a => [a] -> a
mconcat [PropagationInconsistency x υ
p,PropagationInconsistency x υ
q]
instance Monoid (PropagationInconsistency x υ) where
  mempty :: PropagationInconsistency x υ
mempty = [PropagationInconsistency x υ] -> PropagationInconsistency x υ
forall x υ.
[PropagationInconsistency x υ] -> PropagationInconsistency x υ
PropagationInconsistencies []
  mappend :: PropagationInconsistency x υ
-> PropagationInconsistency x υ -> PropagationInconsistency x υ
mappend = PropagationInconsistency x υ
-> PropagationInconsistency x υ -> PropagationInconsistency x υ
forall a. Semigroup a => a -> a -> a
(<>)
  mconcat :: [PropagationInconsistency x υ] -> PropagationInconsistency x υ
mconcat = [PropagationInconsistency x υ] -> PropagationInconsistency x υ
forall x υ.
[PropagationInconsistency x υ] -> PropagationInconsistency x υ
PropagationInconsistencies

instance (NFData x, NFData (Metric x), NFData (Needle' x), NFData y)
           => NFData (Neighbourhood x y)

-- | A 'PointsWeb' is almost, but not quite a mesh. It is a stongly connected†
--   directed graph, backed by a tree for fast nearest-neighbour lookup of points.
-- 
--   †In general, there can be disconnected components, but every connected
--   component is strongly connected.
newtype PointsWeb :: * -> * -> * where
   PointsWeb :: {
       PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc :: x`Shaded`Neighbourhood x y
     } -> PointsWeb x y
  deriving ((forall x. PointsWeb a b -> Rep (PointsWeb a b) x)
-> (forall x. Rep (PointsWeb a b) x -> PointsWeb a b)
-> Generic (PointsWeb a b)
forall x. Rep (PointsWeb a b) x -> PointsWeb a b
forall x. PointsWeb a b -> Rep (PointsWeb a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (PointsWeb a b) x -> PointsWeb a b
forall a b x. PointsWeb a b -> Rep (PointsWeb a b) x
$cto :: forall a b x. Rep (PointsWeb a b) x -> PointsWeb a b
$cfrom :: forall a b x. PointsWeb a b -> Rep (PointsWeb a b) x
Generic, a -> PointsWeb a b -> PointsWeb a a
(a -> b) -> PointsWeb a a -> PointsWeb a b
(forall a b. (a -> b) -> PointsWeb a a -> PointsWeb a b)
-> (forall a b. a -> PointsWeb a b -> PointsWeb a a)
-> Functor (PointsWeb a)
forall a b. a -> PointsWeb a b -> PointsWeb a a
forall a b. (a -> b) -> PointsWeb a a -> PointsWeb a b
forall a a b. a -> PointsWeb a b -> PointsWeb a a
forall a a b. (a -> b) -> PointsWeb a a -> PointsWeb a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PointsWeb a b -> PointsWeb a a
$c<$ :: forall a a b. a -> PointsWeb a b -> PointsWeb a a
fmap :: (a -> b) -> PointsWeb a a -> PointsWeb a b
$cfmap :: forall a a b. (a -> b) -> PointsWeb a a -> PointsWeb a b
Functor, PointsWeb a a -> Bool
(a -> m) -> PointsWeb a a -> m
(a -> b -> b) -> b -> PointsWeb a a -> b
(forall m. Monoid m => PointsWeb a m -> m)
-> (forall m a. Monoid m => (a -> m) -> PointsWeb a a -> m)
-> (forall m a. Monoid m => (a -> m) -> PointsWeb a a -> m)
-> (forall a b. (a -> b -> b) -> b -> PointsWeb a a -> b)
-> (forall a b. (a -> b -> b) -> b -> PointsWeb a a -> b)
-> (forall b a. (b -> a -> b) -> b -> PointsWeb a a -> b)
-> (forall b a. (b -> a -> b) -> b -> PointsWeb a a -> b)
-> (forall a. (a -> a -> a) -> PointsWeb a a -> a)
-> (forall a. (a -> a -> a) -> PointsWeb a a -> a)
-> (forall a. PointsWeb a a -> [a])
-> (forall a. PointsWeb a a -> Bool)
-> (forall a. PointsWeb a a -> WebNodeIdOffset)
-> (forall a. Eq a => a -> PointsWeb a a -> Bool)
-> (forall a. Ord a => PointsWeb a a -> a)
-> (forall a. Ord a => PointsWeb a a -> a)
-> (forall a. Num a => PointsWeb a a -> a)
-> (forall a. Num a => PointsWeb a a -> a)
-> Foldable (PointsWeb a)
forall a. Eq a => a -> PointsWeb a a -> Bool
forall a. Num a => PointsWeb a a -> a
forall a. Ord a => PointsWeb a a -> a
forall m. Monoid m => PointsWeb a m -> m
forall a. PointsWeb a a -> Bool
forall a. PointsWeb a a -> WebNodeIdOffset
forall a. PointsWeb a a -> [a]
forall a. (a -> a -> a) -> PointsWeb a a -> a
forall a a. Eq a => a -> PointsWeb a a -> Bool
forall a a. Num a => PointsWeb a a -> a
forall a a. Ord a => PointsWeb a a -> a
forall m a. Monoid m => (a -> m) -> PointsWeb a a -> m
forall a m. Monoid m => PointsWeb a m -> m
forall a a. PointsWeb a a -> Bool
forall a a. PointsWeb a a -> WebNodeIdOffset
forall a a. PointsWeb a a -> [a]
forall b a. (b -> a -> b) -> b -> PointsWeb a a -> b
forall a b. (a -> b -> b) -> b -> PointsWeb a a -> b
forall a a. (a -> a -> a) -> PointsWeb a a -> a
forall a m a. Monoid m => (a -> m) -> PointsWeb a a -> m
forall a b a. (b -> a -> b) -> b -> PointsWeb a a -> b
forall a a b. (a -> b -> b) -> b -> PointsWeb a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> WebNodeIdOffset)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: PointsWeb a a -> a
$cproduct :: forall a a. Num a => PointsWeb a a -> a
sum :: PointsWeb a a -> a
$csum :: forall a a. Num a => PointsWeb a a -> a
minimum :: PointsWeb a a -> a
$cminimum :: forall a a. Ord a => PointsWeb a a -> a
maximum :: PointsWeb a a -> a
$cmaximum :: forall a a. Ord a => PointsWeb a a -> a
elem :: a -> PointsWeb a a -> Bool
$celem :: forall a a. Eq a => a -> PointsWeb a a -> Bool
length :: PointsWeb a a -> WebNodeIdOffset
$clength :: forall a a. PointsWeb a a -> WebNodeIdOffset
null :: PointsWeb a a -> Bool
$cnull :: forall a a. PointsWeb a a -> Bool
toList :: PointsWeb a a -> [a]
$ctoList :: forall a a. PointsWeb a a -> [a]
foldl1 :: (a -> a -> a) -> PointsWeb a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> PointsWeb a a -> a
foldr1 :: (a -> a -> a) -> PointsWeb a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> PointsWeb a a -> a
foldl' :: (b -> a -> b) -> b -> PointsWeb a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> PointsWeb a a -> b
foldl :: (b -> a -> b) -> b -> PointsWeb a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> PointsWeb a a -> b
foldr' :: (a -> b -> b) -> b -> PointsWeb a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> PointsWeb a a -> b
foldr :: (a -> b -> b) -> b -> PointsWeb a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> PointsWeb a a -> b
foldMap' :: (a -> m) -> PointsWeb a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> PointsWeb a a -> m
foldMap :: (a -> m) -> PointsWeb a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> PointsWeb a a -> m
fold :: PointsWeb a m -> m
$cfold :: forall a m. Monoid m => PointsWeb a m -> m
Foldable, Functor (PointsWeb a)
Foldable (PointsWeb a)
Functor (PointsWeb a)
-> Foldable (PointsWeb a)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> PointsWeb a a -> f (PointsWeb a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PointsWeb a (f a) -> f (PointsWeb a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> PointsWeb a a -> m (PointsWeb a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PointsWeb a (m a) -> m (PointsWeb a a))
-> Traversable (PointsWeb a)
(a -> f b) -> PointsWeb a a -> f (PointsWeb a b)
forall a. Functor (PointsWeb a)
forall a. Foldable (PointsWeb a)
forall a (m :: * -> *) a.
Monad m =>
PointsWeb a (m a) -> m (PointsWeb a a)
forall a (f :: * -> *) a.
Applicative f =>
PointsWeb a (f a) -> f (PointsWeb a a)
forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PointsWeb a a -> m (PointsWeb a b)
forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PointsWeb a a -> f (PointsWeb a b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PointsWeb a (m a) -> m (PointsWeb a a)
forall (f :: * -> *) a.
Applicative f =>
PointsWeb a (f a) -> f (PointsWeb a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PointsWeb a a -> m (PointsWeb a b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PointsWeb a a -> f (PointsWeb a b)
sequence :: PointsWeb a (m a) -> m (PointsWeb a a)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
PointsWeb a (m a) -> m (PointsWeb a a)
mapM :: (a -> m b) -> PointsWeb a a -> m (PointsWeb a b)
$cmapM :: forall a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> PointsWeb a a -> m (PointsWeb a b)
sequenceA :: PointsWeb a (f a) -> f (PointsWeb a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
PointsWeb a (f a) -> f (PointsWeb a a)
traverse :: (a -> f b) -> PointsWeb a a -> f (PointsWeb a b)
$ctraverse :: forall a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PointsWeb a a -> f (PointsWeb a b)
$cp2Traversable :: forall a. Foldable (PointsWeb a)
$cp1Traversable :: forall a. Functor (PointsWeb a)
Traversable)

instance (NFData x, NFData (Metric x), NFData (Needle' x), NFData y) => NFData (PointsWeb x y)

instance CCt.Foldable (PointsWeb x) (->) (->) where
  ffoldl :: ((a, b) -> a) -> (a, PointsWeb x b) -> a
ffoldl = (a -> PointsWeb x b -> a) -> (a, PointsWeb x b) -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> PointsWeb x b -> a) -> (a, PointsWeb x b) -> a)
-> (((a, b) -> a) -> a -> PointsWeb x b -> a)
-> ((a, b) -> a)
-> (a, PointsWeb x b)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> a) -> a -> PointsWeb x b -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Hask.foldl' ((a -> b -> a) -> a -> PointsWeb x b -> a)
-> (((a, b) -> a) -> a -> b -> a)
-> ((a, b) -> a)
-> a
-> PointsWeb x b
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> a) -> a -> b -> a
forall a b c. ((a, b) -> c) -> a -> b -> c
curry
  foldMap :: (a -> m) -> PointsWeb x a -> m
foldMap = (a -> m) -> PointsWeb x a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Hask.foldMap


data WebChunk x y = WebChunk {
     WebChunk x y -> PointsWeb x y
_thisChunk :: PointsWeb x y
   , WebChunk x y -> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
_layersAroundChunk :: [(x`Shaded`Neighbourhood x y, WebNodeId)]
   }

makeLenses ''WebChunk

data NodeInWeb x y = NodeInWeb {
     NodeInWeb x y -> (x, Neighbourhood x y)
_thisNodeOnly :: (x, Neighbourhood x y)
   , NodeInWeb x y -> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
_layersAroundNode :: [(x`Shaded`Neighbourhood x y, WebNodeId)]
   }
makeLenses ''NodeInWeb

data PathStep x y = PathStep {
     PathStep x y -> WebLocally x y
_pathStepStart :: WebLocally x y
   , PathStep x y -> WebLocally x y
_pathStepEnd :: WebLocally x y
   }
makeLenses ''PathStep


type MetricChoice x = Shade x -> Metric x


traverseInnermostChunks :: ∀ f x y z . Applicative f
          => (WebChunk x y -> f (PointsWeb x z)) -> PointsWeb x y -> f (PointsWeb x z)
traverseInnermostChunks :: (WebChunk x y -> f (PointsWeb x z))
-> PointsWeb x y -> f (PointsWeb x z)
traverseInnermostChunks WebChunk x y -> f (PointsWeb x z)
f = [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> PointsWeb x y -> f (PointsWeb x z)
go []
 where go :: [(x`Shaded`Neighbourhood x y, WebNodeId)] -> PointsWeb x y -> f (PointsWeb x z)
       go :: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> PointsWeb x y -> f (PointsWeb x z)
go [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers (w :: PointsWeb x y
w@(PointsWeb (PlainLeaves [(x, Neighbourhood x y)]
_)))
         = WebChunk x y -> f (PointsWeb x z)
f (PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk PointsWeb x y
w [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers) 
       go [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers (PointsWeb Shaded x (Neighbourhood x y)
w) = Shaded x (Neighbourhood x z) -> PointsWeb x z
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x z) -> PointsWeb x z)
-> f (Shaded x (Neighbourhood x z)) -> f (PointsWeb x z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((WebNodeIdOffset, Shaded x (Neighbourhood x y))
 -> Shaded x (Neighbourhood x y)
 -> f (Shaded x (Neighbourhood x z)))
-> Shaded x (Neighbourhood x y) -> f (Shaded x (Neighbourhood x z))
forall (f :: * -> *) x y z.
Applicative f =>
((WebNodeIdOffset, Shaded x y) -> Shaded x y -> f (Shaded x z))
-> Shaded x y -> f (Shaded x z)
traverseTrunkBranchChoices (WebNodeIdOffset, Shaded x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y) -> f (Shaded x (Neighbourhood x z))
travel Shaded x (Neighbourhood x y)
w
        where travel :: (Int, (Shaded x (Neighbourhood x y)))
                 -> Shaded x (Neighbourhood x y)
                 -> f (Shaded x (Neighbourhood x z))
              travel :: (WebNodeIdOffset, Shaded x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y) -> f (Shaded x (Neighbourhood x z))
travel (WebNodeIdOffset
i₀, Shaded x (Neighbourhood x y)
br) Shaded x (Neighbourhood x y)
obrs
                  = PointsWeb x z -> Shaded x (Neighbourhood x z)
forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc (PointsWeb x z -> Shaded x (Neighbourhood x z))
-> f (PointsWeb x z) -> f (Shaded x (Neighbourhood x z))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> PointsWeb x y -> f (PointsWeb x z)
go ((Shaded x (Neighbourhood x y)
obrs,WebNodeIdOffset
i₀) (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers) (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb Shaded x (Neighbourhood x y)
br)

traverseNodesInEnvi :: ∀ f x y z . Applicative f
           => (NodeInWeb x y -> f (Neighbourhood x z))
             -> PointsWeb x y -> f (PointsWeb x z)
traverseNodesInEnvi :: (NodeInWeb x y -> f (Neighbourhood x z))
-> PointsWeb x y -> f (PointsWeb x z)
traverseNodesInEnvi NodeInWeb x y -> f (Neighbourhood x z)
f = (WebChunk x y -> f (PointsWeb x z))
-> PointsWeb x y -> f (PointsWeb x z)
forall (f :: * -> *) x y z.
Applicative f =>
(WebChunk x y -> f (PointsWeb x z))
-> PointsWeb x y -> f (PointsWeb x z)
traverseInnermostChunks WebChunk x y -> f (PointsWeb x z)
fc
 where fc :: WebChunk x y -> f (PointsWeb x z)
       fc :: WebChunk x y -> f (PointsWeb x z)
fc (WebChunk (PointsWeb (PlainLeaves [(x, Neighbourhood x y)]
lvs)) [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers)
            = Shaded x (Neighbourhood x z) -> PointsWeb x z
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x z) -> PointsWeb x z)
-> ([(x, Neighbourhood x z)] -> Shaded x (Neighbourhood x z))
-> [(x, Neighbourhood x z)]
-> PointsWeb x z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(x, Neighbourhood x z)] -> Shaded x (Neighbourhood x z)
forall x y. [(x, y)] -> Shaded x y
PlainLeaves ([(x, Neighbourhood x z)] -> PointsWeb x z)
-> f [(x, Neighbourhood x z)] -> f (PointsWeb x z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (((WebNodeIdOffset, (x, Neighbourhood x y)),
  [(x, Neighbourhood x y)])
 -> f (x, Neighbourhood x z))
-> [((WebNodeIdOffset, (x, Neighbourhood x y)),
     [(x, Neighbourhood x y)])]
-> f [(x, Neighbourhood x z)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse ((WebNodeIdOffset, (x, Neighbourhood x y)),
 [(x, Neighbourhood x y)])
-> f (x, Neighbourhood x z)
fn ([(x, Neighbourhood x y)]
-> [((WebNodeIdOffset, (x, Neighbourhood x y)),
     [(x, Neighbourhood x y)])]
forall a. [a] -> [((WebNodeIdOffset, a), [a])]
ixedFoci [(x, Neighbourhood x y)]
lvs)
        where fn :: ((WebNodeIdOffset, (x, Neighbourhood x y)),
 [(x, Neighbourhood x y)])
-> f (x, Neighbourhood x z)
fn ((WebNodeIdOffset
i, (x
x, Neighbourhood x y
ngbh)), [(x, Neighbourhood x y)]
nearbyLeaves)
               = (x
x,) (Neighbourhood x z -> (x, Neighbourhood x z))
-> f (Neighbourhood x z) -> f (x, Neighbourhood x z)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeInWeb x y -> f (Neighbourhood x z)
f ((x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
NodeInWeb (x
x,Neighbourhood x y
ngbh)
                                     ([(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
 -> NodeInWeb x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
forall a b. (a -> b) -> a -> b
$ ([(x, Neighbourhood x y)] -> Shaded x (Neighbourhood x y)
forall x y. [(x, y)] -> Shaded x y
PlainLeaves [(x, Neighbourhood x y)]
nearbyLeaves, WebNodeIdOffset
i) (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers)

fmapNodesInEnvi :: (NodeInWeb x y -> Neighbourhood x z) -> PointsWeb x y -> PointsWeb x z
fmapNodesInEnvi :: (NodeInWeb x y -> Neighbourhood x z)
-> PointsWeb x y -> PointsWeb x z
fmapNodesInEnvi NodeInWeb x y -> Neighbourhood x z
f = Identity (PointsWeb x z) -> PointsWeb x z
forall a. Identity a -> a
runIdentity (Identity (PointsWeb x z) -> PointsWeb x z)
-> (PointsWeb x y -> Identity (PointsWeb x z))
-> PointsWeb x y
-> PointsWeb x z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeInWeb x y -> Identity (Neighbourhood x z))
-> PointsWeb x y -> Identity (PointsWeb x z)
forall (f :: * -> *) x y z.
Applicative f =>
(NodeInWeb x y -> f (Neighbourhood x z))
-> PointsWeb x y -> f (PointsWeb x z)
traverseNodesInEnvi (Neighbourhood x z -> Identity (Neighbourhood x z)
forall a. a -> Identity a
Identity (Neighbourhood x z -> Identity (Neighbourhood x z))
-> (NodeInWeb x y -> Neighbourhood x z)
-> NodeInWeb x y
-> Identity (Neighbourhood x z)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInWeb x y -> Neighbourhood x z
f)


ixedFoci :: [a] -> [((Int, a), [a])]
ixedFoci :: [a] -> [((WebNodeIdOffset, a), [a])]
ixedFoci = WebNodeIdOffset -> [a] -> [((WebNodeIdOffset, a), [a])]
forall t a. Num t => t -> [a] -> [((t, a), [a])]
go WebNodeIdOffset
0
 where go :: t -> [a] -> [((t, a), [a])]
go t
_ [] = []
       go t
i (a
x:[a]
xs) = ((t
i,a
x), [a]
xs) ((t, a), [a]) -> [((t, a), [a])] -> [((t, a), [a])]
forall a. a -> [a] -> [a]
: (((t, a), [a]) -> ((t, a), [a]))
-> [((t, a), [a])] -> [((t, a), [a])]
forall a b. (a -> b) -> [a] -> [b]
map (([a] -> [a]) -> ((t, a), [a]) -> ((t, a), [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (t -> [a] -> [((t, a), [a])]
go (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1) [a]
xs)
 

indexWeb :: PointsWeb x y -> WebNodeId -> Maybe (x,y)
indexWeb :: PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb (PointsWeb Shaded x (Neighbourhood x y)
rsc) WebNodeIdOffset
i = case Shaded x (Neighbourhood x y)
-> WebNodeIdOffset
-> Either
     WebNodeIdOffset
     ([Shaded x (Neighbourhood x y)], (x, Neighbourhood x y))
forall x y.
Shaded x y
-> WebNodeIdOffset -> Either WebNodeIdOffset ([Shaded x y], (x, y))
indexShadeTree Shaded x (Neighbourhood x y)
rsc WebNodeIdOffset
i of
       Right ([Shaded x (Neighbourhood x y)]
_, (x
x, Neighbourhood y
y Vector WebNodeIdOffset
_ Metric x
_ Maybe (Needle' x)
_)) -> (x, y) -> Maybe (x, y)
forall a. a -> Maybe a
Just (x
x, y
y)
       Either
  WebNodeIdOffset
  ([Shaded x (Neighbourhood x y)], (x, Neighbourhood x y))
_ -> Maybe (x, y)
forall a. Maybe a
Nothing

unsafeIndexWebData :: PointsWeb x y -> WebNodeId -> y
unsafeIndexWebData :: PointsWeb x y -> WebNodeIdOffset -> y
unsafeIndexWebData PointsWeb x y
web WebNodeIdOffset
i = case PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x y
web WebNodeIdOffset
i of
              Just (x
x,y
y) -> y
y


jumpNodeOffset :: WebNodeIdOffset -> NodeInWeb x y -> NodeInWeb x y
jumpNodeOffset :: WebNodeIdOffset -> NodeInWeb x y -> NodeInWeb x y
jumpNodeOffset WebNodeIdOffset
0 NodeInWeb x y
node = NodeInWeb x y
node
jumpNodeOffset WebNodeIdOffset
δi (NodeInWeb (x, Neighbourhood x y)
x [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
environment)
   = case WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
forall x y.
WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
zoomoutWebChunk WebNodeIdOffset
δie (WebChunk x y -> (WebChunk x y, WebNodeIdOffset))
-> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
forall a b. (a -> b) -> a -> b
$ PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> Shaded x (Neighbourhood x y) -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ [(x, Neighbourhood x y)] -> Shaded x (Neighbourhood x y)
forall x y. [(x, y)] -> Shaded x y
PlainLeaves [(x, Neighbourhood x y)
x]) [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
environment of
       (WebChunk PointsWeb x y
bigChunk [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi', WebNodeIdOffset
δi')
           -> case PointsWeb x y -> WebNodeIdOffset -> NodeInWeb x y
forall x y. PointsWeb x y -> WebNodeIdOffset -> NodeInWeb x y
pickNodeInWeb PointsWeb x y
bigChunk WebNodeIdOffset
δi' of
              NodeInWeb (x, Neighbourhood x y)
x' [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi'' -> (x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
NodeInWeb (x, Neighbourhood x y)
x' ([(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
 -> NodeInWeb x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
forall a b. (a -> b) -> a -> b
$ [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi'' [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
forall a. [a] -> [a] -> [a]
++ [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi'
 where δie :: WebNodeIdOffset
δie | WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
0     = WebNodeIdOffset
δi
           | Bool
otherwise  = WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
- WebNodeIdOffset
1

webAroundChunk :: WebChunk x y -> PointsWeb x y
webAroundChunk :: WebChunk x y -> PointsWeb x y
webAroundChunk (WebChunk PointsWeb x y
chunk []) = PointsWeb x y
chunk
webAroundChunk (WebChunk (PointsWeb (PlainLeaves [(x, Neighbourhood x y)]
lvs))
                         ((PlainLeaves [(x, Neighbourhood x y)]
lvsAround, WebNodeIdOffset
i) : [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi))
   = WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk (WebChunk x y -> PointsWeb x y) -> WebChunk x y -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> ([(x, Neighbourhood x y)] -> Shaded x (Neighbourhood x y))
-> [(x, Neighbourhood x y)]
-> PointsWeb x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(x, Neighbourhood x y)] -> Shaded x (Neighbourhood x y)
forall x y. [(x, y)] -> Shaded x y
PlainLeaves ([(x, Neighbourhood x y)] -> PointsWeb x y)
-> [(x, Neighbourhood x y)] -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ [(x, Neighbourhood x y)]
lvsBefore[(x, Neighbourhood x y)]
-> [(x, Neighbourhood x y)] -> [(x, Neighbourhood x y)]
forall a. [a] -> [a] -> [a]
++[(x, Neighbourhood x y)]
lvs[(x, Neighbourhood x y)]
-> [(x, Neighbourhood x y)] -> [(x, Neighbourhood x y)]
forall a. [a] -> [a] -> [a]
++[(x, Neighbourhood x y)]
lvsAfter) [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi
 where ([(x, Neighbourhood x y)]
lvsBefore, [(x, Neighbourhood x y)]
lvsAfter) = WebNodeIdOffset
-> [(x, Neighbourhood x y)]
-> ([(x, Neighbourhood x y)], [(x, Neighbourhood x y)])
forall a. WebNodeIdOffset -> [a] -> ([a], [a])
splitAt WebNodeIdOffset
i [(x, Neighbourhood x y)]
lvsAround
webAroundChunk (WebChunk (PointsWeb Shaded x (Neighbourhood x y)
chunk)
                         ((OverlappingBranches WebNodeIdOffset
nw Shade x
ew (DBranch Needle' x
dir
                            (Hourglass (PlainLeaves[]) Shaded x (Neighbourhood x y)
d) :| [DBranch x (Neighbourhood x y)]
brs), WebNodeIdOffset
0) : [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi))
   = WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk (WebChunk x y -> PointsWeb x y) -> WebChunk x y -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> Shaded x (Neighbourhood x y) -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
chunk) Shade x
ew
                                          (Needle' x
-> Hourglass (Shaded x (Neighbourhood x y))
-> DBranch x (Neighbourhood x y)
forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (Shaded x (Neighbourhood x y)
-> Shaded x (Neighbourhood x y)
-> Hourglass (Shaded x (Neighbourhood x y))
forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
chunk Shaded x (Neighbourhood x y)
d) DBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> [a] -> NonEmpty a
:| [DBranch x (Neighbourhood x y)]
brs))
                               [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi
webAroundChunk (WebChunk (PointsWeb Shaded x (Neighbourhood x y)
chunk)
                         ((OverlappingBranches WebNodeIdOffset
nw Shade x
ew (DBranch Needle' x
dir
                            (Hourglass Shaded x (Neighbourhood x y)
u (PlainLeaves[])) :| [DBranch x (Neighbourhood x y)]
brs), WebNodeIdOffset
i) : [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi))
 | WebNodeIdOffset
iWebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Eq a => a -> a -> Bool
==Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
u
   = WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk (WebChunk x y -> PointsWeb x y) -> WebChunk x y -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> Shaded x (Neighbourhood x y) -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
chunk) Shade x
ew
                                          (Needle' x
-> Hourglass (Shaded x (Neighbourhood x y))
-> DBranch x (Neighbourhood x y)
forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (Shaded x (Neighbourhood x y)
-> Shaded x (Neighbourhood x y)
-> Hourglass (Shaded x (Neighbourhood x y))
forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
u Shaded x (Neighbourhood x y)
chunk) DBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> [a] -> NonEmpty a
:| [DBranch x (Neighbourhood x y)]
brs))
                               [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi
webAroundChunk (WebChunk PointsWeb x y
chunk
                         (( OverlappingBranches WebNodeIdOffset
nw Shade x
ew (br₀ :: DBranch x (Neighbourhood x y)
br₀@(DBranch Needle' x
_ (Hourglass Shaded x (Neighbourhood x y)
u Shaded x (Neighbourhood x y)
d))
                                                          :|DBranch x (Neighbourhood x y)
br₁:[DBranch x (Neighbourhood x y)]
brs)
                          , WebNodeIdOffset
i) : [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi))
  = case WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk (PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk PointsWeb x y
chunk [(WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches WebNodeIdOffset
nw Shade x
ew (DBranch x (Neighbourhood x y)
br₁DBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> [a] -> NonEmpty a
:|[DBranch x (Neighbourhood x y)]
brs), WebNodeIdOffset
i')])
      of PointsWeb (OverlappingBranches WebNodeIdOffset
nw' Shade x
ew' (DBranch x (Neighbourhood x y)
br₁':|[DBranch x (Neighbourhood x y)]
brs'))
           -> WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk (WebChunk x y -> PointsWeb x y) -> WebChunk x y -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk
                    (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> Shaded x (Neighbourhood x y) -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches WebNodeIdOffset
nw' Shade x
ew' (DBranch x (Neighbourhood x y)
br₀DBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> [a] -> NonEmpty a
:|DBranch x (Neighbourhood x y)
br₁'DBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> [DBranch x (Neighbourhood x y)]
forall a. a -> [a] -> [a]
:[DBranch x (Neighbourhood x y)]
brs'))
                    [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi
 where i' :: WebNodeIdOffset
i' = WebNodeIdOffset
i WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
- Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
u WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
- Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
d
webAroundChunk (WebChunk PointsWeb x y
_ ((OverlappingBranches WebNodeIdOffset
nw Shade x
ew NonEmpty (DBranch x (Neighbourhood x y))
branches, WebNodeIdOffset
i):[(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
_))
    = String -> PointsWeb x y
forall a. HasCallStack => String -> a
error (String -> PointsWeb x y) -> String -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ String
"Environment with branch sizes "String -> ShowS
forall a. [a] -> [a] -> [a]
++[[WebNodeIdOffset]] -> String
forall a. Show a => a -> String
show ((Shaded x (Neighbourhood x y) -> WebNodeIdOffset)
-> [Shaded x (Neighbourhood x y)] -> [WebNodeIdOffset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves ([Shaded x (Neighbourhood x y)] -> [WebNodeIdOffset])
-> (DBranch x (Neighbourhood x y)
    -> [Shaded x (Neighbourhood x y)])
-> DBranch x (Neighbourhood x y)
-> [WebNodeIdOffset]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DBranch x (Neighbourhood x y) -> [Shaded x (Neighbourhood x y)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList(DBranch x (Neighbourhood x y) -> [WebNodeIdOffset])
-> [DBranch x (Neighbourhood x y)] -> [[WebNodeIdOffset]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(NonEmpty (DBranch x (Neighbourhood x y))
-> [DBranch x (Neighbourhood x y)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList NonEmpty (DBranch x (Neighbourhood x y))
branches))
                String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" does not have a gap at #"String -> ShowS
forall a. [a] -> [a] -> [a]
++WebNodeIdOffset -> String
forall a. Show a => a -> String
show WebNodeIdOffset
i
webAroundChunk (WebChunk PointsWeb x y
_ ((PlainLeaves [(x, Neighbourhood x y)]
_, WebNodeIdOffset
_):[(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
_))
    = String -> PointsWeb x y
forall a. HasCallStack => String -> a
error String
"Encountered non-PlainLeaves chunk in a PlainLeaves environment."


zoomoutWebChunk :: WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeId)
zoomoutWebChunk :: WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
zoomoutWebChunk WebNodeIdOffset
δi (WebChunk PointsWeb x y
chunk ((Shaded x (Neighbourhood x y)
outlayer, WebNodeIdOffset
olp) : [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers))
  | WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
< -WebNodeIdOffset
olp Bool -> Bool -> Bool
|| WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
>= Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
outlayer WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
- WebNodeIdOffset
olp
      = WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
forall x y.
WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
zoomoutWebChunk WebNodeIdOffset
δiOut (WebChunk x y -> (WebChunk x y, WebNodeIdOffset))
-> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
forall a b. (a -> b) -> a -> b
$ PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk PointsWeb x y
widerChunk [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers
  | Bool
otherwise  = (PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk PointsWeb x y
widerChunk [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers, WebNodeIdOffset
δiIn)
 where δiOut :: WebNodeIdOffset
δiOut | WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
0     = WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp
             | Bool
otherwise  = WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
- Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
outlayer
       δiIn :: WebNodeIdOffset
δiIn | WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
0     = WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp
            | Bool
otherwise  = WebNodeIdOffset
δi WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+ Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves (PointsWeb x y -> Shaded x (Neighbourhood x y)
forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc PointsWeb x y
chunk)
       widerChunk :: PointsWeb x y
widerChunk = WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk (WebChunk x y -> PointsWeb x y) -> WebChunk x y -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk PointsWeb x y
chunk [(Shaded x (Neighbourhood x y)
outlayer,WebNodeIdOffset
olp)]
zoomoutWebChunk WebNodeIdOffset
δi (WebChunk PointsWeb x y
_ [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
e)
    = String -> (WebChunk x y, WebNodeIdOffset)
forall a. HasCallStack => String -> a
error (String -> (WebChunk x y, WebNodeIdOffset))
-> String -> (WebChunk x y, WebNodeIdOffset)
forall a b. (a -> b) -> a -> b
$ String
"Can't zoom out δ"String -> ShowS
forall a. [a] -> [a] -> [a]
++WebNodeIdOffset -> String
forall a. Show a => a -> String
show WebNodeIdOffset
δi
       String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" from a chunk with "String -> ShowS
forall a. [a] -> [a] -> [a]
++WebNodeIdOffset -> String
forall a. Show a => a -> String
show ([(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebNodeIdOffset
forall (t :: * -> *) a. Foldable t => t a -> WebNodeIdOffset
length [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
e)String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" environment layers."

pickNodeInWeb :: PointsWeb x y -> WebNodeId -> NodeInWeb x y
pickNodeInWeb :: PointsWeb x y -> WebNodeIdOffset -> NodeInWeb x y
pickNodeInWeb = [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> PointsWeb x y
-> WebNodeIdOffset
-> NodeInWeb x y
forall x y.
[(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> PointsWeb x y
-> WebNodeIdOffset
-> NodeInWeb x y
go [] (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
forall a. a -> a
id
 where go :: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> PointsWeb x y
-> WebNodeIdOffset
-> NodeInWeb x y
go [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
_ (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
_ (PointsWeb Shaded x (Neighbourhood x y)
w) WebNodeIdOffset
i
        | WebNodeIdOffset
iWebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
<WebNodeIdOffset
0 Bool -> Bool -> Bool
|| WebNodeIdOffset
iWebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
>=WebNodeIdOffset
n  = String -> NodeInWeb x y
forall a. HasCallStack => String -> a
error
           (String -> NodeInWeb x y) -> String -> NodeInWeb x y
forall a b. (a -> b) -> a -> b
$ String
"Trying to pick node #"String -> ShowS
forall a. [a] -> [a] -> [a]
++WebNodeIdOffset -> String
forall a. Show a => a -> String
show WebNodeIdOffset
iString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" in web with "String -> ShowS
forall a. [a] -> [a] -> [a]
++WebNodeIdOffset -> String
forall a. Show a => a -> String
show WebNodeIdOffset
nString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" nodes."
        where n :: WebNodeIdOffset
n = Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
w
       go [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
lMod (PointsWeb (PlainLeaves [(x, Neighbourhood x y)]
lvs)) WebNodeIdOffset
i
        | ([(x, Neighbourhood x y)]
preds, (x, Neighbourhood x y)
node:[(x, Neighbourhood x y)]
succs)<-WebNodeIdOffset
-> [(x, Neighbourhood x y)]
-> ([(x, Neighbourhood x y)], [(x, Neighbourhood x y)])
forall a. WebNodeIdOffset -> [a] -> ([a], [a])
splitAt WebNodeIdOffset
i [(x, Neighbourhood x y)]
lvs
                   = (x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
NodeInWeb (x, Neighbourhood x y)
node ([(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
 -> NodeInWeb x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
forall a b. (a -> b) -> a -> b
$ (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
lMod ([(x, Neighbourhood x y)] -> Shaded x (Neighbourhood x y)
forall x y. [(x, y)] -> Shaded x y
PlainLeaves ([(x, Neighbourhood x y)] -> Shaded x (Neighbourhood x y))
-> [(x, Neighbourhood x y)] -> Shaded x (Neighbourhood x y)
forall a b. (a -> b) -> a -> b
$ [(x, Neighbourhood x y)]
preds[(x, Neighbourhood x y)]
-> [(x, Neighbourhood x y)] -> [(x, Neighbourhood x y)]
forall a. [a] -> [a] -> [a]
++[(x, Neighbourhood x y)]
succs, WebNodeIdOffset
i) (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc
       go [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
lMod
            (PointsWeb (OverlappingBranches WebNodeIdOffset
nw Shade x
ew (DBranch Needle' x
dir (Hourglass Shaded x (Neighbourhood x y)
u Shaded x (Neighbourhood x y)
d):|[DBranch x (Neighbourhood x y)]
brs))) WebNodeIdOffset
i
        | WebNodeIdOffset
i WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
nu     = [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> PointsWeb x y
-> WebNodeIdOffset
-> NodeInWeb x y
go ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
lMod (WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
nu) Shade x
ew
                                      (Needle' x
-> Hourglass (Shaded x (Neighbourhood x y))
-> DBranch x (Neighbourhood x y)
forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (Shaded x (Neighbourhood x y)
-> Shaded x (Neighbourhood x y)
-> Hourglass (Shaded x (Neighbourhood x y))
forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
forall x y. Shaded x y
gap Shaded x (Neighbourhood x y)
d)DBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> [a] -> NonEmpty a
:|[DBranch x (Neighbourhood x y)]
brs), WebNodeIdOffset
0) (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc)
                          (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
forall a. a -> a
id (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb Shaded x (Neighbourhood x y)
u) WebNodeIdOffset
i
        | WebNodeIdOffset
i WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
nuWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
nd  = [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> PointsWeb x y
-> WebNodeIdOffset
-> NodeInWeb x y
go ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
lMod (WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
nd) Shade x
ew
                                      (Needle' x
-> Hourglass (Shaded x (Neighbourhood x y))
-> DBranch x (Neighbourhood x y)
forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (Shaded x (Neighbourhood x y)
-> Shaded x (Neighbourhood x y)
-> Hourglass (Shaded x (Neighbourhood x y))
forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
u Shaded x (Neighbourhood x y)
forall x y. Shaded x y
gap)DBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> [a] -> NonEmpty a
:|[DBranch x (Neighbourhood x y)]
brs), WebNodeIdOffset
nu) (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc)
                          (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
forall a. a -> a
id (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb Shaded x (Neighbourhood x y)
d) (WebNodeIdOffset
iWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
nu)
        | (DBranch x (Neighbourhood x y)
b:[DBranch x (Neighbourhood x y)]
rs)<-[DBranch x (Neighbourhood x y)]
brs  = [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> PointsWeb x y
-> WebNodeIdOffset
-> NodeInWeb x y
go
                          [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc
                          ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
lMod ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
 -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> (Shaded x (Neighbourhood x y), WebNodeIdOffset))
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \(OverlappingBranches WebNodeIdOffset
nwe Shade x
ewe NonEmpty (DBranch x (Neighbourhood x y))
brse, WebNodeIdOffset
ne)
                                   -> ( WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nweWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
nuWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
nd) Shade x
ewe
                                         (NonEmpty (DBranch x (Neighbourhood x y))
 -> Shaded x (Neighbourhood x y))
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall a b. (a -> b) -> a -> b
$ DBranch x (Neighbourhood x y)
-> NonEmpty (DBranch x (Neighbourhood x y))
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (Needle' x
-> Hourglass (Shaded x (Neighbourhood x y))
-> DBranch x (Neighbourhood x y)
forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (Shaded x (Neighbourhood x y)
-> Shaded x (Neighbourhood x y)
-> Hourglass (Shaded x (Neighbourhood x y))
forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
u Shaded x (Neighbourhood x y)
d)) NonEmpty (DBranch x (Neighbourhood x y))
brse
                                      , WebNodeIdOffset
neWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
nuWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
nd ) )
                          (Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> Shaded x (Neighbourhood x y) -> PointsWeb x y
forall a b. (a -> b) -> a -> b
$ WebNodeIdOffset
-> Shade x
-> NonEmpty (DBranch x (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
nuWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
nd) Shade x
ew (DBranch x (Neighbourhood x y)
bDBranch x (Neighbourhood x y)
-> [DBranch x (Neighbourhood x y)]
-> NonEmpty (DBranch x (Neighbourhood x y))
forall a. a -> [a] -> NonEmpty a
:|[DBranch x (Neighbourhood x y)]
rs))
                          (WebNodeIdOffset
iWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
nuWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
nd)
        where gap :: Shaded x y
gap = [(x, y)] -> Shaded x y
forall x y. [(x, y)] -> Shaded x y
PlainLeaves []
              [WebNodeIdOffset
nu,WebNodeIdOffset
nd] = Shaded x (Neighbourhood x y) -> WebNodeIdOffset
forall x y. Shaded x y -> WebNodeIdOffset
nLeaves(Shaded x (Neighbourhood x y) -> WebNodeIdOffset)
-> [Shaded x (Neighbourhood x y)] -> [WebNodeIdOffset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[Shaded x (Neighbourhood x y)
u,Shaded x (Neighbourhood x y)
d]


webLocalInfo :: ∀ x y . WithField ℝ Manifold x
            => PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo :: PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo = (NodeInWeb x y -> Neighbourhood x (WebLocally x y))
-> PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y z.
(NodeInWeb x y -> Neighbourhood x z)
-> PointsWeb x y -> PointsWeb x z
fmapNodesInEnvi NodeInWeb x y -> Neighbourhood x (WebLocally x y)
linkln
 where linkln :: NodeInWeb x y -> Neighbourhood x (WebLocally x y)
       linkln :: NodeInWeb x y -> Neighbourhood x (WebLocally x y)
linkln node :: NodeInWeb x y
node@(NodeInWeb (x
x, locloc :: Neighbourhood x y
locloc@(Neighbourhood y
y Vector WebNodeIdOffset
ngbs Metric x
metric Maybe (Needle' x)
nBoundary)) [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envis)
           = Neighbourhood x y
locloc Neighbourhood x y
-> (Neighbourhood x y -> Neighbourhood x (WebLocally x y))
-> Neighbourhood x (WebLocally x y)
forall a b. a -> (a -> b) -> b
& (y -> Identity (WebLocally x y))
-> Neighbourhood x y -> Identity (Neighbourhood x (WebLocally x y))
forall x y y. Lens (Neighbourhood x y) (Neighbourhood x y) y y
dataAtNode ((y -> Identity (WebLocally x y))
 -> Neighbourhood x y
 -> Identity (Neighbourhood x (WebLocally x y)))
-> WebLocally x y
-> Neighbourhood x y
-> Neighbourhood x (WebLocally x y)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LocalWebInfo :: forall x y.
x
-> y
-> WebNodeIdOffset
-> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
-> Metric x
-> Maybe (Needle' x)
-> WebLocally x y
LocalWebInfo {
                  _thisNodeCoord :: x
_thisNodeCoord = x
x
                , _thisNodeData :: y
_thisNodeData = y
y
                , _thisNodeId :: WebNodeIdOffset
_thisNodeId = WebNodeIdOffset
i
                , _nodeNeighbours :: [(WebNodeIdOffset, (Needle x, WebLocally x y))]
_nodeNeighbours = [ (WebNodeIdOffset
i WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+ WebNodeIdOffset
δi, (Needle x
δx, WebLocally x y
ngb))
                                    | WebNodeIdOffset
δi <- Vector WebNodeIdOffset -> [WebNodeIdOffset]
forall a. Unbox a => Vector a -> [a]
UArr.toList Vector WebNodeIdOffset
ngbs
                                    , let ngbNode :: NodeInWeb x y
ngbNode@(NodeInWeb (x
xn, Neighbourhood x y
_) [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
_)
                                              = WebNodeIdOffset -> NodeInWeb x y -> NodeInWeb x y
forall x y. WebNodeIdOffset -> NodeInWeb x y -> NodeInWeb x y
jumpNodeOffset WebNodeIdOffset
δi NodeInWeb x y
node
                                          Just Needle x
δx = x
xn x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. x
x
                                          Neighbourhood WebLocally x y
ngb Vector WebNodeIdOffset
_ Metric x
_ Maybe (Needle' x)
_ = NodeInWeb x y -> Neighbourhood x (WebLocally x y)
linkln NodeInWeb x y
ngbNode ]
                , _nodeLocalScalarProduct :: Metric x
_nodeLocalScalarProduct = Metric x
metric
                , _webBoundingPlane :: Maybe (Needle' x)
_webBoundingPlane = Maybe (Needle' x)
nBoundary
                }
        where i :: WebNodeIdOffset
i = ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
 -> WebNodeIdOffset -> WebNodeIdOffset)
-> WebNodeIdOffset
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebNodeIdOffset
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
(+) (WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset)
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> WebNodeIdOffset
-> WebNodeIdOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Shaded x (Neighbourhood x y), WebNodeIdOffset) -> WebNodeIdOffset
forall a b. (a, b) -> b
snd) WebNodeIdOffset
0 [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envis


instance Functor (WebLocally x) where
  fmap :: (a -> b) -> WebLocally x a -> WebLocally x b
fmap a -> b
f (LocalWebInfo x
co a
dt WebNodeIdOffset
id [(WebNodeIdOffset, (Needle x, WebLocally x a))]
ng Metric x
sp Maybe (Needle' x)
bn)
       = x
-> b
-> WebNodeIdOffset
-> [(WebNodeIdOffset, (Needle x, WebLocally x b))]
-> Metric x
-> Maybe (Needle' x)
-> WebLocally x b
forall x y.
x
-> y
-> WebNodeIdOffset
-> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
-> Metric x
-> Maybe (Needle' x)
-> WebLocally x y
LocalWebInfo x
co (a -> b
f a
dt) WebNodeIdOffset
id (((WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x b)))
-> [(WebNodeIdOffset, (Needle x, WebLocally x a))]
-> [(WebNodeIdOffset, (Needle x, WebLocally x b))]
forall a b. (a -> b) -> [a] -> [b]
map (((Needle x, WebLocally x a) -> (Needle x, WebLocally x b))
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Needle x, WebLocally x a) -> (Needle x, WebLocally x b))
 -> (WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x b)))
-> ((WebLocally x a -> WebLocally x b)
    -> (Needle x, WebLocally x a) -> (Needle x, WebLocally x b))
-> (WebLocally x a -> WebLocally x b)
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WebLocally x a -> WebLocally x b)
-> (Needle x, WebLocally x a) -> (Needle x, WebLocally x b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((WebLocally x a -> WebLocally x b)
 -> (WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x b)))
-> (WebLocally x a -> WebLocally x b)
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x b))
forall a b. (a -> b) -> a -> b
$ (a -> b) -> WebLocally x a -> WebLocally x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [(WebNodeIdOffset, (Needle x, WebLocally x a))]
ng) Metric x
sp Maybe (Needle' x)
bn
instance WithField ℝ Manifold x => Comonad (WebLocally x) where
  extract :: WebLocally x a -> a
extract = WebLocally x a -> a
forall x y. WebLocally x y -> y
_thisNodeData
  extend :: (WebLocally x a -> b) -> WebLocally x a -> WebLocally x b
extend WebLocally x a -> b
f this :: WebLocally x a
this@(LocalWebInfo x
co a
_ WebNodeIdOffset
id [(WebNodeIdOffset, (Needle x, WebLocally x a))]
ng Metric x
sp Maybe (Needle' x)
bn)
      = x
-> b
-> WebNodeIdOffset
-> [(WebNodeIdOffset, (Needle x, WebLocally x b))]
-> Metric x
-> Maybe (Needle' x)
-> WebLocally x b
forall x y.
x
-> y
-> WebNodeIdOffset
-> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
-> Metric x
-> Maybe (Needle' x)
-> WebLocally x y
LocalWebInfo x
co (WebLocally x a -> b
f WebLocally x a
this) WebNodeIdOffset
id (((WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x b)))
-> [(WebNodeIdOffset, (Needle x, WebLocally x a))]
-> [(WebNodeIdOffset, (Needle x, WebLocally x b))]
forall a b. (a -> b) -> [a] -> [b]
map (((Needle x, WebLocally x a) -> (Needle x, WebLocally x b))
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x b))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Needle x, WebLocally x a) -> (Needle x, WebLocally x b))
 -> (WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x b)))
-> ((WebLocally x a -> WebLocally x b)
    -> (Needle x, WebLocally x a) -> (Needle x, WebLocally x b))
-> (WebLocally x a -> WebLocally x b)
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WebLocally x a -> WebLocally x b)
-> (Needle x, WebLocally x a) -> (Needle x, WebLocally x b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((WebLocally x a -> WebLocally x b)
 -> (WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x b)))
-> (WebLocally x a -> WebLocally x b)
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x b))
forall a b. (a -> b) -> a -> b
$ (WebLocally x a -> b) -> WebLocally x a -> WebLocally x b
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend WebLocally x a -> b
f) [(WebNodeIdOffset, (Needle x, WebLocally x a))]
ng) Metric x
sp Maybe (Needle' x)
bn
  duplicate :: WebLocally x a -> WebLocally x (WebLocally x a)
duplicate this :: WebLocally x a
this@(LocalWebInfo x
co a
_ WebNodeIdOffset
id [(WebNodeIdOffset, (Needle x, WebLocally x a))]
ng Metric x
sp Maybe (Needle' x)
bn)
      = x
-> WebLocally x a
-> WebNodeIdOffset
-> [(WebNodeIdOffset, (Needle x, WebLocally x (WebLocally x a)))]
-> Metric x
-> Maybe (Needle' x)
-> WebLocally x (WebLocally x a)
forall x y.
x
-> y
-> WebNodeIdOffset
-> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
-> Metric x
-> Maybe (Needle' x)
-> WebLocally x y
LocalWebInfo x
co WebLocally x a
this WebNodeIdOffset
id (((WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x (WebLocally x a))))
-> [(WebNodeIdOffset, (Needle x, WebLocally x a))]
-> [(WebNodeIdOffset, (Needle x, WebLocally x (WebLocally x a)))]
forall a b. (a -> b) -> [a] -> [b]
map (((Needle x, WebLocally x a)
 -> (Needle x, WebLocally x (WebLocally x a)))
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x (WebLocally x a)))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (((Needle x, WebLocally x a)
  -> (Needle x, WebLocally x (WebLocally x a)))
 -> (WebNodeIdOffset, (Needle x, WebLocally x a))
 -> (WebNodeIdOffset, (Needle x, WebLocally x (WebLocally x a))))
-> ((Needle x, WebLocally x a)
    -> (Needle x, WebLocally x (WebLocally x a)))
-> (WebNodeIdOffset, (Needle x, WebLocally x a))
-> (WebNodeIdOffset, (Needle x, WebLocally x (WebLocally x a)))
forall a b. (a -> b) -> a -> b
$ (WebLocally x a -> WebLocally x (WebLocally x a))
-> (Needle x, WebLocally x a)
-> (Needle x, WebLocally x (WebLocally x a))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second WebLocally x a -> WebLocally x (WebLocally x a)
forall (w :: * -> *) a. Comonad w => w a -> w (w a)
duplicate) [(WebNodeIdOffset, (Needle x, WebLocally x a))]
ng) Metric x
sp Maybe (Needle' x)
bn

-- ^ 'fmap' from the co-Kleisli category of 'WebLocally'.
localFmapWeb :: WithField ℝ Manifold x
                => (WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb :: (WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb WebLocally x y -> z
f = PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> (PointsWeb x (WebLocally x y) -> PointsWeb x z)
-> PointsWeb x y
-> PointsWeb x z
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (WebLocally x y -> z)
-> PointsWeb x (WebLocally x y) -> PointsWeb x z
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WebLocally x y -> z
f


tweakWebGeometry :: (WithField ℝ Manifold x, SimpleSpace (Needle x))
         => MetricChoice x -> (WebLocally x y -> [WebNodeId])
                        -> PointsWeb x y -> PointsWeb x y
tweakWebGeometry :: MetricChoice x
-> (WebLocally x y -> [WebNodeIdOffset])
-> PointsWeb x y
-> PointsWeb x y
tweakWebGeometry MetricChoice x
metricf WebLocally x y -> [WebNodeIdOffset]
reknit = PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> (PointsWeb x (WebLocally x y) -> PointsWeb x y)
-> PointsWeb x y
-> PointsWeb x y
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (NodeInWeb x (WebLocally x y) -> Neighbourhood x y)
-> PointsWeb x (WebLocally x y) -> PointsWeb x y
forall x y z.
(NodeInWeb x y -> Neighbourhood x z)
-> PointsWeb x y -> PointsWeb x z
fmapNodesInEnvi((NodeInWeb x (WebLocally x y) -> Neighbourhood x y)
 -> PointsWeb x (WebLocally x y) -> PointsWeb x y)
-> (NodeInWeb x (WebLocally x y) -> Neighbourhood x y)
-> PointsWeb x (WebLocally x y)
-> PointsWeb x y
forall a. a -> a
`id`
         \(NodeInWeb (x
x₀, (Neighbourhood WebLocally x y
info Vector WebNodeIdOffset
_ Metric x
lm Maybe (Needle' x)
bound)) [(Shaded x (Neighbourhood x (WebLocally x y)), WebNodeIdOffset)]
_)
             -> let lm' :: Metric x
lm' = MetricChoice x
metricf MetricChoice x
-> (Norm (Needle' x) -> Shade x) -> Norm (Needle' x) -> Metric x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Norm (Needle' x) -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
x₀ (Norm (Needle' x) -> Metric x) -> Norm (Needle' x) -> Metric x
forall a b. (a -> b) -> a -> b
$ Metric x -> Norm (Needle' x)
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric x
lm
                in y
-> Vector WebNodeIdOffset
-> Metric x
-> Maybe (Needle' x)
-> Neighbourhood x y
forall x y.
y
-> Vector WebNodeIdOffset
-> Metric x
-> Maybe (Needle' x)
-> Neighbourhood x y
Neighbourhood (WebLocally x y
infoWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData)
                            ([WebNodeIdOffset] -> Vector WebNodeIdOffset
forall a. Unbox a => [a] -> Vector a
UArr.fromList ([WebNodeIdOffset] -> Vector WebNodeIdOffset)
-> ([WebNodeIdOffset] -> [WebNodeIdOffset])
-> [WebNodeIdOffset]
-> Vector WebNodeIdOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WebNodeIdOffset -> WebNodeIdOffset)
-> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a b. (a -> b) -> [a] -> [b]
map (WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
subtract (WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset)
-> WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a b. (a -> b) -> a -> b
$ WebLocally x y
infoWebLocally x y
-> Getting WebNodeIdOffset (WebLocally x y) WebNodeIdOffset
-> WebNodeIdOffset
forall s a. s -> Getting a s a -> a
^.Getting WebNodeIdOffset (WebLocally x y) WebNodeIdOffset
forall x y. Lens' (WebLocally x y) WebNodeIdOffset
thisNodeId)
                                     ([WebNodeIdOffset] -> Vector WebNodeIdOffset)
-> [WebNodeIdOffset] -> Vector WebNodeIdOffset
forall a b. (a -> b) -> a -> b
$ WebLocally x y -> [WebNodeIdOffset]
reknit WebLocally x y
info)
                            Metric x
lm' Maybe (Needle' x)
bound


bidirectionaliseWebLinks :: ∀ x y . PointsWeb x y -> PointsWeb x y
bidirectionaliseWebLinks :: PointsWeb x y -> PointsWeb x y
bidirectionaliseWebLinks web :: PointsWeb x y
web@(PointsWeb Shaded x (Neighbourhood x y)
wnrsrc) = (NodeInWeb x y -> Neighbourhood x y)
-> PointsWeb x y -> PointsWeb x y
forall x y z.
(NodeInWeb x y -> Neighbourhood x z)
-> PointsWeb x y -> PointsWeb x z
fmapNodesInEnvi NodeInWeb x y -> Neighbourhood x y
bdse PointsWeb x y
web
 where bdse :: NodeInWeb x y -> Neighbourhood x y
       bdse :: NodeInWeb x y -> Neighbourhood x y
bdse (NodeInWeb (x
x, Neighbourhood y
y Vector WebNodeIdOffset
outgn Metric x
lm Maybe (Needle' x)
bound) [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envis)
                = y
-> Vector WebNodeIdOffset
-> Metric x
-> Maybe (Needle' x)
-> Neighbourhood x y
forall x y.
y
-> Vector WebNodeIdOffset
-> Metric x
-> Maybe (Needle' x)
-> Neighbourhood x y
Neighbourhood y
y ([WebNodeIdOffset] -> Vector WebNodeIdOffset
forall a. Unbox a => [a] -> Vector a
UArr.fromList ([WebNodeIdOffset] -> Vector WebNodeIdOffset)
-> ([WebNodeIdOffset] -> [WebNodeIdOffset])
-> [WebNodeIdOffset]
-> Vector WebNodeIdOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. FastNub a => [a] -> [a]
fastNub ([WebNodeIdOffset] -> Vector WebNodeIdOffset)
-> [WebNodeIdOffset] -> Vector WebNodeIdOffset
forall a b. (a -> b) -> a -> b
$ [WebNodeIdOffset]
incmn [WebNodeIdOffset] -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. [a] -> [a] -> [a]
++ Vector WebNodeIdOffset -> [WebNodeIdOffset]
forall a. Unbox a => Vector a -> [a]
UArr.toList Vector WebNodeIdOffset
outgn)
                      Metric x
lm Maybe (Needle' x)
bound
        where i :: WebNodeIdOffset
i = ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
 -> WebNodeIdOffset -> WebNodeIdOffset)
-> WebNodeIdOffset
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebNodeIdOffset
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
(+) (WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset)
-> ((Shaded x (Neighbourhood x y), WebNodeIdOffset)
    -> WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> WebNodeIdOffset
-> WebNodeIdOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Shaded x (Neighbourhood x y), WebNodeIdOffset) -> WebNodeIdOffset
forall a b. (a, b) -> b
snd) WebNodeIdOffset
0 [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envis
              incmn :: [WebNodeIdOffset]
incmn = case WebNodeIdOffset
i WebNodeIdOffset
-> Map WebNodeIdOffset [WebNodeIdOffset] -> Maybe [WebNodeIdOffset]
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map WebNodeIdOffset [WebNodeIdOffset]
incoming of
                Just [WebNodeIdOffset]
o -> WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
subtract WebNodeIdOffset
i(WebNodeIdOffset -> WebNodeIdOffset)
-> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[WebNodeIdOffset]
o
                Maybe [WebNodeIdOffset]
Nothing -> []
       incoming :: Map WebNodeIdOffset [WebNodeIdOffset]
incoming = ([WebNodeIdOffset] -> [WebNodeIdOffset] -> [WebNodeIdOffset])
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
-> Map WebNodeIdOffset [WebNodeIdOffset]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [WebNodeIdOffset] -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. [a] -> [a] -> [a]
(++) ([(WebNodeIdOffset, [WebNodeIdOffset])]
 -> Map WebNodeIdOffset [WebNodeIdOffset])
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
-> Map WebNodeIdOffset [WebNodeIdOffset]
forall a b. (a -> b) -> a -> b
$ ((WebNodeIdOffset,
  [(WebNodeIdOffset, [WebNodeIdOffset])]
  -> [(WebNodeIdOffset, [WebNodeIdOffset])])
 -> Neighbourhood x y
 -> (WebNodeIdOffset,
     [(WebNodeIdOffset, [WebNodeIdOffset])]
     -> [(WebNodeIdOffset, [WebNodeIdOffset])]))
-> (WebNodeIdOffset,
    [(WebNodeIdOffset, [WebNodeIdOffset])]
    -> [(WebNodeIdOffset, [WebNodeIdOffset])])
-> Shaded x (Neighbourhood x y)
-> (WebNodeIdOffset,
    [(WebNodeIdOffset, [WebNodeIdOffset])]
    -> [(WebNodeIdOffset, [WebNodeIdOffset])])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Hask.foldl'
                   (\(WebNodeIdOffset
i,[(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
acc) (Neighbourhood y
_ Vector WebNodeIdOffset
outgn Metric x
_ Maybe (Needle' x)
_)
                        -> (WebNodeIdOffset
iWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
1, [(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
acc ([(WebNodeIdOffset, [WebNodeIdOffset])]
 -> [(WebNodeIdOffset, [WebNodeIdOffset])])
-> ([(WebNodeIdOffset, [WebNodeIdOffset])]
    -> [(WebNodeIdOffset, [WebNodeIdOffset])])
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((,[WebNodeIdOffset
i])(WebNodeIdOffset -> (WebNodeIdOffset, [WebNodeIdOffset]))
-> (WebNodeIdOffset -> WebNodeIdOffset)
-> WebNodeIdOffset
-> (WebNodeIdOffset, [WebNodeIdOffset])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
i)(WebNodeIdOffset -> (WebNodeIdOffset, [WebNodeIdOffset]))
-> [WebNodeIdOffset] -> [(WebNodeIdOffset, [WebNodeIdOffset])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>Vector WebNodeIdOffset -> [WebNodeIdOffset]
forall a. Unbox a => Vector a -> [a]
UArr.toList Vector WebNodeIdOffset
outgn)[(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
forall a. [a] -> [a] -> [a]
++)) )
                     (WebNodeIdOffset
0,[(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
forall a. a -> a
id) Shaded x (Neighbourhood x y)
wnrsrc (WebNodeIdOffset,
 [(WebNodeIdOffset, [WebNodeIdOffset])]
 -> [(WebNodeIdOffset, [WebNodeIdOffset])])
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
forall a b. (a, b) -> b
`snd` []



pumpHalfspace :: ∀ v . (SimpleSpace v, Scalar v ~ ℝ)
     => Norm v
     -> v                    -- ^ A vector @v@ for which we want @dv<.>^v ≥ 0@.
     -> (DualVector v, [v])  -- ^ A plane @dv₀@ and some vectors @ws@ with @dv₀<.>^w ≥ 0@,
                             --   which should also fulfill @dv<.>^w ≥ 0@.
     -> Maybe (DualVector v) -- ^ The plane @dv@ fulfilling these properties, if possible.
pumpHalfspace :: Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
pumpHalfspace Norm v
rieM v
v (DualVector v
prevPlane, [v]
ws) = case DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
 DualSpaceWitness v
DualSpaceWitness -> 
  let    ϑs :: [ℝ]
ϑs = (v -> ℝ) -> [v] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\v
u -> let x :: Scalar v
x = DualVector v
prevPlaneDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
u
                              y :: Scalar v
y = DualVector v
thisPlaneDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
u
                          in ℝ -> ℝ -> ℝ
forall a. RealFloat a => a -> a -> a
atan2 (ℝ
Scalar v
xℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
Scalar v
y) (ℝ
Scalar v
xℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
Scalar v
y)) ([v] -> [ℝ]) -> [v] -> [ℝ]
forall a b. (a -> b) -> a -> b
$ v
vv -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
ws
          -- ϑ = 0 means we are mid-between the planes, ϑ > π/2 means we are past
          -- `thisPlane`, ϑ < -π/2 we are past `prevPlane`. In other words, positive ϑ
          -- mean we should mix in more of `prevPlane`, negative more of `thisPlane`.
         [ℝ
ϑmin, ℝ
ϑmax] = [[ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum, [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum] [[ℝ] -> ℝ] -> [[ℝ]] -> [ℝ]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[ℝ]
ϑs]
         δϑ :: ℝ
δϑ = ℝ
ϑmax ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
ϑmin
         vNudged :: v
vNudged = v
v v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ [v] -> v
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV ((v -> ℝ -> v) -> [v] -> [ℝ] -> [v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith v -> ℝ -> v
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
(^*) [v]
ws [ℝ]
smallPseudorandSeq)
                    -- Introduce a tiny contribution from the other vectors to avoid
                    -- a degenerate 1D-situation in which @thisPlane ∝ prevPlane@.
         dv :: DualVector v
dv = Norm v
rieMNorm v -> v -> DualVector v
forall v. LSpace v => Norm v -> v -> DualVector v
<$|v
vNudged
         thisPlane :: DualVector v
thisPlane = DualVector v
dv DualVector v -> ℝ -> DualVector v
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (DualVector v
dvDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
vNudged)
         cas :: a -> a
cas a
ϑ = a -> a
forall a. Floating a => a -> a
cos (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
ϑ a -> a -> a
forall a. Num a => a -> a -> a
- a
forall a. Floating a => a
pia -> a -> a
forall a. Fractional a => a -> a -> a
/a
4
  in if ℝ
δϑ ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<= ℝ
forall a. Floating a => a
pi then DualVector v -> Maybe (DualVector v)
forall a. a -> Maybe a
Just (DualVector v -> Maybe (DualVector v))
-> DualVector v -> Maybe (DualVector v)
forall a b. (a -> b) -> a -> b
$ let ϑbest :: ℝ
ϑbest = ℝ
ϑmin ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
δϑℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2
                             in DualVector v
prevPlaneDualVector v -> ℝ -> DualVector v
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*ℝ -> ℝ
forall a. Floating a => a -> a
cas ℝ
ϑbest DualVector v -> DualVector v -> DualVector v
forall v. AdditiveGroup v => v -> v -> v
^+^ DualVector v
thisPlaneDualVector v -> ℝ -> DualVector v
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*ℝ -> ℝ
forall a. Floating a => a -> a
cas (-ℝ
ϑbest)
                 else Maybe (DualVector v)
forall a. Maybe a
Nothing

smallPseudorandSeq :: [ℝ]
smallPseudorandSeq :: [ℝ]
smallPseudorandSeq = (ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
2ℝ -> Integer -> ℝ
forall a b. (Fractional a, Integral b) => a -> b -> a
^^(-Integer
45)) (ℝ -> ℝ) -> (WebNodeIdOffset -> ℝ) -> WebNodeIdOffset -> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebNodeIdOffset -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WebNodeIdOffset -> ℝ) -> [WebNodeIdOffset] -> [ℝ]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebNodeIdOffset -> [WebNodeIdOffset]
lcg WebNodeIdOffset
293633
 where lcg :: WebNodeIdOffset -> [WebNodeIdOffset]
lcg WebNodeIdOffset
x = WebNodeIdOffset
x WebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
: WebNodeIdOffset -> [WebNodeIdOffset]
lcg ((WebNodeIdOffset
aWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
*WebNodeIdOffset
x)WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Integral a => a -> a -> a
`mod`WebNodeIdOffset
m)
       m :: WebNodeIdOffset
m = WebNodeIdOffset
2WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
31 WebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
- WebNodeIdOffset
1
       a :: WebNodeIdOffset
a = WebNodeIdOffset
963345    :: Int  -- revised Park-Miller

data LinkingBadness r = LinkingBadness
    { LinkingBadness r -> r
gatherDirectionsBadness :: !r -- ^ Prefer picking neighbours at right angles
                                    --   to the currently-explored-boundary. This
                                    --   is needed while we still have to link to
                                    --   points in different spatial directions.
    , LinkingBadness r -> r
closeSystemBadness :: !r      -- ^ Prefer points directly opposed to the
                                    --   current boundary. This is useful when the
                                    --   system of directions is already complete
                                    --   and we want a nicely symmetric “ball” of
                                    --   neighbours around each point.
    } deriving (a -> LinkingBadness b -> LinkingBadness a
(a -> b) -> LinkingBadness a -> LinkingBadness b
(forall a b. (a -> b) -> LinkingBadness a -> LinkingBadness b)
-> (forall a b. a -> LinkingBadness b -> LinkingBadness a)
-> Functor LinkingBadness
forall a b. a -> LinkingBadness b -> LinkingBadness a
forall a b. (a -> b) -> LinkingBadness a -> LinkingBadness b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> LinkingBadness b -> LinkingBadness a
$c<$ :: forall a b. a -> LinkingBadness b -> LinkingBadness a
fmap :: (a -> b) -> LinkingBadness a -> LinkingBadness b
$cfmap :: forall a b. (a -> b) -> LinkingBadness a -> LinkingBadness b
Functor)

linkingUndesirability :: ℝ -- ^ Absolute-square distance (euclidean norm squared)
                      -> ℝ -- ^ Directional distance (distance from wall containing
                           --   all already known neighbours)
                      -> LinkingBadness ℝ
                           -- ^ “Badness” of this point as the next neighbour to link to.
                           --   In gatherDirections mode this is large if
                           --   the point is far away, but also if it is
                           --   right normal to the wall. The reason we punish this is that
                           --   adding two points directly opposed to each other would lead
                           --   to an ill-defined wall orientation, i.e. wrong normals
                           --   on the web boundary.
linkingUndesirability :: ℝ -> ℝ -> LinkingBadness ℝ
linkingUndesirability ℝ
distSq ℝ
wallDist
  | ℝ
wallDist ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>= ℝ
0  = LinkingBadness :: forall r. r -> r -> LinkingBadness r
LinkingBadness
   { gatherDirectionsBadness :: ℝ
gatherDirectionsBadness = ℝ
distSqℝ -> WebNodeIdOffset -> ℝ
forall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2 ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ -> ℝ -> ℝ
forall a. Ord a => a -> a -> a
max ℝ
0 (ℝ
distSqℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
wallDistℝ -> WebNodeIdOffset -> ℝ
forall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2)
   , closeSystemBadness :: ℝ
closeSystemBadness = ℝ
distSq ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
wallDistℝ -> WebNodeIdOffset -> ℝ
forall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2
   }
  | Bool
otherwise     = ℝ -> ℝ -> LinkingBadness ℝ
forall r. r -> r -> LinkingBadness r
LinkingBadness (ℝ
1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
0) (ℝ
1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
0) 


bestNeighbours :: ∀ i v . (SimpleSpace v, Scalar v ~ ℝ)
                => Norm v -> [(i,v)] -> ([i], Maybe (DualVector v))
bestNeighbours :: Norm v -> [(i, v)] -> ([i], Maybe (DualVector v))
bestNeighbours Norm v
lm' = ([(i, v)] -> [i])
-> ([(i, v)], Maybe (DualVector v)) -> ([i], Maybe (DualVector v))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (((i, v) -> i) -> [(i, v)] -> [i]
forall a b. (a -> b) -> [a] -> [b]
map (i, v) -> i
forall a b. (a, b) -> a
fst) (([(i, v)], Maybe (DualVector v)) -> ([i], Maybe (DualVector v)))
-> ([(i, v)] -> ([(i, v)], Maybe (DualVector v)))
-> [(i, v)]
-> ([i], Maybe (DualVector v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Norm v -> [(i, v)] -> ([(i, v)], Maybe (DualVector v))
forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> [(i, v)] -> ([(i, v)], Maybe (DualVector v))
bestNeighbours' Norm v
lm'

bestNeighbours' :: ∀ i v . (SimpleSpace v, Scalar v ~ ℝ)
                => Norm v -> [(i,v)] -> ([(i,v)], Maybe (DualVector v))
bestNeighbours' :: Norm v -> [(i, v)] -> ([(i, v)], Maybe (DualVector v))
bestNeighbours' Norm v
lm' = ((i, v) -> Maybe ℝ) -> [(i, v)] -> Maybe ((i, v), [(i, v)])
forall b a. Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn (\(i
_,v
v) -> ℝ -> Maybe ℝ
forall a. a -> Maybe a
Just (ℝ -> Maybe ℝ) -> ℝ -> Maybe ℝ
forall a b. (a -> b) -> a -> b
$ Norm v
lm'Norm v -> v -> Scalar v
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|v
v) ([(i, v)] -> Maybe ((i, v), [(i, v)]))
-> (Maybe ((i, v), [(i, v)]) -> ([(i, v)], Maybe (DualVector v)))
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
    \(Just ((i
c₀i,v
c₀δx), [(i, v)]
candidates)) -> case DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
     DualSpaceWitness v
DualSpaceWitness ->
       let wall₀ :: DualVector v
wall₀ = DualVector v
w₀ DualVector v -> ℝ -> DualVector v
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (Variance v
lmVariance v -> DualVector v -> Scalar (DualVector v)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|DualVector v
w₀) -- sqrt (w₀<.>^c₀δx)
            where w₀ :: DualVector v
w₀ = Norm v
lm'Norm v -> v -> DualVector v
forall v. LSpace v => Norm v -> v -> DualVector v
<$|v
c₀δx
       in ([(i, v)] -> [(i, v)])
-> ([(i, v)], Maybe (DualVector v))
-> ([(i, v)], Maybe (DualVector v))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((i
c₀i,v
c₀δx)(i, v) -> [(i, v)] -> [(i, v)]
forall a. a -> [a] -> [a]
:)
              (([(i, v)], Maybe (DualVector v))
 -> ([(i, v)], Maybe (DualVector v)))
-> ([(i, v)], Maybe (DualVector v))
-> ([(i, v)], Maybe (DualVector v))
forall a b. (a -> b) -> a -> b
$ Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
gatherGoodNeighbours Norm v
lm' Variance v
lm DualVector v
wall₀ [v
c₀δx] [] [(i, v)]
candidates
 where lm :: Variance v
lm = Norm v -> Variance v
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Norm v
lm' :: Variance v

gatherGoodNeighbours :: ∀ i v . (SimpleSpace v, Scalar v ~ ℝ)
            => Norm v -> Variance v
               -> DualVector v -> [v] -> [(i,v)]
                    -> [(i, v)] -> ([(i,v)], Maybe (DualVector v))
gatherGoodNeighbours :: Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
gatherGoodNeighbours Norm v
lm' Variance v
lm DualVector v
wall [v]
prev [(i, v)]
preserved [(i, v)]
cs
 | WebNodeIdOffset
dimension WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Eq a => a -> a -> Bool
== WebNodeIdOffset
1  = case ((i, v) -> Maybe ℝ) -> [(i, v)] -> Maybe ((i, v), [(i, v)])
forall b a. Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn
                       (\(i
_,v
δx) -> do
                          let wallDist :: ℝ
wallDist = - DualVector v
wallDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δx
                          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ℝ
wallDist ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0)
                          ℝ -> Maybe ℝ
forall (m :: * -> *) a. Monad m => a -> m a
return ℝ
wallDist
                       ) [(i, v)]
cs of
     Just ((i, v)
r, [(i, v)]
_) -> ([(i, v)
r], Maybe (DualVector v)
forall a. Maybe a
Nothing)
     Maybe ((i, v), [(i, v)])
Nothing -> ([], DualVector v -> Maybe (DualVector v)
forall a. a -> Maybe a
Just DualVector v
wall)
 where dimension :: WebNodeIdOffset
dimension = SubBasis v -> WebNodeIdOffset
forall v. FiniteDimensional v => SubBasis v -> WebNodeIdOffset
subbasisDimension (SubBasis v
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis v)
gatherGoodNeighbours Norm v
lm' Variance v
lm DualVector v
wall [v]
prev [(i, v)]
preserved [(i, v)]
cs
  = case DualSpaceWitness v
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
    DualSpaceWitness v
DualSpaceWitness ->
     case ((i, v) -> Maybe ℝ) -> [(i, v)] -> Maybe ((i, v), [(i, v)])
forall b a. Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn
            (\(i
_,v
δx) -> do
                let wallDist :: ℝ
wallDist = - DualVector v
wallDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δx
                    dx :: DualVector v
dx = Norm v
lm' Norm v -> v -> DualVector v
forall v. LSpace v => Norm v -> v -> DualVector v
<$| v
δx
                    distSq :: Scalar v
distSq = DualVector v
dxDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δx
                    βmin :: ℝ
βmin = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- (DualVector v
dxDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δxo) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ -> ℝ
forall a. Floating a => a -> a
sqrt (ℝ
Scalar v
distSqℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
distSqo)
                                            -- β behaves basically like ϑ², where ϑ is
                                            -- the angle between two neighbour candidates.
                                   | (δxo, distSqo) <- [(v, ℝ)]
prevWMag ]
                Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ℝ
wallDist ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>= ℝ
0 Bool -> Bool -> Bool
&& ℝ
βmin ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
1e-3)
                ℝ -> Maybe ℝ
forall (m :: * -> *) a. Monad m => a -> m a
return (ℝ -> Maybe ℝ) -> ℝ -> Maybe ℝ
forall a b. (a -> b) -> a -> b
$ LinkingBadness ℝ -> ℝ
forall r. LinkingBadness r -> r
gatherDirectionsBadness
                           (ℝ -> ℝ -> LinkingBadness ℝ
linkingUndesirability ℝ
Scalar v
distSq ℝ
wallDist) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
βmin )
            [(i, v)]
cs of
         Just ((i
i,v
δx), [(i, v)]
cs')
           | Just DualVector v
wall' <- Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
forall v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
pumpHalfspace Norm v
lm' v
δx (DualVector v
wall,[v]
prev)
                          -> ([(i, v)] -> [(i, v)])
-> ([(i, v)], Maybe (DualVector v))
-> ([(i, v)], Maybe (DualVector v))
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((i
i,v
δx)(i, v) -> [(i, v)] -> [(i, v)]
forall a. a -> [a] -> [a]
:)
                       (([(i, v)], Maybe (DualVector v))
 -> ([(i, v)], Maybe (DualVector v)))
-> ([(i, v)], Maybe (DualVector v))
-> ([(i, v)], Maybe (DualVector v))
forall a b. (a -> b) -> a -> b
$ Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
gatherGoodNeighbours Norm v
lm' Variance v
lm (DualVector v
wall'DualVector v -> ℝ -> DualVector v
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/(Variance v
lmVariance v -> DualVector v -> Scalar (DualVector v)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|DualVector v
wall'))
                               (v
δxv -> [v] -> [v]
forall a. a -> [a] -> [a]
:[v]
prev) [] ([(i, v)]
preserved[(i, v)] -> [(i, v)] -> [(i, v)]
forall a. [a] -> [a] -> [a]
++[(i, v)]
cs')
           | ((i, v)
_:[(i, v)]
_)<-[(i, v)]
cs'  -> Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
gatherGoodNeighbours Norm v
lm' Variance v
lm DualVector v
wall
                               [v]
prev ((i
i,v
δx)(i, v) -> [(i, v)] -> [(i, v)]
forall a. a -> [a] -> [a]
:[(i, v)]
preserved) [(i, v)]
cs'
         Maybe ((i, v), [(i, v)])
_ -> let closeSys :: [(i, v)] -> ([(i, v)], Maybe (DualVector v))
closeSys ((i
i,v
δx):[(i, v)]
_)
                    | Maybe (DualVector v)
Nothing <- Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
forall v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
pumpHalfspace Norm v
lm' v
δx (DualVector v
wall,[v]
prev)
                        = ([(i
i,v
δx)], Maybe (DualVector v)
forall a. Maybe a
Nothing)
                  closeSys ((i, v)
_:[(i, v)]
cs'') = [(i, v)] -> ([(i, v)], Maybe (DualVector v))
closeSys [(i, v)]
cs''
                  closeSys []
                   | [((i, v), LinkingBadness ℝ)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((i, v), LinkingBadness ℝ)]
closureCandidates  = ([], DualVector v -> Maybe (DualVector v)
forall a. a -> Maybe a
Just DualVector v
wall)
                   | Bool
otherwise  = ([], Maybe (DualVector v)
forall a. Maybe a
Nothing)
                  closureCandidates :: [((i, v), LinkingBadness ℝ)]
closureCandidates = 
                   [ ((i
i,v
δx), LinkingBadness ℝ
badness)
                   | (i
i,v
δx) <- [(i, v)]
preserved[(i, v)] -> [(i, v)] -> [(i, v)]
forall a. [a] -> [a] -> [a]
++[(i, v)]
cs
                   , let wallDist :: ℝ
wallDist = - DualVector v
wallDualVector v -> v -> Scalar v
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δx
                         distSq :: Scalar v
distSq = Norm v -> v -> Scalar v
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Norm v
lm' v
δx
                   , ℝ
wallDist ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0
                   , ℝ
wallDistℝ -> WebNodeIdOffset -> ℝ
forall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2 ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
1e-3 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
Scalar v
distSq
                   , let badness :: LinkingBadness ℝ
badness = ℝ -> ℝ -> LinkingBadness ℝ
linkingUndesirability ℝ
Scalar v
distSq ℝ
wallDist ]
              in [(i, v)] -> ([(i, v)], Maybe (DualVector v))
closeSys ([(i, v)] -> ([(i, v)], Maybe (DualVector v)))
-> ([((i, v), LinkingBadness ℝ)] -> [(i, v)])
-> [((i, v), LinkingBadness ℝ)]
-> ([(i, v)], Maybe (DualVector v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((i, v), LinkingBadness ℝ) -> (i, v))
-> [((i, v), LinkingBadness ℝ)] -> [(i, v)]
forall a b. (a -> b) -> [a] -> [b]
map ((i, v), LinkingBadness ℝ) -> (i, v)
forall a b. (a, b) -> a
fst ([((i, v), LinkingBadness ℝ)] -> ([(i, v)], Maybe (DualVector v)))
-> [((i, v), LinkingBadness ℝ)] -> ([(i, v)], Maybe (DualVector v))
forall a b. (a -> b) -> a -> b
$
                   (((i, v), LinkingBadness ℝ)
 -> ((i, v), LinkingBadness ℝ) -> Ordering)
-> [((i, v), LinkingBadness ℝ)] -> [((i, v), LinkingBadness ℝ)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((((i, v), LinkingBadness ℝ) -> ℝ)
-> ((i, v), LinkingBadness ℝ)
-> ((i, v), LinkingBadness ℝ)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((((i, v), LinkingBadness ℝ) -> ℝ)
 -> ((i, v), LinkingBadness ℝ)
 -> ((i, v), LinkingBadness ℝ)
 -> Ordering)
-> (((i, v), LinkingBadness ℝ) -> ℝ)
-> ((i, v), LinkingBadness ℝ)
-> ((i, v), LinkingBadness ℝ)
-> Ordering
forall a b. (a -> b) -> a -> b
$ LinkingBadness ℝ -> ℝ
forall r. LinkingBadness r -> r
closeSystemBadness (LinkingBadness ℝ -> ℝ)
-> (((i, v), LinkingBadness ℝ) -> LinkingBadness ℝ)
-> ((i, v), LinkingBadness ℝ)
-> ℝ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((i, v), LinkingBadness ℝ) -> LinkingBadness ℝ
forall a b. (a, b) -> b
snd) [((i, v), LinkingBadness ℝ)]
closureCandidates
 where prevWMag :: [(v, ℝ)]
prevWMag = (v -> (v, ℝ)) -> [v] -> [(v, ℝ)]
forall a b. (a -> b) -> [a] -> [b]
map (v -> v
forall a. a -> a
id (v -> v) -> (v -> ℝ) -> v -> (v, ℝ)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Norm v -> v -> Scalar v
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Norm v
lm') [v]
prev


extractSmallestOn :: Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn :: (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn a -> Maybe b
f = [(a, Maybe b)] -> Maybe (a, [a])
forall a a. Ord a => [(a, Maybe a)] -> Maybe (a, [a])
extract ([(a, Maybe b)] -> Maybe (a, [a]))
-> ([a] -> [(a, Maybe b)]) -> [a] -> Maybe (a, [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> (a, Maybe b)) -> [a] -> [(a, Maybe b)]
forall a b. (a -> b) -> [a] -> [b]
map (a -> a
forall a. a -> a
id (a -> a) -> (a -> Maybe b) -> a -> (a, Maybe b)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& a -> Maybe b
f)
 where extract :: [(a, Maybe a)] -> Maybe (a, [a])
extract [] = Maybe (a, [a])
forall a. Maybe a
Nothing
       extract ((a
x, Just a
o):[(a, Maybe a)]
cs) = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just ((a, [a]) -> Maybe (a, [a])) -> (a, [a]) -> Maybe (a, [a])
forall a b. (a -> b) -> a -> b
$ (a, a) -> [(a, Maybe a)] -> (a, [a])
forall a a. Ord a => (a, a) -> [(a, Maybe a)] -> (a, [a])
go (a
o,a
x) [(a, Maybe a)]
cs
       extract ((a
x, Maybe a
Nothing):[(a, Maybe a)]
cs) = ([a] -> [a]) -> (a, [a]) -> (a, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((a, [a]) -> (a, [a])) -> Maybe (a, [a]) -> Maybe (a, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, Maybe a)] -> Maybe (a, [a])
extract [(a, Maybe a)]
cs
       go :: (a, a) -> [(a, Maybe a)] -> (a, [a])
go (a
_,a
refx) [] = (a
refx, [])
       go (a
ref,a
refx) ((a
x, Just a
o):[(a, Maybe a)]
cs)
        | a
o a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
ref   = ([a] -> [a]) -> (a, [a]) -> (a, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
refxa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((a, [a]) -> (a, [a])) -> (a, [a]) -> (a, [a])
forall a b. (a -> b) -> a -> b
$ (a, a) -> [(a, Maybe a)] -> (a, [a])
go (a
o,a
x) [(a, Maybe a)]
cs
       go (a, a)
ref ((a
x, Maybe a
_):[(a, Maybe a)]
cs) = ([a] -> [a]) -> (a, [a]) -> (a, [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((a, [a]) -> (a, [a])) -> (a, [a]) -> (a, [a])
forall a b. (a -> b) -> a -> b
$ (a, a) -> [(a, Maybe a)] -> (a, [a])
go (a, a)
ref [(a, Maybe a)]
cs

type WNIPath = [WebNodeId]
type NodeSet = ℤSet.IntSet


pathsTowards :: ∀ x y . (WithField ℝ Manifold x, HasCallStack)
     => WebNodeId -> PointsWeb x y -> [[y]]
pathsTowards :: WebNodeIdOffset -> PointsWeb x y -> [[y]]
pathsTowards WebNodeIdOffset
target PointsWeb x y
web = Writer [[y]] (PointsWeb x y) -> [[y]]
forall w a. Writer w a -> w
execWriter (Writer [[y]] (PointsWeb x y) -> [[y]])
-> Writer [[y]] (PointsWeb x y) -> [[y]]
forall a b. (a -> b) -> a -> b
$ WebNodeIdOffset
-> (PathStep x y -> WriterT [y] Identity y)
-> (forall υ.
    WebLocally x y
    -> WriterT [y] Identity υ -> WriterT [[y]] Identity υ)
-> PointsWeb x y
-> Writer [[y]] (PointsWeb x y)
forall (f :: * -> *) (φ :: * -> *) x y.
(WithField ℝ Manifold x, Monad φ, Monad f, HasCallStack) =>
WebNodeIdOffset
-> (PathStep x y -> φ y)
-> (forall υ. WebLocally x y -> φ υ -> f υ)
-> PointsWeb x y
-> f (PointsWeb x y)
traversePathsTowards
       WebNodeIdOffset
target
       (\(PathStep WebLocally x y
_ WebLocally x y
y) -> [y] -> WriterT [y] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [WebLocally x y
yWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData] WriterT [y] Identity ()
-> WriterT [y] Identity y -> WriterT [y] Identity y
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> y -> WriterT [y] Identity y
forall (m :: * -> *) a. Monad m => a -> m a
return (WebLocally x y
yWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData))
       (\WebLocally x y
startNode (WriterT (Identity (ν, pathTrav)))
            -> [[y]] -> WriterT [[y]] Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [WebLocally x y
startNodeWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData y -> [y] -> [y]
forall a. a -> [a] -> [a]
: [y]
pathTrav] WriterT [[y]] Identity ()
-> WriterT [[y]] Identity υ -> WriterT [[y]] Identity υ
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> υ -> WriterT [[y]] Identity υ
forall (m :: * -> *) a. Monad m => a -> m a
return υ
ν)
       PointsWeb x y
web

traversePathInIWeb :: ∀ φ x y . (WithField ℝ Manifold x, Monad φ, HasCallStack)
     => [WebNodeId] -> (PathStep x y -> φ y)
              -> PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y))
traversePathInIWeb :: [WebNodeIdOffset]
-> (PathStep x y -> φ y)
-> PointsWeb x (WebLocally x y)
-> φ (PointsWeb x (WebLocally x y))
traversePathInIWeb [WebNodeIdOffset]
path PathStep x y -> φ y
f = [WebNodeIdOffset]
-> PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y))
go [WebNodeIdOffset]
path
 where go :: [WebNodeIdOffset]
-> PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y))
go [] PointsWeb x (WebLocally x y)
web = PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y))
forall (f :: * -> *) a. Applicative f => a -> f a
pure PointsWeb x (WebLocally x y)
web
       go [WebNodeIdOffset
_] PointsWeb x (WebLocally x y)
web = PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y))
forall (f :: * -> *) a. Applicative f => a -> f a
pure PointsWeb x (WebLocally x y)
web
       go (WebNodeIdOffset
i₀:WebNodeIdOffset
i₁:[WebNodeIdOffset]
is) PointsWeb x (WebLocally x y)
web = do
                   y
y' <- PathStep x y -> φ y
f (PathStep x y -> φ y) -> PathStep x y -> φ y
forall a b. (a -> b) -> a -> b
$ WebLocally x y -> WebLocally x y -> PathStep x y
forall x y. WebLocally x y -> WebLocally x y -> PathStep x y
PathStep WebLocally x y
p₀ WebLocally x y
p₁
                   let Right (Identity Shaded x (Neighbourhood x (WebLocally x y))
web')
                         = WebNodeIdOffset
-> (Neighbourhood x (WebLocally x y)
    -> Identity (Neighbourhood x (WebLocally x y)))
-> Shaded x (Neighbourhood x (WebLocally x y))
-> Either
     WebNodeIdOffset
     (Identity (Shaded x (Neighbourhood x (WebLocally x y))))
forall x y (f :: * -> *).
Functor f =>
WebNodeIdOffset
-> (y -> f y)
-> Shaded x y
-> Either WebNodeIdOffset (f (Shaded x y))
treeLeaf WebNodeIdOffset
i₁ ((WebLocally x y -> Identity (WebLocally x y))
-> Neighbourhood x (WebLocally x y)
-> Identity (Neighbourhood x (WebLocally x y))
forall x y y. Lens (Neighbourhood x y) (Neighbourhood x y) y y
dataAtNode ((WebLocally x y -> Identity (WebLocally x y))
 -> Neighbourhood x (WebLocally x y)
 -> Identity (Neighbourhood x (WebLocally x y)))
-> (Identity y -> WebLocally x y -> Identity (WebLocally x y))
-> Identity y
-> Neighbourhood x (WebLocally x y)
-> Identity (Neighbourhood x (WebLocally x y))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> Identity y) -> WebLocally x y -> Identity (WebLocally x y)
forall x y. Lens' (WebLocally x y) y
thisNodeData ((y -> Identity y) -> WebLocally x y -> Identity (WebLocally x y))
-> (Identity y -> y -> Identity y)
-> Identity y
-> WebLocally x y
-> Identity (WebLocally x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity y -> y -> Identity y
forall a b. a -> b -> a
const (Identity y
 -> Neighbourhood x (WebLocally x y)
 -> Identity (Neighbourhood x (WebLocally x y)))
-> Identity y
-> Neighbourhood x (WebLocally x y)
-> Identity (Neighbourhood x (WebLocally x y))
forall a b. (a -> b) -> a -> b
$ y -> Identity y
forall (f :: * -> *) a. Applicative f => a -> f a
pure y
y')
                              (Shaded x (Neighbourhood x (WebLocally x y))
 -> Either
      WebNodeIdOffset
      (Identity (Shaded x (Neighbourhood x (WebLocally x y)))))
-> Shaded x (Neighbourhood x (WebLocally x y))
-> Either
     WebNodeIdOffset
     (Identity (Shaded x (Neighbourhood x (WebLocally x y))))
forall a b. (a -> b) -> a -> b
$ PointsWeb x (WebLocally x y)
-> Shaded x (Neighbourhood x (WebLocally x y))
forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc PointsWeb x (WebLocally x y)
web
                   [WebNodeIdOffset]
-> PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y))
go (WebNodeIdOffset
i₁WebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:[WebNodeIdOffset]
is) (PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y)))
-> PointsWeb x (WebLocally x y) -> φ (PointsWeb x (WebLocally x y))
forall a b. (a -> b) -> a -> b
$ Shaded x (Neighbourhood x (WebLocally x y))
-> PointsWeb x (WebLocally x y)
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb Shaded x (Neighbourhood x (WebLocally x y))
web'
        where Just (x
_, WebLocally x y
p₀) = PointsWeb x (WebLocally x y)
-> WebNodeIdOffset -> Maybe (x, WebLocally x y)
forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x (WebLocally x y)
web WebNodeIdOffset
i₀
              Just (x
_, WebLocally x y
p₁) = PointsWeb x (WebLocally x y)
-> WebNodeIdOffset -> Maybe (x, WebLocally x y)
forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x (WebLocally x y)
web WebNodeIdOffset
i₁

traversePathsTowards :: ∀ f φ x y
         . (WithField ℝ Manifold x, Monad φ, Monad f, HasCallStack)
     => WebNodeId  -- ^ The node towards which the paths should converge.
       -> (PathStep x y -> φ y)
                   -- ^ The action which to traverse along each path.
       -> (∀ υ . WebLocally x y -> φ υ -> f υ)
                   -- ^ Initialisation/evaluation for each path-traversal.
       -> PointsWeb x y -> f (PointsWeb x y)
traversePathsTowards :: WebNodeIdOffset
-> (PathStep x y -> φ y)
-> (forall υ. WebLocally x y -> φ υ -> f υ)
-> PointsWeb x y
-> f (PointsWeb x y)
traversePathsTowards WebNodeIdOffset
target PathStep x y -> φ y
pathTravF forall υ. WebLocally x y -> φ υ -> f υ
routeInitF PointsWeb x y
web
  | Maybe (x, WebLocally x y)
Nothing <- Maybe (x, WebLocally x y)
sn  = String -> f (PointsWeb x y)
forall a. HasCallStack => String -> a
error (String -> f (PointsWeb x y)) -> String -> f (PointsWeb x y)
forall a b. (a -> b) -> a -> b
$ String
"Node "String -> ShowS
forall a. [a] -> [a] -> [a]
++WebNodeIdOffset -> String
forall a. Show a => a -> String
show WebNodeIdOffset
targetString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" not in web."
  | Bool
otherwise      = (PointsWeb x (WebLocally x y) -> PointsWeb x y)
-> f (PointsWeb x (WebLocally x y)) -> f (PointsWeb x y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((WebLocally x y -> y)
-> PointsWeb x (WebLocally x y) -> PointsWeb x y
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WebLocally x y -> y
forall x y. WebLocally x y -> y
_thisNodeData) (f (PointsWeb x (WebLocally x y)) -> f (PointsWeb x y))
-> (([WebNodeIdOffset]
     -> StateT (PointsWeb x (WebLocally x y)) f ())
    -> f (PointsWeb x (WebLocally x y)))
-> ([WebNodeIdOffset]
    -> StateT (PointsWeb x (WebLocally x y)) f ())
-> f (PointsWeb x y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT (PointsWeb x (WebLocally x y)) f ()
-> PointsWeb x (WebLocally x y) -> f (PointsWeb x (WebLocally x y))
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
`execStateT`PointsWeb x (WebLocally x y)
envied) (StateT (PointsWeb x (WebLocally x y)) f ()
 -> f (PointsWeb x (WebLocally x y)))
-> (([WebNodeIdOffset]
     -> StateT (PointsWeb x (WebLocally x y)) f ())
    -> StateT (PointsWeb x (WebLocally x y)) f ())
-> ([WebNodeIdOffset]
    -> StateT (PointsWeb x (WebLocally x y)) f ())
-> f (PointsWeb x (WebLocally x y))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[WebNodeIdOffset]]
-> ([WebNodeIdOffset]
    -> StateT (PointsWeb x (WebLocally x y)) f ())
-> StateT (PointsWeb x (WebLocally x y)) f ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[WebNodeIdOffset]]
paths
                       (([WebNodeIdOffset] -> StateT (PointsWeb x (WebLocally x y)) f ())
 -> f (PointsWeb x y))
-> ([WebNodeIdOffset]
    -> StateT (PointsWeb x (WebLocally x y)) f ())
-> f (PointsWeb x y)
forall a b. (a -> b) -> a -> b
$ \path :: [WebNodeIdOffset]
path@(WebNodeIdOffset
p₀:[WebNodeIdOffset]
_) -> (PointsWeb x (WebLocally x y)
 -> f ((), PointsWeb x (WebLocally x y)))
-> StateT (PointsWeb x (WebLocally x y)) f ()
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((PointsWeb x (WebLocally x y)
  -> f ((), PointsWeb x (WebLocally x y)))
 -> StateT (PointsWeb x (WebLocally x y)) f ())
-> (PointsWeb x (WebLocally x y)
    -> f ((), PointsWeb x (WebLocally x y)))
-> StateT (PointsWeb x (WebLocally x y)) f ()
forall a b. (a -> b) -> a -> b
$ \PointsWeb x (WebLocally x y)
webState -> do
                 let Just (x
_, WebLocally x y
node₀) = PointsWeb x (WebLocally x y)
-> WebNodeIdOffset -> Maybe (x, WebLocally x y)
forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x (WebLocally x y)
webState WebNodeIdOffset
p₀
                 ((),) (PointsWeb x (WebLocally x y)
 -> ((), PointsWeb x (WebLocally x y)))
-> f (PointsWeb x (WebLocally x y))
-> f ((), PointsWeb x (WebLocally x y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WebLocally x y
-> φ (PointsWeb x (WebLocally x y))
-> f (PointsWeb x (WebLocally x y))
forall υ. WebLocally x y -> φ υ -> f υ
routeInitF WebLocally x y
node₀ ([WebNodeIdOffset]
-> (PathStep x y -> φ y)
-> PointsWeb x (WebLocally x y)
-> φ (PointsWeb x (WebLocally x y))
forall (φ :: * -> *) x y.
(WithField ℝ Manifold x, Monad φ, HasCallStack) =>
[WebNodeIdOffset]
-> (PathStep x y -> φ y)
-> PointsWeb x (WebLocally x y)
-> φ (PointsWeb x (WebLocally x y))
traversePathInIWeb [WebNodeIdOffset]
path PathStep x y -> φ y
pathTravF PointsWeb x (WebLocally x y)
webState)
 where envied :: PointsWeb x (WebLocally x y)
envied = PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> PointsWeb x y -> PointsWeb x (WebLocally x y)
forall a b. (a -> b) -> a -> b
$ PointsWeb x y -> PointsWeb x y
forall x y. PointsWeb x y -> PointsWeb x y
bidirectionaliseWebLinks PointsWeb x y
web
       sn :: Maybe (x, WebLocally x y)
sn@(Just (x
targetPos,WebLocally x y
targetNode)) = PointsWeb x (WebLocally x y)
-> WebNodeIdOffset -> Maybe (x, WebLocally x y)
forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x (WebLocally x y)
envied WebNodeIdOffset
target
       paths :: [[WebNodeIdOffset]]
paths = WebNodeIdOffset
-> NodeSet
-> Bool
-> [[WebNodeIdOffset]]
-> [[WebNodeIdOffset]]
-> [[WebNodeIdOffset]]
go WebNodeIdOffset
0 NodeSet
ℤSet.empty Bool
False [[WebNodeIdOffset
target]] []
        where go :: Int -> NodeSet -> Bool -> [WNIPath] -> [WNIPath] -> [WNIPath]
              go :: WebNodeIdOffset
-> NodeSet
-> Bool
-> [[WebNodeIdOffset]]
-> [[WebNodeIdOffset]]
-> [[WebNodeIdOffset]]
go WebNodeIdOffset
targetDist NodeSet
visitedNodes Bool
boundaryCreepingInhibitor [[WebNodeIdOffset]]
workers [[WebNodeIdOffset]]
finishedThreads
               = case WebNodeIdOffset
-> NodeSet
-> Bool
-> [[WebNodeIdOffset]]
-> (NodeSet, [[WebNodeIdOffset]], NodeSet, [[WebNodeIdOffset]])
continue (ℝ -> WebNodeIdOffset
forall a b. (RealFrac a, Integral b) => a -> b
round (ℝ -> ℝ
forall a. Floating a => a -> a
sqrt (ℝ -> ℝ) -> ℝ -> ℝ
forall a b. (a -> b) -> a -> b
$ WebNodeIdOffset -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral WebNodeIdOffset
targetDist :: Double))
                        NodeSet
visitedNodes Bool
boundaryCreepingInhibitor [[WebNodeIdOffset]]
workers of
                  (NodeSet
_, [], NodeSet
_, [[WebNodeIdOffset]]
newFinished) -> [[WebNodeIdOffset]]
newFinished [[WebNodeIdOffset]] -> [[WebNodeIdOffset]] -> [[WebNodeIdOffset]]
forall a. [a] -> [a] -> [a]
++ [[WebNodeIdOffset]]
finishedThreads
                  (NodeSet
visited', [[WebNodeIdOffset]]
continuation, NodeSet
alternatives, [[WebNodeIdOffset]]
newFinished)
                       -> let newThreads :: [WebNodeIdOffset]
newThreads = (WebNodeIdOffset -> Bool) -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. (a -> Bool) -> [a] -> [a]
filter (WebNodeIdOffset -> NodeSet -> Bool
`ℤSet.notMember`NodeSet
visited')
                                                  (NodeSet -> [WebNodeIdOffset]
ℤSet.toList NodeSet
alternatives)
                          in WebNodeIdOffset
-> NodeSet
-> Bool
-> [[WebNodeIdOffset]]
-> [[WebNodeIdOffset]]
-> [[WebNodeIdOffset]]
go (WebNodeIdOffset
targetDistWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
+WebNodeIdOffset
1)
                                (NodeSet -> NodeSet -> NodeSet
ℤSet.union NodeSet
visited' NodeSet
alternatives)
                                Bool
True
                                ([[WebNodeIdOffset]]
continuation [[WebNodeIdOffset]] -> [[WebNodeIdOffset]] -> [[WebNodeIdOffset]]
forall a. [a] -> [a] -> [a]
++ (WebNodeIdOffset -> [WebNodeIdOffset])
-> [WebNodeIdOffset] -> [[WebNodeIdOffset]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap WebNodeIdOffset -> [WebNodeIdOffset]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [WebNodeIdOffset]
newThreads)
                                ([[WebNodeIdOffset]]
newFinished [[WebNodeIdOffset]] -> [[WebNodeIdOffset]] -> [[WebNodeIdOffset]]
forall a. [a] -> [a] -> [a]
++ [[WebNodeIdOffset]]
finishedThreads)
              continue :: Int -> NodeSet -> Bool -> [WNIPath]
                             -> (NodeSet, [WNIPath], NodeSet, [WNIPath])
              continue :: WebNodeIdOffset
-> NodeSet
-> Bool
-> [[WebNodeIdOffset]]
-> (NodeSet, [[WebNodeIdOffset]], NodeSet, [[WebNodeIdOffset]])
continue WebNodeIdOffset
_ NodeSet
visitedNodes Bool
_ [] = (NodeSet
visitedNodes, [], NodeSet
ℤSet.empty, [])
              continue WebNodeIdOffset
dfsDepth NodeSet
visitedNodes Bool
boundaryCreepingInhibitor ((WebNodeIdOffset
cursor:[WebNodeIdOffset]
nds):[[WebNodeIdOffset]]
paths)
                  = case (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
-> ([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
forall a b. (a, b) -> a
fst ((([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
 -> ([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])))
-> [(([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)]
-> [([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
 -> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
 -> Ordering)
-> [(([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)]
-> [(([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ) -> ℝ)
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ) -> ℝ
forall a b. (a, b) -> b
snd)
                          [ WebNodeIdOffset
-> NodeSet
-> [WebNodeIdOffset]
-> [WebNodeIdOffset]
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
goDfs WebNodeIdOffset
dfsDepth (WebNodeIdOffset -> NodeSet -> NodeSet
ℤSet.insert WebNodeIdOffset
i NodeSet
visitedNodes) [] [WebNodeIdOffset
i]
                          | WebNodeIdOffset
i <- [WebNodeIdOffset]
candidates ] of
                       (([WebNodeIdOffset]
preferred, (NodeSet
visited', [WebNodeIdOffset]
pAlts)):[([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
alts)
                         | Maybe (DualVector (Needle x))
Nothing <- Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
boundaryCreepingInhibitor
                                       Maybe ()
-> Maybe (DualVector (Needle x)) -> Maybe (DualVector (Needle x))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WebLocally x y
cursorNode WebLocally x y
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x y)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x y)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                          -> case WebNodeIdOffset
-> NodeSet
-> Bool
-> [[WebNodeIdOffset]]
-> (NodeSet, [[WebNodeIdOffset]], NodeSet, [[WebNodeIdOffset]])
continue WebNodeIdOffset
dfsDepth NodeSet
visited'
                                         Bool
boundaryCreepingInhibitor [[WebNodeIdOffset]]
paths of
                               (NodeSet
visited'', [[WebNodeIdOffset]]
contin'', NodeSet
alts', [[WebNodeIdOffset]]
newFin)
                                 -> ( NodeSet
visited''
                                    , ([WebNodeIdOffset]
preferred[WebNodeIdOffset] -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. [a] -> [a] -> [a]
++WebNodeIdOffset
cursorWebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:[WebNodeIdOffset]
nds)[WebNodeIdOffset] -> [[WebNodeIdOffset]] -> [[WebNodeIdOffset]]
forall a. a -> [a] -> [a]
:[[WebNodeIdOffset]]
contin''
                                    , NodeSet -> NodeSet -> NodeSet
ℤSet.union ([WebNodeIdOffset] -> NodeSet
ℤSet.fromList
                                                   ([WebNodeIdOffset] -> NodeSet) -> [WebNodeIdOffset] -> NodeSet
forall a b. (a -> b) -> a -> b
$ [WebNodeIdOffset]
pAlts [WebNodeIdOffset] -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. [a] -> [a] -> [a]
++ ([WebNodeIdOffset] -> WebNodeIdOffset
forall a. [a] -> a
last ([WebNodeIdOffset] -> WebNodeIdOffset)
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
    -> [WebNodeIdOffset])
-> ([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
-> WebNodeIdOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
-> [WebNodeIdOffset]
forall a b. (a, b) -> a
fst (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
 -> WebNodeIdOffset)
-> [([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
-> [WebNodeIdOffset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
alts))
                                                 NodeSet
alts'
                                    , [[WebNodeIdOffset]]
newFin )
                       [([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
alts -> case WebNodeIdOffset
-> NodeSet
-> Bool
-> [[WebNodeIdOffset]]
-> (NodeSet, [[WebNodeIdOffset]], NodeSet, [[WebNodeIdOffset]])
continue WebNodeIdOffset
dfsDepth NodeSet
visitedNodes
                                           Bool
boundaryCreepingInhibitor [[WebNodeIdOffset]]
paths of
                               (NodeSet
visited'', [[WebNodeIdOffset]]
contin'', NodeSet
alts', [[WebNodeIdOffset]]
newFin)
                                 -> ( NodeSet
visited''
                                    , [[WebNodeIdOffset]]
contin''
                                    , NodeSet -> NodeSet -> NodeSet
ℤSet.union ([WebNodeIdOffset] -> NodeSet
ℤSet.fromList
                                                   ([WebNodeIdOffset] -> NodeSet) -> [WebNodeIdOffset] -> NodeSet
forall a b. (a -> b) -> a -> b
$ [WebNodeIdOffset] -> WebNodeIdOffset
forall a. [a] -> a
last ([WebNodeIdOffset] -> WebNodeIdOffset)
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
    -> [WebNodeIdOffset])
-> ([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
-> WebNodeIdOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
-> [WebNodeIdOffset]
forall a b. (a, b) -> a
fst (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))
 -> WebNodeIdOffset)
-> [([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
-> [WebNodeIdOffset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
alts)
                                                 NodeSet
alts'
                                    , if [WebNodeIdOffset] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WebNodeIdOffset]
nds then [[WebNodeIdOffset]]
newFin
                                                  else (WebNodeIdOffset
cursorWebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:[WebNodeIdOffset]
nds)[WebNodeIdOffset] -> [[WebNodeIdOffset]] -> [[WebNodeIdOffset]]
forall a. a -> [a] -> [a]
:[[WebNodeIdOffset]]
newFin )
               where Just (x
cursorPos,WebLocally x y
cursorNode) = PointsWeb x (WebLocally x y)
-> WebNodeIdOffset -> Maybe (x, WebLocally x y)
forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x (WebLocally x y)
envied WebNodeIdOffset
cursor
                     tgtOpp :: DualVector (Needle x)
tgtOpp = WebLocally x y
cursorNodeWebLocally x y
-> Getting (Norm (Needle x)) (WebLocally x y) (Norm (Needle x))
-> Norm (Needle x)
forall s a. s -> Getting a s a -> a
^.Getting (Norm (Needle x)) (WebLocally x y) (Norm (Needle x))
forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct
                                  Norm (Needle x) -> Needle x -> DualVector (Needle x)
forall v. LSpace v => Norm v -> v -> DualVector v
<$| x
targetPos x -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! x
cursorPos
                     candidates :: [WebNodeIdOffset]
candidates = [ WebNodeIdOffset
ngb
                                  | (WebNodeIdOffset
ngb, (Needle x
_, WebLocally x y
_)) <- WebLocally x y
cursorNodeWebLocally x y
-> Getting
     [(WebNodeIdOffset, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(WebNodeIdOffset, (Needle x, WebLocally x y))]
-> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(WebNodeIdOffset, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(WebNodeIdOffset, (Needle x, WebLocally x y))]
forall x y.
Lens'
  (WebLocally x y) [(WebNodeIdOffset, (Needle x, WebLocally x y))]
nodeNeighbours
                                  , WebNodeIdOffset
ngbWebNodeIdOffset -> NodeSet -> Bool
`ℤSet.notMember`NodeSet
visitedNodes ]
                     goDfs :: Int -> NodeSet -> [WebNodeId] -> WNIPath
                                -> ((WNIPath, (NodeSet, [WebNodeId])), ℝ)
                     goDfs :: WebNodeIdOffset
-> NodeSet
-> [WebNodeIdOffset]
-> [WebNodeIdOffset]
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
goDfs WebNodeIdOffset
d2go NodeSet
visited' [WebNodeIdOffset]
oldAlts (WebNodeIdOffset
p:[WebNodeIdOffset]
old)
                            = case ((WebNodeIdOffset, ℝ) -> (WebNodeIdOffset, ℝ) -> Ordering)
-> [(WebNodeIdOffset, ℝ)] -> [(WebNodeIdOffset, ℝ)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((WebNodeIdOffset, ℝ) -> ℝ)
-> (WebNodeIdOffset, ℝ) -> (WebNodeIdOffset, ℝ) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (WebNodeIdOffset, ℝ) -> ℝ
forall a b. (a, b) -> b
snd) [(WebNodeIdOffset, ℝ)]
candidates of
                                ((WebNodeIdOffset
preferred,ℝ
oppositionQ):[(WebNodeIdOffset, ℝ)]
alts)
                                  -> let visited'' :: NodeSet
visited'' = WebNodeIdOffset -> NodeSet -> NodeSet
ℤSet.insert WebNodeIdOffset
preferred NodeSet
visited'
                                         alts' :: [WebNodeIdOffset]
alts' = (WebNodeIdOffset -> Bool) -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. (a -> Bool) -> [a] -> [a]
filter (WebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Eq a => a -> a -> Bool
/=WebNodeIdOffset
preferred) [WebNodeIdOffset]
oldAlts
                                                    [WebNodeIdOffset] -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. [a] -> [a] -> [a]
++ ((WebNodeIdOffset, ℝ) -> WebNodeIdOffset
forall a b. (a, b) -> a
fst((WebNodeIdOffset, ℝ) -> WebNodeIdOffset)
-> [(WebNodeIdOffset, ℝ)] -> [WebNodeIdOffset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[(WebNodeIdOffset, ℝ)]
alts)
                                     in if WebNodeIdOffset
d2goWebNodeIdOffset -> WebNodeIdOffset -> Bool
forall a. Ord a => a -> a -> Bool
>WebNodeIdOffset
1
                                         then WebNodeIdOffset
-> NodeSet
-> [WebNodeIdOffset]
-> [WebNodeIdOffset]
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
goDfs (WebNodeIdOffset
d2goWebNodeIdOffset -> WebNodeIdOffset -> WebNodeIdOffset
forall a. Num a => a -> a -> a
-WebNodeIdOffset
1) NodeSet
visited'' [WebNodeIdOffset]
alts'
                                                   (WebNodeIdOffset
preferredWebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:WebNodeIdOffset
pWebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:[WebNodeIdOffset]
old)
                                         else ( (WebNodeIdOffset
preferredWebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:WebNodeIdOffset
pWebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:[WebNodeIdOffset]
old, (NodeSet
visited'', [WebNodeIdOffset]
alts'))
                                              , ℝ
oppositionQ )
                                [] -> let δn :: Needle x
δn = x
explorePos x -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! x
cursorPos
                                          oppositionQ :: Scalar (Needle x)
oppositionQ = DualVector (Needle x)
tgtOppDualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
δn
                                      in ((WebNodeIdOffset
pWebNodeIdOffset -> [WebNodeIdOffset] -> [WebNodeIdOffset]
forall a. a -> [a] -> [a]
:[WebNodeIdOffset]
old, (NodeSet
visited', [WebNodeIdOffset]
oldAlts)), ℝ
Scalar (Needle x)
oppositionQ)
                      where Just (x
explorePos,WebLocally x y
exploreNode) = PointsWeb x (WebLocally x y)
-> WebNodeIdOffset -> Maybe (x, WebLocally x y)
forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x (WebLocally x y)
envied WebNodeIdOffset
p
                            candidates :: [(WebNodeIdOffset, ℝ)]
candidates = [ (WebNodeIdOffset
ngb, DualVector (Needle x)
tgtOppDualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
δn)
                                         | (WebNodeIdOffset
ngb, (Needle x
_, WebLocally x y
ngbN)) <- WebLocally x y
exploreNodeWebLocally x y
-> Getting
     [(WebNodeIdOffset, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(WebNodeIdOffset, (Needle x, WebLocally x y))]
-> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(WebNodeIdOffset, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(WebNodeIdOffset, (Needle x, WebLocally x y))]
forall x y.
Lens'
  (WebLocally x y) [(WebNodeIdOffset, (Needle x, WebLocally x y))]
nodeNeighbours
                                         , WebNodeIdOffset
ngbWebNodeIdOffset -> NodeSet -> Bool
`ℤSet.notMember`NodeSet
visited'
                                         , Maybe (DualVector (Needle x)) -> Bool
forall a. Maybe a -> Bool
isNothing (WebLocally x y
ngbNWebLocally x y
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x y)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x y)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane)
                                         , let δn :: Needle x
δn = WebLocally x y
ngbNWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord x -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! x
cursorPos ]