-- |
-- 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 {
     forall x y. Neighbourhood x y -> y
_dataAtNode :: y
   , forall x y. Neighbourhood x y -> Vector WebNodeIdOffset
_neighbours :: UArr.Vector WebNodeIdOffset
   , forall x y. Neighbourhood x y -> Metric x
_localScalarProduct :: Metric x
   , forall x y. Neighbourhood x y -> Maybe (Needle' x)
_webBoundaryAtNode :: Maybe (Needle' x)
   }
  deriving (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, 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
<$ :: forall a b. a -> Neighbourhood x b -> Neighbourhood x a
$c<$ :: forall x a b. a -> Neighbourhood x b -> Neighbourhood x a
fmap :: forall a b. (a -> b) -> Neighbourhood x a -> Neighbourhood x b
$cfmap :: forall x a b. (a -> b) -> Neighbourhood x a -> Neighbourhood x b
Functor, forall a. Neighbourhood x a -> Bool
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 a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
forall x a. (a -> a -> a) -> Neighbourhood x a -> a
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 :: forall a. Num a => Neighbourhood x a -> a
$cproduct :: forall x a. Num a => Neighbourhood x a -> a
sum :: forall a. Num a => Neighbourhood x a -> a
$csum :: forall x a. Num a => Neighbourhood x a -> a
minimum :: forall a. Ord a => Neighbourhood x a -> a
$cminimum :: forall x a. Ord a => Neighbourhood x a -> a
maximum :: forall a. Ord a => Neighbourhood x a -> a
$cmaximum :: forall x a. Ord a => Neighbourhood x a -> a
elem :: forall a. Eq a => a -> Neighbourhood x a -> Bool
$celem :: forall x a. Eq a => a -> Neighbourhood x a -> Bool
length :: forall a. Neighbourhood x a -> WebNodeIdOffset
$clength :: forall x a. Neighbourhood x a -> WebNodeIdOffset
null :: forall a. Neighbourhood x a -> Bool
$cnull :: forall x a. Neighbourhood x a -> Bool
toList :: forall a. Neighbourhood x a -> [a]
$ctoList :: forall x a. Neighbourhood x a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Neighbourhood x a -> a
$cfoldl1 :: forall x a. (a -> a -> a) -> Neighbourhood x a -> a
foldr1 :: forall a. (a -> a -> a) -> Neighbourhood x a -> a
$cfoldr1 :: forall x a. (a -> a -> a) -> Neighbourhood x a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
$cfoldl' :: forall x b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
$cfoldl :: forall x b a. (b -> a -> b) -> b -> Neighbourhood x a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
$cfoldr' :: forall x a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
$cfoldr :: forall x a b. (a -> b -> b) -> b -> Neighbourhood x a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
$cfoldMap' :: forall x m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
$cfoldMap :: forall x m a. Monoid m => (a -> m) -> Neighbourhood x a -> m
fold :: forall m. Monoid m => Neighbourhood x m -> m
$cfold :: forall x m. Monoid m => Neighbourhood x m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Neighbourhood x a -> f (Neighbourhood x b)
sequence :: forall (m :: * -> *) a.
Monad m =>
Neighbourhood x (m a) -> m (Neighbourhood x a)
$csequence :: forall x (m :: * -> *) a.
Monad m =>
Neighbourhood x (m a) -> m (Neighbourhood x a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(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 :: forall (f :: * -> *) a.
Applicative f =>
Neighbourhood x (f a) -> f (Neighbourhood x a)
$csequenceA :: forall x (f :: * -> *) a.
Applicative f =>
Neighbourhood x (f a) -> f (Neighbourhood x a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(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)
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 {
      forall x y. WebLocally x y -> x
_thisNodeCoord :: x
    , forall x y. WebLocally x y -> y
_thisNodeData :: y
    , forall x y. WebLocally x y -> WebNodeIdOffset
_thisNodeId :: WebNodeId
    , forall x y.
WebLocally x y -> [(WebNodeIdOffset, (Needle x, WebLocally x y))]
_nodeNeighbours :: [(WebNodeId, (Needle x, WebLocally x y))]
    , forall x y. WebLocally x y -> Metric x
_nodeLocalScalarProduct :: Metric x
    , forall x y. WebLocally x y -> Maybe (Needle' x)
_webBoundingPlane :: Maybe (Needle' x)
    } deriving (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
          { forall x. NeighbourhoodVector x -> WebNodeIdOffset
_nvectId :: Int
          , forall x. NeighbourhoodVector x -> Needle x
_theNVect :: Needle x
          , forall x. NeighbourhoodVector x -> Needle' x
_nvectNormal :: Needle' x
          , forall x. NeighbourhoodVector x -> Scalar (Needle x)
_nvectLength :: Scalar (Needle x)
          , forall x. NeighbourhoodVector x -> Scalar (Needle x)
_otherNeighboursOverlap :: Scalar (Needle x)
          }
makeLenses ''NeighbourhoodVector

data PropagationInconsistency x υ = PropagationInconsistency {
      forall x υ. PropagationInconsistency x υ -> [(x, υ)]
_inconsistentPropagatedData :: [(x,υ)]
    , forall x υ. PropagationInconsistency x υ -> υ
_inconsistentAPrioriData :: υ }
  | PropagationInconsistencies [PropagationInconsistency x υ]
 deriving (WebNodeIdOffset -> PropagationInconsistency x υ -> ShowS
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 = forall a. Monoid a => [a] -> a
mconcat [PropagationInconsistency x υ
p,PropagationInconsistency x υ
q]
instance Monoid (PropagationInconsistency x υ) where
  mempty :: PropagationInconsistency x υ
mempty = forall x υ.
[PropagationInconsistency x υ] -> PropagationInconsistency x υ
PropagationInconsistencies []
  mappend :: PropagationInconsistency x υ
-> PropagationInconsistency x υ -> PropagationInconsistency x υ
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mconcat :: [PropagationInconsistency x υ] -> PropagationInconsistency x υ
mconcat = 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 :: {
       forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc :: x`Shaded`Neighbourhood x y
     } -> PointsWeb x y
  deriving (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, 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
<$ :: forall a b. a -> PointsWeb a b -> PointsWeb a a
$c<$ :: forall a a b. a -> PointsWeb a b -> PointsWeb a a
fmap :: forall a b. (a -> b) -> PointsWeb a a -> PointsWeb a b
$cfmap :: forall a a b. (a -> b) -> PointsWeb a a -> PointsWeb a b
Functor, forall a. PointsWeb a a -> Bool
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 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 :: forall a. Num a => PointsWeb a a -> a
$cproduct :: forall a a. Num a => PointsWeb a a -> a
sum :: forall a. Num a => PointsWeb a a -> a
$csum :: forall a a. Num a => PointsWeb a a -> a
minimum :: forall a. Ord a => PointsWeb a a -> a
$cminimum :: forall a a. Ord a => PointsWeb a a -> a
maximum :: forall a. Ord a => PointsWeb a a -> a
$cmaximum :: forall a a. Ord a => PointsWeb a a -> a
elem :: forall a. Eq a => a -> PointsWeb a a -> Bool
$celem :: forall a a. Eq a => a -> PointsWeb a a -> Bool
length :: forall a. PointsWeb a a -> WebNodeIdOffset
$clength :: forall a a. PointsWeb a a -> WebNodeIdOffset
null :: forall a. PointsWeb a a -> Bool
$cnull :: forall a a. PointsWeb a a -> Bool
toList :: forall a. PointsWeb a a -> [a]
$ctoList :: forall a a. PointsWeb a a -> [a]
foldl1 :: forall a. (a -> a -> a) -> PointsWeb a a -> a
$cfoldl1 :: forall a a. (a -> a -> a) -> PointsWeb a a -> a
foldr1 :: forall a. (a -> a -> a) -> PointsWeb a a -> a
$cfoldr1 :: forall a a. (a -> a -> a) -> PointsWeb a a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> PointsWeb a a -> b
$cfoldl' :: forall a b a. (b -> a -> b) -> b -> PointsWeb a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PointsWeb a a -> b
$cfoldl :: forall a b a. (b -> a -> b) -> b -> PointsWeb a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PointsWeb a a -> b
$cfoldr' :: forall a a b. (a -> b -> b) -> b -> PointsWeb a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PointsWeb a a -> b
$cfoldr :: forall a a b. (a -> b -> b) -> b -> PointsWeb a a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> PointsWeb a a -> m
$cfoldMap' :: forall a m a. Monoid m => (a -> m) -> PointsWeb a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PointsWeb a a -> m
$cfoldMap :: forall a m a. Monoid m => (a -> m) -> PointsWeb a a -> m
fold :: forall m. Monoid m => PointsWeb a m -> m
$cfold :: forall a m. Monoid m => PointsWeb a m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> PointsWeb a a -> f (PointsWeb a b)
sequence :: forall (m :: * -> *) a.
Monad m =>
PointsWeb a (m a) -> m (PointsWeb a a)
$csequence :: forall a (m :: * -> *) a.
Monad m =>
PointsWeb a (m a) -> m (PointsWeb a a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(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 :: forall (f :: * -> *) a.
Applicative f =>
PointsWeb a (f a) -> f (PointsWeb a a)
$csequenceA :: forall a (f :: * -> *) a.
Applicative f =>
PointsWeb a (f a) -> f (PointsWeb a a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(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)
Traversable)

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

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


data WebChunk x y = WebChunk {
     forall x y. WebChunk x y -> PointsWeb x y
_thisChunk :: PointsWeb x y
   , forall 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 {
     forall x y. NodeInWeb x y -> (x, Neighbourhood x y)
_thisNodeOnly :: (x, Neighbourhood x y)
   , forall 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 {
     forall x y. PathStep x y -> WebLocally x y
_pathStepStart :: WebLocally x y
   , forall 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 :: 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)
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 (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) = forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
                  = forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc 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₀) forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
outlayers) (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 :: forall (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)
f = 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)
            = forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. [(x, y)] -> Shaded x y
PlainLeaves forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (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,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeInWeb x y -> f (Neighbourhood x z)
f (forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
NodeInWeb (x
x,Neighbourhood x y
ngbh)
                                     forall a b. (a -> b) -> a -> b
$ (forall x y. [(x, y)] -> Shaded x y
PlainLeaves [(x, Neighbourhood x y)]
nearbyLeaves, WebNodeIdOffset
i) 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 :: forall x y z.
(NodeInWeb x y -> Neighbourhood x z)
-> PointsWeb x y -> PointsWeb x z
fmapNodesInEnvi NodeInWeb x y -> Neighbourhood x z
f = forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) x y z.
Applicative f =>
(NodeInWeb x y -> f (Neighbourhood x z))
-> PointsWeb x y -> f (PointsWeb x z)
traverseNodesInEnvi (forall a. a -> Identity a
Identity forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInWeb x y -> Neighbourhood x z
f)


ixedFoci :: [a] -> [((Int, a), [a])]
ixedFoci :: forall a. [a] -> [((WebNodeIdOffset, a), [a])]
ixedFoci = 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) forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
xforall a. a -> [a] -> [a]
:)) (t -> [a] -> [((t, a), [a])]
go (t
iforall a. Num a => a -> a -> a
+t
1) [a]
xs)
 

indexWeb :: PointsWeb x y -> WebNodeId -> Maybe (x,y)
indexWeb :: forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb (PointsWeb Shaded x (Neighbourhood x y)
rsc) WebNodeIdOffset
i = case 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)
_)) -> forall a. a -> Maybe a
Just (x
x, y
y)
       Either
  WebNodeIdOffset
  ([Shaded x (Neighbourhood x y)], (x, Neighbourhood x y))
_ -> forall a. Maybe a
Nothing

unsafeIndexWebData :: PointsWeb x y -> WebNodeId -> y
unsafeIndexWebData :: forall x y. PointsWeb x y -> WebNodeIdOffset -> y
unsafeIndexWebData PointsWeb x y
web WebNodeIdOffset
i = case 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 :: forall x y. 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 forall x y.
WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
zoomoutWebChunk WebNodeIdOffset
δie forall a b. (a -> b) -> a -> b
$ forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall a b. (a -> b) -> a -> b
$ 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 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'' -> forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
NodeInWeb (x, Neighbourhood x y)
x' forall a b. (a -> b) -> a -> b
$ [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi'' forall a. [a] -> [a] -> [a]
++ [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi'
 where δie :: WebNodeIdOffset
δie | WebNodeIdOffset
δi forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
0     = WebNodeIdOffset
δi
           | Bool
otherwise  = WebNodeIdOffset
δi forall a. Num a => a -> a -> a
- WebNodeIdOffset
1

webAroundChunk :: WebChunk x y -> PointsWeb x y
webAroundChunk :: forall x y. 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))
   = forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk forall a b. (a -> b) -> a -> b
$ forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. [(x, y)] -> Shaded x y
PlainLeaves forall a b. (a -> b) -> a -> b
$ [(x, Neighbourhood x y)]
lvsBeforeforall a. [a] -> [a] -> [a]
++[(x, Neighbourhood x y)]
lvsforall 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) = 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))
   = forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk forall a b. (a -> b) -> a -> b
$ forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall a b. (a -> b) -> a -> b
$ forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwforall a. Num a => a -> a -> a
+forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
chunk) Shade x
ew
                                          (forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
chunk Shaded x (Neighbourhood x y)
d) 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
iforall a. Eq a => a -> a -> Bool
==forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
u
   = forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk forall a b. (a -> b) -> a -> b
$ forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall a b. (a -> b) -> a -> b
$ forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwforall a. Num a => a -> a -> a
+forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
chunk) Shade x
ew
                                          (forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
u Shaded x (Neighbourhood x y)
chunk) 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 forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk (forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk PointsWeb x y
chunk [(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₁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'))
           -> forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk forall a b. (a -> b) -> a -> b
$ forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> WebChunk x y
WebChunk
                    (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall a b. (a -> b) -> a -> b
$ 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₀forall a. a -> [a] -> NonEmpty a
:|DBranch x (Neighbourhood x y)
br₁'forall a. a -> [a] -> [a]
:[DBranch x (Neighbourhood x y)]
brs'))
                    [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envi
 where i' :: WebNodeIdOffset
i' = WebNodeIdOffset
i forall a. Num a => a -> a -> a
- forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
u forall a. Num a => a -> a -> a
- 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)]
_))
    = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Environment with branch sizes "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x y. Shaded x y -> WebNodeIdOffset
nLeaves forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toListforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList NonEmpty (DBranch x (Neighbourhood x y))
branches))
                forall a. [a] -> [a] -> [a]
++String
" does not have a gap at #"forall a. [a] -> [a] -> [a]
++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)]
_))
    = 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 :: forall x y.
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 forall a. Ord a => a -> a -> Bool
< -WebNodeIdOffset
olp Bool -> Bool -> Bool
|| WebNodeIdOffset
δi forall a. Ord a => a -> a -> Bool
>= forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
outlayer forall a. Num a => a -> a -> a
- WebNodeIdOffset
olp
      = forall x y.
WebNodeIdOffset -> WebChunk x y -> (WebChunk x y, WebNodeIdOffset)
zoomoutWebChunk WebNodeIdOffset
δiOut forall a b. (a -> b) -> a -> b
$ 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  = (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 forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
0     = WebNodeIdOffset
δi forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp
             | Bool
otherwise  = WebNodeIdOffset
δi forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp forall a. Num a => a -> a -> a
- forall x y. Shaded x y -> WebNodeIdOffset
nLeaves Shaded x (Neighbourhood x y)
outlayer
       δiIn :: WebNodeIdOffset
δiIn | WebNodeIdOffset
δi forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
0     = WebNodeIdOffset
δi forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp
            | Bool
otherwise  = WebNodeIdOffset
δi forall a. Num a => a -> a -> a
+ WebNodeIdOffset
olp forall a. Num a => a -> a -> a
+ forall x y. Shaded x y -> WebNodeIdOffset
nLeaves (forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc PointsWeb x y
chunk)
       widerChunk :: PointsWeb x y
widerChunk = forall x y. WebChunk x y -> PointsWeb x y
webAroundChunk forall a b. (a -> b) -> a -> b
$ 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)
    = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Can't zoom out δ"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show WebNodeIdOffset
δi
       forall a. [a] -> [a] -> [a]
++String
" from a chunk with "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> WebNodeIdOffset
length [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
e)forall a. [a] -> [a] -> [a]
++String
" environment layers."

pickNodeInWeb :: PointsWeb x y -> WebNodeId -> NodeInWeb x y
pickNodeInWeb :: forall x y. PointsWeb x y -> WebNodeIdOffset -> NodeInWeb x y
pickNodeInWeb = 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 [] 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
iforall a. Ord a => a -> a -> Bool
<WebNodeIdOffset
0 Bool -> Bool -> Bool
|| WebNodeIdOffset
iforall a. Ord a => a -> a -> Bool
>=WebNodeIdOffset
n  = forall a. HasCallStack => String -> a
error
           forall a b. (a -> b) -> a -> b
$ String
"Trying to pick node #"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show WebNodeIdOffset
iforall a. [a] -> [a] -> [a]
++String
" in web with "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show WebNodeIdOffset
nforall a. [a] -> [a] -> [a]
++String
" nodes."
        where n :: WebNodeIdOffset
n = 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)<-forall a. WebNodeIdOffset -> [a] -> ([a], [a])
splitAt WebNodeIdOffset
i [(x, Neighbourhood x y)]
lvs
                   = forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
-> NodeInWeb x y
NodeInWeb (x, Neighbourhood x y)
node forall a b. (a -> b) -> a -> b
$ (Shaded x (Neighbourhood x y), WebNodeIdOffset)
-> (Shaded x (Neighbourhood x y), WebNodeIdOffset)
lMod (forall x y. [(x, y)] -> Shaded x y
PlainLeaves forall a b. (a -> b) -> a -> b
$ [(x, Neighbourhood x y)]
predsforall a. [a] -> [a] -> [a]
++[(x, Neighbourhood x y)]
succs, WebNodeIdOffset
i) 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 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 (forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwforall a. Num a => a -> a -> a
-WebNodeIdOffset
nu) Shade x
ew
                                      (forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (forall s. s -> s -> Hourglass s
Hourglass forall {x} {y}. Shaded x y
gap Shaded x (Neighbourhood x y)
d)forall a. a -> [a] -> NonEmpty a
:|[DBranch x (Neighbourhood x y)]
brs), WebNodeIdOffset
0) forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc)
                          forall a. a -> a
id (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb Shaded x (Neighbourhood x y)
u) WebNodeIdOffset
i
        | WebNodeIdOffset
i forall a. Ord a => a -> a -> Bool
< WebNodeIdOffset
nuforall 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 (forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwforall a. Num a => a -> a -> a
-WebNodeIdOffset
nd) Shade x
ew
                                      (forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (forall s. s -> s -> Hourglass s
Hourglass Shaded x (Neighbourhood x y)
u forall {x} {y}. Shaded x y
gap)forall a. a -> [a] -> NonEmpty a
:|[DBranch x (Neighbourhood x y)]
brs), WebNodeIdOffset
nu) forall a. a -> [a] -> [a]
: [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
lyrsAcc)
                          forall a. a -> a
id (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb Shaded x (Neighbourhood x y)
d) (WebNodeIdOffset
iforall 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 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)
                                   -> ( forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nweforall a. Num a => a -> a -> a
+WebNodeIdOffset
nuforall a. Num a => a -> a -> a
+WebNodeIdOffset
nd) Shade x
ewe
                                         forall a b. (a -> b) -> a -> b
$ forall a. a -> NonEmpty a -> NonEmpty a
NE.cons (forall x c. Needle' x -> Hourglass c -> DBranch' x c
DBranch Needle' x
dir (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
neforall a. Num a => a -> a -> a
+WebNodeIdOffset
nuforall a. Num a => a -> a -> a
+WebNodeIdOffset
nd ) )
                          (forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb forall a b. (a -> b) -> a -> b
$ forall x y.
WebNodeIdOffset -> Shade x -> NonEmpty (DBranch x y) -> Shaded x y
OverlappingBranches (WebNodeIdOffset
nwforall a. Num a => a -> a -> a
-WebNodeIdOffset
nuforall a. Num a => a -> a -> a
-WebNodeIdOffset
nd) Shade x
ew (DBranch x (Neighbourhood x y)
bforall a. a -> [a] -> NonEmpty a
:|[DBranch x (Neighbourhood x y)]
rs))
                          (WebNodeIdOffset
iforall a. Num a => a -> a -> a
-WebNodeIdOffset
nuforall a. Num a => a -> a -> a
-WebNodeIdOffset
nd)
        where gap :: Shaded x y
gap = forall x y. [(x, y)] -> Shaded x y
PlainLeaves []
              [WebNodeIdOffset
nu,WebNodeIdOffset
nd] = forall x y. Shaded x y -> WebNodeIdOffset
nLeavesforall (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 :: forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo = 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 forall a b. a -> (a -> b) -> b
& forall x y y. Lens (Neighbourhood x y) (Neighbourhood x y) y y
dataAtNode forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 forall a. Num a => a -> a -> a
+ WebNodeIdOffset
δi, (Needle x
δx, WebLocally x y
ngb))
                                    | WebNodeIdOffset
δi <- 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)]
_)
                                              = forall x y. WebNodeIdOffset -> NodeInWeb x y -> NodeInWeb x y
jumpNodeOffset WebNodeIdOffset
δi NodeInWeb x y
node
                                          Just Needle x
δx = x
xn 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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) WebNodeIdOffset
0 [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envis


instance Functor (WebLocally x) where
  fmap :: forall a b. (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)
       = 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 (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> 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 :: forall a. WebLocally x a -> a
extract = forall x y. WebLocally x y -> y
_thisNodeData
  extend :: forall a b.
(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)
      = 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 (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> 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 :: forall a. 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)
      = 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 (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second 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 :: forall x y z.
WithField ℝ Manifold x =>
(WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb WebLocally x y -> z
f = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x
-> (WebLocally x y -> [WebNodeIdOffset])
-> PointsWeb x y
-> PointsWeb x y
tweakWebGeometry MetricChoice x
metricf WebLocally x y -> [WebNodeIdOffset]
reknit = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall x y z.
(NodeInWeb x y -> Neighbourhood x z)
-> PointsWeb x y -> PointsWeb x z
fmapNodesInEnviforall 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
x₀ forall a b. (a -> b) -> a -> b
$ forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric x
lm
                in forall x y.
y
-> Vector WebNodeIdOffset
-> Metric x
-> Maybe (Needle' x)
-> Neighbourhood x y
Neighbourhood (WebLocally x y
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
                            (forall a. Unbox a => [a] -> Vector a
UArr.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Num a => a -> a -> a
subtract forall a b. (a -> b) -> a -> b
$ WebLocally x y
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) WebNodeIdOffset
thisNodeId)
                                     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 :: forall x y. PointsWeb x y -> PointsWeb x y
bidirectionaliseWebLinks web :: PointsWeb x y
web@(PointsWeb Shaded x (Neighbourhood x y)
wnrsrc) = 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)
                = forall x y.
y
-> Vector WebNodeIdOffset
-> Metric x
-> Maybe (Needle' x)
-> Neighbourhood x y
Neighbourhood y
y (forall a. Unbox a => [a] -> Vector a
UArr.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FastNub a => [a] -> [a]
fastNub forall a b. (a -> b) -> a -> b
$ [WebNodeIdOffset]
incmn forall a. [a] -> [a] -> [a]
++ forall a. Unbox a => Vector a -> [a]
UArr.toList Vector WebNodeIdOffset
outgn)
                      Metric x
lm Maybe (Needle' x)
bound
        where i :: WebNodeIdOffset
i = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) WebNodeIdOffset
0 [(Shaded x (Neighbourhood x y), WebNodeIdOffset)]
envis
              incmn :: [WebNodeIdOffset]
incmn = case WebNodeIdOffset
i forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map WebNodeIdOffset [WebNodeIdOffset]
incoming of
                Just [WebNodeIdOffset]
o -> forall a. Num a => a -> a -> a
subtract WebNodeIdOffset
iforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[WebNodeIdOffset]
o
                Maybe [WebNodeIdOffset]
Nothing -> []
       incoming :: Map WebNodeIdOffset [WebNodeIdOffset]
incoming = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ 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
iforall a. Num a => a -> a -> a
+WebNodeIdOffset
1, [(WebNodeIdOffset, [WebNodeIdOffset])]
-> [(WebNodeIdOffset, [WebNodeIdOffset])]
acc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((,[WebNodeIdOffset
i])forall b c a. (b -> c) -> (a -> b) -> a -> c
.(forall a. Num a => a -> a -> a
+WebNodeIdOffset
i)forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>forall a. Unbox a => Vector a -> [a]
UArr.toList Vector WebNodeIdOffset
outgn)forall a. [a] -> [a] -> [a]
++)) )
                     (WebNodeIdOffset
0,forall a. a -> a
id) Shaded x (Neighbourhood x y)
wnrsrc 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 :: forall v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
pumpHalfspace Norm v
rieM v
v (DualVector v
prevPlane, [v]
ws) = case forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
 DualSpaceWitness v
DualSpaceWitness -> 
  let    ϑs :: [ℝ]
ϑs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\v
u -> let x :: Scalar v
x = DualVector v
prevPlaneforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
u
                              y :: Scalar v
y = DualVector v
thisPlaneforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
u
                          in forall a. RealFloat a => a -> a -> a
atan2 (Scalar v
xforall a. Num a => a -> a -> a
-Scalar v
y) (Scalar v
xforall a. Num a => a -> a -> a
+Scalar v
y)) forall a b. (a -> b) -> a -> b
$ v
vforall 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 forall v. AdditiveGroup v => v -> v -> v
^+^ forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith 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
rieMforall v. LSpace v => Norm v -> v -> DualVector v
<$|v
vNudged
         thisPlane :: DualVector v
thisPlane = DualVector v
dv forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (DualVector v
dvforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
vNudged)
         cas :: a -> a
cas a
ϑ = forall a. Floating a => a -> a
cos forall a b. (a -> b) -> a -> b
$ a
ϑ forall a. Num a => a -> a -> a
- forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/a
4
  in if ℝ
δϑ forall a. Ord a => a -> a -> Bool
<= forall a. Floating a => a
pi then forall a. a -> Maybe a
Just 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
prevPlaneforall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*forall a. Floating a => a -> a
cas ℝ
ϑbest forall v. AdditiveGroup v => v -> v -> v
^+^ DualVector v
thisPlaneforall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*forall a. Floating a => a -> a
cas (-ℝ
ϑbest)
                 else forall a. Maybe a
Nothing

smallPseudorandSeq :: [ℝ]
smallPseudorandSeq :: [ℝ]
smallPseudorandSeq = (forall a. Num a => a -> a -> a
*ℝ
2forall a b. (Fractional a, Integral b) => a -> b -> a
^^(-Integer
45)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 forall a. a -> [a] -> [a]
: WebNodeIdOffset -> [WebNodeIdOffset]
lcg ((WebNodeIdOffset
aforall a. Num a => a -> a -> a
*WebNodeIdOffset
x)forall a. Integral a => a -> a -> a
`mod`WebNodeIdOffset
m)
       m :: WebNodeIdOffset
m = WebNodeIdOffset
2forall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
31 forall a. Num a => a -> a -> a
- WebNodeIdOffset
1
       a :: WebNodeIdOffset
a = WebNodeIdOffset
963345    :: Int  -- revised Park-Miller

data LinkingBadness r = LinkingBadness
    { forall r. 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.
    , forall r. 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 (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
<$ :: forall a b. a -> LinkingBadness b -> LinkingBadness a
$c<$ :: forall a b. a -> LinkingBadness b -> LinkingBadness a
fmap :: forall a b. (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 forall a. Ord a => a -> a -> Bool
>= ℝ
0  = LinkingBadness
   { gatherDirectionsBadness :: ℝ
gatherDirectionsBadness = ℝ
distSqforall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2 forall a. Fractional a => a -> a -> a
/ forall a. Ord a => a -> a -> a
max ℝ
0 (ℝ
distSqforall a. Num a => a -> a -> a
-ℝ
wallDistforall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2)
   , closeSystemBadness :: ℝ
closeSystemBadness = ℝ
distSq forall a. Num a => a -> a -> a
- ℝ
wallDistforall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2forall a. Fractional a => a -> a -> a
/ℝ
2
   }
  | Bool
otherwise     = forall r. r -> r -> LinkingBadness r
LinkingBadness (ℝ
1forall a. Fractional a => a -> a -> a
/ℝ
0) (ℝ
1forall a. Fractional a => a -> a -> a
/ℝ
0) 


bestNeighbours :: ∀ i v . (SimpleSpace v, Scalar v ~ ℝ)
                => Norm v -> [(i,v)] -> ([i], Maybe (DualVector v))
bestNeighbours :: forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> [(i, v)] -> ([i], Maybe (DualVector v))
bestNeighbours Norm v
lm' = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' :: forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> [(i, v)] -> ([(i, v)], Maybe (DualVector v))
bestNeighbours' Norm v
lm' = forall b a. Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn (\(i
_,v
v) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Norm v
lm'forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|v
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 forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
     DualSpaceWitness v
DualSpaceWitness ->
       let wall₀ :: DualVector v
wall₀ = DualVector v
w₀ forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (Variance v
lmforall 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'forall v. LSpace v => Norm v -> v -> DualVector v
<$|v
c₀δx
       in forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((i
c₀i,v
c₀δx)forall a. a -> [a] -> [a]
:)
              forall a b. (a -> b) -> a -> b
$ 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 = 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 :: 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, v)]
preserved [(i, v)]
cs
 | WebNodeIdOffset
dimension forall a. Eq a => a -> a -> Bool
== WebNodeIdOffset
1  = case forall b a. Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn
                       (\(i
_,v
δx) -> do
                          let wallDist :: ℝ
wallDist = - DualVector v
wallforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δx
                          forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ℝ
wallDist forall a. Ord a => a -> a -> Bool
> ℝ
0)
                          forall (m :: * -> *) a. Monad m => a -> m a
return ℝ
wallDist
                       ) [(i, v)]
cs of
     Just ((i, v)
r, [(i, v)]
_) -> ([(i, v)
r], forall a. Maybe a
Nothing)
     Maybe ((i, v), [(i, v)])
Nothing -> ([], forall a. a -> Maybe a
Just DualVector v
wall)
 where dimension :: WebNodeIdOffset
dimension = forall v. FiniteDimensional v => SubBasis v -> WebNodeIdOffset
subbasisDimension (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 forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v of
    DualSpaceWitness v
DualSpaceWitness ->
     case forall b a. Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn
            (\(i
_,v
δx) -> do
                let wallDist :: ℝ
wallDist = - DualVector v
wallforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δx
                    dx :: DualVector v
dx = Norm v
lm' forall v. LSpace v => Norm v -> v -> DualVector v
<$| v
δx
                    distSq :: Scalar v
distSq = DualVector v
dxforall 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
dxforall 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
distSqforall a. Num a => a -> a -> a
*ℝ
distSqo)
                                            -- β behaves basically like ϑ², where ϑ is
                                            -- the angle between two neighbour candidates.
                                   | (v
δxo, ℝ
distSqo) <- [(v, ℝ)]
prevWMag ]
                forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ℝ
wallDist forall a. Ord a => a -> a -> Bool
>= ℝ
0 Bool -> Bool -> Bool
&& ℝ
βmin forall a. Ord a => a -> a -> Bool
> ℝ
1e-3)
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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' <- 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)
                          -> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((i
i,v
δx)forall a. a -> [a] -> [a]
:)
                       forall a b. (a -> b) -> a -> b
$ 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'forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/(Variance v
lmforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|DualVector v
wall'))
                               (v
δxforall a. a -> [a] -> [a]
:[v]
prev) [] ([(i, v)]
preservedforall a. [a] -> [a] -> [a]
++[(i, v)]
cs')
           | ((i, v)
_:[(i, v)]
_)<-[(i, v)]
cs'  -> 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)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 <- 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)], forall a. Maybe a
Nothing)
                  closeSys ((i, v)
_:[(i, v)]
cs'') = [(i, v)] -> ([(i, v)], Maybe (DualVector v))
closeSys [(i, v)]
cs''
                  closeSys []
                   | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((i, v), LinkingBadness ℝ)]
closureCandidates  = ([], forall a. a -> Maybe a
Just DualVector v
wall)
                   | Bool
otherwise  = ([], forall a. Maybe a
Nothing)
                  closureCandidates :: [((i, v), LinkingBadness ℝ)]
closureCandidates = 
                   [ ((i
i,v
δx), LinkingBadness ℝ
badness)
                   | (i
i,v
δx) <- [(i, v)]
preservedforall a. [a] -> [a] -> [a]
++[(i, v)]
cs
                   , let wallDist :: ℝ
wallDist = - DualVector v
wallforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
δx
                         distSq :: Scalar v
distSq = forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Norm v
lm' v
δx
                   , ℝ
wallDist forall a. Ord a => a -> a -> Bool
> ℝ
0
                   , ℝ
wallDistforall a. Num a => a -> WebNodeIdOffset -> a
^WebNodeIdOffset
2 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$
                   forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a -> b) -> a -> b
$ forall r. LinkingBadness r -> r
closeSystemBadness forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [((i, v), LinkingBadness ℝ)]
closureCandidates
 where prevWMag :: [(v, ℝ)]
prevWMag = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& 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 :: forall b a. Ord b => (a -> Maybe b) -> [a] -> Maybe (a, [a])
extractSmallestOn a -> Maybe b
f = forall {a} {a}. Ord a => [(a, Maybe a)] -> Maybe (a, [a])
extract forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> a
id 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 [] = forall a. Maybe a
Nothing
       extract ((a
x, Just a
o):[(a, Maybe a)]
cs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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) = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
xforall a. a -> [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 forall a. Ord a => a -> a -> Bool
< a
ref   = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
refxforall 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) = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a
xforall 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 :: forall x y.
(WithField ℝ Manifold x, HasCallStack) =>
WebNodeIdOffset -> PointsWeb x y -> [[y]]
pathsTowards WebNodeIdOffset
target PointsWeb x y
web = forall w a. Writer w a -> w
execWriter forall a b. (a -> b) -> a -> b
$ 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) -> forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [WebLocally x y
yforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (WebLocally x y
yforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData))
       (\WebLocally x y
startNode (WriterT (Identity (υ
ν, [y]
pathTrav)))
            -> forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [WebLocally x y
startNodeforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData forall a. a -> [a] -> [a]
: [y]
pathTrav] forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 :: 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
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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure PointsWeb x (WebLocally x y)
web
       go [WebNodeIdOffset
_] PointsWeb x (WebLocally x y)
web = 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 forall a b. (a -> b) -> a -> b
$ 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')
                         = forall x y (f :: * -> *).
Functor f =>
WebNodeIdOffset
-> (y -> f y)
-> Shaded x y
-> Either WebNodeIdOffset (f (Shaded x y))
treeLeaf WebNodeIdOffset
i₁ (forall x y y. Lens (Neighbourhood x y) (Neighbourhood x y) y y
dataAtNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. Lens' (WebLocally x y) y
thisNodeData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure y
y')
                              forall a b. (a -> b) -> a -> b
$ 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₁forall a. a -> [a] -> [a]
:[WebNodeIdOffset]
is) forall a b. (a -> b) -> a -> b
$ 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₀) = 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₁) = 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 :: 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 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  = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Node "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show WebNodeIdOffset
targetforall a. [a] -> [a] -> [a]
++String
" not in web."
  | Bool
otherwise      = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall x y. WebLocally x y -> y
_thisNodeData) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
`execStateT`PointsWeb x (WebLocally x y)
envied) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [[WebNodeIdOffset]]
paths
                       forall a b. (a -> b) -> a -> b
$ \path :: [WebNodeIdOffset]
path@(WebNodeIdOffset
p₀:[WebNodeIdOffset]
_) -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \PointsWeb x (WebLocally x y)
webState -> do
                 let Just (x
_, WebLocally x y
node₀) = forall x y. PointsWeb x y -> WebNodeIdOffset -> Maybe (x, y)
indexWeb PointsWeb x (WebLocally x y)
webState WebNodeIdOffset
p₀
                 ((),) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall υ. WebLocally x y -> φ υ -> f υ
routeInitF WebLocally x y
node₀ (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 = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo forall a b. (a -> b) -> a -> b
$ 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)) = 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 (forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Floating a => a -> a
sqrt forall a b. (a -> b) -> a -> b
$ 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 forall a. [a] -> [a] -> [a]
++ [[WebNodeIdOffset]]
finishedThreads
                  (NodeSet
visited', [[WebNodeIdOffset]]
continuation, NodeSet
alternatives, [[WebNodeIdOffset]]
newFinished)
                       -> let newThreads :: [WebNodeIdOffset]
newThreads = 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
targetDistforall a. Num a => a -> a -> a
+WebNodeIdOffset
1)
                                (NodeSet -> NodeSet -> NodeSet
ℤSet.union NodeSet
visited' NodeSet
alternatives)
                                Bool
True
                                ([[WebNodeIdOffset]]
continuation forall a. [a] -> [a] -> [a]
++ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) a. Applicative f => a -> f a
pure [WebNodeIdOffset]
newThreads)
                                ([[WebNodeIdOffset]]
newFinished 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 forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing 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 <- forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
boundaryCreepingInhibitor
                                       forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WebLocally x y
cursorNode forall s a. s -> Getting a s a -> a
^. 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]
preferredforall a. [a] -> [a] -> [a]
++WebNodeIdOffset
cursorforall a. a -> [a] -> [a]
:[WebNodeIdOffset]
nds)forall a. a -> [a] -> [a]
:[[WebNodeIdOffset]]
contin''
                                    , NodeSet -> NodeSet -> NodeSet
ℤSet.union ([WebNodeIdOffset] -> NodeSet
ℤSet.fromList
                                                   forall a b. (a -> b) -> a -> b
$ [WebNodeIdOffset]
pAlts forall a. [a] -> [a] -> [a]
++ (forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst 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
                                                   forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset]))]
alts)
                                                 NodeSet
alts'
                                    , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [WebNodeIdOffset]
nds then [[WebNodeIdOffset]]
newFin
                                                  else (WebNodeIdOffset
cursorforall a. a -> [a] -> [a]
:[WebNodeIdOffset]
nds)forall a. a -> [a] -> [a]
:[[WebNodeIdOffset]]
newFin )
               where Just (x
cursorPos,WebLocally x y
cursorNode) = 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
cursorNodeforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct
                                  forall v. LSpace v => Norm v -> v -> DualVector v
<$| x
targetPos 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
cursorNodeforall s a. s -> Getting a s a -> a
^.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 forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing 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' = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=WebNodeIdOffset
preferred) [WebNodeIdOffset]
oldAlts
                                                    forall a. [a] -> [a] -> [a]
++ (forall a b. (a, b) -> a
fstforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[(WebNodeIdOffset, ℝ)]
alts)
                                     in if WebNodeIdOffset
d2goforall a. Ord a => a -> a -> Bool
>WebNodeIdOffset
1
                                         then WebNodeIdOffset
-> NodeSet
-> [WebNodeIdOffset]
-> [WebNodeIdOffset]
-> (([WebNodeIdOffset], (NodeSet, [WebNodeIdOffset])), ℝ)
goDfs (WebNodeIdOffset
d2goforall a. Num a => a -> a -> a
-WebNodeIdOffset
1) NodeSet
visited'' [WebNodeIdOffset]
alts'
                                                   (WebNodeIdOffset
preferredforall a. a -> [a] -> [a]
:WebNodeIdOffset
pforall a. a -> [a] -> [a]
:[WebNodeIdOffset]
old)
                                         else ( (WebNodeIdOffset
preferredforall a. a -> [a] -> [a]
:WebNodeIdOffset
pforall a. a -> [a] -> [a]
:[WebNodeIdOffset]
old, (NodeSet
visited'', [WebNodeIdOffset]
alts'))
                                              , ℝ
oppositionQ )
                                [] -> let δn :: Needle x
δn = x
explorePos forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! x
cursorPos
                                          oppositionQ :: Scalar (Needle x)
oppositionQ = DualVector (Needle x)
tgtOppforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
δn
                                      in ((WebNodeIdOffset
pforall a. a -> [a] -> [a]
:[WebNodeIdOffset]
old, (NodeSet
visited', [WebNodeIdOffset]
oldAlts)), Scalar (Needle x)
oppositionQ)
                      where Just (x
explorePos,WebLocally x y
exploreNode) = 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)
tgtOppforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
δn)
                                         | (WebNodeIdOffset
ngb, (Needle x
_, WebLocally x y
ngbN)) <- WebLocally x y
exploreNodeforall s a. s -> Getting a s a -> a
^.forall x y.
Lens'
  (WebLocally x y) [(WebNodeIdOffset, (Needle x, WebLocally x y))]
nodeNeighbours
                                         , WebNodeIdOffset
ngbWebNodeIdOffset -> NodeSet -> Bool
`ℤSet.notMember`NodeSet
visited'
                                         , forall a. Maybe a -> Bool
isNothing (WebLocally x y
ngbNforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane)
                                         , let δn :: Needle x
δn = WebLocally x y
ngbNforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! x
cursorPos ]