-- |
-- Module      : Data.Manifold.Web
-- Copyright   : (c) Justus Sagemüller 2016
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE ParallelListComp           #-}
{-# LANGUAGE UnicodeSyntax              #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE PatternGuards              #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE LiberalTypeSynonyms        #-}
{-# LANGUAGE TemplateHaskell            #-}


module Data.Manifold.Web (
              -- * The web data type
              PointsWeb
              -- ** Construction
            , fromWebNodes, fromShadeTree_auto, fromShadeTree, fromShaded
              -- ** Lookup
            , nearestNeighbour, indexWeb, toGraph, webBoundary
              -- ** Decomposition
            , sliceWeb_lin -- , sampleWebAlongLine_lin
            , sampleWeb_2Dcartesian_lin, sampleEntireWeb_2Dcartesian_lin
              -- ** Local environments
            , localFocusWeb
              -- * Uncertain functions
            , differentiateUncertainWebFunction, differentiate²UncertainWebFunction
            , localModels_CGrid
              -- * Differential equations
              -- ** Fixed resolution
            , iterateFilterDEqn_static, iterateFilterDEqn_pathwise
            , iterateFilterDEqn_static_selective
              -- ** Automatic resolution
            , filterDEqnSolutions_adaptive, iterateFilterDEqn_adaptive
              -- ** Configuration
            , InconsistencyStrategy(..)
            , InformationMergeStrategy(..)
            , naïve, inconsistencyAware, indicateInconsistencies, postponeInconsistencies
            , PropagationInconsistency(..)
              -- * Misc
            , ConvexSet(..), ellipsoid, ellipsoidSet, coerceWebDomain
            , rescanPDELocally, localOnion, webOnions, knitShortcuts
            ) where


import Data.List hiding (filter, all, foldr1)
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Vector as Arr
import qualified Data.Vector.Mutable as MArr
import qualified Data.Vector.Unboxed as UArr
import qualified Data.Array as PArr
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.List.FastNub (fastNub,fastNubBy)
import Data.Ord (comparing)
import Data.Semigroup
import Control.DeepSeq

import Data.VectorSpace
import Math.LinearMap.Category hiding (trace)

import Data.Tagged
import Data.Function (on)
import Data.Fixed (mod')

import Data.Manifold.Types
import Data.Manifold.Types.Primitive
import Data.Manifold.PseudoAffine
import Data.Manifold.Shade
import Data.Manifold.TreeCover
import Data.SetLike.Intersection
import Data.Manifold.Riemannian
import Data.Manifold.WithBoundary
import Data.Manifold.WithBoundary.Class
import Data.Manifold.Atlas
import Data.Manifold.Function.LocalModel
import Data.Manifold.Function.Quadratic
import Data.Function.Affine
import Data.Manifold.Web.Internal
import Data.Embedding
    
import qualified Prelude as Hask hiding(foldl, sum, sequence)
import qualified Control.Applicative as Hask
import qualified Control.Monad       as Hask hiding(forM_, sequence)
import Control.Monad.ST (runST)
import Data.STRef (newSTRef, modifySTRef, readSTRef)
import Control.Monad.Trans.State
import Control.Monad.Trans.List
import Control.Monad.Trans.Except
import Control.Monad.Trans.Writer hiding (censor)
import Data.Functor.Identity (Identity(..))
import qualified Data.Foldable       as Hask
import Data.Foldable (all, toList)
import qualified Data.Traversable as Hask
import Data.Traversable (forM)
import Data.Graph

import Control.Category.Constrained.Prelude hiding
     ((^), all, elem, sum, forM, Foldable(..), foldr1, Traversable, traverse)
import Control.Arrow.Constrained
import Control.Monad.Constrained hiding (forM)
import Data.Foldable.Constrained
import Data.Traversable.Constrained (Traversable, traverse)

import Control.Comonad (Comonad(..))
import Control.Comonad.Cofree
import Control.Lens ((&), (%~), (^.), (.~), (+~), ix, iover, indexing)
import Control.Lens.TH

import GHC.Generics (Generic)

import Development.Placeholders


unlinkedFromWebNodes :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
                    => (MetricChoice x) -> [(x,y)] -> PointsWeb x y
unlinkedFromWebNodes :: MetricChoice x -> [(x, y)] -> PointsWeb x y
unlinkedFromWebNodes MetricChoice x
mf = MetricChoice x -> Shaded x y -> PointsWeb x y
forall x y.
SimpleSpace (Needle x) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
unlinkedFromShaded MetricChoice x
mf (Shaded x y -> PointsWeb x y)
-> ([(x, y)] -> Shaded x y) -> [(x, y)] -> PointsWeb x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [(x, y)] -> Shaded x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
[(x, y)] -> Shaded x y
fromLeafPoints_

fromWebNodes :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
                    => (MetricChoice x) -> [(x,y)] -> PointsWeb x y
fromWebNodes :: MetricChoice x -> [(x, y)] -> PointsWeb x y
fromWebNodes MetricChoice x
mf = MetricChoice x -> Shaded x y -> PointsWeb x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded MetricChoice x
mf (Shaded x y -> PointsWeb x y)
-> ([(x, y)] -> Shaded x y) -> [(x, y)] -> PointsWeb x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [(x, y)] -> Shaded x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
[(x, y)] -> Shaded x y
fromLeafPoints_

fromTopWebNodes :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
                    => (MetricChoice x) -> [((x,[Int+Needle x]),y)] -> PointsWeb x y
fromTopWebNodes :: MetricChoice x -> [((x, [Int + Needle x]), y)] -> PointsWeb x y
fromTopWebNodes MetricChoice x
mf = MetricChoice x -> Shaded x ([Int + Needle x], y) -> PointsWeb x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x ([Int + Needle x], y) -> PointsWeb x y
fromTopShaded MetricChoice x
mf (Shaded x ([Int + Needle x], y) -> PointsWeb x y)
-> ([((x, [Int + Needle x]), y)] -> Shaded x ([Int + Needle x], y))
-> [((x, [Int + Needle x]), y)]
-> PointsWeb x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [(x, ([Int + Needle x], y))] -> Shaded x ([Int + Needle x], y)
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
[(x, y)] -> Shaded x y
fromLeafPoints_ ([(x, ([Int + Needle x], y))] -> Shaded x ([Int + Needle x], y))
-> ([((x, [Int + Needle x]), y)] -> [(x, ([Int + Needle x], y))])
-> [((x, [Int + Needle x]), y)]
-> Shaded x ([Int + Needle x], y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (((x, [Int + Needle x]), y) -> (x, ([Int + Needle x], y)))
-> [((x, [Int + Needle x]), y)] -> [(x, ([Int + Needle x], y))]
forall a b. (a -> b) -> [a] -> [b]
map ((x, [Int + Needle x]), y) -> (x, ([Int + Needle x], y))
forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup'

fromShadeTree_auto :: ∀ x . (WithField ℝ Manifold x, SimpleSpace (Needle x))
                              => ShadeTree x -> PointsWeb x ()
fromShadeTree_auto :: ShadeTree x -> PointsWeb x ()
fromShadeTree_auto = MetricChoice x -> ShadeTree x -> PointsWeb x ()
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded (Norm (DualVector (Needle x)) -> Norm (Needle x)
forall v. SimpleSpace v => Variance v -> Norm v
dualNorm' (Norm (DualVector (Needle x)) -> Norm (Needle x))
-> (Shade x -> Norm (DualVector (Needle x))) -> MetricChoice x
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Shade x -> Norm (DualVector (Needle x))
forall x. Shade x -> Metric' x
_shadeExpanse) (ShadeTree x -> PointsWeb x ())
-> (ShadeTree x -> ShadeTree x) -> ShadeTree x -> PointsWeb x ()
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. () -> ShadeTree x -> ShadeTree x
forall y x y₀. y -> Shaded x y₀ -> Shaded x y
constShaded ()

fromShadeTree :: ∀ x . (WithField ℝ Manifold x, SimpleSpace (Needle x))
     => (Shade x -> Metric x) -> ShadeTree x -> PointsWeb x ()
fromShadeTree :: (Shade x -> Metric x) -> ShadeTree x -> PointsWeb x ()
fromShadeTree Shade x -> Metric x
mf = (Shade x -> Metric x) -> ShadeTree x -> PointsWeb x ()
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded Shade x -> Metric x
mf (ShadeTree x -> PointsWeb x ())
-> (ShadeTree x -> ShadeTree x) -> ShadeTree x -> PointsWeb x ()
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. () -> ShadeTree x -> ShadeTree x
forall y x y₀. y -> Shaded x y₀ -> Shaded x y
constShaded ()

fromShaded :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
     => (MetricChoice x) -- ^ Local scalar-product generator. You can always
                              --   use @'recipMetric' . '_shadeExpanse'@ (but this
                              --   may give distortions compared to an actual
                              --   Riemannian metric).
     -> (x`Shaded`y)          -- ^ Source tree.
     -> PointsWeb x y
fromShaded :: MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded MetricChoice x
metricf = MetricChoice x -> PointsWeb x y -> PointsWeb x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> PointsWeb x y -> PointsWeb x y
knitShortcuts MetricChoice x
metricf (PointsWeb x y -> PointsWeb x y)
-> (Shaded x y -> PointsWeb x y) -> Shaded x y -> PointsWeb x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x y -> PointsWeb x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
PointsWeb x y -> PointsWeb x y
autoLinkWeb (PointsWeb x y -> PointsWeb x y)
-> (Shaded x y -> PointsWeb x y) -> Shaded x y -> PointsWeb x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. MetricChoice x -> Shaded x y -> PointsWeb x y
forall x y.
SimpleSpace (Needle x) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
unlinkedFromShaded MetricChoice x
metricf

toShaded :: WithField ℝ PseudoAffine x => PointsWeb x y -> (x`Shaded`y)
toShaded :: PointsWeb x y -> Shaded x y
toShaded (PointsWeb Shaded x (Neighbourhood x y)
shd) = (Neighbourhood x y -> y)
-> Shaded x (Neighbourhood x y) -> Shaded x y
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap Neighbourhood x y -> y
forall x y. Neighbourhood x y -> y
_dataAtNode Shaded x (Neighbourhood x y)
shd

unlinkedFromShaded :: ∀ x y . SimpleSpace (Needle x)
                 => MetricChoice x -> (x`Shaded`y) -> PointsWeb x y
unlinkedFromShaded :: MetricChoice x -> Shaded x y -> PointsWeb x y
unlinkedFromShaded MetricChoice x
metricf = Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb(Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> (Shaded x y -> Shaded x (Neighbourhood x y))
-> Shaded x y
-> PointsWeb x y
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
<<<(y -> Neighbourhood x y)
-> Shaded x y -> Shaded x (Neighbourhood x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((y -> Neighbourhood x y)
 -> Shaded x y -> Shaded x (Neighbourhood x y))
-> (y -> Neighbourhood x y)
-> Shaded x y
-> Shaded x (Neighbourhood x y)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
`id` \y
y
                -> y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y Vector Int
forall a. Monoid a => a
mempty Metric x
nm (Needle' x -> Maybe (Needle' x)
forall a. a -> Maybe a
Just Needle' x
dv)
 where nm :: Metric x
nm = MetricChoice x
metricf [Char]
[Char] -> PlaceholderException
PlaceholderException -> Shade x
(PlaceholderException -> Shade x)
-> PlaceholderException -> Shade x
forall a e. Exception e => e -> a
forall a b. (a -> b) -> a -> b
$ :: forall a b. (a -> b) -> a -> b
throw :: forall a e. Exception e => e -> a
$notImplemented
       dv :: Needle' x
dv = [Needle' x] -> Needle' x
forall a. [a] -> a
head ([Needle' x] -> Needle' x) -> [Needle' x] -> Needle' x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric x -> [Needle' x]
forall v. SimpleSpace v => Seminorm v -> [DualVector v]
normSpanningSystem Metric x
nm



autoLinkWeb :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
                => PointsWeb x y -> PointsWeb x y
autoLinkWeb :: PointsWeb x y -> PointsWeb x y
autoLinkWeb = Identity (PointsWeb x y) -> PointsWeb x y
forall a. Identity a -> a
runIdentity (Identity (PointsWeb x y) -> PointsWeb x y)
-> (PointsWeb x y -> Identity (PointsWeb x y))
-> PointsWeb x y
-> PointsWeb x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (NodeInWeb x y -> Identity (Neighbourhood x y))
-> PointsWeb x y -> Identity (PointsWeb x y)
forall (f :: * -> *) x y z.
Applicative f =>
(NodeInWeb x y -> f (Neighbourhood x z))
-> PointsWeb x y -> f (PointsWeb x z)
traverseNodesInEnvi ( Neighbourhood x y -> Identity (Neighbourhood x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Neighbourhood x y -> Identity (Neighbourhood x y))
-> (NodeInWeb x y -> Neighbourhood x y)
-> NodeInWeb x y
-> Identity (Neighbourhood x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [(Int, Needle x)]
-> (NodeInWeb x y, [[(Int, (x, Neighbourhood x y))]])
-> Neighbourhood x y
fetchNgbs []
                                                  ((NodeInWeb x y, [[(Int, (x, Neighbourhood x y))]])
 -> Neighbourhood x y)
-> (NodeInWeb x y
    -> (NodeInWeb x y, [[(Int, (x, Neighbourhood x y))]]))
-> NodeInWeb x y
-> Neighbourhood x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (NodeInWeb x y -> NodeInWeb x y
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id (NodeInWeb x y -> NodeInWeb x y)
-> (NodeInWeb x y -> [[(Int, (x, Neighbourhood x y))]])
-> NodeInWeb x y
-> (NodeInWeb x y, [[(Int, (x, Neighbourhood x y))]])
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& (Int, Int) -> NodeInWeb x y -> [[(Int, (x, Neighbourhood x y))]]
forall x y.
(PseudoAffine x, Scalar (Needle x) ~ ℝ,
 Scalar (DualVector (Needle x)) ~ ℝ) =>
(Int, Int) -> NodeInWeb x y -> [[(Int, (x, Neighbourhood x y))]]
findEnviPts (Int
0,Int
1)) )
 where fetchNgbs :: [(WebNodeIdOffset, Needle x)]
                 -> (NodeInWeb x y, [[(WebNodeIdOffset, (x, Neighbourhood x y))]])
                 -> Neighbourhood x y
       fetchNgbs :: [(Int, Needle x)]
-> (NodeInWeb x y, [[(Int, (x, Neighbourhood x y))]])
-> Neighbourhood x y
fetchNgbs [(Int, Needle x)]
alreadyFound
                 ( NodeInWeb (x
x, Neighbourhood y
y Vector Int
aprNgbs Metric x
locMetr (Just Needle' x
wall))
                             [(Shaded x (Neighbourhood x y), Int)]
layersAroundThis
                 , [[(Int, (x, Neighbourhood x y))]]
enviLayers )
         | (Int
δi, (Needle x
v, Neighbourhood x y
nh)) : [(Int, (Needle x, Neighbourhood x y))]
_ <- [(Int, (Needle x, Neighbourhood x y))]
newNgbCandidates
             = [(Int, Needle x)]
-> (NodeInWeb x y, [[(Int, (x, Neighbourhood x y))]])
-> Neighbourhood x y
fetchNgbs
                ((Int
δi, Needle x
v) (Int, Needle x) -> [(Int, Needle x)] -> [(Int, Needle x)]
forall a. a -> [a] -> [a]
: [(Int, Needle x)]
alreadyFound)
                ( (x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), Int)] -> NodeInWeb x y
forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), Int)] -> NodeInWeb x y
NodeInWeb (x
x, y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y (Int -> Vector Int -> Vector Int
forall a. Unbox a => a -> Vector a -> Vector a
UArr.cons Int
δi Vector Int
aprNgbs) Metric x
locMetr
                                  (Maybe (Needle' x) -> Neighbourhood x y)
-> Maybe (Needle' x) -> Neighbourhood x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ if Int
dimension Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                                     then Metric x
-> Needle x -> (Needle' x, [Needle x]) -> Maybe (Needle' x)
forall v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
pumpHalfspace Metric x
locMetr Needle x
v
                                                 (Needle' x
wall, (Int, Needle x) -> Needle x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((Int, Needle x) -> Needle x) -> [(Int, Needle x)] -> [Needle x]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Int, Needle x)]
alreadyFound)
                                     else case [(Int, Needle x)]
alreadyFound of
                                            [] -> Needle' x -> Maybe (Needle' x)
forall a. a -> Maybe a
Just (Needle' x -> Maybe (Needle' x)) -> Needle' x -> Maybe (Needle' x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric x
locMetrMetric x -> Needle x -> Needle' x
forall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle x
v
                                            [(Int, Needle x)
_] -> Maybe (Needle' x)
forall a. Maybe a
Nothing
                                                 )
                            [(Shaded x (Neighbourhood x y), Int)]
layersAroundThis
                , [[(Int, (x, Neighbourhood x y))]]
enviLayers )
        where newNgbCandidates :: [(Int, (Needle x, Neighbourhood x y))]
newNgbCandidates
                  = [ (Int
δi, (Needle x
v, Neighbourhood x y
nh))
                    | [(Int, (x, Neighbourhood x y))]
envi <- [[(Int, (x, Neighbourhood x y))]]
enviLayers
                    , (Int
δi, ((Needle x
v,ℝ
_), Neighbourhood x y
nh)) <- ((Int, ((Needle x, ℝ), Neighbourhood x y))
 -> (Int, ((Needle x, ℝ), Neighbourhood x y)) -> Ordering)
-> [(Int, ((Needle x, ℝ), Neighbourhood x y))]
-> [(Int, ((Needle x, ℝ), Neighbourhood x y))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, ((Needle x, ℝ), Neighbourhood x y)) -> ℝ)
-> (Int, ((Needle x, ℝ), Neighbourhood x y))
-> (Int, ((Needle x, ℝ), Neighbourhood x y))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Int, ((Needle x, ℝ), Neighbourhood x y)) -> ℝ)
 -> (Int, ((Needle x, ℝ), Neighbourhood x y))
 -> (Int, ((Needle x, ℝ), Neighbourhood x y))
 -> Ordering)
-> ((Int, ((Needle x, ℝ), Neighbourhood x y)) -> ℝ)
-> (Int, ((Needle x, ℝ), Neighbourhood x y))
-> (Int, ((Needle x, ℝ), Neighbourhood x y))
-> Ordering
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Needle x, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((Needle x, ℝ) -> ℝ)
-> ((Int, ((Needle x, ℝ), Neighbourhood x y)) -> (Needle x, ℝ))
-> (Int, ((Needle x, ℝ), Neighbourhood x y))
-> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((Needle x, ℝ), Neighbourhood x y) -> (Needle x, ℝ)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst (((Needle x, ℝ), Neighbourhood x y) -> (Needle x, ℝ))
-> ((Int, ((Needle x, ℝ), Neighbourhood x y))
    -> ((Needle x, ℝ), Neighbourhood x y))
-> (Int, ((Needle x, ℝ), Neighbourhood x y))
-> (Needle x, ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int, ((Needle x, ℝ), Neighbourhood x y))
-> ((Needle x, ℝ), Neighbourhood x y)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
                                  [ (Int
δi, ((Needle x
v, if Int
dimension Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
                                               then LinkingBadness ℝ -> ℝ
forall r. LinkingBadness r -> r
gatherDirectionsBadness
                                                 (LinkingBadness ℝ -> ℝ) -> LinkingBadness ℝ -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> LinkingBadness ℝ
linkingUndesirability ℝ
Scalar (Needle x)
distSq ℝ
Scalar (Needle x)
wallDist
                                               else ℝ
Scalar (Needle x)
distSq
                                                 ), Neighbourhood x y
nh))
                                  | (Int
δi,(x
xp,Neighbourhood x y
nh)) <- [(Int, (x, Neighbourhood x y))]
envi
                                  , let Just Needle x
v = x
xpx -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
x
                                        distSq :: Scalar (Needle x)
distSq = Metric x -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric x
locMetr Needle x
v
                                        wallDist :: Scalar (Needle x)
wallDist = Needle' x
wallnNeedle' x -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
v
                                  , ℝ
Scalar (Needle x)
wallDist ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>= ℝ
0
                                  , ℝ
Scalar (Needle x)
distSq ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
Scalar (Needle x)
wallDistℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2
                                     Bool -> Bool -> Bool
|| Int
dimensionInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
1 -- in 1D, we must allow linking
                                                     -- to the direct opposite
                                                     -- (there IS no other direction)
                                  , Bool -> Bool
not (Bool -> Bool) -> ([Int] -> Bool) -> [Int] -> Bool
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
δi) ([Int] -> Bool) -> [Int] -> Bool
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Vector Int -> [Int]
forall a. Unbox a => Vector a -> [a]
UArr.toList Vector Int
aprNgbs
                                                        [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ ((Int, Needle x) -> Int) -> [(Int, Needle x)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Needle x) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst [(Int, Needle x)]
alreadyFound
                                  ] ]
              locMetr' :: Variance (Needle x)
locMetr' = Metric x -> Variance (Needle x)
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric x
locMetr
              walln :: Needle' x
walln = Needle' x
wall Needle' x -> ℝ -> Needle' x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (- (Variance (Needle x)
locMetr'Variance (Needle x) -> Needle' x -> Scalar (Needle' x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|Needle' x
wall))
       fetchNgbs [(Int, Needle x)]
_ (NodeInWeb (x
_, Neighbourhood x y
d) [(Shaded x (Neighbourhood x y), Int)]
_, [[(Int, (x, Neighbourhood x y))]]
_) = Neighbourhood x y
d
       findEnviPts :: (Int, Int) -> NodeInWeb x y -> [[(Int, (x, Neighbourhood x y))]]
findEnviPts (Int
iw,Int
wedgeSize) (NodeInWeb (x, Neighbourhood x y)
tr ((Shaded x (Neighbourhood x y)
envi,Int
iSpl):[(Shaded x (Neighbourhood x y), Int)]
envis))
                  = ([Int]
-> [(x, Neighbourhood x y)] -> [(Int, (x, Neighbourhood x y))]
forall a b. [a] -> [b] -> [(a, b)]
zip [-Int
iwInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iSpl ..] [(x, Neighbourhood x y)]
preds [(Int, (x, Neighbourhood x y))]
-> [(Int, (x, Neighbourhood x y))]
-> [(Int, (x, Neighbourhood x y))]
forall a. [a] -> [a] -> [a]
++ [Int]
-> [(x, Neighbourhood x y)] -> [(Int, (x, Neighbourhood x y))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
wedgeSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
iw ..] [(x, Neighbourhood x y)]
succs)
                     [(Int, (x, Neighbourhood x y))]
-> [[(Int, (x, Neighbourhood x y))]]
-> [[(Int, (x, Neighbourhood x y))]]
forall a. a -> [a] -> [a]
: (Int, Int) -> NodeInWeb x y -> [[(Int, (x, Neighbourhood x y))]]
findEnviPts (Int
iwInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
iSpl, Int
wedgeSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
iSpl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(x, Neighbourhood x y)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(x, Neighbourhood x y)]
succs)
                                   ((x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), Int)] -> NodeInWeb x y
forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), Int)] -> NodeInWeb x y
NodeInWeb (x, Neighbourhood x y)
tr [(Shaded x (Neighbourhood x y), Int)]
envis)
               where ([(x, Neighbourhood x y)]
preds, [(x, Neighbourhood x y)]
succs) = Int
-> [(x, Neighbourhood x y)]
-> ([(x, Neighbourhood x y)], [(x, Neighbourhood x y)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
iSpl ([(x, Neighbourhood x y)]
 -> ([(x, Neighbourhood x y)], [(x, Neighbourhood x y)]))
-> [(x, Neighbourhood x y)]
-> ([(x, Neighbourhood x y)], [(x, Neighbourhood x y)])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shaded x (Neighbourhood x y) -> [(x, Neighbourhood x y)]
forall x y. WithField ℝ PseudoAffine x => Shaded x y -> [(x, y)]
onlyLeaves Shaded x (Neighbourhood x y)
envi
       findEnviPts (Int, Int)
_ NodeInWeb x y
_ = []
       dimension :: Int
dimension = SubBasis (Needle x) -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis (Needle x)
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis (Needle x))

fromTopShaded :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
     => (MetricChoice x)
     -> (x`Shaded`([Int+Needle x], y))
                      -- ^ Source tree, with topology information
                      --   (IDs of neighbour-candidates, or needles pointing to them)
     -> PointsWeb x y
fromTopShaded :: MetricChoice x -> Shaded x ([Int + Needle x], y) -> PointsWeb x y
fromTopShaded MetricChoice x
metricf Shaded x ([Int + Needle x], y)
shd = [Char]
[Char] -> PlaceholderException
PlaceholderException -> PointsWeb x y
(PlaceholderException -> PointsWeb x y)
-> PlaceholderException -> PointsWeb x y
forall a e. Exception e => e -> a
forall a b. (a -> b) -> a -> b
$ :: forall a b. (a -> b) -> a -> b
throw :: forall a e. Exception e => e -> a
$notImplemented


-- | Re-calculate the links in a web, so as to give each point a satisfyingly
--   “complete-spanning” environment.
smoothenWebTopology :: (WithField ℝ Manifold x, SimpleSpace (Needle x))
             => MetricChoice x -> PointsWeb x y -> PointsWeb x y
smoothenWebTopology :: MetricChoice x -> PointsWeb x y -> PointsWeb x y
smoothenWebTopology = MetricChoice x -> PointsWeb x y -> PointsWeb x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> PointsWeb x y -> PointsWeb x y
knitShortcuts



type OSNeedle x = (Needle' x, Needle x)
type OSNode x y = (OSNeedle x, WebLocally x y)
type CPCone x = (Needle' x, ℝ)


-- | Consider at each node not just the connections to already known neighbours, but
--   also the connections to /their/ neighbours. If these next-neighbours turn out
--   to be actually situated closer, link to them directly.
knitShortcuts :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
             => MetricChoice x -> PointsWeb x y -> PointsWeb x y
knitShortcuts :: MetricChoice x -> PointsWeb x y -> PointsWeb x y
knitShortcuts MetricChoice x
metricf PointsWeb x y
w₀ = MetricChoice x
-> (WebLocally x y -> [Int]) -> PointsWeb x y -> PointsWeb x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x
-> (WebLocally x y -> [Int]) -> PointsWeb x y -> PointsWeb x y
tweakWebGeometry MetricChoice x
metricf WebLocally x y -> [Int]
closeObtuseAngles
                             (PointsWeb x y -> PointsWeb x y) -> PointsWeb x y -> PointsWeb x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> PointsWeb x y -> PointsWeb x y
pseudoFixMaximise (PointsWeb x y -> ℝ
rateLinkings PointsWeb x y
w₀) PointsWeb x y
w₀
 where pseudoFixMaximise :: ℝ -> PointsWeb x y -> PointsWeb x y
pseudoFixMaximise ℝ
oldBadness PointsWeb x y
oldSt
         | ℝ
newBadness ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< ℝ
oldBadness  = ℝ -> PointsWeb x y -> PointsWeb x y
pseudoFixMaximise ℝ
newBadness PointsWeb x y
newSt
         | Bool
otherwise                = PointsWeb x y
newSt
        where newSt :: PointsWeb x y
newSt = MetricChoice x
-> (WebLocally x y -> [Int]) -> PointsWeb x y -> PointsWeb x y
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x
-> (WebLocally x y -> [Int]) -> PointsWeb x y -> PointsWeb x y
tweakWebGeometry MetricChoice x
metricf WebLocally x y -> [Int]
pickNewNeighbours
                          (PointsWeb x y -> PointsWeb x y) -> PointsWeb x y -> PointsWeb x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ PointsWeb x y -> PointsWeb x y
forall x y. PointsWeb x y -> PointsWeb x y
bidirectionaliseWebLinks PointsWeb x y
oldSt
              newBadness :: ℝ
newBadness = PointsWeb x y -> ℝ
rateLinkings PointsWeb x y
newSt
       rateLinkings :: PointsWeb x y -> Double
       rateLinkings :: PointsWeb x y -> ℝ
rateLinkings = (WebLocally x y -> ℝ) -> PointsWeb x (WebLocally x y) -> ℝ
forall (f :: * -> *) n a.
(Foldable f, Floating n) =>
(a -> n) -> f a -> n
geometricMeanOf WebLocally x y -> ℝ
rateNode (PointsWeb x (WebLocally x y) -> ℝ)
-> (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> PointsWeb x y
-> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo
       rateNode :: WebLocally x y -> Double
       rateNode :: WebLocally x y -> ℝ
rateNode WebLocally x y
info = ((Int, (Needle x, WebLocally x y)) -> ℝ)
-> [(Int, (Needle x, WebLocally x y))] -> ℝ
forall (f :: * -> *) n a.
(Foldable f, Floating n) =>
(a -> n) -> f a -> n
geometricMeanOf
             (\(Int
_, (Needle x
δx,WebLocally x y
_)) -> WebLocally x y
infoWebLocally x y
-> Getting
     (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
-> Seminorm (Needle x)
forall s a. s -> Getting a s a -> a
^.Getting
  (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProductSeminorm (Needle x) -> Needle x -> Scalar (Needle x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|Needle x
δx)
             ([(Int, (Needle x, WebLocally x y))] -> ℝ)
-> [(Int, (Needle x, WebLocally x y))] -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x y
infoWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
       
       pickNewNeighbours :: WebLocally x y -> [WebNodeId]
       pickNewNeighbours :: WebLocally x y -> [Int]
pickNewNeighbours WebLocally x y
me = (Int, Needle x) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((Int, Needle x) -> Int) -> [(Int, Needle x)] -> [Int]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Maybe (DualVector (Needle x))
-> [Needle x] -> [[(Int, Needle x)]] -> [(Int, Needle x)]
go Maybe (DualVector (Needle x))
forall a. Maybe a
Nothing [] [[(Int, Needle x)]]
candidates
        where go :: Maybe (DualVector (Needle x))
-> [Needle x] -> [[(Int, Needle x)]] -> [(Int, Needle x)]
go Maybe (DualVector (Needle x))
Nothing [Needle x]
prevs ([(Int, Needle x)]
cs:[[(Int, Needle x)]]
ccs) = case Seminorm (Needle x)
-> [(Int, Needle x)]
-> ([(Int, Needle x)], Maybe (DualVector (Needle x)))
forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> [(i, v)] -> ([(i, v)], Maybe (DualVector v))
bestNeighbours' Seminorm (Needle x)
lm' [(Int, Needle x)]
cs of
                        ([(Int, Needle x)]
links, Maybe (DualVector (Needle x))
Nothing) -> [(Int, Needle x)]
links
                        ([(Int, Needle x)]
links, Just DualVector (Needle x)
newWall)
                         | Just DualVector (Needle x)
_ <- WebLocally x y
meWebLocally x y
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x y)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x y)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane -> [(Int, Needle x)]
links
                         | Bool
otherwise  ->
                             [(Int, Needle x)]
links [(Int, Needle x)] -> [(Int, Needle x)] -> [(Int, Needle x)]
forall a. [a] -> [a] -> [a]
++ Maybe (DualVector (Needle x))
-> [Needle x] -> [[(Int, Needle x)]] -> [(Int, Needle x)]
go (DualVector (Needle x) -> Maybe (DualVector (Needle x))
forall a. a -> Maybe a
Just DualVector (Needle x)
newWall) (((Int, Needle x) -> Needle x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((Int, Needle x) -> Needle x) -> [(Int, Needle x)] -> [Needle x]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Int, Needle x)]
links) [Needle x] -> [Needle x] -> [Needle x]
forall a. [a] -> [a] -> [a]
++ [Needle x]
prevs) [[(Int, Needle x)]]
ccs
              go (Just DualVector (Needle x)
wall) [Needle x]
prevs ([(Int, Needle x)]
cs:[[(Int, Needle x)]]
ccs) = case Seminorm (Needle x)
-> Variance (Needle x)
-> DualVector (Needle x)
-> [Needle x]
-> [(Int, Needle x)]
-> [(Int, Needle x)]
-> ([(Int, Needle x)], Maybe (DualVector (Needle x)))
forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
gatherGoodNeighbours
                               Seminorm (Needle x)
lm' Variance (Needle x)
lm DualVector (Needle x)
wall [Needle x]
prevs [] [(Int, Needle x)]
cs of
                        ([(Int, Needle x)]
links, Maybe (DualVector (Needle x))
Nothing) -> [(Int, Needle x)]
links
                        ([(Int, Needle x)]
links, Just DualVector (Needle x)
newWall)
                         | Maybe (DualVector (Needle x))
Nothing <- WebLocally x y
meWebLocally x y
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x y)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x y)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                         , ([(Int, Needle x)]
_:[[(Int, Needle x)]]
_) <-[[(Int, Needle x)]]
ccs ->
                             [(Int, Needle x)]
links [(Int, Needle x)] -> [(Int, Needle x)] -> [(Int, Needle x)]
forall a. [a] -> [a] -> [a]
++ Maybe (DualVector (Needle x))
-> [Needle x] -> [[(Int, Needle x)]] -> [(Int, Needle x)]
go (DualVector (Needle x) -> Maybe (DualVector (Needle x))
forall a. a -> Maybe a
Just DualVector (Needle x)
newWall) (((Int, Needle x) -> Needle x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((Int, Needle x) -> Needle x) -> [(Int, Needle x)] -> [Needle x]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Int, Needle x)]
links) [Needle x] -> [Needle x] -> [Needle x]
forall a. [a] -> [a] -> [a]
++ [Needle x]
prevs) [[(Int, Needle x)]]
ccs
                         | Bool
otherwise   -> [(Int, Needle x)]
links
              go Maybe (DualVector (Needle x))
_ [Needle x]
_ [] = []
              lm' :: Seminorm (Needle x)
lm' = WebLocally x y
meWebLocally x y
-> Getting
     (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
-> Seminorm (Needle x)
forall s a. s -> Getting a s a -> a
^.Getting
  (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct :: Metric x
              lm :: Variance (Needle x)
lm = Seminorm (Needle x) -> Variance (Needle x)
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Seminorm (Needle x)
lm'
              candidates :: [[(WebNodeId, Needle x)]]
              candidates :: [[(Int, Needle x)]]
candidates = [(Int, Needle x)]
preferred [(Int, Needle x)] -> [[(Int, Needle x)]] -> [[(Int, Needle x)]]
forall a. a -> [a] -> [a]
: [[(Int, Needle x)]]
other
               where ([(Int, Needle x)]
preferred, [[(Int, Needle x)]]
other) = case WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x y
me [] of
                       [(Needle x, WebLocally x y)]
_l₀:[(Needle x, WebLocally x y)]
l₁:[(Needle x, WebLocally x y)]
l₂:[[(Needle x, WebLocally x y)]]
ls -> ( (WebLocally x y -> Int)
-> (WebLocally x y, Needle x) -> (Int, Needle x)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first WebLocally x y -> Int
forall x y. WebLocally x y -> Int
_thisNodeId ((WebLocally x y, Needle x) -> (Int, Needle x))
-> ((Needle x, WebLocally x y) -> (WebLocally x y, Needle x))
-> (Needle x, WebLocally x y)
-> (Int, Needle x)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Needle x, WebLocally x y) -> (WebLocally x y, Needle x)
forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap ((Needle x, WebLocally x y) -> (Int, Needle x))
-> [(Needle x, WebLocally x y)] -> [(Int, Needle x)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> ([(Needle x, WebLocally x y)]
l₁[(Needle x, WebLocally x y)]
-> [(Needle x, WebLocally x y)] -> [(Needle x, WebLocally x y)]
forall a. [a] -> [a] -> [a]
++[(Needle x, WebLocally x y)]
l₂)
                                       , ((Needle x, WebLocally x y) -> (Int, Needle x))
-> [(Needle x, WebLocally x y)] -> [(Int, Needle x)]
forall a b. (a -> b) -> [a] -> [b]
map ((WebLocally x y -> Int)
-> (WebLocally x y, Needle x) -> (Int, Needle x)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first WebLocally x y -> Int
forall x y. WebLocally x y -> Int
_thisNodeId ((WebLocally x y, Needle x) -> (Int, Needle x))
-> ((Needle x, WebLocally x y) -> (WebLocally x y, Needle x))
-> (Needle x, WebLocally x y)
-> (Int, Needle x)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Needle x, WebLocally x y) -> (WebLocally x y, Needle x)
forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap) ([(Needle x, WebLocally x y)] -> [(Int, Needle x)])
-> [[(Needle x, WebLocally x y)]] -> [[(Int, Needle x)]]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [[(Needle x, WebLocally x y)]]
ls )
                       [[(Needle x, WebLocally x y)]
_l₀,[(Needle x, WebLocally x y)]
l₁] -> ((WebLocally x y -> Int)
-> (WebLocally x y, Needle x) -> (Int, Needle x)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first WebLocally x y -> Int
forall x y. WebLocally x y -> Int
_thisNodeId ((WebLocally x y, Needle x) -> (Int, Needle x))
-> ((Needle x, WebLocally x y) -> (WebLocally x y, Needle x))
-> (Needle x, WebLocally x y)
-> (Int, Needle x)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Needle x, WebLocally x y) -> (WebLocally x y, Needle x)
forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap ((Needle x, WebLocally x y) -> (Int, Needle x))
-> [(Needle x, WebLocally x y)] -> [(Int, Needle x)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [(Needle x, WebLocally x y)]
l₁, [])
       
       closeObtuseAngles :: WebLocally x y -> [WebNodeId]
       closeObtuseAngles :: WebLocally x y -> [Int]
closeObtuseAngles WebLocally x y
me = [OSNeedle x] -> [OSNode x y] -> [Int]
go [ (DualVector (Needle x)
dv,Needle x
v) OSNeedle x -> ℝ -> OSNeedle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ ℝ -> ℝ
forall a. Floating a => a -> a
sqrt (DualVector (Needle x)
dvDualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
v)
                                 | (Int
i,(Needle x
v,WebLocally x y
_)) <- WebLocally x y
meWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                 , let dv :: DualVector (Needle x)
dv = Seminorm (Needle x)
metricSeminorm (Needle x) -> Needle x -> DualVector (Needle x)
forall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle x
v ]
                                 [OSNode x y]
candidates
        where go :: [OSNeedle x] -> [OSNode x y] -> [WebNodeId]
              go :: [OSNeedle x] -> [OSNode x y] -> [Int]
go [OSNeedle x]
existing [OSNode x y]
fillSrc = case [OSNeedle x] -> Maybe (CPCone x)
constructUninhabitedCone [OSNeedle x]
existing of
                    Maybe (CPCone x)
Nothing -> (Int, (Needle x, WebLocally x y)) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((Int, (Needle x, WebLocally x y)) -> Int)
-> [(Int, (Needle x, WebLocally x y))] -> [Int]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> WebLocally x y
meWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                    Just CPCone x
cone -> case CPCone x -> [OSNode x y] -> Maybe (OSNode x y, [OSNode x y])
findInCone CPCone x
cone [OSNode x y]
fillSrc of
                      Just ((OSNeedle x
fv,WebLocally x y
filler),[OSNode x y]
fillSrc')
                              -> (WebLocally x y
fillerWebLocally x y -> Getting Int (WebLocally x y) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x y) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [OSNeedle x] -> [OSNode x y] -> [Int]
go (OSNeedle x
fvOSNeedle x -> [OSNeedle x] -> [OSNeedle x]
forall a. a -> [a] -> [a]
:[OSNeedle x]
existing) [OSNode x y]
fillSrc'
                      Maybe (OSNode x y, [OSNode x y])
Nothing -> (Int, (Needle x, WebLocally x y)) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((Int, (Needle x, WebLocally x y)) -> Int)
-> [(Int, (Needle x, WebLocally x y))] -> [Int]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> WebLocally x y
meWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
              constructUninhabitedCone :: [OSNeedle x] -> Maybe (CPCone x)
              constructUninhabitedCone :: [OSNeedle x] -> Maybe (CPCone x)
constructUninhabitedCone [OSNeedle x]
vs = (CPCone x -> Bool) -> [CPCone x] -> Maybe (CPCone x)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
not(Bool -> Bool) -> (CPCone x -> Bool) -> CPCone x -> Bool
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.((OSNeedle x -> Bool) -> [OSNeedle x] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any`[OSNeedle x]
vs)((OSNeedle x -> Bool) -> Bool)
-> (CPCone x -> OSNeedle x -> Bool) -> CPCone x -> Bool
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.CPCone x -> OSNeedle x -> Bool
includes)
                                              ([CPCone x] -> Maybe (CPCone x)) -> [CPCone x] -> Maybe (CPCone x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [OSNeedle x] -> CPCone x
forall a. [(DualVector (Needle x), a)] -> CPCone x
coneBetween ([OSNeedle x] -> CPCone x) -> [[OSNeedle x]] -> [CPCone x]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Int -> [OSNeedle x] -> [[OSNeedle x]]
forall a. Int -> [a] -> [[a]]
choices Int
dimension [OSNeedle x]
vs
               where coneBetween :: [(Needle' x, a)] -> (Needle' x, ℝ)
                     coneBetween :: [(DualVector (Needle x), a)] -> CPCone x
coneBetween [(DualVector (Needle x), a)]
dvs = (DualVector (Needle x)
coneDir, (Variance (Needle x)
coMetricVariance (Needle x)
-> DualVector (Needle x) -> Scalar (DualVector (Needle x))
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|DualVector (Needle x)
coneDir)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ -> ℝ
forall a. Floating a => a -> a
sqrt ℝ
2)
                      where coneDir :: DualVector (Needle x)
coneDir = [DualVector (Needle x)] -> DualVector (Needle x)
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV ([DualVector (Needle x)] -> DualVector (Needle x))
-> [DualVector (Needle x)] -> DualVector (Needle x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (DualVector (Needle x), a) -> DualVector (Needle x)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((DualVector (Needle x), a) -> DualVector (Needle x))
-> [(DualVector (Needle x), a)] -> [DualVector (Needle x)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [(DualVector (Needle x), a)]
dvs
              findInCone :: CPCone x -> [OSNode x y]
                             -> Maybe (OSNode x y, [OSNode x y])
              findInCone :: CPCone x -> [OSNode x y] -> Maybe (OSNode x y, [OSNode x y])
findInCone CPCone x
cone ((OSNeedle x
po,WebLocally x y
pn):[OSNode x y]
ps) | CPCone x
coneCPCone x -> OSNeedle x -> Bool
`includes`OSNeedle x
po  = (OSNode x y, [OSNode x y]) -> Maybe (OSNode x y, [OSNode x y])
forall a. a -> Maybe a
Just ((OSNeedle x
po,WebLocally x y
pn), [OSNode x y]
ps)
              findInCone (DualVector (Needle x)
coneDir, ℝ
_) ((OSNeedle x
po,WebLocally x y
pn):[OSNode x y]
_)
                | Just DualVector (Needle x)
wall <- WebLocally x y
pnWebLocally x y
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x y)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x y)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                , DualSpaceWitness (Needle x)
DualSpaceWitness <- DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                , x
testp <- WebLocally x y
pnWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ (Variance (Needle x)
coMetricVariance (Needle x)
-> DualVector (Needle x) -> DualVector (DualVector (Needle x))
forall v. LSpace v => Norm v -> v -> DualVector v
<$|DualVector (Needle x)
wall)
                , (Seminorm (Needle x)
metric Seminorm (Needle x) -> Needle x -> Scalar (Needle x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| x
testpx -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!WebLocally x y
meWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord) ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> (Seminorm (Needle x)
metricSeminorm (Needle x) -> Needle x -> Scalar (Needle x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|OSNeedle x -> Needle x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd OSNeedle x
po)
                    = Maybe (OSNode x y, [OSNode x y])
forall a. Maybe a
Nothing
              findInCone CPCone x
cone (OSNode x y
p:[OSNode x y]
ps) = ([OSNode x y] -> [OSNode x y])
-> (OSNode x y, [OSNode x y]) -> (OSNode x y, [OSNode x y])
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (OSNode x y
pOSNode x y -> [OSNode x y] -> [OSNode x y]
forall a. a -> [a] -> [a]
:) ((OSNode x y, [OSNode x y]) -> (OSNode x y, [OSNode x y]))
-> Maybe (OSNode x y, [OSNode x y])
-> Maybe (OSNode x y, [OSNode x y])
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> CPCone x -> [OSNode x y] -> Maybe (OSNode x y, [OSNode x y])
findInCone CPCone x
cone [OSNode x y]
ps
              findInCone CPCone x
_ [] = Maybe (OSNode x y, [OSNode x y])
forall a. Maybe a
Nothing
              includes :: CPCone x -> OSNeedle x -> Bool
              (DualVector (Needle x)
coneDir, ℝ
narrowing)includes :: CPCone x -> OSNeedle x -> Bool
`includes`(DualVector (Needle x)
_, Needle x
v) = DualVector (Needle x)
coneDirDualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
v ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>= ℝ
narrowing
              candidates :: [OSNode x y]
              candidates :: [OSNode x y]
candidates = case WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x y
me [] of
                       [(Needle x, WebLocally x y)]
_l₀:[(Needle x, WebLocally x y)]
_l₁:[[(Needle x, WebLocally x y)]]
ls -> [[OSNode x y]] -> [OSNode x y]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ (ℝ, OSNode x y) -> OSNode x y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((ℝ, OSNode x y) -> OSNode x y)
-> [(ℝ, OSNode x y)] -> [OSNode x y]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> ((ℝ, OSNode x y) -> (ℝ, OSNode x y) -> Ordering)
-> [(ℝ, OSNode x y)] -> [(ℝ, OSNode x y)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((ℝ, OSNode x y) -> ℝ)
-> (ℝ, OSNode x y) -> (ℝ, OSNode x y) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ℝ, OSNode x y) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                                                [ (ℝ
Scalar (Needle x)
distSq, ((DualVector (Needle x)
dv,Needle x
v) OSNeedle x -> ℝ -> OSNeedle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ ℝ -> ℝ
forall a. Floating a => a -> a
sqrt ℝ
Scalar (Needle x)
distSq, WebLocally x y
node))
                                                | (Needle x
v, WebLocally x y
node) <- [(Needle x, WebLocally x y)]
layer
                                                , let dv :: DualVector (Needle x)
dv = Seminorm (Needle x)
metricSeminorm (Needle x) -> Needle x -> DualVector (Needle x)
forall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle x
v
                                                      distSq :: Scalar (Needle x)
distSq = DualVector (Needle x)
dvDualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
v ]
                                            | [(Needle x, WebLocally x y)]
layer <- [[(Needle x, WebLocally x y)]]
ls ]
                       [[(Needle x, WebLocally x y)]]
_ -> []
              metric :: Seminorm (Needle x)
metric = WebLocally x y
meWebLocally x y
-> Getting
     (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
-> Seminorm (Needle x)
forall s a. s -> Getting a s a -> a
^.Getting
  (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct
              coMetric :: Variance (Needle x)
coMetric = Seminorm (Needle x) -> Variance (Needle x)
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Seminorm (Needle x)
metric
       dimension :: Int
dimension = SubBasis (Needle x) -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis (Needle x)
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis (Needle x))

choices :: Int -> [a] -> [[a]]
choices :: Int -> [a] -> [[a]]
choices Int
n [a]
l = Int -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
forall a a a.
(Eq a, Num a) =>
a -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go Int
n [a]
l [a] -> [a]
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id []
 where go :: a -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go a
0 [a]
_ [a] -> [a]
f = ([a] -> [a]
f[][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:)
       go a
_ [] [a] -> [a]
_ = [[a]] -> [[a]]
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
       go a
n (a
x:[a]
xs) [a] -> [a]
f = a -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go a
n [a]
xs [a] -> [a]
f ([[a]] -> [[a]]) -> ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. a -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go (a
na -> a -> a
forall a. Num a => a -> a -> a
-a
1) [a]
xs ((a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.[a] -> [a]
f)

meanOf :: (Hask.Foldable f, Fractional n) => (a -> n) -> f a -> n
meanOf :: (a -> n) -> f a -> n
meanOf a -> n
f = (n, Int) -> n
forall a a. (Fractional a, Integral a) => (a, a) -> a
renormalise ((n, Int) -> n) -> (f a -> (n, Int)) -> f a -> n
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((n, Int) -> a -> (n, Int)) -> (n, Int) -> f a -> (n, Int)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Hask.foldl' (n, Int) -> a -> (n, Int)
accs (n
0, Int
0::Int)
 where renormalise :: (a, a) -> a
renormalise (a
acc,a
n) = a
acca -> a -> a
forall a. Fractional a => a -> a -> a
/a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n
       accs :: (n, Int) -> a -> (n, Int)
accs (n
acc,Int
n) a
x = (n
accn -> n -> n
forall a. Num a => a -> a -> a
+a -> n
f a
x, Int -> Int
forall a. Enum a => a -> a
succ Int
n)

geometricMeanOf :: (Hask.Foldable f, Floating n) => (a -> n) -> f a -> n
geometricMeanOf :: (a -> n) -> f a -> n
geometricMeanOf a -> n
f = n -> n
forall a. Floating a => a -> a
exp (n -> n) -> (f a -> n) -> f a -> n
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (a -> n) -> f a -> n
forall (f :: * -> *) n a.
(Foldable f, Fractional n) =>
(a -> n) -> f a -> n
meanOf (n -> n
forall a. Floating a => a -> a
log (n -> n) -> (a -> n) -> a -> n
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. a -> n
f)



webBoundary :: WithField ℝ Manifold x => PointsWeb x y -> [(Cutplane x, y)]
webBoundary :: PointsWeb x y -> [(Cutplane x, y)]
webBoundary = PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> (PointsWeb x (WebLocally x y) -> [(Cutplane x, y)])
-> PointsWeb x y
-> [(Cutplane x, y)]
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> PointsWeb x (WebLocally x y) -> [WebLocally x y]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList (PointsWeb x (WebLocally x y) -> [WebLocally x y])
-> ([WebLocally x y] -> [(Cutplane x, y)])
-> PointsWeb x (WebLocally x y)
-> [(Cutplane x, y)]
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (WebLocally x y -> [(Cutplane x, y)])
-> [WebLocally x y] -> [(Cutplane x, y)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Hask.concatMap((WebLocally x y -> [(Cutplane x, y)])
 -> [WebLocally x y] -> [(Cutplane x, y)])
-> (WebLocally x y -> [(Cutplane x, y)])
-> [WebLocally x y]
-> [(Cutplane x, y)]
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
`id`
        \WebLocally x y
info -> [ (x -> Stiefel1 (Needle x) -> Cutplane x
forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane (WebLocally x y
infoWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord) (DualVector (Needle x) -> Stiefel1 (Needle x)
forall v. DualVector v -> Stiefel1 v
Stiefel1 DualVector (Needle x)
wall), WebLocally x y
infoWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData)
                 | Just DualVector (Needle x)
wall <- [WebLocally x y
infoWebLocally x y
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x y)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x y)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane] ]


coerceWebDomain :: ∀ a b y
     . (Manifold a, Manifold b, LocallyCoercible a b, SimpleSpace (Needle b))
                                 => PointsWeb a y -> PointsWeb b y
coerceWebDomain :: PointsWeb a y -> PointsWeb b y
coerceWebDomain (PointsWeb Shaded a (Neighbourhood a y)
web) = Shaded b (Neighbourhood b y) -> PointsWeb b y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb
     (Shaded b (Neighbourhood b y) -> PointsWeb b y)
-> Shaded b (Neighbourhood b y) -> PointsWeb b y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (NonEmpty (a, Neighbourhood a y)
 -> NonEmpty (b, Neighbourhood b y))
-> (Needle' a -> Needle' b)
-> (Shade a -> Shade b)
-> Shaded a (Neighbourhood a y)
-> Shaded b (Neighbourhood b y)
forall x y ξ υ.
(NonEmpty (x, y) -> NonEmpty (ξ, υ))
-> (Needle' x -> Needle' ξ)
-> (Shade x -> Shade ξ)
-> Shaded x y
-> Shaded ξ υ
unsafeFmapTree ( ((a, Neighbourhood a y) -> (b, Neighbourhood b y))
-> NonEmpty (a, Neighbourhood a y)
-> NonEmpty (b, Neighbourhood b y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (((a, Neighbourhood a y) -> (b, Neighbourhood b y))
 -> NonEmpty (a, Neighbourhood a y)
 -> NonEmpty (b, Neighbourhood b y))
-> ((a, Neighbourhood a y) -> (b, Neighbourhood b y))
-> NonEmpty (a, Neighbourhood a y)
-> NonEmpty (b, Neighbourhood b y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(a
x, Neighbourhood y
y Vector Int
ngbs Metric a
lscl Maybe (Needle' a)
bndry)
                            -> ( a -> b
forall x ξ. LocallyCoercible x ξ => x -> ξ
locallyTrivialDiffeomorphism a
x
                               , y
-> Vector Int -> Metric b -> Maybe (Needle' b) -> Neighbourhood b y
forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y Vector Int
ngbs
                                       ([(a, b)] -> Metric a -> Metric b
forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Metric x -> Metric ξ
coerceNorm ([]::[(a,b)]) Metric a
lscl)
                                       ((Needle' a -> Needle' b) -> Maybe (Needle' a) -> Maybe (Needle' b)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap Needle' a -> Needle' b
crcNeedle' Maybe (Needle' a)
bndry) ) )
                      Needle' a -> Needle' b
crcNeedle' Shade a -> Shade b
forall (shade :: * -> *) x y.
(IsShade shade, Manifold x, Manifold y, LocallyCoercible x y,
 SimpleSpace (Needle y)) =>
shade x -> shade y
coerceShade Shaded a (Neighbourhood a y)
web
 where crcNeedle' :: Needle' a -> Needle' b
crcNeedle' = case ( DualSpaceWitness (Needle a)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle a)
                         , DualSpaceWitness (Needle b)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle b) ) of
           (DualSpaceWitness (Needle a)
DualSpaceWitness, DualSpaceWitness (Needle b)
DualSpaceWitness) -> LinearFunction (Scalar (Needle b)) (Needle' a) (Needle' b)
-> Needle' a -> Needle' b
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (LinearFunction (Scalar (Needle b)) (Needle' a) (Needle' b)
 -> Needle' a -> Needle' b)
-> LinearFunction (Scalar (Needle b)) (Needle' a) (Needle' b)
-> Needle' a
-> Needle' b
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [(a, b)] -> Needle' a -+> Needle' b
forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle' x -+> Needle' ξ
coerceNeedle' ([]::[(a,b)])


data InterpolationIv y = InterpolationIv {
          InterpolationIv y -> (ℝ, ℝ)
_interpolationSegRange :: (ℝ,ℝ)
        , InterpolationIv y -> ℝ -> y
_interpolationFunction :: ℝ -> y
        }

type InterpolationSeq y = [InterpolationIv y]

mkInterpolationSeq_lin :: (x~ℝ, Geodesic y)
           => [(x,y)] -> InterpolationSeq y
mkInterpolationSeq_lin :: [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin [(x
xψ,y
yψ), (x
xω,y
yω)]
       = InterpolationIv y -> InterpolationSeq y
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (InterpolationIv y -> InterpolationSeq y)
-> InterpolationIv y -> InterpolationSeq y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ, ℝ) -> (ℝ -> y) -> InterpolationIv y
forall y. (ℝ, ℝ) -> (ℝ -> y) -> InterpolationIv y
InterpolationIv
           (x
ℝ
xψ,x
ℝ
xω)
           (\ℝ
x -> let drel :: D¹
drel = ℝ -> D¹
fromIntv0to1 (ℝ -> D¹) -> ℝ -> D¹
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ
xℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-x
ℝ
xψ)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/(x
xωx -> x -> x
forall a. Num a => a -> a -> a
-x
xψ)
                  in D¹ -> y
yio D¹
drel )
 where Just D¹ -> y
yio = y -> y -> Maybe (D¹ -> y)
forall x. Geodesic x => x -> x -> Maybe (D¹ -> x)
geodesicBetween y
yψ y
yω
mkInterpolationSeq_lin ((x, y)
p₀:(x, y)
p₁:[(x, y)]
ps)
    = [(x, y)] -> InterpolationSeq y
forall x y. (x ~ ℝ, Geodesic y) => [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin [(x, y)
p₀,(x, y)
p₁] InterpolationSeq y -> InterpolationSeq y -> InterpolationSeq y
forall a. Semigroup a => a -> a -> a
<> [(x, y)] -> InterpolationSeq y
forall x y. (x ~ ℝ, Geodesic y) => [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin ((x, y)
p₁(x, y) -> [(x, y)] -> [(x, y)]
forall a. a -> [a] -> [a]
:[(x, y)]
ps)
mkInterpolationSeq_lin [(x, y)]
_ = []


-- | Fetch a point between any two neighbouring web nodes on opposite
--   sides of the plane, and linearly interpolate the values onto the
--   cut plane.
sliceWeb_lin :: ∀ x y . ( WithField ℝ Manifold x, SimpleSpace (Needle x)
                        , Geodesic x, Geodesic y )
               => PointsWeb x y -> Cutplane x -> [(x,y)]
sliceWeb_lin :: PointsWeb x y -> Cutplane x -> [(x, y)]
sliceWeb_lin PointsWeb x y
web = Cutplane x -> [(x, y)]
sliceEdgs
 where edgs :: [((x,y),(x,y))]
       edgs :: [((x, y), (x, y))]
edgs = [ (Int -> (x, y)
gnodes Int
i₀, Int -> (x, y)
gnodes Int
i₁)
              | (Int
i₀,Int
i₁) <- [(Int, Int)] -> [(Int, Int)]
forall a. FastNub a => [a] -> [a]
fastNub [ (Int
i₀,Int
i₁)
                                   | (Int
il,Int
ir) <- Graph -> [(Int, Int)]
edges Graph
graph
                                   , let [Int
i₀,Int
i₁] = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort [Int
il,Int
ir] ]
              ]
       (Graph
graph, Int -> (x, y)
gnodes) = PointsWeb x y -> (Graph, Int -> (x, y))
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
PointsWeb x y -> (Graph, Int -> (x, y))
toGraph PointsWeb x y
web
       sliceEdgs :: Cutplane x -> [(x, y)]
sliceEdgs Cutplane x
cp = [ (D¹ -> x
xi D¹
d, D¹ -> y
yi D¹
d)  -- Brute-force search through all edges
                      | ((x
x₀,y
y₀), (x
x₁,y
y₁)) <- [((x, y), (x, y))]
edgs
                      , Just D¹
d <- [Cutplane x -> (x, x) -> Maybe D¹
forall x.
WithField ℝ Manifold x =>
Cutplane x -> (x, x) -> Maybe D¹
cutPosBetween Cutplane x
cp (x
x₀,x
x₁)]
                      , Just D¹ -> x
xi <- [x -> x -> Maybe (D¹ -> x)
forall x. Geodesic x => x -> x -> Maybe (D¹ -> x)
geodesicBetween x
x₀ x
x₁]
                      , Just D¹ -> y
yi <- [y -> y -> Maybe (D¹ -> y)
forall x. Geodesic x => x -> x -> Maybe (D¹ -> x)
geodesicBetween y
y₀ y
y₁]
                      ]



data GridPlanes x = GridPlanes {
        GridPlanes x -> Needle' x
_gridPlaneNormal :: Needle' x
      , GridPlanes x -> Needle x
_gridPlaneSpacing :: Needle x
      , GridPlanes x -> Int
_gridPlanesCount :: Int
      }
deriving instance (Show x, Show (Needle x), Show (Needle' x)) => Show (GridPlanes x)
data GridSetup x = GridSetup {
        GridSetup x -> x
_gridStartCorner :: x
      , GridSetup x -> [GridPlanes x]
_gridSplitDirs :: [GridPlanes x]
      }
deriving instance (Show x, Show (Needle x), Show (Needle' x)) => Show (GridSetup x)

cartesianGrid2D :: (x~ℝ, y~ℝ) => ((x,x), Int) -> ((y,y), Int) -> GridSetup (x,y)
cartesianGrid2D :: ((x, x), Int) -> ((y, y), Int) -> GridSetup (x, y)
cartesianGrid2D ((x
x₀,x
x₁), Int
nx) ((y
y₀,y
y₁), Int
ny)
    = (x, y) -> [GridPlanes (x, y)] -> GridSetup (x, y)
forall x. x -> [GridPlanes x] -> GridSetup x
GridSetup (x
x₀x -> x -> x
forall a. Num a => a -> a -> a
+x
dxx -> x -> x
forall a. Fractional a => a -> a -> a
/x
2, y
y₀y -> y -> y
forall a. Num a => a -> a -> a
+y
dyy -> y -> y
forall a. Fractional a => a -> a -> a
/y
2)
                [ Needle' (x, y) -> Needle (x, y) -> Int -> GridPlanes (x, y)
forall x. Needle' x -> Needle x -> Int -> GridPlanes x
GridPlanes (ℝ
0,ℝ
1) (ℝ
0, y
dy) Int
ny, Needle' (x, y) -> Needle (x, y) -> Int -> GridPlanes (x, y)
forall x. Needle' x -> Needle x -> Int -> GridPlanes x
GridPlanes (ℝ
1,ℝ
0) (x
dx, ℝ
0) Int
nx ]
 where dx :: x
dx = (x
x₁x -> x -> x
forall a. Num a => a -> a -> a
-x
x₀)x -> x -> x
forall a. Fractional a => a -> a -> a
/Int -> x
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nx
       dy :: y
dy = (y
y₁y -> y -> y
forall a. Num a => a -> a -> a
-y
y₀)y -> y -> y
forall a. Fractional a => a -> a -> a
/Int -> y
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ny

splitToGridLines :: ( WithField ℝ Manifold x, SimpleSpace (Needle x)
                    , Geodesic x, Geodesic y )
          => PointsWeb x y -> GridSetup x -> [((x, GridPlanes x), [(x,y)])]
splitToGridLines :: PointsWeb x y -> GridSetup x -> [((x, GridPlanes x), [(x, y)])]
splitToGridLines PointsWeb x y
web (GridSetup x
x₀ [GridPlanes Needle' x
dirΩ Needle x
spcΩ Int
nΩ, GridPlanes x
linePln])
    = [ ((x
x₀', GridPlanes x
linePln), PointsWeb x y -> Cutplane x -> [(x, y)]
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x), Geodesic x,
 Geodesic y) =>
PointsWeb x y -> Cutplane x -> [(x, y)]
sliceWeb_lin PointsWeb x y
web (Cutplane x -> [(x, y)]) -> Cutplane x -> [(x, y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x -> Stiefel1 (Needle x) -> Cutplane x
forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane x
x₀' (Needle' x -> Stiefel1 (Needle x)
forall v. DualVector v -> Stiefel1 v
Stiefel1 Needle' x
dirΩ))
      | Int
k <- [Int
0 .. Int
nΩInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
      , let x₀' :: x
x₀' = x
x₀x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^(Int -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k Scalar (Needle x) -> Needle x -> Needle x
forall v. VectorSpace v => Scalar v -> v -> v
*^ Needle x
spcΩ) ]

sampleWebAlongGrid_lin :: ∀ x y . ( WithField ℝ Manifold x, SimpleSpace (Needle x)
                                  , Geodesic x, Geodesic y )
               => PointsWeb x y -> GridSetup x -> [(x,Maybe y)]
sampleWebAlongGrid_lin :: PointsWeb x y -> GridSetup x -> [(x, Maybe y)]
sampleWebAlongGrid_lin PointsWeb x y
web GridSetup x
grid = ((x, GridPlanes x), [(x, y)]) -> [(x, Maybe y)]
finalLine
                                      (((x, GridPlanes x), [(x, y)]) -> [(x, Maybe y)])
-> [((x, GridPlanes x), [(x, y)])] -> [(x, Maybe y)]
forall (m :: * -> *) (k :: * -> * -> *) a b.
(Monad m k, Object k a, Object k b, Object k (m a), Object k (m b),
 Object k (m (m b))) =>
k a (m b) -> k (m a) (m b)
=<< PointsWeb x y -> GridSetup x -> [((x, GridPlanes x), [(x, y)])]
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x), Geodesic x,
 Geodesic y) =>
PointsWeb x y -> GridSetup x -> [((x, GridPlanes x), [(x, y)])]
splitToGridLines PointsWeb x y
web GridSetup x
grid
 where finalLine :: ((x, GridPlanes x), [(x,y)]) -> [(x,Maybe y)]
       finalLine :: ((x, GridPlanes x), [(x, y)]) -> [(x, Maybe y)]
finalLine ((x
x₀, GridPlanes Needle' x
_ Needle x
dir Int
nSpl), [(x, y)]
verts)
          | [(x, y)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(x, y)]
verts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2  = Int -> [(x, Maybe y)] -> [(x, Maybe y)]
forall a. Int -> [a] -> [a]
take Int
nSpl ([(x, Maybe y)] -> [(x, Maybe y)])
-> [(x, Maybe y)] -> [(x, Maybe y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (,Maybe y
forall (f :: * -> *) a. Alternative f => f a
empty)(x -> (x, Maybe y)) -> [x] -> [(x, Maybe y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>(x -> x) -> x -> [x]
forall a. (a -> a) -> a -> [a]
iterate (x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle x
dir) x
x₀
       finalLine ((x
x₀, GridPlanes Needle' x
dx Needle x
dir Int
nSpl), [(x, y)]
verts)
                     = Int -> [(x, Maybe y)] -> [(x, Maybe y)]
forall a. Int -> [a] -> [a]
take Int
nSpl ([(x, Maybe y)] -> [(x, Maybe y)])
-> [(x, Maybe y)] -> [(x, Maybe y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (x, ℝ) -> [InterpolationIv y] -> [(x, Maybe y)]
go (x
x₀,ℝ
0) [InterpolationIv y]
intpseq 
        where intpseq :: [InterpolationIv y]
intpseq = [(ℝ, y)] -> [InterpolationIv y]
forall x y. (x ~ ℝ, Geodesic y) => [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin ([(ℝ, y)] -> [InterpolationIv y])
-> [(ℝ, y)] -> [InterpolationIv y]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((ℝ, y) -> (ℝ, y) -> Ordering) -> [(ℝ, y)] -> [(ℝ, y)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((ℝ, y) -> ℝ) -> (ℝ, y) -> (ℝ, y) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ℝ, y) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                         [ (Needle' x
dx Needle' x -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^ (x
xx -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!x
x₀), y
y) | (x
x,y
y) <- [(x, y)]
verts ]
              go :: (x, ℝ) -> [InterpolationIv y] -> [(x, Maybe y)]
go (x
x,ℝ
_) [] = (,Maybe y
forall (f :: * -> *) a. Alternative f => f a
empty)(x -> (x, Maybe y)) -> [x] -> [(x, Maybe y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>(x -> x) -> x -> [x]
forall a. (a -> a) -> a -> [a]
iterate (x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle x
dir) x
x
              go (x, ℝ)
xt (InterpolationIv (ℝ
tb,ℝ
te) ℝ -> y
f:[InterpolationIv y]
fs)
                        = case ((x, ℝ) -> Bool) -> [(x, ℝ)] -> ([(x, ℝ)], [(x, ℝ)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<ℝ
te) (ℝ -> Bool) -> ((x, ℝ) -> ℝ) -> (x, ℝ) -> Bool
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (x, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) ([(x, ℝ)] -> ([(x, ℝ)], [(x, ℝ)]))
-> [(x, ℝ)] -> ([(x, ℝ)], [(x, ℝ)])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((x, ℝ) -> (x, ℝ)) -> (x, ℝ) -> [(x, ℝ)]
forall a. (a -> a) -> a -> [a]
iterate ((x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle x
dir)(x -> x) -> (ℝ -> ℝ) -> (x, ℝ) -> (x, ℝ)
forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
***(ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
Scalar (Needle x)
δt)) (x, ℝ)
xt of
                             ([(x, ℝ)]
thisRange, (x, ℝ)
xtn:[(x, ℝ)]
_)
                                 -> [ (x
x, if ℝ
tℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<ℝ
tb then Maybe y
forall (f :: * -> *) a. Alternative f => f a
empty else y -> Maybe y
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (y -> Maybe y) -> y -> Maybe y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> y
f ℝ
t)
                                    | (x
x,ℝ
t) <- [(x, ℝ)]
thisRange ]
                                     [(x, Maybe y)] -> [(x, Maybe y)] -> [(x, Maybe y)]
forall a. [a] -> [a] -> [a]
++ (x, ℝ) -> [InterpolationIv y] -> [(x, Maybe y)]
go (x, ℝ)
xtn [InterpolationIv y]
fs
              δt :: Scalar (Needle x)
δt = Needle' x
dxNeedle' x -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
dir
       
sampleWeb_2Dcartesian_lin :: (x~ℝ, y~ℝ, Geodesic z)
             => PointsWeb (x,y) z -> ((x,x),Int) -> ((y,y),Int) -> [(y,[(x,Maybe z)])]
sampleWeb_2Dcartesian_lin :: PointsWeb (x, y) z
-> ((x, x), Int) -> ((y, y), Int) -> [(y, [(x, Maybe z)])]
sampleWeb_2Dcartesian_lin PointsWeb (x, y) z
web (xspec :: ((x, x), Int)
xspec@((x, x)
_,Int
nx)) ((y, y), Int)
yspec
       = [((ℝ, ℝ), Maybe z)] -> [(y, [(x, Maybe z)])]
[((ℝ, ℝ), Maybe z)] -> [(ℝ, [(ℝ, Maybe z)])]
go ([((ℝ, ℝ), Maybe z)] -> [(y, [(x, Maybe z)])])
-> (GridSetup (x, y) -> [((ℝ, ℝ), Maybe z)])
-> GridSetup (x, y)
-> [(y, [(x, Maybe z)])]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb (x, y) z -> GridSetup (x, y) -> [((x, y), Maybe z)]
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x), Geodesic x,
 Geodesic y) =>
PointsWeb x y -> GridSetup x -> [(x, Maybe y)]
sampleWebAlongGrid_lin PointsWeb (x, y) z
web (GridSetup (x, y) -> [(y, [(x, Maybe z)])])
-> GridSetup (x, y) -> [(y, [(x, Maybe z)])]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((x, x), Int) -> ((y, y), Int) -> GridSetup (x, y)
forall x y.
(x ~ ℝ, y ~ ℝ) =>
((x, x), Int) -> ((y, y), Int) -> GridSetup (x, y)
cartesianGrid2D ((x, x), Int)
xspec ((y, y), Int)
yspec
 where go :: [((ℝ, ℝ), Maybe z)] -> [(ℝ, [(ℝ, Maybe z)])]
go [] = []
       go l :: [((ℝ, ℝ), Maybe z)]
l@(((ℝ
_,ℝ
y),Maybe z
_):[((ℝ, ℝ), Maybe z)]
_) = let ([((ℝ, ℝ), Maybe z)]
ln,[((ℝ, ℝ), Maybe z)]
l') = Int
-> [((ℝ, ℝ), Maybe z)]
-> ([((ℝ, ℝ), Maybe z)], [((ℝ, ℝ), Maybe z)])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
nx [((ℝ, ℝ), Maybe z)]
l
                             in (ℝ
y, (((ℝ, ℝ), Maybe z) -> (ℝ, Maybe z))
-> [((ℝ, ℝ), Maybe z)] -> [(ℝ, Maybe z)]
forall a b. (a -> b) -> [a] -> [b]
map (\((ℝ
x,ℝ
_),Maybe z
z) -> (ℝ
x,Maybe z
z)) [((ℝ, ℝ), Maybe z)]
ln) (ℝ, [(ℝ, Maybe z)])
-> [(ℝ, [(ℝ, Maybe z)])] -> [(ℝ, [(ℝ, Maybe z)])]
forall a. a -> [a] -> [a]
: [((ℝ, ℝ), Maybe z)] -> [(ℝ, [(ℝ, Maybe z)])]
go [((ℝ, ℝ), Maybe z)]
l'
       
sampleEntireWeb_2Dcartesian_lin :: (x~ℝ, y~ℝ, Geodesic z)
             => PointsWeb (x,y) z -> Int -> Int -> [(y,[(x,Maybe z)])]
sampleEntireWeb_2Dcartesian_lin :: PointsWeb (x, y) z -> Int -> Int -> [(y, [(x, Maybe z)])]
sampleEntireWeb_2Dcartesian_lin PointsWeb (x, y) z
web Int
nx Int
ny
       = PointsWeb (x, y) z
-> ((x, x), Int) -> ((y, y), Int) -> [(y, [(x, Maybe z)])]
forall x y z.
(x ~ ℝ, y ~ ℝ, Geodesic z) =>
PointsWeb (x, y) z
-> ((x, x), Int) -> ((y, y), Int) -> [(y, [(x, Maybe z)])]
sampleWeb_2Dcartesian_lin PointsWeb (x, y) z
web ((x
x₀,x
x₁),Int
nx) ((y
y₀,y
y₁),Int
ny)
 where x₀ :: x
x₀ = [x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((x, y) -> x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst((x, y) -> x) -> [(x, y)] -> [x]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(x, y)]
pts)
       x₁ :: x
x₁ = [x] -> x
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((x, y) -> x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst((x, y) -> x) -> [(x, y)] -> [x]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(x, y)]
pts)
       y₀ :: y
y₀ = [y] -> y
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ((x, y) -> y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((x, y) -> y) -> [(x, y)] -> [y]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(x, y)]
pts)
       y₁ :: y
y₁ = [y] -> y
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((x, y) -> y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((x, y) -> y) -> [(x, y)] -> [y]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(x, y)]
pts)
       pts :: [(x, y)]
pts = ((x, y), z) -> (x, y)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst (((x, y), z) -> (x, y))
-> ((((x, y), z), [((ℝ, ℝ), z)]) -> ((x, y), z))
-> (((x, y), z), [((ℝ, ℝ), z)])
-> (x, y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (((x, y), z), [((ℝ, ℝ), z)]) -> ((x, y), z)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((((x, y), z), [((ℝ, ℝ), z)]) -> (x, y))
-> [(((x, y), z), [((ℝ, ℝ), z)])] -> [(x, y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> PointsWeb (x, y) (((x, y), z), [((ℝ, ℝ), z)])
-> [(((x, y), z), [((ℝ, ℝ), z)])]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (PointsWeb (x, y) z
-> PointsWeb (x, y) (((x, y), z), [(Needle (x, y), z)])
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x ((x, y), [(Needle x, y)])
localFocusWeb PointsWeb (x, y) z
web)



hardbakeChunk :: WebChunk x y -> PointsWeb x y
hardbakeChunk :: WebChunk x y -> PointsWeb x y
hardbakeChunk = WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
_thisChunk

entireWeb :: PointsWeb x y -> WebChunk x y
entireWeb :: PointsWeb x y -> WebChunk x y
entireWeb PointsWeb x y
web = PointsWeb x y
-> [(Shaded x (Neighbourhood x y), Int)] -> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), Int)] -> WebChunk x y
WebChunk PointsWeb x y
web []

localFocusWeb :: WithField ℝ Manifold x
                   => PointsWeb x y -> PointsWeb x ((x,y), [(Needle x, y)])
localFocusWeb :: PointsWeb x y -> PointsWeb x ((x, y), [(Needle x, y)])
localFocusWeb = PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> (PointsWeb x (WebLocally x y)
    -> PointsWeb x ((x, y), [(Needle x, y)]))
-> PointsWeb x y
-> PointsWeb x ((x, y), [(Needle x, y)])
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (WebLocally x y -> ((x, y), [(Needle x, y)]))
-> PointsWeb x (WebLocally x y)
-> PointsWeb x ((x, y), [(Needle x, y)])
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x y -> ((x, y), [(Needle x, y)]))
 -> PointsWeb x (WebLocally x y)
 -> PointsWeb x ((x, y), [(Needle x, y)]))
-> (WebLocally x y -> ((x, y), [(Needle x, y)]))
-> PointsWeb x (WebLocally x y)
-> PointsWeb x ((x, y), [(Needle x, y)])
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
`id`\WebLocally x y
n
           -> ( (WebLocally x y
nWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord, WebLocally x y
nWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData)
              , [ (Needle x
δx, WebLocally x y
ngbWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData)
                | (Int
_, (Needle x
δx, WebLocally x y
ngb)) <- WebLocally x y
nWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours ] )



treewiseTraverseLocalWeb :: ∀ f x y . (WithField ℝ Manifold x, Hask.Applicative f)
     => (WebLocally x y -> f y)
       -> (∀ t i w . (Hask.Traversable t, Ord i) => (w -> f w) -> t (i, w) -> f (t w) )
       -> PointsWeb x y -> f (PointsWeb x y)
treewiseTraverseLocalWeb :: (WebLocally x y -> f y)
-> (forall (t :: * -> *) i w.
    (Traversable t, Ord i) =>
    (w -> f w) -> t (i, w) -> f (t w))
-> PointsWeb x y
-> f (PointsWeb x y)
treewiseTraverseLocalWeb WebLocally x y -> f y
fl forall (t :: * -> *) i w.
(Traversable t, Ord i) =>
(w -> f w) -> t (i, w) -> f (t w)
ct = (WebChunk x y -> PointsWeb x y)
-> f (WebChunk x y) -> f (PointsWeb x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap WebChunk x y -> PointsWeb x y
forall x y. WebChunk x y -> PointsWeb x y
hardbakeChunk (f (WebChunk x y) -> f (PointsWeb x y))
-> (PointsWeb x y -> f (WebChunk x y))
-> PointsWeb x y
-> f (PointsWeb x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. WebChunk x y -> f (WebChunk x y)
twt (WebChunk x y -> f (WebChunk x y))
-> (PointsWeb x y -> WebChunk x y)
-> PointsWeb x y
-> f (WebChunk x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x y -> WebChunk x y
forall x y. PointsWeb x y -> WebChunk x y
entireWeb
 where twt :: WebChunk x y -> f (WebChunk x y)
twt = (WebLocally x y -> f y)
-> (NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y)))
-> WebChunk x y
-> f (WebChunk x y)
forall (f :: * -> *) x y.
(WithField ℝ Manifold x, Applicative f) =>
(WebLocally x y -> f y)
-> (NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y)))
-> WebChunk x y
-> f (WebChunk x y)
treewiseTraverseLocalWeb' WebLocally x y -> f y
fl ((NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y)))
 -> WebChunk x y -> f (WebChunk x y))
-> (NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y)))
-> WebChunk x y
-> f (WebChunk x y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebChunk x y -> f (WebChunk x y))
-> NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y))
forall (t :: * -> *) i w.
(Traversable t, Ord i) =>
(w -> f w) -> t (i, w) -> f (t w)
ct WebChunk x y -> f (WebChunk x y)
twt

treewiseTraverseLocalWeb' :: ∀ f x y . (WithField ℝ Manifold x, Hask.Applicative f)
     => (WebLocally x y -> f y)
       -> (NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y)))
       -> WebChunk x y -> f (WebChunk x y)
treewiseTraverseLocalWeb' :: (WebLocally x y -> f y)
-> (NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y)))
-> WebChunk x y
-> f (WebChunk x y)
treewiseTraverseLocalWeb' WebLocally x y -> f y
fl NonEmpty (Int, WebChunk x y) -> f (NonEmpty (WebChunk x y))
ct WebChunk x y
domain
                  = [Char]
[Char] -> PlaceholderException
PlaceholderException -> f (WebChunk x y)
(PlaceholderException -> f (WebChunk x y))
-> PlaceholderException -> f (WebChunk x y)
forall a e. Exception e => e -> a
forall a b. (a -> b) -> a -> b
$ :: forall a b. (a -> b) -> a -> b
throw :: forall a e. Exception e => e -> a
$notImplemented{-
 where rezoomed (PlainLeaves _) _ = localTraverseWebChunk fl domain
       rezoomed tree pos
         | pos == i₀, nLeaves tree == lDomain
             = fmap reassemble $ ct (NE.zipWith
                       (\jb (i₀b,t')
                         -> (jb, domain & overrideStart .~ i₀+i₀b
                                        & overriddenData
                                            .~ Arr.slice i₀b (nLeaves t') domainData ))
                       (0:|[1..]) branches)
         | otherwise                     = go branches
        where branches = trunkBranches tree
              go (_:|((i₀nb,nb):brs))
                | pos+i₀nb <= i₀  = go $ (i₀nb,nb):|brs
              go ((i₀b,t):|_) = rezoomed t (pos+i₀b)
              reassemble :: NonEmpty (WebChunk x y) -> WebChunk x y
              reassemble brs = domain & overriddenData
                                  .~ Hask.foldMap _overriddenData brs
       lDomain = Arr.length domainData
   -}



localOnion :: ∀ x y . WithField ℝ Manifold x
            => WebLocally x y -> [WebNodeId] -> [[(Needle x, WebLocally x y)]]
localOnion :: WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x y
origin [Int]
directCandidates = ([(Needle x, WebLocally x y)] -> [(Needle x, WebLocally x y)])
-> [[(Needle x, WebLocally x y)]] -> [[(Needle x, WebLocally x y)]]
forall a b. (a -> b) -> [a] -> [b]
map [(Needle x, WebLocally x y)] -> [(Needle x, WebLocally x y)]
sortBCDistance ([[(Needle x, WebLocally x y)]] -> [[(Needle x, WebLocally x y)]])
-> ([(Int, (Int, WebLocally x y))]
    -> [[(Needle x, WebLocally x y)]])
-> [(Int, (Int, WebLocally x y))]
-> [[(Needle x, WebLocally x y)]]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Map Int (Int, WebLocally x y)
-> Map Int (Int, WebLocally x y) -> [[(Needle x, WebLocally x y)]]
go Map Int (Int, WebLocally x y)
forall k a. Map k a
Map.empty (Map Int (Int, WebLocally x y) -> [[(Needle x, WebLocally x y)]])
-> ([(Int, (Int, WebLocally x y))]
    -> Map Int (Int, WebLocally x y))
-> [(Int, (Int, WebLocally x y))]
-> [[(Needle x, WebLocally x y)]]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [(Int, (Int, WebLocally x y))] -> Map Int (Int, WebLocally x y)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                      ([(Int, (Int, WebLocally x y))] -> [[(Needle x, WebLocally x y)]])
-> [(Int, (Int, WebLocally x y))] -> [[(Needle x, WebLocally x y)]]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x y
originWebLocally x y -> Getting Int (WebLocally x y) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x y) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId, (Int
1, WebLocally x y
origin)) (Int, (Int, WebLocally x y))
-> [(Int, (Int, WebLocally x y))] -> [(Int, (Int, WebLocally x y))]
forall a. a -> [a] -> [a]
: [(Int, (Int, WebLocally x y))]
seeds
 where seeds :: [(WebNodeId, (Int, WebLocally x y))]
       seeds :: [(Int, (Int, WebLocally x y))]
seeds = [ (Int
nid, (Int
1, WebLocally x y
ninfo))
               | Int
nid <- [Int]
directCandidates
               , (Int
_,(Needle x
_,WebLocally x y
ninfo)) <- WebLocally x y
originWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
               , WebLocally x y
ninfoWebLocally x y -> Getting Int (WebLocally x y) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x y) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
nid ]
       go :: Map Int (Int, WebLocally x y)
-> Map Int (Int, WebLocally x y) -> [[(Needle x, WebLocally x y)]]
go Map Int (Int, WebLocally x y)
previous Map Int (Int, WebLocally x y)
next
        | Map Int (Int, WebLocally x y) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (Int, WebLocally x y)
next = []
        | Bool
otherwise  = ( WebLocally x y -> (Needle x, WebLocally x y)
computeOffset (WebLocally x y -> (Needle x, WebLocally x y))
-> ((Int, WebLocally x y) -> WebLocally x y)
-> (Int, WebLocally x y)
-> (Needle x, WebLocally x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int, WebLocally x y) -> WebLocally x y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd
                                    ((Int, WebLocally x y) -> (Needle x, WebLocally x y))
-> [(Int, WebLocally x y)] -> [(Needle x, WebLocally x y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> ((Int, WebLocally x y) -> (Int, WebLocally x y) -> Ordering)
-> [(Int, WebLocally x y)] -> [(Int, WebLocally x y)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, WebLocally x y) -> Int)
-> (Int, WebLocally x y) -> (Int, WebLocally x y) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (((Int, WebLocally x y) -> Int)
 -> (Int, WebLocally x y) -> (Int, WebLocally x y) -> Ordering)
-> ((Int, WebLocally x y) -> Int)
-> (Int, WebLocally x y)
-> (Int, WebLocally x y)
-> Ordering
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate (Int -> Int)
-> ((Int, WebLocally x y) -> Int) -> (Int, WebLocally x y) -> Int
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int, WebLocally x y) -> Int
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                                                 (Map Int (Int, WebLocally x y) -> [(Int, WebLocally x y)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList Map Int (Int, WebLocally x y)
next) )
                     [(Needle x, WebLocally x y)]
-> [[(Needle x, WebLocally x y)]] -> [[(Needle x, WebLocally x y)]]
forall a. a -> [a] -> [a]
: Map Int (Int, WebLocally x y)
-> Map Int (Int, WebLocally x y) -> [[(Needle x, WebLocally x y)]]
go (Map Int (Int, WebLocally x y)
-> Map Int (Int, WebLocally x y) -> Map Int (Int, WebLocally x y)
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Int (Int, WebLocally x y)
previous Map Int (Int, WebLocally x y)
next)
                          (((Int, WebLocally x y)
 -> (Int, WebLocally x y) -> (Int, WebLocally x y))
-> [(Int, (Int, WebLocally x y))] -> Map Int (Int, WebLocally x y)
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (\(Int
n,WebLocally x y
ninfo) (Int
n',WebLocally x y
_) -> (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n'::Int, WebLocally x y
ninfo))
                             [ (Int
nnid,(Int
1,WebLocally x y
nneigh))
                             | (Int
nid,(Int
_,WebLocally x y
ninfo))<-Map Int (Int, WebLocally x y) -> [(Int, (Int, WebLocally x y))]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int (Int, WebLocally x y)
next
                             , (Int
nnid,(Needle x
_,WebLocally x y
nneigh))<-WebLocally x y
ninfoWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                             , Int -> Map Int (Int, WebLocally x y) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Int
nnid Map Int (Int, WebLocally x y)
previous Bool -> Bool -> Bool
&& Int -> Map Int (Int, WebLocally x y) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Int
nnid Map Int (Int, WebLocally x y)
next ])
       computeOffset :: WebLocally x y -> (Needle x, WebLocally x y)
computeOffset WebLocally x y
p = case WebLocally x y
pWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. WebLocally x y
originWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord of
                Just Needle x
v -> (Needle x
v,WebLocally x y
p)
       sortBCDistance :: [(Needle x, WebLocally x y)] -> [(Needle x, WebLocally x y)]
sortBCDistance = ((ℝ, (Needle x, WebLocally x y)) -> (Needle x, WebLocally x y))
-> [(ℝ, (Needle x, WebLocally x y))]
-> [(Needle x, WebLocally x y)]
forall a b. (a -> b) -> [a] -> [b]
map (ℝ, (Needle x, WebLocally x y)) -> (Needle x, WebLocally x y)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ([(ℝ, (Needle x, WebLocally x y))] -> [(Needle x, WebLocally x y)])
-> ([(Needle x, WebLocally x y)]
    -> [(ℝ, (Needle x, WebLocally x y))])
-> [(Needle x, WebLocally x y)]
-> [(Needle x, WebLocally x y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((ℝ, (Needle x, WebLocally x y))
 -> (ℝ, (Needle x, WebLocally x y)) -> Ordering)
-> [(ℝ, (Needle x, WebLocally x y))]
-> [(ℝ, (Needle x, WebLocally x y))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((ℝ, (Needle x, WebLocally x y)) -> ℝ)
-> (ℝ, (Needle x, WebLocally x y))
-> (ℝ, (Needle x, WebLocally x y))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ℝ, (Needle x, WebLocally x y)) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) ([(ℝ, (Needle x, WebLocally x y))]
 -> [(ℝ, (Needle x, WebLocally x y))])
-> ([(Needle x, WebLocally x y)]
    -> [(ℝ, (Needle x, WebLocally x y))])
-> [(Needle x, WebLocally x y)]
-> [(ℝ, (Needle x, WebLocally x y))]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((Needle x, WebLocally x y) -> (ℝ, (Needle x, WebLocally x y)))
-> [(Needle x, WebLocally x y)]
-> [(ℝ, (Needle x, WebLocally x y))]
forall a b. (a -> b) -> [a] -> [b]
map ((Needle x, WebLocally x y) -> ℝ
bcDist((Needle x, WebLocally x y) -> ℝ)
-> ((Needle x, WebLocally x y) -> (Needle x, WebLocally x y))
-> (Needle x, WebLocally x y)
-> (ℝ, (Needle x, WebLocally x y))
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&(Needle x, WebLocally x y) -> (Needle x, WebLocally x y)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
        where bcDist :: (Needle x, WebLocally x y) -> ℝ
bcDist (Needle x
v,WebLocally x y
_)
                = Seminorm (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq (WebLocally x y
originWebLocally x y
-> Getting
     (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
-> Seminorm (Needle x)
forall s a. s -> Getting a s a -> a
^.Getting
  (Seminorm (Needle x)) (WebLocally x y) (Seminorm (Needle x))
forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct) (Needle x -> ℝ) -> Needle x -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
vNeedle x -> Needle x -> Needle x
forall v. AdditiveGroup v => v -> v -> v
^-^Needle x
seedBarycenterOffs
       seedBarycenterOffs :: Needle x
seedBarycenterOffs = [Needle x] -> Needle x
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV [Needle x]
ngbOffs Needle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Int -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
directCandidates Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        where ngbOffs :: [Needle x]
ngbOffs = [ Needle x
v | (Int
_, (Int
_, WebLocally x y
n)) <- [(Int, (Int, WebLocally x y))]
seeds
                            , let Just Needle x
v = WebLocally x y
nWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. WebLocally x y
originWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord ]

webOnions :: ∀ x y . WithField ℝ Manifold x
            => PointsWeb x y -> PointsWeb x [[(x,y)]]
webOnions :: PointsWeb x y -> PointsWeb x [[(x, y)]]
webOnions = (WebLocally x y -> [[(x, y)]])
-> PointsWeb x y -> PointsWeb x [[(x, y)]]
forall x y z.
WithField ℝ Manifold x =>
(WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb (([(Needle x, WebLocally x y)] -> [(x, y)])
-> [[(Needle x, WebLocally x y)]] -> [[(x, y)]]
forall a b. (a -> b) -> [a] -> [b]
map (((Needle x, WebLocally x y) -> (x, y))
-> [(Needle x, WebLocally x y)] -> [(x, y)]
forall a b. (a -> b) -> [a] -> [b]
map (((Needle x, WebLocally x y) -> (x, y))
 -> [(Needle x, WebLocally x y)] -> [(x, y)])
-> ((Needle x, WebLocally x y) -> (x, y))
-> [(Needle x, WebLocally x y)]
-> [(x, y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x y -> x
forall x y. WebLocally x y -> x
_thisNodeCoord(WebLocally x y -> x)
-> (WebLocally x y -> y) -> WebLocally x y -> (x, y)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&WebLocally x y -> y
forall x y. WebLocally x y -> y
_thisNodeData (WebLocally x y -> (x, y))
-> ((Needle x, WebLocally x y) -> WebLocally x y)
-> (Needle x, WebLocally x y)
-> (x, y)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
<<< (Needle x, WebLocally x y) -> WebLocally x y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
                                ([[(Needle x, WebLocally x y)]] -> [[(x, y)]])
-> (WebLocally x y -> [[(Needle x, WebLocally x y)]])
-> WebLocally x y
-> [[(x, y)]]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
`localOnion`[]))

nearestNeighbour :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
                      => PointsWeb x y -> x -> Maybe (x,y)
nearestNeighbour :: PointsWeb x y -> x -> Maybe (x, y)
nearestNeighbour = PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> (PointsWeb x (WebLocally x y) -> x -> Maybe (x, y))
-> PointsWeb x y
-> x
-> Maybe (x, y)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \(PointsWeb Shaded x (Neighbourhood x (WebLocally x y))
rsc) x
x
                 -> ((Int,
  ([Shaded x (Neighbourhood x (WebLocally x y))],
   (x, Neighbourhood x (WebLocally x y))))
 -> (x, y))
-> Maybe
     (Int,
      ([Shaded x (Neighbourhood x (WebLocally x y))],
       (x, Neighbourhood x (WebLocally x y))))
-> Maybe (x, y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (x
-> (Int,
    ([Shaded x (Neighbourhood x (WebLocally x y))],
     (x, Neighbourhood x (WebLocally x y))))
-> (x, y)
fine x
x) (Maybe (Metric x)
-> Shaded x (Neighbourhood x (WebLocally x y))
-> x
-> Maybe
     (Int,
      ([Shaded x (Neighbourhood x (WebLocally x y))],
       (x, Neighbourhood x (WebLocally x y))))
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
Maybe (Metric x)
-> Shaded x y -> x -> Maybe (Int, ([Shaded x y], (x, y)))
positionIndex Maybe (Metric x)
forall (f :: * -> *) a. Alternative f => f a
empty Shaded x (Neighbourhood x (WebLocally x y))
rsc x
x)
 where fine :: x -> (Int, ( [Shaded x (Neighbourhood x (WebLocally x y))]
                          , (x, Neighbourhood x (WebLocally x y)) ))
                 -> (x,y)
       fine :: x
-> (Int,
    ([Shaded x (Neighbourhood x (WebLocally x y))],
     (x, Neighbourhood x (WebLocally x y))))
-> (x, y)
fine x
x (Int
_, ([Shaded x (Neighbourhood x (WebLocally x y))]
_, (x
xc, (Neighbourhood WebLocally x y
c Vector Int
_ Metric x
locMetr Maybe (Needle' x)
_))))
           = (ℝ, (x, y)) -> (x, y)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((ℝ, (x, y)) -> (x, y))
-> ([(Needle x, (x, y))] -> (ℝ, (x, y)))
-> [(Needle x, (x, y))]
-> (x, y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((ℝ, (x, y)) -> (ℝ, (x, y)) -> Ordering)
-> [(ℝ, (x, y))] -> (ℝ, (x, y))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (((ℝ, (x, y)) -> ℝ) -> (ℝ, (x, y)) -> (ℝ, (x, y)) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ℝ, (x, y)) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
              ([(ℝ, (x, y))] -> (ℝ, (x, y)))
-> ([(Needle x, (x, y))] -> [(ℝ, (x, y))])
-> [(Needle x, (x, y))]
-> (ℝ, (x, y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((Needle x, (x, y)) -> (ℝ, (x, y)))
-> [(Needle x, (x, y))] -> [(ℝ, (x, y))]
forall a b. (a -> b) -> [a] -> [b]
map ((Needle x -> ℝ) -> (Needle x, (x, y)) -> (ℝ, (x, y))
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first ((Needle x -> ℝ) -> (Needle x, (x, y)) -> (ℝ, (x, y)))
-> (Needle x -> ℝ) -> (Needle x, (x, y)) -> (ℝ, (x, y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x y
cWebLocally x y
-> Getting (Metric x) (WebLocally x y) (Metric x) -> Metric x
forall s a. s -> Getting a s a -> a
^.Getting (Metric x) (WebLocally x y) (Metric x)
forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProductMetric x -> Needle x -> Scalar (Needle x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|)
                           (Needle x -> ℝ) -> (Needle x -> Needle x) -> Needle x -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Needle x -> Needle x -> Needle x
forall v. AdditiveGroup v => v -> v -> v
^-^Needle x
vc))
              ([(Needle x, (x, y))] -> (x, y)) -> [(Needle x, (x, y))] -> (x, y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Needle x
forall v. AdditiveGroup v => v
zeroV, (x
xc, WebLocally x y
cWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData))
                (Needle x, (x, y)) -> [(Needle x, (x, y))] -> [(Needle x, (x, y))]
forall a. a -> [a] -> [a]
: [ (Needle x
δx, (WebLocally x y
ngbWebLocally x y -> Getting x (WebLocally x y) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x y) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord, WebLocally x y
ngbWebLocally x y -> Getting y (WebLocally x y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (WebLocally x y) y
forall x y. Lens' (WebLocally x y) y
thisNodeData))
                  | (Int
_, (Needle x
δx, WebLocally x y
ngb)) <- WebLocally x y
cWebLocally x y
-> Getting
     [(Int, (Needle x, WebLocally x y))]
     (WebLocally x y)
     [(Int, (Needle x, WebLocally x y))]
-> [(Int, (Needle x, WebLocally x y))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x y))]
  (WebLocally x y)
  [(Int, (Needle x, WebLocally x y))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours ]
        where Just Needle x
vc = x
xx -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
xc



-- ^ 'fmap' from the co-Kleisli category of 'WebLocally'.
localTraverseWeb :: (WithField ℝ Manifold x, Hask.Applicative m)
                => (WebLocally x y -> m z) -> PointsWeb x y -> m (PointsWeb x z)
localTraverseWeb :: (WebLocally x y -> m z) -> PointsWeb x y -> m (PointsWeb x z)
localTraverseWeb WebLocally x y -> m z
f = PointsWeb x y -> PointsWeb x (WebLocally x y)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x y -> PointsWeb x (WebLocally x y))
-> (PointsWeb x (WebLocally x y) -> m (PointsWeb x z))
-> PointsWeb x y
-> m (PointsWeb x z)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (WebLocally x y -> m z)
-> PointsWeb x (WebLocally x y) -> m (PointsWeb x z)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse WebLocally x y -> m z
f

-- ^ 'fmap' from the co-Kleisli category of 'WebLocally', restricted to some
--   contiguous part of a web.
localTraverseWebChunk :: (WithField ℝ Manifold x, Hask.Applicative m)
                => (WebLocally x y -> m y) -> WebChunk x y -> m (WebChunk x y)
localTraverseWebChunk :: (WebLocally x y -> m y) -> WebChunk x y -> m (WebChunk x y)
localTraverseWebChunk WebLocally x y -> m y
f (WebChunk PointsWeb x y
this [(Shaded x (Neighbourhood x y), Int)]
outlayers)
      = (PointsWeb x y -> WebChunk x y)
-> m (PointsWeb x y) -> m (WebChunk x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\PointsWeb x y
c -> PointsWeb x y
-> [(Shaded x (Neighbourhood x y), Int)] -> WebChunk x y
forall x y.
PointsWeb x y
-> [(Shaded x (Neighbourhood x y), Int)] -> WebChunk x y
WebChunk PointsWeb x y
c [(Shaded x (Neighbourhood x y), Int)]
outlayers) (m (PointsWeb x y) -> m (WebChunk x y))
-> m (PointsWeb x y) -> m (WebChunk x y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x y -> m y) -> PointsWeb x y -> m (PointsWeb x y)
forall x (m :: * -> *) y z.
(WithField ℝ Manifold x, Applicative m) =>
(WebLocally x y -> m z) -> PointsWeb x y -> m (PointsWeb x z)
localTraverseWeb WebLocally x y -> m y
f PointsWeb x y
this

differentiateUncertainWebLocally :: ∀ x y
   . ( ModellableRelation x y )
            => WebLocally x (Shade' y)
             -> Shade' (LocalLinear x y)
differentiateUncertainWebLocally :: WebLocally x (Shade' y) -> Shade' (LocalLinear x y)
differentiateUncertainWebLocally = (DualSpaceWitness (Needle x), DualSpaceWitness (Needle y))
-> WebLocally x (Shade' y)
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
duwl
                ( DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                , DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle y) )
 where duwl :: (DualSpaceWitness (Needle x), DualSpaceWitness (Needle y))
-> WebLocally x (Shade' y)
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
duwl (DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle y)
DualSpaceWitness) WebLocally x (Shade' y)
info
          = case [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally ([(Needle x, Shade' y)] -> Maybe (AffineModel x y))
-> [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                          (\(Needle x
δx,WebLocally x (Shade' y)
ngb) -> (Needle x
δx, WebLocally x (Shade' y)
ngbWebLocally x (Shade' y)
-> Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
forall x y. Lens' (WebLocally x y) y
thisNodeData) )
                          ((Needle x, WebLocally x (Shade' y)) -> (Needle x, Shade' y))
-> [(Needle x, WebLocally x (Shade' y))] -> [(Needle x, Shade' y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (Needle x
forall v. AdditiveGroup v => v
zeroV,WebLocally x (Shade' y)
info) (Needle x, WebLocally x (Shade' y))
-> [(Needle x, WebLocally x (Shade' y))]
-> [(Needle x, WebLocally x (Shade' y))]
forall a. a -> [a] -> [a]
: [(Needle x, WebLocally x (Shade' y))]
envi
                          of
               Just (AffineModel Shade y
_ Shade (LocalLinear x y)
j :: AffineModel x y) -> Shade (LinearMap ℝ (Needle x) (Needle y))
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade (LinearMap ℝ (Needle x) (Needle y))
Shade (LocalLinear x y)
j
        where [(Needle x, WebLocally x (Shade' y))]
_:[(Needle x, WebLocally x (Shade' y))]
directEnvi:[[(Needle x, WebLocally x (Shade' y))]]
remoteEnvi = WebLocally x (Shade' y)
-> [Int] -> [[(Needle x, WebLocally x (Shade' y))]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x (Shade' y)
info []
              envi :: [(Needle x, WebLocally x (Shade' y))]
envi = [(Needle x, WebLocally x (Shade' y))]
directEnvi [(Needle x, WebLocally x (Shade' y))]
-> [(Needle x, WebLocally x (Shade' y))]
-> [(Needle x, WebLocally x (Shade' y))]
forall a. [a] -> [a] -> [a]
++ [[(Needle x, WebLocally x (Shade' y))]]
-> [(Needle x, WebLocally x (Shade' y))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Needle x, WebLocally x (Shade' y))]]
remoteEnvi


differentiateUncertainWebFunction :: ∀ x y
   . ( ModellableRelation x y )
            => PointsWeb x (Shade' y)
             -> PointsWeb x (Shade' (LocalLinear x y))
differentiateUncertainWebFunction :: PointsWeb x (Shade' y) -> PointsWeb x (Shade' (LocalLinear x y))
differentiateUncertainWebFunction = (WebLocally x (Shade' y)
 -> Shade' (LinearMap ℝ (Needle x) (Needle y)))
-> PointsWeb x (Shade' y)
-> PointsWeb x (Shade' (LinearMap ℝ (Needle x) (Needle y)))
forall x y z.
WithField ℝ Manifold x =>
(WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb WebLocally x (Shade' y)
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
forall x y.
ModellableRelation x y =>
WebLocally x (Shade' y) -> Shade' (LocalLinear x y)
differentiateUncertainWebLocally

differentiate²UncertainWebLocally :: ∀ x y
   . ( ModellableRelation x y )
            => WebLocally x (Shade' y)
             -> Shade' (Needle x ⊗〃+> Needle y)
differentiate²UncertainWebLocally :: WebLocally x (Shade' y) -> Shade' (Needle x ⊗〃+> Needle y)
differentiate²UncertainWebLocally = (DualSpaceWitness (Needle x), DualSpaceWitness (Needle y))
-> WebLocally x (Shade' y)
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
d²uwl
                ( DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                , DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle y) )
 where d²uwl :: (DualSpaceWitness (Needle x), DualSpaceWitness (Needle y))
-> WebLocally x (Shade' y)
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
d²uwl (DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle y)
DualSpaceWitness) WebLocally x (Shade' y)
info
          = case [(Needle x, Shade' y)] -> Maybe (QuadraticModel x y)
forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally ([(Needle x, Shade' y)] -> Maybe (QuadraticModel x y))
-> [(Needle x, Shade' y)] -> Maybe (QuadraticModel x y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                          (\(Needle x
δx,WebLocally x (Shade' y)
ngb) -> (Needle x
δx, WebLocally x (Shade' y)
ngbWebLocally x (Shade' y)
-> Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
forall x y. Lens' (WebLocally x y) y
thisNodeData) )
                          ((Needle x, WebLocally x (Shade' y)) -> (Needle x, Shade' y))
-> [(Needle x, WebLocally x (Shade' y))] -> [(Needle x, Shade' y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (Needle x
forall v. AdditiveGroup v => v
zeroV,WebLocally x (Shade' y)
info) (Needle x, WebLocally x (Shade' y))
-> [(Needle x, WebLocally x (Shade' y))]
-> [(Needle x, WebLocally x (Shade' y))]
forall a. a -> [a] -> [a]
: [(Needle x, WebLocally x (Shade' y))]
envi
                          of
               Just (QuadraticModel Shade y
_ Shade (Needle x +> Needle y)
_ Shade (Needle x ⊗〃+> Needle y)
h :: QuadraticModel x y)
                        -> (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y)
 +> LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
forall (shade :: * -> *) x y.
(IsShade shade, SimpleSpace x, SimpleSpace y, Scalar x ~ Scalar y,
 Num' (Scalar x)) =>
(x +> y) -> shade x -> shade y
linIsoTransformShade (Scalar
  (LinearMap
     ℝ
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y)))
2Scalar
  (LinearMap
     ℝ
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y)))
-> LinearMap
     ℝ
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
-> LinearMap
     ℝ
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
     (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
forall v. VectorSpace v => Scalar v -> v -> v
*^LinearMap
  ℝ
  (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
  (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) (Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
 -> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y)))
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
Shade (Needle x ⊗〃+> Needle y)
h
        where [(Needle x, WebLocally x (Shade' y))]
_:[(Needle x, WebLocally x (Shade' y))]
directEnvi:[[(Needle x, WebLocally x (Shade' y))]]
remoteEnvi = WebLocally x (Shade' y)
-> [Int] -> [[(Needle x, WebLocally x (Shade' y))]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x (Shade' y)
info []
              envi :: [(Needle x, WebLocally x (Shade' y))]
envi = [(Needle x, WebLocally x (Shade' y))]
directEnvi [(Needle x, WebLocally x (Shade' y))]
-> [(Needle x, WebLocally x (Shade' y))]
-> [(Needle x, WebLocally x (Shade' y))]
forall a. [a] -> [a] -> [a]
++ [[(Needle x, WebLocally x (Shade' y))]]
-> [(Needle x, WebLocally x (Shade' y))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Needle x, WebLocally x (Shade' y))]]
remoteEnvi


-- | Calculate a quadratic fit with uncertainty margin centered around the connection
--   between any two adjacent nodes. In case of a regular grid (which we by no means
--   require here!) this corresponds to the vector quantities of an Arakawa type C/D
--   grid (cf. A. Arakawa, V.R. Lamb (1977):
--   Computational design of the basic dynamical processes of the UCLA general circulation model)
localModels_CGrid :: ∀ x y ㄇ . ( ModellableRelation x y, LocalModel ㄇ )
          => PointsWeb x (Shade' y) -> [(x, ㄇ x y)]
localModels_CGrid :: PointsWeb x (Shade' y) -> [(x, ㄇ x y)]
localModels_CGrid = (WebLocally x (Shade' y) -> [(x, ㄇ x y)])
-> [WebLocally x (Shade' y)] -> [(x, ㄇ x y)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Hask.concatMap WebLocally x (Shade' y) -> [(x, ㄇ x y)]
theCGrid ([WebLocally x (Shade' y)] -> [(x, ㄇ x y)])
-> (PointsWeb x (Shade' y) -> [WebLocally x (Shade' y)])
-> PointsWeb x (Shade' y)
-> [(x, ㄇ x y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x (WebLocally x (Shade' y)) -> [WebLocally x (Shade' y)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList (PointsWeb x (WebLocally x (Shade' y))
 -> [WebLocally x (Shade' y)])
-> (PointsWeb x (Shade' y)
    -> PointsWeb x (WebLocally x (Shade' y)))
-> PointsWeb x (Shade' y)
-> [WebLocally x (Shade' y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x (Shade' y) -> PointsWeb x (WebLocally x (Shade' y))
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo
 where theCGrid :: WebLocally x (Shade' y) -> [(x, ㄇ x y)]
       theCGrid :: WebLocally x (Shade' y) -> [(x, ㄇ x y)]
theCGrid WebLocally x (Shade' y)
node = [ ( x
pn x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.-~^ Needle x
δxNeedle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
2
                         , LocalDataPropPlan x (Shade' y) -> ㄇ x y
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
LocalDataPropPlan x (Shade' y) -> ㄇ x y
propagationCenteredModel
                             ( x
-> Needle x
-> Shade' y
-> Shade' y
-> [(Needle x, Shade' y)]
-> LocalDataPropPlan x (Shade' y)
forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                    x
pn
                                    (Needle x -> Needle x
forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                    (WebLocally x (Shade' y)
ngbNodeWebLocally x (Shade' y)
-> Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                    (WebLocally x (Shade' y)
nodeWebLocally x (Shade' y)
-> Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                    (((Needle x, WebLocally x (Shade' y)) -> (Needle x, Shade' y))
-> [(Needle x, WebLocally x (Shade' y))] -> [(Needle x, Shade' y)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x (Shade' y) -> Shade' y)
-> (Needle x, WebLocally x (Shade' y)) -> (Needle x, Shade' y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second WebLocally x (Shade' y) -> Shade' y
forall x y. WebLocally x y -> y
_thisNodeData)
                                      ([(Needle x, WebLocally x (Shade' y))] -> [(Needle x, Shade' y)])
-> ([[(Needle x, WebLocally x (Shade' y))]]
    -> [(Needle x, WebLocally x (Shade' y))])
-> [[(Needle x, WebLocally x (Shade' y))]]
-> [(Needle x, Shade' y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x (Shade' y))]]
-> [(Needle x, WebLocally x (Shade' y))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Needle x, WebLocally x (Shade' y))]]
 -> [(Needle x, WebLocally x (Shade' y))])
-> ([[(Needle x, WebLocally x (Shade' y))]]
    -> [[(Needle x, WebLocally x (Shade' y))]])
-> [[(Needle x, WebLocally x (Shade' y))]]
-> [(Needle x, WebLocally x (Shade' y))]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x (Shade' y))]]
-> [[(Needle x, WebLocally x (Shade' y))]]
forall a. [a] -> [a]
tail
                                           ([[(Needle x, WebLocally x (Shade' y))]] -> [(Needle x, Shade' y)])
-> [[(Needle x, WebLocally x (Shade' y))]]
-> [(Needle x, Shade' y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (Shade' y)
-> [Int] -> [[(Needle x, WebLocally x (Shade' y))]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x (Shade' y)
ngbNode [WebLocally x (Shade' y)
nodeWebLocally x (Shade' y)
-> Getting Int (WebLocally x (Shade' y)) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x (Shade' y)) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId] )
                                          ) )
                       | (Int
nid, (Needle x
δx, WebLocally x (Shade' y)
ngbNode)) <- WebLocally x (Shade' y)
nodeWebLocally x (Shade' y)
-> Getting
     [(Int, (Needle x, WebLocally x (Shade' y)))]
     (WebLocally x (Shade' y))
     [(Int, (Needle x, WebLocally x (Shade' y)))]
-> [(Int, (Needle x, WebLocally x (Shade' y)))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x (Shade' y)))]
  (WebLocally x (Shade' y))
  [(Int, (Needle x, WebLocally x (Shade' y)))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                       , Int
nid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> WebLocally x (Shade' y)
nodeWebLocally x (Shade' y)
-> Getting Int (WebLocally x (Shade' y)) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x (Shade' y)) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId
                       , let pn :: x
pn = WebLocally x (Shade' y)
ngbNodeWebLocally x (Shade' y)
-> Getting x (WebLocally x (Shade' y)) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x (Shade' y)) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord
                       ]


acoSnd :: ∀ s v y . ( RealFloat'' s, Object (Affine s) y, Object (Affine s) v
                    , LinearSpace v, Scalar v ~ s ) => Affine s y (v,y)
acoSnd :: Affine s y (v, y)
acoSnd = (OpenManifold (Needle (Interior y)) => Affine s y (v, y))
-> Affine s y (v, y)
forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @y (((LinearSpace (Needle (Boundary y)),
  Scalar (Needle (Boundary y)) ~ Scalar (Needle (Interior y))) =>
 Affine s y (v, y))
-> Affine s y (v, y)
forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @y (
           (ProjectableBoundary (Needle (Interior y)) => Affine s y (v, y))
-> Affine s y (v, y)
forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @y (((LinearSpace (Needle (Boundary v)),
  Scalar (Needle (Boundary v)) ~ Scalar (Needle (Interior v))) =>
 Affine s y (v, y))
-> Affine s y (v, y)
forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @v (case
              ( TensorSpace v => LinearManifoldWitness v
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @v
              , LinearSpace (Needle v) => DualSpaceWitness (Needle v)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle v), LinearSpace (Needle y) => DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle y)
              , Semimanifold y => SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @y
              ) of
   (LinearManifoldWitness v
LinearManifoldWitness, DualSpaceWitness (Needle v)
DualSpaceWitness, DualSpaceWitness (Needle y)
DualSpaceWitness, SemimanifoldWitness y
SemimanifoldWitness)
       -> v -> Affine s y v
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const v
forall v. AdditiveGroup v => v
zeroV Affine s y v -> Affine s y y -> Affine s y (v, y)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& Affine s y y
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  ))))


differentiate²UncertainWebFunction :: ∀ x y
   . ( ModellableRelation x y )
         => PointsWeb x (Shade' y)
          -> PointsWeb x (Shade' (Needle x ⊗〃+> Needle y)) 
differentiate²UncertainWebFunction :: PointsWeb x (Shade' y)
-> PointsWeb x (Shade' (Needle x ⊗〃+> Needle y))
differentiate²UncertainWebFunction = (WebLocally x (Shade' y)
 -> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y)))
-> PointsWeb x (Shade' y)
-> PointsWeb
     x (Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y)))
forall x y z.
WithField ℝ Manifold x =>
(WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb WebLocally x (Shade' y)
-> Shade' (LinearMap ℝ (SymmetricTensor ℝ (Needle x)) (Needle y))
forall x y.
ModellableRelation x y =>
WebLocally x (Shade' y) -> Shade' (Needle x ⊗〃+> Needle y)
differentiate²UncertainWebLocally

rescanPDELocally :: ∀ x y ㄇ .
     ( ModellableRelation x y, LocalModel ㄇ )
         => DifferentialEqn ㄇ x y -> WebLocally x (Shade' y) -> Maybe (Shade' y)
rescanPDELocally :: DifferentialEqn ㄇ x y
-> WebLocally x (Shade' y) -> Maybe (Shade' y)
rescanPDELocally = case ( DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x
                        , DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness y
                        , PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness y ) of
   ( DualSpaceWitness (Needle x)
DualSpaceWitness,DualSpaceWitness (Needle y)
DualSpaceWitness
    , PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness )
     -> \DifferentialEqn ㄇ x y
f WebLocally x (Shade' y)
info
          -> if Maybe (DualVector (Needle x)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (DualVector (Needle x)) -> Bool)
-> Maybe (DualVector (Needle x)) -> Bool
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (Shade' y)
infoWebLocally x (Shade' y)
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x (Shade' y))
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x (Shade' y))
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
              then Shade' y -> Maybe (Shade' y)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Shade' y -> Maybe (Shade' y)) -> Shade' y -> Maybe (Shade' y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (Shade' y)
infoWebLocally x (Shade' y)
-> Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
forall x y. Lens' (WebLocally x y) y
thisNodeData
              else let xc :: x
xc = WebLocally x (Shade' y)
infoWebLocally x (Shade' y)
-> Getting x (WebLocally x (Shade' y)) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x (Shade' y)) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord
                       yc :: y
yc = WebLocally x (Shade' y)
infoWebLocally x (Shade' y)
-> Getting y (WebLocally x (Shade' y)) y -> y
forall s a. s -> Getting a s a -> a
^.(Shade' y -> Const y (Shade' y))
-> WebLocally x (Shade' y) -> Const y (WebLocally x (Shade' y))
forall x y. Lens' (WebLocally x y) y
thisNodeData((Shade' y -> Const y (Shade' y))
 -> WebLocally x (Shade' y) -> Const y (WebLocally x (Shade' y)))
-> ((y -> Const y y) -> Shade' y -> Const y (Shade' y))
-> Getting y (WebLocally x (Shade' y)) y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(y -> Const y y) -> Shade' y -> Const y (Shade' y)
forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr
                   in case DifferentialEqn ㄇ x y
f DifferentialEqn ㄇ x y -> DifferentialEqn ㄇ x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (x, y) -> [Needle (x, y)] -> Shade (x, y)
forall x s.
(Fractional' s, WithField s PseudoAffine x,
 SimpleSpace (Needle x)) =>
x -> [Needle x] -> Shade x
coverAllAround (x
xc, y
yc)
                                     [ (Needle x
δx, (WebLocally x (Shade' y)
ngbWebLocally x (Shade' y)
-> Getting y (WebLocally x (Shade' y)) y -> y
forall s a. s -> Getting a s a -> a
^.(Shade' y -> Const y (Shade' y))
-> WebLocally x (Shade' y) -> Const y (WebLocally x (Shade' y))
forall x y. Lens' (WebLocally x y) y
thisNodeData((Shade' y -> Const y (Shade' y))
 -> WebLocally x (Shade' y) -> Const y (WebLocally x (Shade' y)))
-> ((y -> Const y y) -> Shade' y -> Const y (Shade' y))
-> Getting y (WebLocally x (Shade' y)) y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(y -> Const y y) -> Shade' y -> Const y (Shade' y)
forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtry -> y -> Needle y
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!y
yc) Needle y -> Needle y -> Needle y
forall v. AdditiveGroup v => v -> v -> v
^+^ Needle y
v)
                                     | (Int
_,(Needle x
δx,WebLocally x (Shade' y)
ngb))<-WebLocally x (Shade' y)
infoWebLocally x (Shade' y)
-> Getting
     [(Int, (Needle x, WebLocally x (Shade' y)))]
     (WebLocally x (Shade' y))
     [(Int, (Needle x, WebLocally x (Shade' y)))]
-> [(Int, (Needle x, WebLocally x (Shade' y)))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x (Shade' y)))]
  (WebLocally x (Shade' y))
  [(Int, (Needle x, WebLocally x (Shade' y)))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                     , Needle y
v <- Seminorm (Needle y) -> [Needle y]
forall v.
(FiniteDimensional v, IEEE (Scalar v)) =>
Seminorm v -> [v]
normSpanningSystem'
                                              (WebLocally x (Shade' y)
ngbWebLocally x (Shade' y)
-> Getting
     (Seminorm (Needle y))
     (WebLocally x (Shade' y))
     (Seminorm (Needle y))
-> Seminorm (Needle y)
forall s a. s -> Getting a s a -> a
^.(Shade' y -> Const (Seminorm (Needle y)) (Shade' y))
-> WebLocally x (Shade' y)
-> Const (Seminorm (Needle y)) (WebLocally x (Shade' y))
forall x y. Lens' (WebLocally x y) y
thisNodeData((Shade' y -> Const (Seminorm (Needle y)) (Shade' y))
 -> WebLocally x (Shade' y)
 -> Const (Seminorm (Needle y)) (WebLocally x (Shade' y)))
-> ((Seminorm (Needle y)
     -> Const (Seminorm (Needle y)) (Seminorm (Needle y)))
    -> Shade' y -> Const (Seminorm (Needle y)) (Shade' y))
-> Getting
     (Seminorm (Needle y))
     (WebLocally x (Shade' y))
     (Seminorm (Needle y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(Seminorm (Needle y)
 -> Const (Seminorm (Needle y)) (Seminorm (Needle y)))
-> Shade' y -> Const (Seminorm (Needle y)) (Shade' y)
forall x. Lens' (Shade' x) (Metric x)
shadeNarrowness)] of
                        LocalDifferentialEqn ㄇ x y -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y)))
rescan -> (Maybe (Shade' y),
 Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
-> Maybe (Shade' y)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst
                             ( ㄇ x y
-> (Maybe (Shade' y),
    Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
ㄇ x y -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y)))
rescan (ㄇ x y
 -> (Maybe (Shade' y),
     Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))))
-> ㄇ x y
-> (Maybe (Shade' y),
    Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ case [(Needle x, Shade' y)] -> Maybe (ㄇ x y)
forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally ([(Needle x, Shade' y)] -> Maybe (ㄇ x y))
-> [(Needle x, Shade' y)] -> Maybe (ㄇ x y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Needle x, WebLocally x (Shade' y)) -> (Needle x, Shade' y))
-> [(Needle x, WebLocally x (Shade' y))] -> [(Needle x, Shade' y)]
forall a b. (a -> b) -> [a] -> [b]
map (Needle x -> Needle x
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id (Needle x -> Needle x)
-> (WebLocally x (Shade' y) -> Shade' y)
-> (Needle x, WebLocally x (Shade' y))
-> (Needle x, Shade' y)
forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** WebLocally x (Shade' y) -> Shade' y
forall x y. WebLocally x y -> y
_thisNodeData)
                                               ([(Needle x, WebLocally x (Shade' y))] -> [(Needle x, Shade' y)])
-> [[(Needle x, WebLocally x (Shade' y))]]
-> [(Needle x, Shade' y)]
forall (m :: * -> *) (k :: * -> * -> *) a b.
(Monad m k, Object k a, Object k b, Object k (m a), Object k (m b),
 Object k (m (m b))) =>
k a (m b) -> k (m a) (m b)
=<< (WebLocally x (Shade' y)
-> [Int] -> [[(Needle x, WebLocally x (Shade' y))]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x (Shade' y)
info []) of
                                 Just ㄇ x y
ㄇ -> ㄇ x y
ㄇ)
                                 Maybe (Shade' y)
-> (Shade' y -> Maybe (Shade' y)) -> Maybe (Shade' y)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Function f, Monad m f, Object f a, Object f b, Object f (m a),
 Object f (m b), Object f (m (m b))) =>
m a -> f a (m b) -> m b
>>= NonEmpty (Shade' y) -> Maybe (Shade' y)
forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's (NonEmpty (Shade' y) -> Maybe (Shade' y))
-> (Shade' y -> NonEmpty (Shade' y))
-> Shade' y
-> Maybe (Shade' y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Shade' y -> [Shade' y] -> NonEmpty (Shade' y)
forall a. a -> [a] -> NonEmpty a
:|[WebLocally x (Shade' y)
infoWebLocally x (Shade' y)
-> Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (WebLocally x (Shade' y)) (Shade' y)
forall x y. Lens' (WebLocally x y) y
thisNodeData])

fromGraph :: ∀ x y . (WithField ℝ Manifold x, SimpleSpace (Needle x))
              => MetricChoice x -> Graph -> (Vertex -> (x, y)) -> PointsWeb x y
fromGraph :: MetricChoice x -> Graph -> (Int -> (x, y)) -> PointsWeb x y
fromGraph MetricChoice x
metricf Graph
gr Int -> (x, y)
dataLookup
      = PointsWeb x Int -> PointsWeb x y
introduceLinks (PointsWeb x Int -> PointsWeb x y)
-> PointsWeb x Int -> PointsWeb x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ MetricChoice x -> [(x, Int)] -> PointsWeb x Int
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> [(x, y)] -> PointsWeb x y
unlinkedFromWebNodes MetricChoice x
metricf
                           [((x, y) -> x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst (Int -> (x, y)
dataLookup Int
v), Int
v) | Int
v <- Graph -> [Int]
vertices Graph
gr]
 where introduceLinks :: PointsWeb x Vertex -> PointsWeb x y
       introduceLinks :: PointsWeb x Int -> PointsWeb x y
introduceLinks (PointsWeb Shaded x (Neighbourhood x Int)
w) = Shaded x (Neighbourhood x y) -> PointsWeb x y
forall x y. Shaded x (Neighbourhood x y) -> PointsWeb x y
PointsWeb (Shaded x (Neighbourhood x y) -> PointsWeb x y)
-> Shaded x (Neighbourhood x y) -> PointsWeb x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
          AnIndexedSetter
  Int
  (Shaded x (Neighbourhood x Int))
  (Shaded x (Neighbourhood x y))
  (Neighbourhood x Int)
  (Neighbourhood x y)
-> (Int -> Neighbourhood x Int -> Neighbourhood x y)
-> Shaded x (Neighbourhood x Int)
-> Shaded x (Neighbourhood x y)
forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
iover (((Neighbourhood x Int -> Indexing Identity (Neighbourhood x y))
 -> Shaded x (Neighbourhood x Int)
 -> Indexing Identity (Shaded x (Neighbourhood x y)))
-> AnIndexedSetter
     Int
     (Shaded x (Neighbourhood x Int))
     (Shaded x (Neighbourhood x y))
     (Neighbourhood x Int)
     (Neighbourhood x y)
forall (p :: * -> * -> *) a (f :: * -> *) b s t.
Indexable Int p =>
((a -> Indexing f b) -> s -> Indexing f t) -> p a (f b) -> s -> f t
indexing (Neighbourhood x Int -> Indexing Identity (Neighbourhood x y))
-> Shaded x (Neighbourhood x Int)
-> Indexing Identity (Shaded x (Neighbourhood x y))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse)
             (\Int
wi (Neighbourhood Int
vert Vector Int
_ Metric x
sclPr Maybe (Needle' x)
bound)
                -> let neighbours :: [Int]
neighbours = Graph
gr Graph -> Int -> [Int]
forall i e. Ix i => Array i e -> i -> e
PArr.! Int
wi
                       neighbourwis :: [Int]
neighbourwis = (Map Int Int
vertToWebNode Map Int Int -> Int -> Int
forall k a. Ord k => Map k a -> k -> a
Map.!) (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [Int]
neighbours
                       (x
x, y
y) = Int -> (x, y)
dataLookup Int
vert
                   in y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y
                                    ([Int] -> Vector Int
forall a. Unbox a => [a] -> Vector a
UArr.fromList ([Int] -> Vector Int) -> [Int] -> Vector Int
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
wi(Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[Int]
neighbourwis)
                                    Metric x
sclPr
                                    (([()], Maybe (Needle' x)) -> Maybe (Needle' x)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd (Metric x -> [((), Needle x)] -> ([()], Maybe (Needle' x))
forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> [(i, v)] -> ([i], Maybe (DualVector v))
bestNeighbours Metric x
sclPr
                                            [ ((), (x, y) -> x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst (Int -> (x, y)
dataLookup Int
ni)x -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!x
x)
                                            | Int
ni<-[Int]
neighbours ])) )
             Shaded x (Neighbourhood x Int)
w
        where webNodeToVert :: Map Int Int
webNodeToVert = [(Int, Int)] -> Map Int Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int, Int)]
assocs
              vertToWebNode :: Map Int Int
vertToWebNode = [(Int, Int)] -> Map Int Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Int, Int)] -> Map Int Int) -> [(Int, Int)] -> Map Int Int
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Int, Int) -> (Int, Int)
forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap((Int, Int) -> (Int, Int)) -> [(Int, Int)] -> [(Int, Int)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Int, Int)]
assocs
              assocs :: [(Int, Int)]
assocs = [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Int
vert | Neighbourhood Int
vert Vector Int
_ Metric x
_ Maybe (Needle' x)
_ <- Shaded x (Neighbourhood x Int) -> [Neighbourhood x Int]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Shaded x (Neighbourhood x Int)
w]

toGraph :: (WithField ℝ Manifold x, SimpleSpace (Needle x))
              => PointsWeb x y -> (Graph, Vertex -> (x, y))
toGraph :: PointsWeb x y -> (Graph, Int -> (x, y))
toGraph PointsWeb x y
wb = ((Int -> (Int, Int, [Int])) -> Int -> (x, y))
-> (Graph, Int -> (Int, Int, [Int])) -> (Graph, Int -> (x, y))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Int -> (Int, Int, [Int]))
-> ((Int, Int, [Int]) -> (x, y)) -> Int -> (x, y)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \(Int
i,Int
_,[Int]
_) -> case PointsWeb x y -> Int -> Maybe (x, y)
forall x y. PointsWeb x y -> Int -> Maybe (x, y)
indexWeb PointsWeb x y
wb Int
i of {Just (x, y)
xy -> (x, y)
xy})
                ([(Int, Int, [Int])] -> (Graph, Int -> (Int, Int, [Int]))
forall key node.
Ord key =>
[(node, key, [key])] -> (Graph, Int -> (node, key, [key]))
graphFromEdges' [(Int, Int, [Int])]
edgs)
 where edgs :: [(Int, Int, [Int])]
       edgs :: [(Int, Int, [Int])]
edgs = Vector (Int, Int, [Int]) -> [(Int, Int, [Int])]
forall a. Vector a -> [a]
Arr.toList
            (Vector (Int, Int, [Int]) -> [(Int, Int, [Int])])
-> (Shaded x (Neighbourhood x y) -> Vector (Int, Int, [Int]))
-> Shaded x (Neighbourhood x y)
-> [(Int, Int, [Int])]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int -> Neighbourhood x y -> (Int, Int, [Int]))
-> Vector (Neighbourhood x y) -> Vector (Int, Int, [Int])
forall a b. (Int -> a -> b) -> Vector a -> Vector b
Arr.imap (\Int
i (Neighbourhood y
_ Vector Int
ngbs Metric x
_ Maybe (Needle' x)
_) -> (Int
i, Int
i, (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> [Int] -> [Int]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Vector Int -> [Int]
forall a. Unbox a => Vector a -> [a]
UArr.toList Vector Int
ngbs))
            (Vector (Neighbourhood x y) -> Vector (Int, Int, [Int]))
-> (Shaded x (Neighbourhood x y) -> Vector (Neighbourhood x y))
-> Shaded x (Neighbourhood x y)
-> Vector (Int, Int, [Int])
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [Neighbourhood x y] -> Vector (Neighbourhood x y)
forall a. [a] -> Vector a
Arr.fromList ([Neighbourhood x y] -> Vector (Neighbourhood x y))
-> (Shaded x (Neighbourhood x y) -> [Neighbourhood x y])
-> Shaded x (Neighbourhood x y)
-> Vector (Neighbourhood x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Shaded x (Neighbourhood x y) -> [Neighbourhood x y]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList (Shaded x (Neighbourhood x y) -> [(Int, Int, [Int])])
-> Shaded x (Neighbourhood x y) -> [(Int, Int, [Int])]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ PointsWeb x y -> Shaded x (Neighbourhood x y)
forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc PointsWeb x y
wb




data ConvexSet x
    = EmptyConvex
    | ConvexSet {
      ConvexSet x -> Shade' x
convexSetHull :: Shade' x
      -- ^ If @p@ is in all intersectors, it must also be in the hull.
    , ConvexSet x -> [Shade' x]
convexSetIntersectors :: [Shade' x]
    }
deriving instance LtdErrorShow x => Show (ConvexSet x)

ellipsoid :: Shade' x -> ConvexSet x
ellipsoid :: Shade' x -> ConvexSet x
ellipsoid Shade' x
s = Shade' x -> [Shade' x] -> ConvexSet x
forall x. Shade' x -> [Shade' x] -> ConvexSet x
ConvexSet Shade' x
s [Shade' x
s]

ellipsoidSet :: Embedding (->) (Maybe (Shade' x)) (ConvexSet x)
ellipsoidSet :: Embedding (->) (Maybe (Shade' x)) (ConvexSet x)
ellipsoidSet = (Maybe (Shade' x) -> ConvexSet x)
-> (ConvexSet x -> Maybe (Shade' x))
-> Embedding (->) (Maybe (Shade' x)) (ConvexSet x)
forall (c :: * -> * -> *) a b. c a b -> c b a -> Embedding c a b
Embedding (\case {Just Shade' x
s -> Shade' x -> [Shade' x] -> ConvexSet x
forall x. Shade' x -> [Shade' x] -> ConvexSet x
ConvexSet Shade' x
s [Shade' x
s]; Maybe (Shade' x)
Nothing -> ConvexSet x
forall x. ConvexSet x
EmptyConvex})
                         (\case {ConvexSet Shade' x
h [Shade' x]
_ -> Shade' x -> Maybe (Shade' x)
forall a. a -> Maybe a
Just Shade' x
h; ConvexSet x
EmptyConvex -> Maybe (Shade' x)
forall a. Maybe a
Nothing})

intersectors :: ConvexSet x -> Maybe (NonEmpty (Shade' x))
intersectors :: ConvexSet x -> Maybe (NonEmpty (Shade' x))
intersectors (ConvexSet Shade' x
h []) = NonEmpty (Shade' x) -> Maybe (NonEmpty (Shade' x))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Shade' x
hShade' x -> [Shade' x] -> NonEmpty (Shade' x)
forall a. a -> [a] -> NonEmpty a
:|[])
intersectors (ConvexSet Shade' x
_ (Shade' x
i:[Shade' x]
sts)) = NonEmpty (Shade' x) -> Maybe (NonEmpty (Shade' x))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Shade' x
iShade' x -> [Shade' x] -> NonEmpty (Shade' x)
forall a. a -> [a] -> NonEmpty a
:|[Shade' x]
sts)
intersectors ConvexSet x
_ = Maybe (NonEmpty (Shade' x))
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Under intersection.
instance Refinable x => Semigroup (ConvexSet x) where
  ConvexSet x
a<> :: ConvexSet x -> ConvexSet x -> ConvexSet x
<>ConvexSet x
b = NonEmpty (ConvexSet x) -> ConvexSet x
forall a. Semigroup a => NonEmpty a -> a
sconcat (ConvexSet x
aConvexSet x -> [ConvexSet x] -> NonEmpty (ConvexSet x)
forall a. a -> [a] -> NonEmpty a
:|[ConvexSet x
b])
  sconcat :: NonEmpty (ConvexSet x) -> ConvexSet x
sconcat NonEmpty (ConvexSet x)
csets
    | Just NonEmpty (Shade' x)
allIntersectors <- NonEmpty (NonEmpty (Shade' x)) -> NonEmpty (Shade' x)
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty (Shade' x)) -> NonEmpty (Shade' x))
-> Maybe (NonEmpty (NonEmpty (Shade' x)))
-> Maybe (NonEmpty (Shade' x))
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (ConvexSet x -> Maybe (NonEmpty (Shade' x)))
-> NonEmpty (ConvexSet x) -> Maybe (NonEmpty (NonEmpty (Shade' x)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse ConvexSet x -> Maybe (NonEmpty (Shade' x))
forall x. ConvexSet x -> Maybe (NonEmpty (Shade' x))
intersectors NonEmpty (ConvexSet x)
csets
    , IntersectT NonEmpty (Shade' x)
ists <- (Shade' x -> Shade' x -> Maybe (Shade' x))
-> IntersectT Shade' x -> IntersectT Shade' x
forall (s :: * -> *) x.
(s x -> s x -> Maybe (s x)) -> IntersectT s x -> IntersectT s x
rmTautologyIntersect Shade' x -> Shade' x -> Maybe (Shade' x)
forall y (f :: * -> *).
(Refinable y, Alternative f) =>
Shade' y -> Shade' y -> f (Shade' y)
perfectRefine (IntersectT Shade' x -> IntersectT Shade' x)
-> IntersectT Shade' x -> IntersectT Shade' x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ NonEmpty (Shade' x) -> IntersectT Shade' x
forall (s :: * -> *) x. NonEmpty (s x) -> IntersectT s x
IntersectT NonEmpty (Shade' x)
allIntersectors
    , Just Shade' x
hull' <- NonEmpty (Shade' x) -> Maybe (Shade' x)
forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's NonEmpty (Shade' x)
ists
                 = Shade' x -> [Shade' x] -> ConvexSet x
forall x. Shade' x -> [Shade' x] -> ConvexSet x
ConvexSet Shade' x
hull' (NonEmpty (Shade' x) -> [Shade' x]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Shade' x)
ists)
    | Bool
otherwise  = ConvexSet x
forall x. ConvexSet x
EmptyConvex
   where perfectRefine :: Shade' y -> Shade' y -> f (Shade' y)
perfectRefine Shade' y
sh₁ Shade' y
sh₂
           | Shade' y
sh₁Shade' y -> Shade' y -> Bool
forall y. Refinable y => Shade' y -> Shade' y -> Bool
`subShade'`Shade' y
sh₂   = Shade' y -> f (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Shade' y
sh₁
           | Shade' y
sh₂Shade' y -> Shade' y -> Bool
forall y. Refinable y => Shade' y -> Shade' y -> Bool
`subShade'`Shade' y
sh₁   = Shade' y -> f (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Shade' y
sh₂
           | Bool
otherwise           = f (Shade' y)
forall (f :: * -> *) a. Alternative f => f a
empty



itWhileJust :: InconsistencyStrategy m x y -> (a -> m a) -> a -> [a]
itWhileJust :: InconsistencyStrategy m x y -> (a -> m a) -> a -> [a]
itWhileJust InconsistencyStrategy m x y
AbortOnInconsistency a -> m a
f a
x
 | Just y <- a -> m a
f a
x  = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: InconsistencyStrategy Maybe Any Any -> (a -> Maybe a) -> a -> [a]
forall (m :: * -> *) x y a.
InconsistencyStrategy m x y -> (a -> m a) -> a -> [a]
itWhileJust InconsistencyStrategy Maybe Any Any
forall x y. InconsistencyStrategy Maybe x y
AbortOnInconsistency a -> m a
a -> Maybe a
f a
y
itWhileJust InconsistencyStrategy m x y
IgnoreInconsistencies a -> m a
f a
x
 | Identity y <- a -> m a
f a
x  = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: InconsistencyStrategy Identity Any Any
-> (a -> Identity a) -> a -> [a]
forall (m :: * -> *) x y a.
InconsistencyStrategy m x y -> (a -> m a) -> a -> [a]
itWhileJust InconsistencyStrategy Identity Any Any
forall x y. InconsistencyStrategy Identity x y
IgnoreInconsistencies a -> m a
a -> Identity a
f a
y
itWhileJust (HighlightInconsistencies y
yh) a -> m a
f a
x
 | Identity y <- a -> m a
f a
x  = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: InconsistencyStrategy Identity Any y
-> (a -> Identity a) -> a -> [a]
forall (m :: * -> *) x y a.
InconsistencyStrategy m x y -> (a -> m a) -> a -> [a]
itWhileJust (y -> InconsistencyStrategy Identity Any y
forall y x. y -> InconsistencyStrategy Identity x y
HighlightInconsistencies y
yh) a -> m a
a -> Identity a
f a
y
itWhileJust InconsistencyStrategy m x y
_ a -> m a
_ a
x = [a
x]

dupHead :: NonEmpty a -> NonEmpty a
dupHead :: NonEmpty a -> NonEmpty a
dupHead (a
x:|[a]
xs) = a
xa -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:|a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs


newtype InformationMergeStrategy n m y' y = InformationMergeStrategy
    { InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation :: y -> n y' -> m y }

naïve :: (NonEmpty y -> y) -> InformationMergeStrategy [] Identity (x,y) y
naïve :: (NonEmpty y -> y) -> InformationMergeStrategy [] Identity (x, y) y
naïve NonEmpty y -> y
merge = (y -> [(x, y)] -> Identity y)
-> InformationMergeStrategy [] Identity (x, y) y
forall (n :: * -> *) (m :: * -> *) y' y.
(y -> n y' -> m y) -> InformationMergeStrategy n m y' y
InformationMergeStrategy (\y
o [(x, y)]
n -> y -> Identity y
forall a. a -> Identity a
Identity (y -> Identity y) -> (NonEmpty y -> y) -> NonEmpty y -> Identity y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. NonEmpty y -> y
merge (NonEmpty y -> Identity y) -> NonEmpty y -> Identity y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ y
o y -> [y] -> NonEmpty y
forall a. a -> [a] -> NonEmpty a
:| ((x, y) -> y) -> [(x, y)] -> [y]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (x, y) -> y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd [(x, y)]
n)

inconsistencyAware :: (NonEmpty y -> m y) -> InformationMergeStrategy [] m (x,y) y
inconsistencyAware :: (NonEmpty y -> m y) -> InformationMergeStrategy [] m (x, y) y
inconsistencyAware NonEmpty y -> m y
merge = (y -> [(x, y)] -> m y) -> InformationMergeStrategy [] m (x, y) y
forall (n :: * -> *) (m :: * -> *) y' y.
(y -> n y' -> m y) -> InformationMergeStrategy n m y' y
InformationMergeStrategy (\y
o [(x, y)]
n -> NonEmpty y -> m y
merge (NonEmpty y -> m y) -> NonEmpty y -> m y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ y
o y -> [y] -> NonEmpty y
forall a. a -> [a] -> NonEmpty a
:| ((x, y) -> y) -> [(x, y)] -> [y]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (x, y) -> y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd [(x, y)]
n)

indicateInconsistencies :: (NonEmpty υ -> Maybe υ)
         -> InformationMergeStrategy [] (Except (PropagationInconsistency x υ)) (x,υ) υ
indicateInconsistencies :: (NonEmpty υ -> Maybe υ)
-> InformationMergeStrategy
     [] (Except (PropagationInconsistency x υ)) (x, υ) υ
indicateInconsistencies NonEmpty υ -> Maybe υ
merge = (υ -> [(x, υ)] -> Except (PropagationInconsistency x υ) υ)
-> InformationMergeStrategy
     [] (Except (PropagationInconsistency x υ)) (x, υ) υ
forall (n :: * -> *) (m :: * -> *) y' y.
(y -> n y' -> m y) -> InformationMergeStrategy n m y' y
InformationMergeStrategy
           (\υ
o [(x, υ)]
n -> case NonEmpty υ -> Maybe υ
merge (NonEmpty υ -> Maybe υ) -> NonEmpty υ -> Maybe υ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ υ
o υ -> [υ] -> NonEmpty υ
forall a. a -> [a] -> NonEmpty a
:| ((x, υ) -> υ) -> [(x, υ)] -> [υ]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (x, υ) -> υ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd [(x, υ)]
n of
               Just υ
r  -> υ -> Except (PropagationInconsistency x υ) υ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure υ
r
               Maybe υ
Nothing -> PropagationInconsistency x υ
-> Except (PropagationInconsistency x υ) υ
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (PropagationInconsistency x υ
 -> Except (PropagationInconsistency x υ) υ)
-> PropagationInconsistency x υ
-> Except (PropagationInconsistency x υ) υ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [(x, υ)] -> υ -> PropagationInconsistency x υ
forall x υ. [(x, υ)] -> υ -> PropagationInconsistency x υ
PropagationInconsistency [(x, υ)]
n υ
o )

postponeInconsistencies :: Hask.Monad m => (NonEmpty υ -> Maybe υ)
   -> InformationMergeStrategy [] (WriterT [PropagationInconsistency x υ] m)
                                  (x,υ) υ
postponeInconsistencies :: (NonEmpty υ -> Maybe υ)
-> InformationMergeStrategy
     [] (WriterT [PropagationInconsistency x υ] m) (x, υ) υ
postponeInconsistencies NonEmpty υ -> Maybe υ
merge = (υ -> [(x, υ)] -> WriterT [PropagationInconsistency x υ] m υ)
-> InformationMergeStrategy
     [] (WriterT [PropagationInconsistency x υ] m) (x, υ) υ
forall (n :: * -> *) (m :: * -> *) y' y.
(y -> n y' -> m y) -> InformationMergeStrategy n m y' y
InformationMergeStrategy
           (\υ
o [(x, υ)]
n -> case NonEmpty υ -> Maybe υ
merge (NonEmpty υ -> Maybe υ) -> NonEmpty υ -> Maybe υ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ υ
o υ -> [υ] -> NonEmpty υ
forall a. a -> [a] -> NonEmpty a
:| ((x, υ) -> υ) -> [(x, υ)] -> [υ]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (x, υ) -> υ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd [(x, υ)]
n of
               Just υ
r  -> υ -> WriterT [PropagationInconsistency x υ] m υ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure υ
r
               Maybe υ
Nothing -> (υ, [PropagationInconsistency x υ])
-> WriterT [PropagationInconsistency x υ] m υ
forall (m :: * -> *) a w. Monad m => (a, w) -> WriterT w m a
writer (υ
o,[[(x, υ)] -> υ -> PropagationInconsistency x υ
forall x υ. [(x, υ)] -> υ -> PropagationInconsistency x υ
PropagationInconsistency [(x, υ)]
n υ
o]) )

maybeAlt :: Hask.Alternative f => Maybe a -> f a
maybeAlt :: Maybe a -> f a
maybeAlt (Just a
x) = a -> f a
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure a
x
maybeAlt Maybe a
Nothing = f a
forall (f :: * -> *) a. Alternative f => f a
Hask.empty

data InconsistencyStrategy m x y where
    AbortOnInconsistency :: InconsistencyStrategy Maybe x y
    IgnoreInconsistencies :: InconsistencyStrategy Identity x y
    HighlightInconsistencies :: y -> InconsistencyStrategy Identity x y
deriving instance Hask.Functor (InconsistencyStrategy m x)


iterateFilterDEqn_static :: ( ModellableRelation x y, Hask.MonadPlus m, LocalModel ㄇ )
       => InformationMergeStrategy [] m (x,Shade' y) iy
           -> Embedding (->) (Shade' y) iy
           -> DifferentialEqn ㄇ x y
                 -> PointsWeb x (Shade' y) -> Cofree m (PointsWeb x (Shade' y))
iterateFilterDEqn_static :: InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x (Shade' y))
iterateFilterDEqn_static InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
                           = (PointsWeb x iy -> PointsWeb x (Shade' y))
-> Cofree m (PointsWeb x iy) -> Cofree m (PointsWeb x (Shade' y))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((iy -> Shade' y) -> PointsWeb x iy -> PointsWeb x (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$))
                           (Cofree m (PointsWeb x iy) -> Cofree m (PointsWeb x (Shade' y)))
-> (PointsWeb x (Shade' y) -> Cofree m (PointsWeb x iy))
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x (Shade' y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (PointsWeb x iy -> m (PointsWeb x iy))
-> PointsWeb x iy -> Cofree m (PointsWeb x iy)
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter (InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall x y (ㄇ :: * -> * -> *) iy (m :: * -> *).
(ModellableRelation x y, MonadPlus m, LocalModel ㄇ) =>
InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
filterDEqnSolutions_static InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f)
                           (PointsWeb x iy -> Cofree m (PointsWeb x iy))
-> (PointsWeb x (Shade' y) -> PointsWeb x iy)
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x iy)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Shade' y -> iy) -> PointsWeb x (Shade' y) -> PointsWeb x iy
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> Shade' y -> iy
forall (c :: * -> * -> *) a b.
(Function c, Object c a, Object c b) =>
Embedding c a b -> a -> b
$->)


iterateFilterDEqn_pathwise
     :: ( ModellableRelation x y, Hask.MonadPlus m, Hask.Traversable m, LocalModel ㄇ )
       => InformationMergeStrategy [] m (x,Shade' y) iy
           -> Embedding (->) (Shade' y) iy
           -> DifferentialEqn ㄇ x y
                 -> PointsWeb x (Shade' y) -> Cofree m (PointsWeb x (Shade' y))
iterateFilterDEqn_pathwise :: InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x (Shade' y))
iterateFilterDEqn_pathwise InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
            = (PointsWeb x iy -> PointsWeb x (Shade' y))
-> Cofree m (PointsWeb x iy) -> Cofree m (PointsWeb x (Shade' y))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((iy -> Shade' y) -> PointsWeb x iy -> PointsWeb x (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$))
            (Cofree m (PointsWeb x iy) -> Cofree m (PointsWeb x (Shade' y)))
-> (PointsWeb x (Shade' y) -> Cofree m (PointsWeb x iy))
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x (Shade' y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (State Int (Cofree m (PointsWeb x iy))
-> Int -> Cofree m (PointsWeb x iy)
forall s a. State s a -> s -> a
`evalState`Int
7438)
            (State Int (Cofree m (PointsWeb x iy))
 -> Cofree m (PointsWeb x iy))
-> (PointsWeb x (Shade' y)
    -> State Int (Cofree m (PointsWeb x iy)))
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x iy)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (PointsWeb x iy
 -> StateT Int Identity (PointsWeb x iy, m (PointsWeb x iy)))
-> PointsWeb x iy -> State Int (Cofree m (PointsWeb x iy))
forall (f :: * -> *) (m :: * -> *) b a.
(Traversable f, Monad m) =>
(b -> m (a, f b)) -> b -> m (Cofree f a)
unfoldM (\PointsWeb x iy
oldWeb -> do
               Int
r <- StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get
               let i :: Int
i = Int
r Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Shaded x (Neighbourhood x iy) -> Int
forall x y. Shaded x y -> Int
nLeaves (PointsWeb x iy -> Shaded x (Neighbourhood x iy)
forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc PointsWeb x iy
oldWeb)
                   m :: Int
m = Int
2Int -> Int -> Int
forall a. Num a => a -> Int -> a
^Int
31 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                   a :: Int
a = Int
963345    :: Int  -- revised Park-Miller
               Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int -> StateT Int Identity ()) -> Int -> StateT Int Identity ()
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
r)Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod`Int
m
               (PointsWeb x iy, m (PointsWeb x iy))
-> StateT Int Identity (PointsWeb x iy, m (PointsWeb x iy))
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ( PointsWeb x iy
oldWeb
                      , InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall x y (ㄇ :: * -> * -> *) iy (m :: * -> *).
(ModellableRelation x y, MonadPlus m, LocalModel ㄇ) =>
InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
filterDEqnSolutions_static InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
                       (PointsWeb x iy -> m (PointsWeb x iy))
-> m (PointsWeb x iy) -> m (PointsWeb x iy)
forall (m :: * -> *) (k :: * -> * -> *) a b.
(Monad m k, Object k a, Object k b, Object k (m a), Object k (m b),
 Object k (m (m b))) =>
k a (m b) -> k (m a) (m b)
=<<Int
-> InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall x y (ㄇ :: * -> * -> *) iy (m :: * -> *).
(ModellableRelation x y, MonadPlus m, LocalModel ㄇ) =>
Int
-> InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
filterDEqnSolutions_pathsTowards Int
i InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f PointsWeb x iy
oldWeb
                      ))
            (PointsWeb x iy -> State Int (Cofree m (PointsWeb x iy)))
-> (PointsWeb x (Shade' y) -> PointsWeb x iy)
-> PointsWeb x (Shade' y)
-> State Int (Cofree m (PointsWeb x iy))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Shade' y -> iy) -> PointsWeb x (Shade' y) -> PointsWeb x iy
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> Shade' y -> iy
forall (c :: * -> * -> *) a b.
(Function c, Object c a, Object c b) =>
Embedding c a b -> a -> b
$->)


iterateFilterDEqn_static_selective :: ( ModellableRelation x y
                                      , Hask.MonadPlus m, badness ~ ℝ
                                      , LocalModel ㄇ )
       => InformationMergeStrategy [] m (x,Shade' y) iy
           -> Embedding (->) (Shade' y) iy
           -> (x -> iy -> badness)
           -> DifferentialEqn ㄇ x y
                 -> PointsWeb x (Shade' y) -> Cofree m (PointsWeb x (Shade' y))
iterateFilterDEqn_static_selective :: InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> (x -> iy -> badness)
-> DifferentialEqn ㄇ x y
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x (Shade' y))
iterateFilterDEqn_static_selective InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading x -> iy -> badness
badness DifferentialEqn ㄇ x y
f
      = (PointsWeb x iy -> PointsWeb x (Shade' y))
-> Cofree m (PointsWeb x iy) -> Cofree m (PointsWeb x (Shade' y))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((iy -> Shade' y) -> PointsWeb x iy -> PointsWeb x (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$))
      (Cofree m (PointsWeb x iy) -> Cofree m (PointsWeb x (Shade' y)))
-> (PointsWeb x (Shade' y) -> Cofree m (PointsWeb x iy))
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x (Shade' y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (PointsWeb x iy -> m (PointsWeb x iy))
-> PointsWeb x iy -> Cofree m (PointsWeb x iy)
forall (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter (InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> (x -> iy -> badness)
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall x y (ㄇ :: * -> * -> *) iy (m :: * -> *) badness.
(ModellableRelation x y, MonadPlus m, badness ~ ℝ, LocalModel ㄇ) =>
InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> (x -> iy -> badness)
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
filterDEqnSolutions_static_selective InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading x -> iy -> badness
badness DifferentialEqn ㄇ x y
f)
      (PointsWeb x iy -> Cofree m (PointsWeb x iy))
-> (PointsWeb x (Shade' y) -> PointsWeb x iy)
-> PointsWeb x (Shade' y)
-> Cofree m (PointsWeb x iy)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Shade' y -> iy) -> PointsWeb x (Shade' y) -> PointsWeb x iy
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> Shade' y -> iy
forall (c :: * -> * -> *) a b.
(Function c, Object c a, Object c b) =>
Embedding c a b -> a -> b
$->)


filterDEqnSolutions_static :: ∀ x y ㄇ iy m .
                     ( ModellableRelation x y, Hask.MonadPlus m, LocalModel ㄇ )
       => InformationMergeStrategy [] m  (x,Shade' y) iy -> Embedding (->) (Shade' y) iy
          -> DifferentialEqn ㄇ x y -> PointsWeb x iy -> m (PointsWeb x iy)
filterDEqnSolutions_static :: InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
filterDEqnSolutions_static InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
       = PointsWeb x iy -> PointsWeb x (WebLocally x iy)
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo
           (PointsWeb x iy -> PointsWeb x (WebLocally x iy))
-> (PointsWeb x (WebLocally x iy) -> m (PointsWeb x iy))
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (WebLocally x iy -> (WebLocally x iy, Maybe (Shade' y)))
-> PointsWeb x (WebLocally x iy)
-> PointsWeb x (WebLocally x iy, Maybe (Shade' y))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (WebLocally x iy -> WebLocally x iy
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id (WebLocally x iy -> WebLocally x iy)
-> (WebLocally x iy -> Maybe (Shade' y))
-> WebLocally x iy
-> (WebLocally x iy, Maybe (Shade' y))
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& DifferentialEqn ㄇ x y
-> WebLocally x (Shade' y) -> Maybe (Shade' y)
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> WebLocally x (Shade' y) -> Maybe (Shade' y)
rescanPDELocally DifferentialEqn ㄇ x y
f (WebLocally x (Shade' y) -> Maybe (Shade' y))
-> (WebLocally x iy -> WebLocally x (Shade' y))
-> WebLocally x iy
-> Maybe (Shade' y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (iy -> Shade' y) -> WebLocally x iy -> WebLocally x (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$))
           (PointsWeb x (WebLocally x iy)
 -> PointsWeb x (WebLocally x iy, Maybe (Shade' y)))
-> (PointsWeb x (WebLocally x iy, Maybe (Shade' y))
    -> m (PointsWeb x iy))
-> PointsWeb x (WebLocally x iy)
-> m (PointsWeb x iy)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> PointsWeb x (WebLocally x iy, Maybe (Shade' y))
-> PointsWeb
     x
     ((x, (WebLocally x iy, Maybe (Shade' y))),
      [(Needle x, (WebLocally x iy, Maybe (Shade' y)))])
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x ((x, y), [(Needle x, y)])
localFocusWeb (PointsWeb x (WebLocally x iy, Maybe (Shade' y))
 -> PointsWeb
      x
      ((x, (WebLocally x iy, Maybe (Shade' y))),
       [(Needle x, (WebLocally x iy, Maybe (Shade' y)))]))
-> (PointsWeb
      x
      ((x, (WebLocally x iy, Maybe (Shade' y))),
       [(Needle x, (WebLocally x iy, Maybe (Shade' y)))])
    -> m (PointsWeb x iy))
-> PointsWeb x (WebLocally x iy, Maybe (Shade' y))
-> m (PointsWeb x iy)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (((x, (WebLocally x iy, Maybe (Shade' y))),
  [(Needle x, (WebLocally x iy, Maybe (Shade' y)))])
 -> m iy)
-> PointsWeb
     x
     ((x, (WebLocally x iy, Maybe (Shade' y))),
      [(Needle x, (WebLocally x iy, Maybe (Shade' y)))])
-> m (PointsWeb x iy)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse ( \((x
_,(WebLocally x iy
me,Maybe (Shade' y)
updShy)), [(Needle x, (WebLocally x iy, Maybe (Shade' y)))]
ngbs)
          -> let oldValue :: iy
oldValue = WebLocally x iy
meWebLocally x iy -> Getting iy (WebLocally x iy) iy -> iy
forall s a. s -> Getting a s a -> a
^.Getting iy (WebLocally x iy) iy
forall x y. Lens' (WebLocally x y) y
thisNodeData :: iy
             in if Maybe (DualVector (Needle x)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (DualVector (Needle x)) -> Bool)
-> Maybe (DualVector (Needle x)) -> Bool
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy
me WebLocally x iy
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x iy)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x iy)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                 then iy -> m iy
forall (m :: * -> *) a. Monad m (->) => a -> m a
return iy
oldValue
                 else case Maybe (Shade' y)
updShy of
              Just Shade' y
shy -> case [(Needle x, (WebLocally x iy, Maybe (Shade' y)))]
ngbs of
                  []  -> iy -> m iy
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure iy
oldValue
                  (Needle x, (WebLocally x iy, Maybe (Shade' y)))
_:[(Needle x, (WebLocally x iy, Maybe (Shade' y)))]
_ -> [m (x, Shade' y)] -> m [(x, Shade' y)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [ Maybe (Shade' y) -> m (Shade' y)
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeAlt Maybe (Shade' y)
sj
                                m (Shade' y) -> (Shade' y -> m (x, Shade' y)) -> m (x, Shade' y)
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Function f, Monad m f, Object f a, Object f b, Object f (m a),
 Object f (m b), Object f (m (m b))) =>
m a -> f a (m b) -> m b
>>= \Shade' y
ngbShyð -> (iy -> (x, Shade' y)) -> m iy -> m (x, Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x iy
meWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
δx,)
                                                   (Shade' y -> (x, Shade' y))
-> (iy -> Shade' y) -> iy -> (x, Shade' y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$))
                                  (m iy -> m (x, Shade' y))
-> (Maybe (x, Shade' y) -> m iy)
-> Maybe (x, Shade' y)
-> m (x, Shade' y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. InformationMergeStrategy [] m (x, Shade' y) iy
-> iy -> [(x, Shade' y)] -> m iy
forall (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy iy
oldValue ([(x, Shade' y)] -> m iy)
-> (Maybe (x, Shade' y) -> [(x, Shade' y)])
-> Maybe (x, Shade' y)
-> m iy
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Maybe (x, Shade' y) -> [(x, Shade' y)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList
                                  (Maybe (x, Shade' y) -> m (x, Shade' y))
-> Maybe (x, Shade' y) -> m (x, Shade' y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x iy
ngbInfoWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord,)(Shade' y -> (x, Shade' y))
-> Maybe (Shade' y) -> Maybe (x, Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>
                                     DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc
                                       DifferentialEqn ㄇ x y
f (x
-> Needle x
-> Shade' y
-> Shade' y
-> [(Needle x, Shade' y)]
-> LocalDataPropPlan x (Shade' y)
forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                             (WebLocally x iy
ngbInfoWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                             (Needle x -> Needle x
forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                             Shade' y
ngbShyð
                                             Shade' y
shy
                                             (((Needle x, WebLocally x iy) -> (Needle x, Shade' y))
-> [(Needle x, WebLocally x iy)] -> [(Needle x, Shade' y)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x iy -> Shade' y)
-> (Needle x, WebLocally x iy) -> (Needle x, Shade' y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$) (iy -> Shade' y)
-> (WebLocally x iy -> iy) -> WebLocally x iy -> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. WebLocally x iy -> iy
forall x y. WebLocally x y -> y
_thisNodeData))
                                               ([(Needle x, WebLocally x iy)] -> [(Needle x, Shade' y)])
-> ([[(Needle x, WebLocally x iy)]]
    -> [(Needle x, WebLocally x iy)])
-> [[(Needle x, WebLocally x iy)]]
-> [(Needle x, Shade' y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x iy)]] -> [(Needle x, WebLocally x iy)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Needle x, WebLocally x iy)]] -> [(Needle x, WebLocally x iy)])
-> ([[(Needle x, WebLocally x iy)]]
    -> [[(Needle x, WebLocally x iy)]])
-> [[(Needle x, WebLocally x iy)]]
-> [(Needle x, WebLocally x iy)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x iy)]] -> [[(Needle x, WebLocally x iy)]]
forall a. [a] -> [a]
tail ([[(Needle x, WebLocally x iy)]] -> [(Needle x, Shade' y)])
-> [[(Needle x, WebLocally x iy)]] -> [(Needle x, Shade' y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy -> [Int] -> [[(Needle x, WebLocally x iy)]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x iy
ngbInfo
                                                                     [WebLocally x iy
meWebLocally x iy -> Getting Int (WebLocally x iy) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x iy) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId])
                                          )
                                  | (Needle x
δx, (WebLocally x iy
ngbInfo,Maybe (Shade' y)
sj)) <- [(Needle x, (WebLocally x iy, Maybe (Shade' y)))]
ngbs
                                  ]
                            m [(x, Shade' y)] -> ([(x, Shade' y)] -> m iy) -> m iy
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Function f, Monad m f, Object f a, Object f b, Object f (m a),
 Object f (m b), Object f (m (m b))) =>
m a -> f a (m b) -> m b
>>= InformationMergeStrategy [] m (x, Shade' y) iy
-> iy -> [(x, Shade' y)] -> m iy
forall (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy (Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> Shade' y -> iy
forall (c :: * -> * -> *) a b.
(Function c, Object c a, Object c b) =>
Embedding c a b -> a -> b
$->Shade' y
shy)
              Maybe (Shade' y)
_ -> InformationMergeStrategy [] m (x, Shade' y) iy
-> iy -> [(x, Shade' y)] -> m iy
forall (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy iy
oldValue [(x, Shade' y)]
forall (f :: * -> *) a. Alternative f => f a
empty
        )


filterDEqnSolutions_pathsTowards :: ∀ x y ㄇ iy m .
                     ( ModellableRelation x y, Hask.MonadPlus m, LocalModel ㄇ )
       => WebNodeId
          -> InformationMergeStrategy [] m  (x,Shade' y) iy
          -> Embedding (->) (Shade' y) iy
          -> DifferentialEqn ㄇ x y -> PointsWeb x iy -> m (PointsWeb x iy)
filterDEqnSolutions_pathsTowards :: Int
-> InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
filterDEqnSolutions_pathsTowards Int
targetNode InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
       = Int
-> (PathStep x iy -> StateT (Shade' y) m iy)
-> (forall υ. WebLocally x iy -> StateT (Shade' y) m υ -> m υ)
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall (f :: * -> *) (φ :: * -> *) x y.
(WithField ℝ Manifold x, Monad φ, Monad f, HasCallStack) =>
Int
-> (PathStep x y -> φ y)
-> (forall υ. WebLocally x y -> φ υ -> f υ)
-> PointsWeb x y
-> f (PointsWeb x y)
traversePathsTowards Int
targetNode
            (\(PathStep WebLocally x iy
stepStart WebLocally x iy
stepEnd) -> (Shade' y -> m (iy, Shade' y)) -> StateT (Shade' y) m iy
forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT ((Shade' y -> m (iy, Shade' y)) -> StateT (Shade' y) m iy)
-> (Shade' y -> m (iy, Shade' y)) -> StateT (Shade' y) m iy
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
              \Shade' y
odeState ->
                let apriori :: Shade' y
apriori = Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ WebLocally x iy
stepEndWebLocally x iy -> Getting iy (WebLocally x iy) iy -> iy
forall s a. s -> Getting a s a -> a
^.Getting iy (WebLocally x iy) iy
forall x y. Lens' (WebLocally x y) y
thisNodeData
                in case DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc
                                DifferentialEqn ㄇ x y
f
                                (LocalDataPropPlan :: forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan{
                                   _sourcePosition :: x
_sourcePosition = WebLocally x iy
stepStartWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord
                                 , _targetPosOffset :: Needle x
_targetPosOffset = (WebLocally x iy
stepEndWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                                        x -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! (WebLocally x iy
stepStartWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                 , _sourceData :: Shade' y
_sourceData = Shade' y
odeState
                                 , _targetAPrioriData :: Shade' y
_targetAPrioriData = Shade' y
apriori
                                 , _relatedData :: [(Needle x, Shade' y)]
_relatedData
                                     = (((Needle x, WebLocally x iy) -> (Needle x, Shade' y))
-> [(Needle x, WebLocally x iy)] -> [(Needle x, Shade' y)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x iy -> Shade' y)
-> (Needle x, WebLocally x iy) -> (Needle x, Shade' y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$) (iy -> Shade' y)
-> (WebLocally x iy -> iy) -> WebLocally x iy -> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. WebLocally x iy -> iy
forall x y. WebLocally x y -> y
_thisNodeData))
                                               ([(Needle x, WebLocally x iy)] -> [(Needle x, Shade' y)])
-> ([[(Needle x, WebLocally x iy)]]
    -> [(Needle x, WebLocally x iy)])
-> [[(Needle x, WebLocally x iy)]]
-> [(Needle x, Shade' y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x iy)]] -> [(Needle x, WebLocally x iy)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Needle x, WebLocally x iy)]] -> [(Needle x, WebLocally x iy)])
-> ([[(Needle x, WebLocally x iy)]]
    -> [[(Needle x, WebLocally x iy)]])
-> [[(Needle x, WebLocally x iy)]]
-> [(Needle x, WebLocally x iy)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x iy)]] -> [[(Needle x, WebLocally x iy)]]
forall a. [a] -> [a]
tail ([[(Needle x, WebLocally x iy)]] -> [(Needle x, Shade' y)])
-> [[(Needle x, WebLocally x iy)]] -> [(Needle x, Shade' y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy -> [Int] -> [[(Needle x, WebLocally x iy)]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x iy
stepStart
                                                                  [WebLocally x iy
stepEndWebLocally x iy -> Getting Int (WebLocally x iy) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x iy) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId])
                                 }) of
                          Maybe (Shade' y)
Nothing -> iy -> (iy, Shade' y)
forall a. HasCallStack => a
undefined
                              (iy -> (iy, Shade' y)) -> m iy -> m (iy, Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> InformationMergeStrategy [] m (x, Shade' y) iy
-> iy -> [(x, Shade' y)] -> m iy
forall (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy (WebLocally x iy
stepEndWebLocally x iy -> Getting iy (WebLocally x iy) iy -> iy
forall s a. s -> Getting a s a -> a
^.Getting iy (WebLocally x iy) iy
forall x y. Lens' (WebLocally x y) y
thisNodeData) []
                          Just Shade' y
propd -> (, Shade' y
propd)
                                  (iy -> (iy, Shade' y)) -> m iy -> m (iy, Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> InformationMergeStrategy [] m (x, Shade' y) iy
-> iy -> [(x, Shade' y)] -> m iy
forall (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy
                                        (WebLocally x iy
stepEndWebLocally x iy -> Getting iy (WebLocally x iy) iy -> iy
forall s a. s -> Getting a s a -> a
^.Getting iy (WebLocally x iy) iy
forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                        [ ( WebLocally x iy
stepEndWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord, Shade' y
apriori )
                                        , ( WebLocally x iy
stepStartWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord, Shade' y
propd ) ] )
            (\WebLocally x iy
startPoint StateT (Shade' y) m υ
pathTrav
               -> StateT (Shade' y) m υ -> Shade' y -> m υ
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (Shade' y) m υ
pathTrav (Shade' y -> m υ) -> Shade' y -> m υ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ WebLocally x iy
startPointWebLocally x iy -> Getting iy (WebLocally x iy) iy -> iy
forall s a. s -> Getting a s a -> a
^.Getting iy (WebLocally x iy) iy
forall x y. Lens' (WebLocally x y) y
thisNodeData)


data Average a = Average { Average a -> Int
weight :: Int
                         , Average a -> a
averageAcc :: a
                         } deriving (a -> Average b -> Average a
(a -> b) -> Average a -> Average b
(forall a b. (a -> b) -> Average a -> Average b)
-> (forall a b. a -> Average b -> Average a) -> Functor Average
forall a b. a -> Average b -> Average a
forall a b. (a -> b) -> Average a -> Average b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Average b -> Average a
$c<$ :: forall a b. a -> Average b -> Average a
fmap :: (a -> b) -> Average a -> Average b
$cfmap :: forall a b. (a -> b) -> Average a -> Average b
Hask.Functor)
instance Num a => Semigroup (Average a) where
  Average Int
w₀ a
a₀ <> :: Average a -> Average a -> Average a
<> Average Int
w₁ a
a₁ = Int -> a -> Average a
forall a. Int -> a -> Average a
Average (Int
w₀Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w₁) (a
a₀a -> a -> a
forall a. Num a => a -> a -> a
+a
a₁)
instance Num a => Monoid (Average a) where
  mempty :: Average a
mempty = Int -> a -> Average a
forall a. Int -> a -> Average a
Average Int
0 a
0
  mappend :: Average a -> Average a -> Average a
mappend = Average a -> Average a -> Average a
forall a. Semigroup a => a -> a -> a
(<>)
instance Hask.Applicative Average where
  pure :: a -> Average a
pure = Int -> a -> Average a
forall a. Int -> a -> Average a
Average Int
1
  Average Int
w₀ a -> b
a₀ <*> :: Average (a -> b) -> Average a -> Average b
<*> Average Int
w₁ a
a₁ = Int -> b -> Average b
forall a. Int -> a -> Average a
Average (Int
w₀Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
w₁) (a -> b
a₀ a
a₁)

average :: Fractional a => Average a -> a
average :: Average a -> a
average (Average Int
w a
a) = a
a a -> a -> a
forall a. Fractional a => a -> a -> a
/ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w

averaging :: VectorSpace a => [a] -> Average a
averaging :: [a] -> Average a
averaging [a]
l = Int -> a -> Average a
forall a. Int -> a -> Average a
Average ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) ([a] -> a
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV [a]
l)

filterDEqnSolutions_static_selective :: ∀ x y ㄇ iy m badness .
                              ( ModellableRelation x y
                              , Hask.MonadPlus m, badness ~ ℝ
                              , LocalModel ㄇ )
       => InformationMergeStrategy [] m  (x,Shade' y) iy -> Embedding (->) (Shade' y) iy
          -> (x -> iy -> badness)
          -> DifferentialEqn ㄇ x y
          -> PointsWeb x iy -> m (PointsWeb x iy)
filterDEqnSolutions_static_selective :: InformationMergeStrategy [] m (x, Shade' y) iy
-> Embedding (->) (Shade' y) iy
-> (x -> iy -> badness)
-> DifferentialEqn ㄇ x y
-> PointsWeb x iy
-> m (PointsWeb x iy)
filterDEqnSolutions_static_selective InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading x -> iy -> badness
badness DifferentialEqn ㄇ x y
f
      =    -- Integration step: determine at each point from the function values
           -- what the derivatives should be, and use them to propagate the solution
           -- in all directions. We only spend a single computation step on regions
           -- where nothing much changes (indicating the a-priori information is
           -- too weak yet to make any predictions anyway), but multiple steps in
           -- regions where good progress is noticed.
         ((PointsWeb x iy, Average ℝ) -> PointsWeb x iy)
-> m (PointsWeb x iy, Average ℝ) -> m (PointsWeb x iy)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (PointsWeb x iy, Average ℝ) -> PointsWeb x iy
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst (m (PointsWeb x iy, Average ℝ) -> m (PointsWeb x iy))
-> (PointsWeb x iy -> m (PointsWeb x iy, Average ℝ))
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (WriterT (Average badness) m (PointsWeb x iy)
-> m (PointsWeb x iy, Average badness)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT :: WriterT (Average badness) m (PointsWeb x iy)
                                        -> m (PointsWeb x iy, Average badness))
         (WriterT (Average ℝ) m (PointsWeb x iy)
 -> m (PointsWeb x iy, Average ℝ))
-> (PointsWeb x iy -> WriterT (Average ℝ) m (PointsWeb x iy))
-> PointsWeb x iy
-> m (PointsWeb x iy, Average ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (WebLocally x iy -> WriterT (Average ℝ) m iy)
-> (forall (t :: * -> *) i w.
    (Traversable t, Ord i) =>
    (w -> WriterT (Average ℝ) m w)
    -> t (i, w) -> WriterT (Average ℝ) m (t w))
-> PointsWeb x iy
-> WriterT (Average ℝ) m (PointsWeb x iy)
forall (f :: * -> *) x y.
(WithField ℝ Manifold x, Applicative f) =>
(WebLocally x y -> f y)
-> (forall (t :: * -> *) i w.
    (Traversable t, Ord i) =>
    (w -> f w) -> t (i, w) -> f (t w))
-> PointsWeb x y
-> f (PointsWeb x y)
treewiseTraverseLocalWeb ( \WebLocally x iy
me
          -> let oldValue :: iy
oldValue = WebLocally x iy
meWebLocally x iy -> Getting iy (WebLocally x iy) iy -> iy
forall s a. s -> Getting a s a -> a
^.Getting iy (WebLocally x iy) iy
forall x y. Lens' (WebLocally x y) y
thisNodeData :: iy
                 badHere :: iy -> ℝ
badHere = x -> iy -> badness
x -> iy -> ℝ
badness (x -> iy -> ℝ) -> x -> iy -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy
meWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord
                 oldBadness :: ℝ
oldBadness = iy -> ℝ
badHere iy
oldValue
             in if Maybe (DualVector (Needle x)) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (DualVector (Needle x)) -> Bool)
-> Maybe (DualVector (Needle x)) -> Bool
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy
me WebLocally x iy
-> Getting
     (Maybe (DualVector (Needle x)))
     (WebLocally x iy)
     (Maybe (DualVector (Needle x)))
-> Maybe (DualVector (Needle x))
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (DualVector (Needle x)))
  (WebLocally x iy)
  (Maybe (DualVector (Needle x)))
forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                 then iy -> WriterT (Average ℝ) m iy
forall (m :: * -> *) a. Monad m (->) => a -> m a
return iy
oldValue
                 else case WebLocally x iy
meWebLocally x iy
-> Getting
     [(Int, (Needle x, WebLocally x iy))]
     (WebLocally x iy)
     [(Int, (Needle x, WebLocally x iy))]
-> [(Int, (Needle x, WebLocally x iy))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x iy))]
  (WebLocally x iy)
  [(Int, (Needle x, WebLocally x iy))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours of
                  [] -> iy -> WriterT (Average ℝ) m iy
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure iy
oldValue
                  (Int, (Needle x, WebLocally x iy))
_:[(Int, (Needle x, WebLocally x iy))]
_ -> m (iy, Average ℝ) -> WriterT (Average ℝ) m iy
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (iy, Average ℝ) -> WriterT (Average ℝ) m iy)
-> (m iy -> m (iy, Average ℝ)) -> m iy -> WriterT (Average ℝ) m iy
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (iy -> (iy, Average ℝ)) -> m iy -> m (iy, Average ℝ)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\iy
updated
                                    -> (iy
updated, ℝ -> Average ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (ℝ
oldBadness ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ iy -> ℝ
badHere iy
updated)))
                       (m iy -> WriterT (Average ℝ) m iy)
-> m iy -> WriterT (Average ℝ) m iy
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [m (x, Shade' y)] -> m [(x, Shade' y)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [ (iy -> (x, Shade' y)) -> m iy -> m (x, Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x iy
meWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
δx,)
                                                   (Shade' y -> (x, Shade' y))
-> (iy -> Shade' y) -> iy -> (x, Shade' y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$))
                                  (m iy -> m (x, Shade' y))
-> (Maybe (x, Shade' y) -> m iy)
-> Maybe (x, Shade' y)
-> m (x, Shade' y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. InformationMergeStrategy [] m (x, Shade' y) iy
-> iy -> [(x, Shade' y)] -> m iy
forall (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy iy
oldValue ([(x, Shade' y)] -> m iy)
-> (Maybe (x, Shade' y) -> [(x, Shade' y)])
-> Maybe (x, Shade' y)
-> m iy
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Maybe (x, Shade' y) -> [(x, Shade' y)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList
                                  (Maybe (x, Shade' y) -> m (x, Shade' y))
-> Maybe (x, Shade' y) -> m (x, Shade' y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x iy
ngbInfoWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord,)(Shade' y -> (x, Shade' y))
-> Maybe (Shade' y) -> Maybe (x, Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>
                                     DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc
                                       DifferentialEqn ㄇ x y
f (x
-> Needle x
-> Shade' y
-> Shade' y
-> [(Needle x, Shade' y)]
-> LocalDataPropPlan x (Shade' y)
forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                             (WebLocally x iy
ngbInfoWebLocally x iy -> Getting x (WebLocally x iy) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x iy) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                             (Needle x -> Needle x
forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                             (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ WebLocally x iy
ngbInfoWebLocally x iy -> Getting iy (WebLocally x iy) iy -> iy
forall s a. s -> Getting a s a -> a
^.Getting iy (WebLocally x iy) iy
forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                             (Embedding (->) (Shade' y) iy
shading Embedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ iy
oldValue)
                                             (((Needle x, WebLocally x iy) -> (Needle x, Shade' y))
-> [(Needle x, WebLocally x iy)] -> [(Needle x, Shade' y)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x iy -> Shade' y)
-> (Needle x, WebLocally x iy) -> (Needle x, Shade' y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second ((Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$) (iy -> Shade' y)
-> (WebLocally x iy -> iy) -> WebLocally x iy -> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. WebLocally x iy -> iy
forall x y. WebLocally x y -> y
_thisNodeData))
                                               ([(Needle x, WebLocally x iy)] -> [(Needle x, Shade' y)])
-> ([[(Needle x, WebLocally x iy)]]
    -> [(Needle x, WebLocally x iy)])
-> [[(Needle x, WebLocally x iy)]]
-> [(Needle x, Shade' y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x iy)]] -> [(Needle x, WebLocally x iy)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Needle x, WebLocally x iy)]] -> [(Needle x, WebLocally x iy)])
-> ([[(Needle x, WebLocally x iy)]]
    -> [[(Needle x, WebLocally x iy)]])
-> [[(Needle x, WebLocally x iy)]]
-> [(Needle x, WebLocally x iy)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[(Needle x, WebLocally x iy)]] -> [[(Needle x, WebLocally x iy)]]
forall a. [a] -> [a]
tail ([[(Needle x, WebLocally x iy)]] -> [(Needle x, Shade' y)])
-> [[(Needle x, WebLocally x iy)]] -> [(Needle x, Shade' y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy -> [Int] -> [[(Needle x, WebLocally x iy)]]
forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion
                                                        WebLocally x iy
ngbInfo [WebLocally x iy
meWebLocally x iy -> Getting Int (WebLocally x iy) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x iy) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId] )
                                          )
                                  | (Int
_, (Needle x
δx, WebLocally x iy
ngbInfo)) <- WebLocally x iy
meWebLocally x iy
-> Getting
     [(Int, (Needle x, WebLocally x iy))]
     (WebLocally x iy)
     [(Int, (Needle x, WebLocally x iy))]
-> [(Int, (Needle x, WebLocally x iy))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x iy))]
  (WebLocally x iy)
  [(Int, (Needle x, WebLocally x iy))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                  ]
                            m [(x, Shade' y)] -> ([(x, Shade' y)] -> m iy) -> m iy
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Function f, Monad m f, Object f a, Object f b, Object f (m a),
 Object f (m b), Object f (m (m b))) =>
m a -> f a (m b) -> m b
>>= InformationMergeStrategy [] m (x, Shade' y) iy
-> iy -> [(x, Shade' y)] -> m iy
forall (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy iy
oldValue )
                 (\w -> WriterT (Average ℝ) m w
combiner t (i, w)
branchData -> m (t w, Average ℝ) -> WriterT (Average ℝ) m (t w)
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (t w, Average ℝ) -> WriterT (Average ℝ) m (t w))
-> m (t w, Average ℝ) -> WriterT (Average ℝ) m (t w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ do
                       (t (i, w)
branchResults,[(i, ℝ)]
improvements)
                         <- WriterT [(i, ℝ)] m (t (i, w)) -> m (t (i, w), [(i, ℝ)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [(i, ℝ)] m (t (i, w)) -> m (t (i, w), [(i, ℝ)]))
-> WriterT [(i, ℝ)] m (t (i, w)) -> m (t (i, w), [(i, ℝ)])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((i, w) -> WriterT [(i, ℝ)] m (i, w))
-> t (i, w) -> WriterT [(i, ℝ)] m (t (i, w))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse
                                          (\(i
i,w
branch) -> (w -> (i, w)) -> WriterT [(i, ℝ)] m w -> WriterT [(i, ℝ)] m (i, w)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (i
i,)
                                                          (WriterT [(i, ℝ)] m w -> WriterT [(i, ℝ)] m (i, w))
-> (WriterT (Average ℝ) m w -> WriterT [(i, ℝ)] m w)
-> WriterT (Average ℝ) m w
-> WriterT [(i, ℝ)] m (i, w)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Average ℝ -> [(i, ℝ)])
-> WriterT (Average ℝ) m w -> WriterT [(i, ℝ)] m w
forall (m :: * -> *) w w' a.
Functor m (->) (->) =>
(w -> w') -> WriterT w m a -> WriterT w' m a
censor ((i, ℝ) -> [(i, ℝ)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure ((i, ℝ) -> [(i, ℝ)])
-> (Average ℝ -> (i, ℝ)) -> Average ℝ -> [(i, ℝ)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (i
i,) (ℝ -> (i, ℝ)) -> (Average ℝ -> ℝ) -> Average ℝ -> (i, ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Average ℝ -> ℝ
forall a. Fractional a => Average a -> a
average)
                                                          (WriterT (Average ℝ) m w -> WriterT [(i, ℝ)] m (i, w))
-> WriterT (Average ℝ) m w -> WriterT [(i, ℝ)] m (i, w)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> WriterT (Average ℝ) m w
combiner w
branch)
                                          t (i, w)
branchData
                       let (i
best, ℝ
_) = ((i, ℝ) -> (i, ℝ) -> Ordering) -> [(i, ℝ)] -> (i, ℝ)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((i, ℝ) -> ℝ) -> (i, ℝ) -> (i, ℝ) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (i, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) [(i, ℝ)]
improvements
                       (t w
branchResults',[(i, ℝ)]
improvements')
                         <- WriterT [(i, ℝ)] m (t w) -> m (t w, [(i, ℝ)])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT [(i, ℝ)] m (t w) -> m (t w, [(i, ℝ)]))
-> WriterT [(i, ℝ)] m (t w) -> m (t w, [(i, ℝ)])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((i, w) -> WriterT [(i, ℝ)] m w)
-> t (i, w) -> WriterT [(i, ℝ)] m (t w)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse
                                          (\(i
i,w
branch) -> if i
ii -> i -> Bool
forall a. Eq a => a -> a -> Bool
==i
best
                                             then (Average ℝ -> [(i, ℝ)])
-> WriterT (Average ℝ) m w -> WriterT [(i, ℝ)] m w
forall (m :: * -> *) w w' a.
Functor m (->) (->) =>
(w -> w') -> WriterT w m a -> WriterT w' m a
censor ((i, ℝ) -> [(i, ℝ)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure ((i, ℝ) -> [(i, ℝ)])
-> (Average ℝ -> (i, ℝ)) -> Average ℝ -> [(i, ℝ)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (i
i,) (ℝ -> (i, ℝ)) -> (Average ℝ -> ℝ) -> Average ℝ -> (i, ℝ)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Average ℝ -> ℝ
forall a. Fractional a => Average a -> a
average)
                                                              (WriterT (Average ℝ) m w -> WriterT [(i, ℝ)] m w)
-> WriterT (Average ℝ) m w -> WriterT [(i, ℝ)] m w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ w -> WriterT (Average ℝ) m w
combiner w
branch
                                             else m (w, [(i, ℝ)]) -> WriterT [(i, ℝ)] m w
forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT (m (w, [(i, ℝ)]) -> WriterT [(i, ℝ)] m w)
-> m (w, [(i, ℝ)]) -> WriterT [(i, ℝ)] m w
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (w, [(i, ℝ)]) -> m (w, [(i, ℝ)])
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (w
branch, (i, ℝ) -> [(i, ℝ)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (i
i,ℝ
1)) )
                                          t (i, w)
branchResults
                       (t w, Average ℝ) -> m (t w, Average ℝ)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ( t w
branchResults'
                              , (ℝ -> ℝ -> ℝ) -> Average ℝ -> Average ℝ -> Average ℝ
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c b a.
(Applicative f r t, Object r c, ObjectMorphism r b c,
 Object t (f c), ObjectMorphism t (f b) (f c), ObjectPair r a b,
 ObjectPair t (f a) (f b)) =>
r a (r b c) -> t (f a) (t (f b) (f c))
liftA2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
(*) ([ℝ] -> Average ℝ
forall a. VectorSpace a => [a] -> Average a
averaging ([ℝ] -> Average ℝ) -> [ℝ] -> Average ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (i, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((i, ℝ) -> ℝ) -> [(i, ℝ)] -> [ℝ]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(i, ℝ)]
improvements)
                                           ([ℝ] -> Average ℝ
forall a. VectorSpace a => [a] -> Average a
averaging ([ℝ] -> Average ℝ) -> [ℝ] -> Average ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (i, ℝ) -> ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((i, ℝ) -> ℝ) -> [(i, ℝ)] -> [ℝ]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(i, ℝ)]
improvements') )
                 )
          (PointsWeb x iy -> m (PointsWeb x iy))
-> (PointsWeb x iy -> m (PointsWeb x iy))
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall (m :: * -> *) (k :: * -> * -> *) a b c.
(Monad m k, Object k a, Object k b, Object k c, Object k (m b),
 Object k (m c), Object k (m (m c))) =>
k a (m b) -> k b (m c) -> k a (m c)
>=> -- Boundary-condition / differentiation step: update the local values
              -- based on a-priori boundary conditions, possibly dependent on
              -- numerical derivatives of the current solution estimate.
              (WebLocally x (Shade' y) -> m iy)
-> PointsWeb x (Shade' y) -> m (PointsWeb x iy)
forall x (m :: * -> *) y z.
(WithField ℝ Manifold x, Applicative m) =>
(WebLocally x y -> m z) -> PointsWeb x y -> m (PointsWeb x z)
localTraverseWeb (\WebLocally x (Shade' y)
me -> (Shade' y -> iy) -> m (Shade' y) -> m iy
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> Shade' y -> iy
forall (c :: * -> * -> *) a b.
(Function c, Object c a, Object c b) =>
Embedding c a b -> a -> b
$->)
                                         (m (Shade' y) -> m iy)
-> (Maybe (Shade' y) -> m (Shade' y)) -> Maybe (Shade' y) -> m iy
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Maybe (Shade' y) -> m (Shade' y)
forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeAlt (Maybe (Shade' y) -> m iy) -> Maybe (Shade' y) -> m iy
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DifferentialEqn ㄇ x y
-> WebLocally x (Shade' y) -> Maybe (Shade' y)
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> WebLocally x (Shade' y) -> Maybe (Shade' y)
rescanPDELocally DifferentialEqn ㄇ x y
f WebLocally x (Shade' y)
me)
            (PointsWeb x (Shade' y) -> m (PointsWeb x iy))
-> (PointsWeb x iy -> PointsWeb x (Shade' y))
-> PointsWeb x iy
-> m (PointsWeb x iy)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (iy -> Shade' y) -> PointsWeb x iy -> PointsWeb x (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Embedding (->) (Shade' y) iy
shadingEmbedding (->) (Shade' y) iy -> iy -> Shade' y
forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$)

-- | The <http://hackage.haskell.org/package/transformers-0.5.4.0/docs/Control-Monad-Trans-Writer-Lazy.html#v:censor transformers version of this>
--   is insufficiently polymorphic, requiring @w ~ w'@.
censor :: Functor m (->) (->) => (w -> w') -> WriterT w m a -> WriterT w' m a
censor :: (w -> w') -> WriterT w m a -> WriterT w' m a
censor = (m (a, w) -> m (a, w')) -> WriterT w m a -> WriterT w' m a
forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT ((m (a, w) -> m (a, w')) -> WriterT w m a -> WriterT w' m a)
-> ((w -> w') -> m (a, w) -> m (a, w'))
-> (w -> w')
-> WriterT w m a
-> WriterT w' m a
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((a, w) -> (a, w')) -> m (a, w) -> m (a, w')
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (((a, w) -> (a, w')) -> m (a, w) -> m (a, w'))
-> ((w -> w') -> (a, w) -> (a, w'))
-> (w -> w')
-> m (a, w)
-> m (a, w')
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (w -> w') -> (a, w) -> (a, w')
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second



handleInconsistency :: InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency :: InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency InconsistencyStrategy m x a
AbortOnInconsistency a
_ Maybe a
i = m a
Maybe a
i
handleInconsistency InconsistencyStrategy m x a
IgnoreInconsistencies a
_ (Just a
v) = a -> Identity a
forall a. a -> Identity a
Identity a
v
handleInconsistency InconsistencyStrategy m x a
IgnoreInconsistencies a
b Maybe a
_ = a -> Identity a
forall a. a -> Identity a
Identity a
b
handleInconsistency (HighlightInconsistencies a
_) a
_ (Just a
v) = a -> Identity a
forall a. a -> Identity a
Identity a
v
handleInconsistency (HighlightInconsistencies a
b) a
_ Maybe a
_ = a -> Identity a
forall a. a -> Identity a
Identity a
b

data SolverNodeState x y = SolverNodeInfo {
      SolverNodeState x y -> ConvexSet y
_solverNodeStatus :: ConvexSet y
    , SolverNodeState x y -> Shade' (LocalLinear x y)
_solverNodeJacobian :: Shade' (LocalLinear x y)
    , SolverNodeState x y -> ℝ
_solverNodeBadness :: ℝ
    , SolverNodeState x y -> Int
_solverNodeAge :: Int
    }
makeLenses ''SolverNodeState


type OldAndNew d = (Maybe d, [d])

oldAndNew :: OldAndNew d -> [d]
oldAndNew :: OldAndNew d -> [d]
oldAndNew (Just d
x, [d]
l) = d
x d -> [d] -> [d]
forall a. a -> [a] -> [a]
: [d]
l
oldAndNew (Maybe d
_, [d]
l) = [d]
l

oldAndNew' :: OldAndNew d -> [(Bool, d)]
oldAndNew' :: OldAndNew d -> [(Bool, d)]
oldAndNew' (Just d
x, [d]
l) = (Bool
True, d
x) (Bool, d) -> [(Bool, d)] -> [(Bool, d)]
forall a. a -> [a] -> [a]
: (d -> (Bool, d)) -> [d] -> [(Bool, d)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (Bool
False,) [d]
l
oldAndNew' (Maybe d
_, [d]
l) = (Bool
False,) (d -> (Bool, d)) -> [d] -> [(Bool, d)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [d]
l


filterDEqnSolutions_adaptive :: ∀ x y ㄇ ð badness m
        . ( ModellableRelation x y, AffineManifold y
          , badness ~ ℝ, Hask.Monad m
          , LocalModel ㄇ )
       => MetricChoice x      -- ^ Scalar product on the domain, for regularising the web.
       -> InconsistencyStrategy m x (Shade' y)
       -> DifferentialEqn ㄇ x y
       -> (x -> Shade' y -> badness)
             -> PointsWeb x (SolverNodeState x y)
                        -> m (PointsWeb x (SolverNodeState x y))
filterDEqnSolutions_adaptive :: MetricChoice x
-> InconsistencyStrategy m x (Shade' y)
-> DifferentialEqn ㄇ x y
-> (x -> Shade' y -> badness)
-> PointsWeb x (SolverNodeState x y)
-> m (PointsWeb x (SolverNodeState x y))
filterDEqnSolutions_adaptive MetricChoice x
mf InconsistencyStrategy m x (Shade' y)
strategy DifferentialEqn ㄇ x y
f x -> Shade' y -> badness
badness' PointsWeb x (SolverNodeState x y)
oldState
            = (PointsWeb x (SolverNodeState x y)
 -> PointsWeb x (SolverNodeState x y))
-> m (PointsWeb x (SolverNodeState x y))
-> m (PointsWeb x (SolverNodeState x y))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
forall x y.
ModellableRelation x y =>
PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
recomputeJacobian (m (PointsWeb x (SolverNodeState x y))
 -> m (PointsWeb x (SolverNodeState x y)))
-> m (PointsWeb x (SolverNodeState x y))
-> m (PointsWeb x (SolverNodeState x y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ PointsWeb
  x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
-> m (PointsWeb x (SolverNodeState x y))
PointsWeb x (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
-> m (PointsWeb x (SolverNodeState x y))
filterGo (PointsWeb x (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
 -> m (PointsWeb x (SolverNodeState x y)))
-> m (PointsWeb
        x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)]))
-> m (PointsWeb x (SolverNodeState x y))
forall (m :: * -> *) (k :: * -> * -> *) a b.
(Monad m k, Object k a, Object k b, Object k (m a), Object k (m b),
 Object k (m (m b))) =>
k a (m b) -> k (m a) (m b)
=<< m (PointsWeb
     x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)]))
tryPreproc
 where tryPreproc :: m (PointsWeb x ( (WebLocally x (SolverNodeState x y)
                                    , [(Shade' y, badness)]) ))
       tryPreproc :: m (PointsWeb
     x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)]))
tryPreproc 
               = (WebLocally x (SolverNodeState x y)
 -> m (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)]))
-> PointsWeb x (WebLocally x (SolverNodeState x y))
-> m (PointsWeb
        x (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)]))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse WebLocally x (SolverNodeState x y)
-> m (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
addPropagation (PointsWeb x (WebLocally x (SolverNodeState x y))
 -> m (PointsWeb
         x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])))
-> PointsWeb x (WebLocally x (SolverNodeState x y))
-> m (PointsWeb
        x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)]))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ PointsWeb x (SolverNodeState x y)
-> PointsWeb x (WebLocally x (SolverNodeState x y))
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo PointsWeb x (SolverNodeState x y)
oldState
        where addPropagation :: WebLocally x (SolverNodeState x y)
-> m (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
addPropagation WebLocally x (SolverNodeState x y)
wl
                 | [(Needle x, WebLocally x (SolverNodeState x y))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Needle x, WebLocally x (SolverNodeState x y))]
neighbourInfo = (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
-> m (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (WebLocally x (SolverNodeState x y)
wl, [])
                 | Bool
otherwise           = (WebLocally x (SolverNodeState x y)
wl,) ([(Shade' y, ℝ)]
 -> (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)]))
-> ([Shade' y] -> [(Shade' y, ℝ)])
-> [Shade' y]
-> (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Shade' y -> (Shade' y, ℝ)) -> [Shade' y] -> [(Shade' y, ℝ)]
forall a b. (a -> b) -> [a] -> [b]
map (Shade' y -> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id(Shade' y -> Shade' y)
-> (Shade' y -> ℝ) -> Shade' y -> (Shade' y, ℝ)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&x -> Shade' y -> ℝ
badness x
forall a. HasCallStack => a
undefined)
                                           ([Shade' y]
 -> (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)]))
-> m [Shade' y]
-> m (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> m [Shade' y]
propFromNgbs
               where propFromNgbs :: m [Shade' y]
                     propFromNgbs :: m [Shade' y]
propFromNgbs = (Maybe (Shade' y) -> m (Shade' y))
-> [Maybe (Shade' y)] -> m [Shade' y]
forall (s :: * -> *) (t :: * -> *) (k :: * -> * -> *)
       (l :: * -> * -> *) (m :: * -> *) a b.
(Traversable s t k l, k ~ l, s ~ t, Applicative m k k, Object k a,
 Object k (t a), ObjectPair k b (t b), ObjectPair k (m b) (m (t b)),
 TraversalObject k t b) =>
k a (m b) -> k (t a) (m (t b))
mapM (InconsistencyStrategy m x (Shade' y)
-> Shade' y -> Maybe (Shade' y) -> m (Shade' y)
forall (m :: * -> *) x a.
InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency InconsistencyStrategy m x (Shade' y)
strategy Shade' y
thisShy) [
                                       DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc DifferentialEqn ㄇ x y
f
                                        (x
-> Needle x
-> Shade' y
-> Shade' y
-> [(Needle x, Shade' y)]
-> LocalDataPropPlan x (Shade' y)
forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                           (WebLocally x (SolverNodeState x y)
neighWebLocally x (SolverNodeState x y)
-> Getting x (WebLocally x (SolverNodeState x y)) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x (SolverNodeState x y)) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                           (Needle x -> Needle x
forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                           (ConvexSet y -> Shade' y
forall x. ConvexSet x -> Shade' x
convexSetHull (ConvexSet y -> Shade' y) -> ConvexSet y -> Shade' y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (SolverNodeState x y)
neighWebLocally x (SolverNodeState x y)
-> Getting
     (ConvexSet y) (WebLocally x (SolverNodeState x y)) (ConvexSet y)
-> ConvexSet y
forall s a. s -> Getting a s a -> a
^.(SolverNodeState x y -> Const (ConvexSet y) (SolverNodeState x y))
-> WebLocally x (SolverNodeState x y)
-> Const (ConvexSet y) (WebLocally x (SolverNodeState x y))
forall x y. Lens' (WebLocally x y) y
thisNodeData
                                                                  ((SolverNodeState x y -> Const (ConvexSet y) (SolverNodeState x y))
 -> WebLocally x (SolverNodeState x y)
 -> Const (ConvexSet y) (WebLocally x (SolverNodeState x y)))
-> ((ConvexSet y -> Const (ConvexSet y) (ConvexSet y))
    -> SolverNodeState x y
    -> Const (ConvexSet y) (SolverNodeState x y))
-> Getting
     (ConvexSet y) (WebLocally x (SolverNodeState x y)) (ConvexSet y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(ConvexSet y -> Const (ConvexSet y) (ConvexSet y))
-> SolverNodeState x y -> Const (ConvexSet y) (SolverNodeState x y)
forall x y. Lens' (SolverNodeState x y) (ConvexSet y)
solverNodeStatus)
                                           Shade' y
thisShy
                                           [ (WebLocally x (SolverNodeState x y) -> Shade' y)
-> (Needle x, WebLocally x (SolverNodeState x y))
-> (Needle x, Shade' y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (ConvexSet y -> Shade' y
forall x. ConvexSet x -> Shade' x
convexSetHull
                                                     (ConvexSet y -> Shade' y)
-> (WebLocally x (SolverNodeState x y) -> ConvexSet y)
-> WebLocally x (SolverNodeState x y)
-> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. SolverNodeState x y -> ConvexSet y
forall x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus (SolverNodeState x y -> ConvexSet y)
-> (WebLocally x (SolverNodeState x y) -> SolverNodeState x y)
-> WebLocally x (SolverNodeState x y)
-> ConvexSet y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. WebLocally x (SolverNodeState x y) -> SolverNodeState x y
forall x y. WebLocally x y -> y
_thisNodeData) (Needle x, WebLocally x (SolverNodeState x y))
nn
                                           | (Int
_,(Needle x, WebLocally x (SolverNodeState x y))
nn)<-WebLocally x (SolverNodeState x y)
neighWebLocally x (SolverNodeState x y)
-> Getting
     [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
     (WebLocally x (SolverNodeState x y))
     [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
-> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
  (WebLocally x (SolverNodeState x y))
  [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours ] )
                                     | (Needle x
δx, WebLocally x (SolverNodeState x y)
neigh) <- [(Needle x, WebLocally x (SolverNodeState x y))]
neighbourInfo ]  -- ( (thisPos, thisShy), NE.fromList neighbourHulls )
                     thisPos :: x
thisPos = WebLocally x (SolverNodeState x y) -> x
forall x y. WebLocally x y -> x
_thisNodeCoord WebLocally x (SolverNodeState x y)
wl :: x
                     thisShy :: Shade' y
thisShy = ConvexSet y -> Shade' y
forall x. ConvexSet x -> Shade' x
convexSetHull (ConvexSet y -> Shade' y)
-> (SolverNodeState x y -> ConvexSet y)
-> SolverNodeState x y
-> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. SolverNodeState x y -> ConvexSet y
forall x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus (SolverNodeState x y -> Shade' y)
-> SolverNodeState x y -> Shade' y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (SolverNodeState x y) -> SolverNodeState x y
forall x y. WebLocally x y -> y
_thisNodeData WebLocally x (SolverNodeState x y)
wl
                     neighbourInfo :: [(Needle x, WebLocally x (SolverNodeState x y))]
neighbourInfo = (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> (Needle x, WebLocally x (SolverNodeState x y))
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((Int, (Needle x, WebLocally x (SolverNodeState x y)))
 -> (Needle x, WebLocally x (SolverNodeState x y)))
-> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
-> [(Needle x, WebLocally x (SolverNodeState x y))]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> WebLocally x (SolverNodeState x y)
-> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
forall x y. WebLocally x y -> [(Int, (Needle x, WebLocally x y))]
_nodeNeighbours WebLocally x (SolverNodeState x y)
wl

       totalAge :: Int
totalAge = PointsWeb x Int -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (PointsWeb x Int -> Int) -> PointsWeb x Int -> Int
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ SolverNodeState x y -> Int
forall x y. SolverNodeState x y -> Int
_solverNodeAge (SolverNodeState x y -> Int)
-> PointsWeb x (SolverNodeState x y) -> PointsWeb x Int
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> PointsWeb x (SolverNodeState x y)
oldState
       errTgtModulation :: ℝ
errTgtModulation = (ℝ
1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-) (ℝ -> ℝ) -> (ℝ -> ℝ) -> ℝ -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (ℝ -> ℝ -> ℝ
forall a. Real a => a -> a -> a
`mod'`ℝ
1) (ℝ -> ℝ) -> (ℝ -> ℝ) -> ℝ -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ℝ -> ℝ
forall a. Num a => a -> a
negate (ℝ -> ℝ) -> (ℝ -> ℝ) -> ℝ -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ℝ -> ℝ
forall a. Floating a => a -> a
sqrt (ℝ -> ℝ) -> ℝ -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
totalAge
       badness :: x -> Shade' y -> ℝ
badness x
x = x -> Shade' y -> badness
badness' x
x (Shade' y -> ℝ) -> (Shade' y -> Shade' y) -> Shade' y -> ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. ((Norm (Diff y) -> Identity (Norm (Diff y)))
-> Shade' y -> Identity (Shade' y)
forall x. Lens' (Shade' x) (Metric x)
shadeNarrowness ((Norm (Diff y) -> Identity (Norm (Diff y)))
 -> Shade' y -> Identity (Shade' y))
-> (Norm (Diff y) -> Norm (Diff y)) -> Shade' y -> Shade' y
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Scalar (Diff y) -> Norm (Diff y) -> Norm (Diff y)
forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm ℝ
Scalar (Diff y)
errTgtModulation))
              
       filterGo :: (PointsWeb x ( (WebLocally x (SolverNodeState x y)
                                   , [(Shade' y, badness)]) ))
                   -> m (PointsWeb x (SolverNodeState x y))
       filterGo :: PointsWeb
  x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
-> m (PointsWeb x (SolverNodeState x y))
filterGo PointsWeb
  x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
preproc'd
             = (PointsWeb x (OldAndNew (x, SolverNodeState x y))
 -> PointsWeb x (SolverNodeState x y))
-> m (PointsWeb x (OldAndNew (x, SolverNodeState x y)))
-> m (PointsWeb x (SolverNodeState x y))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (MetricChoice x
-> PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> PointsWeb x y -> PointsWeb x y
smoothenWebTopology MetricChoice x
mf
                                     (PointsWeb x (SolverNodeState x y)
 -> PointsWeb x (SolverNodeState x y))
-> (PointsWeb x (OldAndNew (x, SolverNodeState x y))
    -> PointsWeb x (SolverNodeState x y))
-> PointsWeb x (OldAndNew (x, SolverNodeState x y))
-> PointsWeb x (SolverNodeState x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. MetricChoice x
-> [((x, [Either Int (Needle x)]), SolverNodeState x y)]
-> PointsWeb x (SolverNodeState x y)
forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> [((x, [Int + Needle x]), y)] -> PointsWeb x y
fromTopWebNodes MetricChoice x
mf ([((x, [Either Int (Needle x)]), SolverNodeState x y)]
 -> PointsWeb x (SolverNodeState x y))
-> (PointsWeb x (OldAndNew (x, SolverNodeState x y))
    -> [((x, [Either Int (Needle x)]), SolverNodeState x y)])
-> PointsWeb x (OldAndNew (x, SolverNodeState x y))
-> PointsWeb x (SolverNodeState x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [[((x, [Either Int (Needle x)]), SolverNodeState x y)]]
-> [((x, [Either Int (Needle x)]), SolverNodeState x y)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[((x, [Either Int (Needle x)]), SolverNodeState x y)]]
 -> [((x, [Either Int (Needle x)]), SolverNodeState x y)])
-> (PointsWeb x (OldAndNew (x, SolverNodeState x y))
    -> [[((x, [Either Int (Needle x)]), SolverNodeState x y)]])
-> PointsWeb x (OldAndNew (x, SolverNodeState x y))
-> [((x, [Either Int (Needle x)]), SolverNodeState x y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
 -> [((x, [Either Int (Needle x)]), SolverNodeState x y)])
-> [WebLocally
      x (WebLocally x (OldAndNew (x, SolverNodeState x y)))]
-> [[((x, [Either Int (Needle x)]), SolverNodeState x y)]]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> [((x, [Either Int (Needle x)]), SolverNodeState x y)]
retraceBonds
                                        ([WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))]
 -> [[((x, [Either Int (Needle x)]), SolverNodeState x y)]])
-> (PointsWeb x (OldAndNew (x, SolverNodeState x y))
    -> [WebLocally
          x (WebLocally x (OldAndNew (x, SolverNodeState x y)))])
-> PointsWeb x (OldAndNew (x, SolverNodeState x y))
-> [[((x, [Either Int (Needle x)]), SolverNodeState x y)]]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb
  x
  (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
-> [WebLocally
      x (WebLocally x (OldAndNew (x, SolverNodeState x y)))]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList (PointsWeb
   x
   (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
 -> [WebLocally
       x (WebLocally x (OldAndNew (x, SolverNodeState x y)))])
-> (PointsWeb x (OldAndNew (x, SolverNodeState x y))
    -> PointsWeb
         x
         (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))
-> PointsWeb x (OldAndNew (x, SolverNodeState x y))
-> [WebLocally
      x (WebLocally x (OldAndNew (x, SolverNodeState x y)))]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> PointsWeb
     x
     (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo (PointsWeb x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
 -> PointsWeb
      x
      (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))
-> (PointsWeb x (OldAndNew (x, SolverNodeState x y))
    -> PointsWeb x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
-> PointsWeb x (OldAndNew (x, SolverNodeState x y))
-> PointsWeb
     x
     (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x (OldAndNew (x, SolverNodeState x y))
-> PointsWeb x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo)
             (m (PointsWeb x (OldAndNew (x, SolverNodeState x y)))
 -> m (PointsWeb x (SolverNodeState x y)))
-> m (PointsWeb x (OldAndNew (x, SolverNodeState x y)))
-> m (PointsWeb x (SolverNodeState x y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
 -> m (OldAndNew (x, SolverNodeState x y)))
-> PointsWeb
     x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
-> m (PointsWeb x (OldAndNew (x, SolverNodeState x y)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse ((WebLocally x (SolverNodeState x y)
 -> [(Shade' y, ℝ)] -> m (OldAndNew (x, SolverNodeState x y)))
-> (WebLocally x (SolverNodeState x y), [(Shade' y, ℝ)])
-> m (OldAndNew (x, SolverNodeState x y))
forall (k :: * -> * -> *) a b c.
(Curry k, ObjectPair k a b, ObjectMorphism k b c) =>
k a (k b c) -> k (a, b) c
uncurry WebLocally x (SolverNodeState x y)
-> [(Shade' y, badness)] -> m (OldAndNew (x, SolverNodeState x y))
WebLocally x (SolverNodeState x y)
-> [(Shade' y, ℝ)] -> m (OldAndNew (x, SolverNodeState x y))
localChange) PointsWeb
  x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
preproc'd
        where smallBadnessGradient, largeBadnessGradient :: ℝ
              (ℝ
smallBadnessGradient, ℝ
largeBadnessGradient)
                  = ( [badness]
badnessGradRated[badness] -> Int -> badness
forall a. [a] -> Int -> a
!!(Int
nInt -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
4), [badness]
badnessGradRated[badness] -> Int -> badness
forall a. [a] -> Int -> a
!!(Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
3Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
4) )
               where n :: Int
n = case [badness] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [badness]
badnessGradRated of
                           Int
0 -> [Char] -> Int
forall a. HasCallStack => [Char] -> a
error [Char]
"No statistics available for badness-grading."
                           Int
l -> Int
l
                     badnessGradRated :: [badness]
                     badnessGradRated :: [badness]
badnessGradRated = [badness] -> [badness]
forall a. Ord a => [a] -> [a]
sort [ badness
ngBad badness -> badness -> badness
forall a. Fractional a => a -> a -> a
/ badness
ℝ
bad
                                             | ( LocalWebInfo {
                                                   _thisNodeData :: forall x y. WebLocally x y -> y
_thisNodeData
                                                     = SolverNodeInfo ConvexSet y
_ Shade' (LocalLinear x y)
_ ℝ
bad Int
_
                                                 , _nodeNeighbours :: forall x y. WebLocally x y -> [(Int, (Needle x, WebLocally x y))]
_nodeNeighbours=[(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
ngbs        }
                                               , [(Shade' y, badness)]
ngbProps) <- PointsWeb
  x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
-> [(WebLocally x (SolverNodeState x y), [(Shade' y, badness)])]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList PointsWeb
  x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
preproc'd
                                             , (Shade' y
_, badness
ngBad) <- [(Shade' y, badness)]
ngbProps
                                             , badness
ngBadbadness -> badness -> Bool
forall a. Ord a => a -> a -> Bool
>badness
ℝ
bad ]
              localChange :: WebLocally x (SolverNodeState x y) -> [(Shade' y, badness)]
                                    -> m (OldAndNew (x, SolverNodeState x y))
              localChange :: WebLocally x (SolverNodeState x y)
-> [(Shade' y, badness)] -> m (OldAndNew (x, SolverNodeState x y))
localChange localInfo :: WebLocally x (SolverNodeState x y)
localInfo@LocalWebInfo{
                                _thisNodeCoord :: forall x y. WebLocally x y -> x
_thisNodeCoord = x
x
                              , _thisNodeData :: forall x y. WebLocally x y -> y
_thisNodeData = SolverNodeInfo
                                                   shy :: ConvexSet y
shy@(ConvexSet Shade' y
hull [Shade' y]
_) Shade' (LocalLinear x y)
prevJacobi
                                                   ℝ
prevBadness Int
age
                              , _nodeNeighbours :: forall x y. WebLocally x y -> [(Int, (Needle x, WebLocally x y))]
_nodeNeighbours = [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
ngbs
                              }
                          [(Shade' y, badness)]
ngbProps
               | [(Int, (Needle x, WebLocally x (SolverNodeState x y)))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
ngbs  = OldAndNew (x, SolverNodeState x y)
-> m (OldAndNew (x, SolverNodeState x y))
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ( (x, SolverNodeState x y) -> Maybe (x, SolverNodeState x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (x
x, ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo ConvexSet y
shy Shade' (LocalLinear x y)
prevJacobi
                                                           ℝ
prevBadness (Int
ageInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
                                     , [] )
               | Bool
otherwise  = do
                      let (Int
environAge, Int
unfreshness)
                             = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum([Int] -> Int) -> ([Int] -> Int) -> [Int] -> (Int, Int)
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&[Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Int] -> (Int, Int)) -> [Int] -> (Int, Int)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int
age Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (SolverNodeState x y -> Int
forall x y. SolverNodeState x y -> Int
_solverNodeAge (SolverNodeState x y -> Int)
-> ((Int, (Needle x, WebLocally x (SolverNodeState x y)))
    -> SolverNodeState x y)
-> (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> Int
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. WebLocally x (SolverNodeState x y) -> SolverNodeState x y
forall x y. WebLocally x y -> y
_thisNodeData
                                                               (WebLocally x (SolverNodeState x y) -> SolverNodeState x y)
-> ((Int, (Needle x, WebLocally x (SolverNodeState x y)))
    -> WebLocally x (SolverNodeState x y))
-> (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> SolverNodeState x y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Needle x, WebLocally x (SolverNodeState x y))
-> WebLocally x (SolverNodeState x y)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((Needle x, WebLocally x (SolverNodeState x y))
 -> WebLocally x (SolverNodeState x y))
-> ((Int, (Needle x, WebLocally x (SolverNodeState x y)))
    -> (Needle x, WebLocally x (SolverNodeState x y)))
-> (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> WebLocally x (SolverNodeState x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> (Needle x, WebLocally x (SolverNodeState x y))
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((Int, (Needle x, WebLocally x (SolverNodeState x y))) -> Int)
-> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))] -> [Int]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
ngbs)
                      case ((Shade' y, ℝ) -> Bool) -> [(Shade' y, ℝ)] -> Maybe (Shade' y, ℝ)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Shade' y
_, ℝ
badnessN)
                                      -> ℝ
badnessN ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
prevBadness ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
smallBadnessGradient)
                                     ([(Shade' y, badness)] -> Maybe (Shade' y, ℝ))
-> [(Shade' y, badness)] -> Maybe (Shade' y, ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [(Shade' y, badness)]
ngbProps of
                        Maybe (Shade' y, ℝ)
Nothing | Int
age Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
environAge   -- point is an obsolete step-stone;
                          -> OldAndNew (x, SolverNodeState x y)
-> m (OldAndNew (x, SolverNodeState x y))
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Maybe (x, SolverNodeState x y)
forall (f :: * -> *) a. Alternative f => f a
empty,[(x, SolverNodeState x y)]
forall (f :: * -> *) a. Alternative f => f a
empty)    -- do not further use it.
                        Maybe (Shade' y, ℝ)
_otherwise -> do
                          ConvexSet y
shy' <- InconsistencyStrategy m x (ConvexSet y)
-> ConvexSet y -> Maybe (ConvexSet y) -> m (ConvexSet y)
forall (m :: * -> *) x a.
InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency (Shade' y -> ConvexSet y
forall x. Shade' x -> ConvexSet x
ellipsoid(Shade' y -> ConvexSet y)
-> InconsistencyStrategy m x (Shade' y)
-> InconsistencyStrategy m x (ConvexSet y)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>InconsistencyStrategy m x (Shade' y)
strategy) ConvexSet y
shy
                                  (Maybe (ConvexSet y) -> m (ConvexSet y))
-> Maybe (ConvexSet y) -> m (ConvexSet y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((ConvexSet y
shyConvexSet y -> ConvexSet y -> ConvexSet y
forall a. Semigroup a => a -> a -> a
<>) (ConvexSet y -> ConvexSet y)
-> (Shade' y -> ConvexSet y) -> Shade' y -> ConvexSet y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Shade' y -> ConvexSet y
forall x. Shade' x -> ConvexSet x
ellipsoid)
                                   (Shade' y -> ConvexSet y)
-> Maybe (Shade' y) -> Maybe (ConvexSet y)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> NonEmpty (Shade' y) -> Maybe (Shade' y)
forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's ((Shade' y, badness) -> Shade' y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((Shade' y, badness) -> Shade' y)
-> NonEmpty (Shade' y, badness) -> NonEmpty (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [(Shade' y, badness)] -> NonEmpty (Shade' y, badness)
forall a. [a] -> NonEmpty a
NE.fromList [(Shade' y, badness)]
ngbProps)
                          ℝ
newBadness
                               <- InconsistencyStrategy m x ℝ -> ℝ -> Maybe ℝ -> m ℝ
forall (m :: * -> *) x a.
InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency (x -> Shade' y -> ℝ
badness x
x(Shade' y -> ℝ)
-> InconsistencyStrategy m x (Shade' y)
-> InconsistencyStrategy m x ℝ
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>InconsistencyStrategy m x (Shade' y)
strategy) ℝ
prevBadness
                                      (Maybe ℝ -> m ℝ) -> Maybe ℝ -> m ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ case ConvexSet y
shy' of
                             ConvexSet y
EmptyConvex        -> Maybe ℝ
forall (f :: * -> *) a. Alternative f => f a
empty
                             ConvexSet Shade' y
hull' [Shade' y]
_  -> ℝ -> Maybe ℝ
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (ℝ -> Maybe ℝ) -> ℝ -> Maybe ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x -> Shade' y -> ℝ
badness x
x Shade' y
hull'
                          let updatedNode :: SolverNodeState x y
updatedNode = ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo ConvexSet y
shy' Shade' (LocalLinear x y)
prevJacobi
                                                     ℝ
newBadness (Int
ageInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
                          [(x, SolverNodeState x y)]
stepStones <-
                            if Int
unfreshness Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
                             then [(x, SolverNodeState x y)] -> m [(x, SolverNodeState x y)]
forall (m :: * -> *) a. Monad m (->) => a -> m a
return []
                             else ([[(x, SolverNodeState x y)]] -> [(x, SolverNodeState x y)])
-> m [[(x, SolverNodeState x y)]] -> m [(x, SolverNodeState x y)]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap [[(x, SolverNodeState x y)]] -> [(x, SolverNodeState x y)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (m [[(x, SolverNodeState x y)]] -> m [(x, SolverNodeState x y)])
-> ((((Needle x, SolverNodeState x y), (Shade' y, ℝ))
     -> m [(x, SolverNodeState x y)])
    -> m [[(x, SolverNodeState x y)]])
-> (((Needle x, SolverNodeState x y), (Shade' y, ℝ))
    -> m [(x, SolverNodeState x y)])
-> m [(x, SolverNodeState x y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [((Needle x, SolverNodeState x y), (Shade' y, badness))]
-> (((Needle x, SolverNodeState x y), (Shade' y, badness))
    -> m [(x, SolverNodeState x y)])
-> m [[(x, SolverNodeState x y)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([(Needle x, SolverNodeState x y)]
-> [(Shade' y, badness)]
-> [((Needle x, SolverNodeState x y), (Shade' y, badness))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((WebLocally x (SolverNodeState x y) -> SolverNodeState x y)
-> (Needle x, WebLocally x (SolverNodeState x y))
-> (Needle x, SolverNodeState x y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second WebLocally x (SolverNodeState x y) -> SolverNodeState x y
forall x y. WebLocally x y -> y
_thisNodeData((Needle x, WebLocally x (SolverNodeState x y))
 -> (Needle x, SolverNodeState x y))
-> ((Int, (Needle x, WebLocally x (SolverNodeState x y)))
    -> (Needle x, WebLocally x (SolverNodeState x y)))
-> (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> (Needle x, SolverNodeState x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> (Needle x, WebLocally x (SolverNodeState x y))
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((Int, (Needle x, WebLocally x (SolverNodeState x y)))
 -> (Needle x, SolverNodeState x y))
-> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
-> [(Needle x, SolverNodeState x y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
ngbs)
                                                          [(Shade' y, badness)]
ngbProps)
                                          ((((Needle x, SolverNodeState x y), (Shade' y, ℝ))
  -> m [(x, SolverNodeState x y)])
 -> m [(x, SolverNodeState x y)])
-> (((Needle x, SolverNodeState x y), (Shade' y, ℝ))
    -> m [(x, SolverNodeState x y)])
-> m [(x, SolverNodeState x y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \( (Needle x
vN, SolverNodeInfo (ConvexSet Shade' y
hullN [Shade' y]
_)
                                                               Shade' (LocalLinear x y)
_ ℝ
_ Int
ageN)
                                               , (Shade' y
_, ℝ
nBadnessProp'd) ) -> do
                              case Int
ageN of
                               Int
_  | Int
ageN Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                                  , ℝ
badnessGrad <- ℝ
nBadnessProp'd ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
prevBadness
                                  , ℝ
badnessGrad ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
largeBadnessGradient -> do
                                        let stepV :: Needle x
stepV = Needle x
vNNeedle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
2
                                            xStep :: x
xStep = x
x x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
stepV
                                            aprioriInterpolate :: Shade' y
                                            Just Shade' y
aprioriInterpolate
                                               = Shade' y -> Shade' y -> Maybe (Shade' y)
forall x. Geodesic x => x -> x -> Maybe x
middleBetween Shade' y
hull Shade' y
hullN
                                        case NonEmpty (Shade' y) -> Maybe (Shade' y)
forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's (NonEmpty (Shade' y) -> Maybe (Shade' y))
-> Maybe (NonEmpty (Shade' y)) -> Maybe (Shade' y)
forall (m :: * -> *) (k :: * -> * -> *) a b.
(Monad m k, Object k a, Object k b, Object k (m a), Object k (m b),
 Object k (m (m b))) =>
k a (m b) -> k (m a) (m b)
=<<
                                               (NonEmpty (Maybe (Shade' y)) -> Maybe (NonEmpty (Shade' y))
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (NonEmpty (Maybe (Shade' y)) -> Maybe (NonEmpty (Shade' y)))
-> NonEmpty (Maybe (Shade' y)) -> Maybe (NonEmpty (Shade' y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Maybe (Shade' y)] -> NonEmpty (Maybe (Shade' y))
forall a. [a] -> NonEmpty a
NE.fromList
                                               [ DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc DifferentialEqn ㄇ x y
f
                                                   (x
-> Needle x
-> Shade' y
-> Shade' y
-> [(Needle x, Shade' y)]
-> LocalDataPropPlan x (Shade' y)
forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                                      (WebLocally x (SolverNodeState x y)
nWebLocally x (SolverNodeState x y)
-> Getting x (WebLocally x (SolverNodeState x y)) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x (SolverNodeState x y)) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                                      (Needle x
stepV Needle x -> Needle x -> Needle x
forall v. AdditiveGroup v => v -> v -> v
^-^ Needle x
δx)
                                                      (ConvexSet y -> Shade' y
forall x. ConvexSet x -> Shade' x
convexSetHull (ConvexSet y -> Shade' y) -> ConvexSet y -> Shade' y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                                                        WebLocally x (SolverNodeState x y)
nWebLocally x (SolverNodeState x y)
-> Getting
     (ConvexSet y) (WebLocally x (SolverNodeState x y)) (ConvexSet y)
-> ConvexSet y
forall s a. s -> Getting a s a -> a
^.(SolverNodeState x y -> Const (ConvexSet y) (SolverNodeState x y))
-> WebLocally x (SolverNodeState x y)
-> Const (ConvexSet y) (WebLocally x (SolverNodeState x y))
forall x y. Lens' (WebLocally x y) y
thisNodeData((SolverNodeState x y -> Const (ConvexSet y) (SolverNodeState x y))
 -> WebLocally x (SolverNodeState x y)
 -> Const (ConvexSet y) (WebLocally x (SolverNodeState x y)))
-> ((ConvexSet y -> Const (ConvexSet y) (ConvexSet y))
    -> SolverNodeState x y
    -> Const (ConvexSet y) (SolverNodeState x y))
-> Getting
     (ConvexSet y) (WebLocally x (SolverNodeState x y)) (ConvexSet y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(ConvexSet y -> Const (ConvexSet y) (ConvexSet y))
-> SolverNodeState x y -> Const (ConvexSet y) (SolverNodeState x y)
forall x y. Lens' (SolverNodeState x y) (ConvexSet y)
solverNodeStatus)
                                                      Shade' y
aprioriInterpolate
                                                      ((WebLocally x (SolverNodeState x y) -> Shade' y)
-> (Needle x, WebLocally x (SolverNodeState x y))
-> (Needle x, Shade' y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (ConvexSet y -> Shade' y
forall x. ConvexSet x -> Shade' x
convexSetHull
                                                               (ConvexSet y -> Shade' y)
-> (WebLocally x (SolverNodeState x y) -> ConvexSet y)
-> WebLocally x (SolverNodeState x y)
-> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.SolverNodeState x y -> ConvexSet y
forall x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus
                                                               (SolverNodeState x y -> ConvexSet y)
-> (WebLocally x (SolverNodeState x y) -> SolverNodeState x y)
-> WebLocally x (SolverNodeState x y)
-> ConvexSet y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.WebLocally x (SolverNodeState x y) -> SolverNodeState x y
forall x y. WebLocally x y -> y
_thisNodeData)
                                                              ((Needle x, WebLocally x (SolverNodeState x y))
 -> (Needle x, Shade' y))
-> ((Int, (Needle x, WebLocally x (SolverNodeState x y)))
    -> (Needle x, WebLocally x (SolverNodeState x y)))
-> (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> (Needle x, Shade' y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int, (Needle x, WebLocally x (SolverNodeState x y)))
-> (Needle x, WebLocally x (SolverNodeState x y))
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd
                                                              ((Int, (Needle x, WebLocally x (SolverNodeState x y)))
 -> (Needle x, Shade' y))
-> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
-> [(Needle x, Shade' y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> WebLocally x (SolverNodeState x y)
nWebLocally x (SolverNodeState x y)
-> Getting
     [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
     (WebLocally x (SolverNodeState x y))
     [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
-> [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
  (WebLocally x (SolverNodeState x y))
  [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours) )
                                                -- ( (xStep, hull)
                                                -- , NE.cons (negateV stepV, hull)
                                                --     $ fmap (\(vN',hullN')
                                                --              -> (vN'^-^stepV, hullN') ) )
                                                | (Int
_, (Needle x
δx, WebLocally x (SolverNodeState x y)
n)) <- [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
ngbs ]) of
                                         Just Shade' y
shyStep -> [(x, SolverNodeState x y)] -> m [(x, SolverNodeState x y)]
forall (m :: * -> *) a. Monad m (->) => a -> m a
return
                                               [( x
xStep
                                                , ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo (Shade' y -> ConvexSet y
forall x. Shade' x -> ConvexSet x
ellipsoid Shade' y
shyStep)
                                                       Shade' (LocalLinear x y)
prevJacobi (x -> Shade' y -> ℝ
badness x
xStep Shade' y
shyStep) Int
1
                                                )]
                                         Maybe (Shade' y)
_ -> [(x, SolverNodeState x y)] -> m [(x, SolverNodeState x y)]
forall (m :: * -> *) a. Monad m (->) => a -> m a
return []
                               Int
_otherwise -> [(x, SolverNodeState x y)] -> m [(x, SolverNodeState x y)]
forall (m :: * -> *) a. Monad m (->) => a -> m a
return []
                          let updated :: (x, SolverNodeState x y)
updated = (x
x, SolverNodeState x y
updatedNode)
                          OldAndNew (x, SolverNodeState x y)
-> m (OldAndNew (x, SolverNodeState x y))
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (OldAndNew (x, SolverNodeState x y)
 -> m (OldAndNew (x, SolverNodeState x y)))
-> OldAndNew (x, SolverNodeState x y)
-> m (OldAndNew (x, SolverNodeState x y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((x, SolverNodeState x y) -> Maybe (x, SolverNodeState x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (x, SolverNodeState x y)
updated, [(x, SolverNodeState x y)]
stepStones)
              
              retraceBonds :: WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
                              -> [((x, [Int+Needle x]), SolverNodeState x y)]
              retraceBonds :: WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> [((x, [Either Int (Needle x)]), SolverNodeState x y)]
retraceBonds locWeb :: WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
locWeb@LocalWebInfo{ _thisNodeId :: forall x y. WebLocally x y -> Int
_thisNodeId = Int
myId
                                              , _thisNodeCoord :: forall x y. WebLocally x y -> x
_thisNodeCoord = x
xOld
                                              , _nodeLocalScalarProduct :: forall x y. WebLocally x y -> Metric x
_nodeLocalScalarProduct = Metric x
locMetr }
                   = [ ( (x
x, Needle x -> Either Int (Needle x)
forall a b. b -> Either a b
Right (Needle x -> Either Int (Needle x))
-> ((Needle x, Int) -> Needle x)
-> (Needle x, Int)
-> Either Int (Needle x)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Needle x, Int) -> Needle x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst((Needle x, Int) -> Either Int (Needle x))
-> [(Needle x, Int)] -> [Either Int (Needle x)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Needle x, Int)]
neighbourCandidates), SolverNodeState x y
snsy)
                     | (Bool
isOld, (x
x, SolverNodeState x y
snsy)) <- [(Bool, (x, SolverNodeState x y))]
focused
                     , let neighbourCandidates :: [(Needle x, Int)]
neighbourCandidates
                            = [ (Needle x
v,Int
nnId)
                              | (Needle x
_,WebLocally x (OldAndNew (x, SolverNodeState x y))
ngb) <- [(Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y)))]
knownNgbs
                              , (Just Needle x
v, Int
nnId)
                                 <- case OldAndNew (x, SolverNodeState x y) -> [(x, SolverNodeState x y)]
forall d. OldAndNew d -> [d]
oldAndNew (OldAndNew (x, SolverNodeState x y) -> [(x, SolverNodeState x y)])
-> OldAndNew (x, SolverNodeState x y) -> [(x, SolverNodeState x y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (OldAndNew (x, SolverNodeState x y))
ngbWebLocally x (OldAndNew (x, SolverNodeState x y))
-> Getting
     (OldAndNew (x, SolverNodeState x y))
     (WebLocally x (OldAndNew (x, SolverNodeState x y)))
     (OldAndNew (x, SolverNodeState x y))
-> OldAndNew (x, SolverNodeState x y)
forall s a. s -> Getting a s a -> a
^.Getting
  (OldAndNew (x, SolverNodeState x y))
  (WebLocally x (OldAndNew (x, SolverNodeState x y)))
  (OldAndNew (x, SolverNodeState x y))
forall x y. Lens' (WebLocally x y) y
thisNodeData of
                                          [] -> [ (x
xNx -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
x, Int
nnId)
                                                | (Int
nnId, (Needle x
_,WebLocally x (OldAndNew (x, SolverNodeState x y))
nnWeb)) <- WebLocally x (OldAndNew (x, SolverNodeState x y))
ngbWebLocally x (OldAndNew (x, SolverNodeState x y))
-> Getting
     [(Int,
       (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y))))]
     (WebLocally x (OldAndNew (x, SolverNodeState x y)))
     [(Int,
       (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y))))]
-> [(Int,
     (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y))))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int,
    (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y))))]
  (WebLocally x (OldAndNew (x, SolverNodeState x y)))
  [(Int,
    (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y))))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                                , Int
nnId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
myId
                                                , (x
xN,SolverNodeState x y
_) <- OldAndNew (x, SolverNodeState x y) -> [(x, SolverNodeState x y)]
forall d. OldAndNew d -> [d]
oldAndNew (OldAndNew (x, SolverNodeState x y) -> [(x, SolverNodeState x y)])
-> OldAndNew (x, SolverNodeState x y) -> [(x, SolverNodeState x y)]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (OldAndNew (x, SolverNodeState x y))
nnWebWebLocally x (OldAndNew (x, SolverNodeState x y))
-> Getting
     (OldAndNew (x, SolverNodeState x y))
     (WebLocally x (OldAndNew (x, SolverNodeState x y)))
     (OldAndNew (x, SolverNodeState x y))
-> OldAndNew (x, SolverNodeState x y)
forall s a. s -> Getting a s a -> a
^.Getting
  (OldAndNew (x, SolverNodeState x y))
  (WebLocally x (OldAndNew (x, SolverNodeState x y)))
  (OldAndNew (x, SolverNodeState x y))
forall x y. Lens' (WebLocally x y) y
thisNodeData ]
                                          [(x, SolverNodeState x y)]
l -> [(x
xNx -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
x, WebLocally x (OldAndNew (x, SolverNodeState x y))
ngbWebLocally x (OldAndNew (x, SolverNodeState x y))
-> Getting
     Int (WebLocally x (OldAndNew (x, SolverNodeState x y))) Int
-> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (WebLocally x (OldAndNew (x, SolverNodeState x y))) Int
forall x y. Lens' (WebLocally x y) Int
thisNodeId) | (x
xN,SolverNodeState x y
_) <- [(x, SolverNodeState x y)]
l]
                              ]
                           possibleConflicts :: [ℝ]
possibleConflicts = [ Metric x -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric x
locMetr Needle x
v
                                               | (Needle x
v,Int
nnId)<-[(Needle x, Int)]
neighbourCandidates
                                               , Int
nnId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
myId ]
                     , Bool
isOld Bool -> Bool -> Bool
|| [ℝ] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ℝ]
possibleConflicts
                         Bool -> Bool -> Bool
|| [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ℝ]
possibleConflicts ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
oldMinDistSq ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
4
                     ]
               where focused :: [(Bool, (x, SolverNodeState x y))]
focused = OldAndNew (x, SolverNodeState x y)
-> [(Bool, (x, SolverNodeState x y))]
forall d. OldAndNew d -> [(Bool, d)]
oldAndNew' (OldAndNew (x, SolverNodeState x y)
 -> [(Bool, (x, SolverNodeState x y))])
-> OldAndNew (x, SolverNodeState x y)
-> [(Bool, (x, SolverNodeState x y))]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
locWebWebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> Getting
     (WebLocally x (OldAndNew (x, SolverNodeState x y)))
     (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
     (WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> WebLocally x (OldAndNew (x, SolverNodeState x y))
forall s a. s -> Getting a s a -> a
^.Getting
  (WebLocally x (OldAndNew (x, SolverNodeState x y)))
  (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
  (WebLocally x (OldAndNew (x, SolverNodeState x y)))
forall x y. Lens' (WebLocally x y) y
thisNodeDataWebLocally x (OldAndNew (x, SolverNodeState x y))
-> Getting
     (OldAndNew (x, SolverNodeState x y))
     (WebLocally x (OldAndNew (x, SolverNodeState x y)))
     (OldAndNew (x, SolverNodeState x y))
-> OldAndNew (x, SolverNodeState x y)
forall s a. s -> Getting a s a -> a
^.Getting
  (OldAndNew (x, SolverNodeState x y))
  (WebLocally x (OldAndNew (x, SolverNodeState x y)))
  (OldAndNew (x, SolverNodeState x y))
forall x y. Lens' (WebLocally x y) y
thisNodeData
                     knownNgbs :: [(Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y)))]
knownNgbs = (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
 -> WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> (Needle x,
    WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
-> (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y)))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> WebLocally x (OldAndNew (x, SolverNodeState x y))
forall x y. WebLocally x y -> y
_thisNodeData ((Needle x,
  WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
 -> (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y))))
-> ((Int,
     (Needle x,
      WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))
    -> (Needle x,
        WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))
-> (Int,
    (Needle x,
     WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))
-> (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y)))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Int,
 (Needle x,
  WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))
-> (Needle x,
    WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ((Int,
  (Needle x,
   WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))
 -> (Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y))))
-> [(Int,
     (Needle x,
      WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))]
-> [(Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y)))]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
locWebWebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))
-> Getting
     [(Int,
       (Needle x,
        WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))]
     (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
     [(Int,
       (Needle x,
        WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))]
-> [(Int,
     (Needle x,
      WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Int,
    (Needle x,
     WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))]
  (WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y))))
  [(Int,
    (Needle x,
     WebLocally x (WebLocally x (OldAndNew (x, SolverNodeState x y)))))]
forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                     oldMinDistSq :: ℝ
oldMinDistSq = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ Metric x -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric x
locMetr Needle x
vOld
                                            | (Needle x
_,WebLocally x (OldAndNew (x, SolverNodeState x y))
ngb) <- [(Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y)))]
knownNgbs
                                            , let Just Needle x
vOld = WebLocally x (OldAndNew (x, SolverNodeState x y))
ngbWebLocally x (OldAndNew (x, SolverNodeState x y))
-> Getting x (WebLocally x (OldAndNew (x, SolverNodeState x y))) x
-> x
forall s a. s -> Getting a s a -> a
^.Getting x (WebLocally x (OldAndNew (x, SolverNodeState x y))) x
forall x y. Lens' (WebLocally x y) x
thisNodeCoord x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. x
xOld
                                            ]
                              
recomputeJacobian :: ( ModellableRelation x y )
             => PointsWeb x (SolverNodeState x y)
             -> PointsWeb x (SolverNodeState x y)
recomputeJacobian :: PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
recomputeJacobian = PointsWeb x (SolverNodeState x y)
-> PointsWeb x (WebLocally x (SolverNodeState x y))
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo
                (PointsWeb x (SolverNodeState x y)
 -> PointsWeb x (WebLocally x (SolverNodeState x y)))
-> (PointsWeb x (WebLocally x (SolverNodeState x y))
    -> PointsWeb x (SolverNodeState x y))
-> PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (WebLocally x (SolverNodeState x y) -> SolverNodeState x y)
-> PointsWeb x (WebLocally x (SolverNodeState x y))
-> PointsWeb x (SolverNodeState x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap ((WebLocally x (SolverNodeState x y) -> SolverNodeState x y
forall x y. WebLocally x y -> y
_thisNodeData
                           (WebLocally x (SolverNodeState x y) -> SolverNodeState x y)
-> (WebLocally x (SolverNodeState x y)
    -> Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
-> WebLocally x (SolverNodeState x y)
-> (SolverNodeState x y,
    Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& WebLocally x (Shade' y)
-> Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
forall x y.
ModellableRelation x y =>
WebLocally x (Shade' y) -> Shade' (LocalLinear x y)
differentiateUncertainWebLocally
                                   (WebLocally x (Shade' y)
 -> Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
-> (WebLocally x (SolverNodeState x y) -> WebLocally x (Shade' y))
-> WebLocally x (SolverNodeState x y)
-> Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (SolverNodeState x y -> Shade' y)
-> WebLocally x (SolverNodeState x y) -> WebLocally x (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (ConvexSet y -> Shade' y
forall x. ConvexSet x -> Shade' x
convexSetHull (ConvexSet y -> Shade' y)
-> (SolverNodeState x y -> ConvexSet y)
-> SolverNodeState x y
-> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. SolverNodeState x y -> ConvexSet y
forall x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus))
                          (WebLocally x (SolverNodeState x y)
 -> (SolverNodeState x y,
     Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))))
-> ((SolverNodeState x y,
     Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
    -> SolverNodeState x y)
-> WebLocally x (SolverNodeState x y)
-> SolverNodeState x y
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \(SolverNodeState x y
nst, Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
shj) -> SolverNodeState x y
nst SolverNodeState x y
-> (SolverNodeState x y -> SolverNodeState x y)
-> SolverNodeState x y
forall a b. a -> (a -> b) -> b
& (Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
 -> Identity
      (Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))))
-> SolverNodeState x y -> Identity (SolverNodeState x y)
forall x y x.
Lens
  (SolverNodeState x y)
  (SolverNodeState x y)
  (Shade' (LocalLinear x y))
  (Shade' (LocalLinear x y))
solverNodeJacobian ((Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
  -> Identity
       (Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))))
 -> SolverNodeState x y -> Identity (SolverNodeState x y))
-> Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
-> SolverNodeState x y
-> SolverNodeState x y
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
shj )


iterateFilterDEqn_adaptive
     :: ( ModellableRelation x y, AffineManifold y
        , LocalModel ㄇ, Hask.Monad m )
       => MetricChoice x      -- ^ Scalar product on the domain, for regularising the web.
       -> InconsistencyStrategy m x (Shade' y)
       -> DifferentialEqn ㄇ x y
       -> (x -> Shade' y -> ℝ) -- ^ Badness function for local results.
             -> PointsWeb x (Shade' y) -> [PointsWeb x (Shade' y)]
iterateFilterDEqn_adaptive :: MetricChoice x
-> InconsistencyStrategy m x (Shade' y)
-> DifferentialEqn ㄇ x y
-> (x -> Shade' y -> ℝ)
-> PointsWeb x (Shade' y)
-> [PointsWeb x (Shade' y)]
iterateFilterDEqn_adaptive MetricChoice x
mf InconsistencyStrategy m x (Shade' y)
strategy DifferentialEqn ㄇ x y
f x -> Shade' y -> ℝ
badness
    = (PointsWeb x (SolverNodeState x y) -> PointsWeb x (Shade' y))
-> [PointsWeb x (SolverNodeState x y)] -> [PointsWeb x (Shade' y)]
forall a b. (a -> b) -> [a] -> [b]
map ((SolverNodeState x y -> Shade' y)
-> PointsWeb x (SolverNodeState x y) -> PointsWeb x (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (ConvexSet y -> Shade' y
forall x. ConvexSet x -> Shade' x
convexSetHull (ConvexSet y -> Shade' y)
-> (SolverNodeState x y -> ConvexSet y)
-> SolverNodeState x y
-> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. SolverNodeState x y -> ConvexSet y
forall x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus))
    ([PointsWeb x (SolverNodeState x y)] -> [PointsWeb x (Shade' y)])
-> (PointsWeb x (Shade' y) -> [PointsWeb x (SolverNodeState x y)])
-> PointsWeb x (Shade' y)
-> [PointsWeb x (Shade' y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. InconsistencyStrategy m x (Shade' y)
-> (PointsWeb x (SolverNodeState x y)
    -> m (PointsWeb x (SolverNodeState x y)))
-> PointsWeb x (SolverNodeState x y)
-> [PointsWeb x (SolverNodeState x y)]
forall (m :: * -> *) x y a.
InconsistencyStrategy m x y -> (a -> m a) -> a -> [a]
itWhileJust InconsistencyStrategy m x (Shade' y)
strategy (MetricChoice x
-> InconsistencyStrategy m x (Shade' y)
-> DifferentialEqn ㄇ x y
-> (x -> Shade' y -> ℝ)
-> PointsWeb x (SolverNodeState x y)
-> m (PointsWeb x (SolverNodeState x y))
forall x y (ㄇ :: * -> * -> *) ð badness (m :: * -> *).
(ModellableRelation x y, AffineManifold y, badness ~ ℝ, Monad m,
 LocalModel ㄇ) =>
MetricChoice x
-> InconsistencyStrategy m x (Shade' y)
-> DifferentialEqn ㄇ x y
-> (x -> Shade' y -> badness)
-> PointsWeb x (SolverNodeState x y)
-> m (PointsWeb x (SolverNodeState x y))
filterDEqnSolutions_adaptive MetricChoice x
mf InconsistencyStrategy m x (Shade' y)
strategy DifferentialEqn ㄇ x y
f x -> Shade' y -> ℝ
badness)
    (PointsWeb x (SolverNodeState x y)
 -> [PointsWeb x (SolverNodeState x y)])
-> (PointsWeb x (Shade' y) -> PointsWeb x (SolverNodeState x y))
-> PointsWeb x (Shade' y)
-> [PointsWeb x (SolverNodeState x y)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
forall x y.
ModellableRelation x y =>
PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
recomputeJacobian
    (PointsWeb x (SolverNodeState x y)
 -> PointsWeb x (SolverNodeState x y))
-> (PointsWeb x (Shade' y) -> PointsWeb x (SolverNodeState x y))
-> PointsWeb x (Shade' y)
-> PointsWeb x (SolverNodeState x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (((x, Shade' y), [(Needle x, Shade' y)]) -> SolverNodeState x y)
-> PointsWeb x ((x, Shade' y), [(Needle x, Shade' y)])
-> PointsWeb x (SolverNodeState x y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (\((x
x,Shade' y
shy),[(Needle x, Shade' y)]
_) -> ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo (Shade' y -> ConvexSet y
forall x. Shade' x -> ConvexSet x
ellipsoid Shade' y
shy)
                                           (LinearMap (Scalar (Needle x)) (Needle x) (Diff y)
-> Metric (LinearMap (Scalar (Needle x)) (Needle x) (Diff y))
-> Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Diff y))
forall x. x -> Metric x -> Shade' x
Shade' LinearMap (Scalar (Needle x)) (Needle x) (Diff y)
forall v. AdditiveGroup v => v
zeroV Metric (LinearMap (Scalar (Needle x)) (Needle x) (Diff y))
forall a. Monoid a => a
mempty)
                                           (x -> Shade' y -> ℝ
badness x
x Shade' y
shy)
                                           Int
1
           )
    (PointsWeb x ((x, Shade' y), [(Needle x, Shade' y)])
 -> PointsWeb x (SolverNodeState x y))
-> (PointsWeb x (Shade' y)
    -> PointsWeb x ((x, Shade' y), [(Needle x, Shade' y)]))
-> PointsWeb x (Shade' y)
-> PointsWeb x (SolverNodeState x y)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. PointsWeb x (Shade' y)
-> PointsWeb x ((x, Shade' y), [(Needle x, Shade' y)])
forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x ((x, y), [(Needle x, y)])
localFocusWeb