-- |
-- 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.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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> [(x, y)] -> PointsWeb x y
unlinkedFromWebNodes MetricChoice x
mf = forall x y.
SimpleSpace (Needle x) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
unlinkedFromShaded MetricChoice x
mf 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 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> [(x, y)] -> PointsWeb x y
fromWebNodes MetricChoice x
mf = forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded MetricChoice x
mf 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 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> [((x, [Int + Needle x]), y)] -> PointsWeb x y
fromTopWebNodes MetricChoice x
mf = forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x ([Int + Needle x], y) -> PointsWeb x y
fromTopShaded MetricChoice x
mf 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 x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
[(x, y)] -> Shaded x y
fromLeafPoints_ 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 b. (a -> b) -> [a] -> [b]
map 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 :: forall x.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
ShadeTree x -> PointsWeb x ()
fromShadeTree_auto = forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded (forall v. SimpleSpace v => Variance v -> Norm v
dualNorm' 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 x. Shade x -> Metric' x
_shadeExpanse) 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 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 :: forall x.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
(Shade x -> Metric x) -> ShadeTree x -> PointsWeb x ()
fromShadeTree Shade x -> Metric x
mf = forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded Shade x -> Metric x
mf 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 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
fromShaded MetricChoice x
metricf = forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> PointsWeb x y -> PointsWeb x y
knitShortcuts MetricChoice x
metricf 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 x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
PointsWeb x y -> PointsWeb x y
autoLinkWeb 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 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 :: forall x y.
WithField ℝ PseudoAffine x =>
PointsWeb x y -> Shaded x y
toShaded (PointsWeb Shaded x (Neighbourhood x y)
shd) = 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 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 :: forall x y.
SimpleSpace (Needle x) =>
MetricChoice x -> Shaded x y -> PointsWeb x y
unlinkedFromShaded MetricChoice x
metricf = forall a b. Shaded a (Neighbourhood a b) -> PointsWeb a b
PointsWebforall (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 (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 forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
`id` \y
y
                -> forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y forall a. Monoid a => a
mempty Metric x
nm (forall a. a -> Maybe a
Just DualVector (Needle x)
dv)
 where nm :: Metric x
nm = MetricChoice x
metricf $String
Shade x
String -> PlaceholderException
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 :: DualVector (Needle x)
dv = forall a. [a] -> a
head forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
PointsWeb x y -> PointsWeb x y
autoLinkWeb = forall a. Identity a -> a
runIdentity 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 (f :: * -> *) x y z.
Applicative f =>
(NodeInWeb x y -> f (Neighbourhood x z))
-> PointsWeb x y -> f (PointsWeb x z)
traverseNodesInEnvi ( forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure 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 []
                                                  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 κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& forall {x} {y}.
(Scalar (Needle x) ~ ℝ, Scalar (DualVector (Needle x)) ~ ℝ,
 PseudoAffine 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 DualVector (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) forall a. a -> [a] -> [a]
: [(Int, Needle x)]
alreadyFound)
                ( forall x y.
(x, Neighbourhood x y)
-> [(Shaded x (Neighbourhood x y), Int)] -> NodeInWeb x y
NodeInWeb (x
x, forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y (forall a. Unbox a => a -> Vector a -> Vector a
UArr.cons Int
δi Vector Int
aprNgbs) Metric x
locMetr
                                  forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ if Int
dimension forall a. Ord a => a -> a -> Bool
> Int
1
                                     then forall v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> v -> (DualVector v, [v]) -> Maybe (DualVector v)
pumpHalfspace Metric x
locMetr Needle x
v
                                                 (DualVector (Needle x)
wall, forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (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
                                            [] -> forall a. a -> Maybe a
Just forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric x
locMetrforall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle x
v
                                            [(Int, 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)) <- forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
                                  [ (Int
δi, ((Needle x
v, if Int
dimension forall a. Ord a => a -> a -> Bool
> Int
1
                                               then forall r. LinkingBadness r -> r
gatherDirectionsBadness
                                                 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
xpforall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
x
                                        distSq :: Scalar (Needle x)
distSq = forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric x
locMetr Needle x
v
                                        wallDist :: Scalar (Needle x)
wallDist = DualVector (Needle x)
wallnforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
v
                                  , Scalar (Needle x)
wallDist forall a. Ord a => a -> a -> Bool
>= ℝ
0
                                  , Scalar (Needle x)
distSq forall a. Ord a => a -> a -> Bool
> Scalar (Needle x)
wallDistforall a. Num a => a -> Int -> a
^Int
2
                                     Bool -> Bool -> Bool
|| Int
dimensionforall 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 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 (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => a -> a -> Bool
==Int
δi) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Unbox a => Vector a -> [a]
UArr.toList Vector Int
aprNgbs
                                                        forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst [(Int, Needle x)]
alreadyFound
                                  ] ]
              locMetr' :: Variance (Needle x)
locMetr' = forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric x
locMetr
              walln :: DualVector (Needle x)
walln = DualVector (Needle x)
wall forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (- (Variance (Needle x)
locMetr'forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|DualVector (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))
                  = (forall a b. [a] -> [b] -> [(a, b)]
zip [-Int
iwforall a. Num a => a -> a -> a
-Int
iSpl ..] [(x, Neighbourhood x y)]
preds forall a. [a] -> [a] -> [a]
++ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
wedgeSizeforall a. Num a => a -> a -> a
-Int
iw ..] [(x, Neighbourhood x y)]
succs)
                     forall a. a -> [a] -> [a]
: (Int, Int) -> NodeInWeb x y -> [[(Int, (x, Neighbourhood x y))]]
findEnviPts (Int
iwforall a. Num a => a -> a -> a
+Int
iSpl, Int
wedgeSize forall a. Num a => a -> a -> a
+ Int
iSpl forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(x, Neighbourhood x y)]
succs)
                                   (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) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
iSpl forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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 = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> Shaded x ([Int + Needle x], y) -> PointsWeb x y
fromTopShaded MetricChoice x
metricf Shaded x ([Int + Needle x], y)
shd = $String
PointsWeb x y
String -> PlaceholderException
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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> PointsWeb x y -> PointsWeb x y
smoothenWebTopology = 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> PointsWeb x y -> PointsWeb x y
knitShortcuts MetricChoice x
metricf PointsWeb x y
w₀ = 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
                             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 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 = 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
                          forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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 = forall (f :: * -> *) n a.
(Foldable f, Floating n) =>
(a -> n) -> f a -> n
geometricMeanOf WebLocally x y -> ℝ
rateNode 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 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 = forall (f :: * -> *) n a.
(Foldable f, Floating n) =>
(a -> n) -> f a -> n
geometricMeanOf
             (\(Int
_, (Needle x
δx,WebLocally x y
_)) -> WebLocally x y
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProductforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|Needle x
δx)
             forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x y
infoforall s a. s -> Getting a s a -> a
^.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 = forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst 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 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 forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> [(i, v)] -> ([(i, v)], Maybe (DualVector v))
bestNeighbours' Norm (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
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane -> [(Int, Needle x)]
links
                         | Bool
otherwise  ->
                             [(Int, Needle x)]
links forall a. [a] -> [a] -> [a]
++ Maybe (DualVector (Needle x))
-> [Needle x] -> [[(Int, Needle x)]] -> [(Int, Needle x)]
go (forall a. a -> Maybe a
Just DualVector (Needle x)
newWall) ((forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Int, Needle x)]
links) 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 forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v
-> Variance v
-> DualVector v
-> [v]
-> [(i, v)]
-> [(i, v)]
-> ([(i, v)], Maybe (DualVector v))
gatherGoodNeighbours
                               Norm (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
meforall s a. s -> Getting a s a -> a
^.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 forall a. [a] -> [a] -> [a]
++ Maybe (DualVector (Needle x))
-> [Needle x] -> [[(Int, Needle x)]] -> [(Int, Needle x)]
go (forall a. a -> Maybe a
Just DualVector (Needle x)
newWall) ((forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Int, Needle x)]
links) 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' :: Norm (Needle x)
lm' = WebLocally x y
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct :: Metric x
              lm :: Variance (Needle x)
lm = forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Norm (Needle x)
lm'
              candidates :: [[(WebNodeId, Needle x)]]
              candidates :: [[(Int, Needle x)]]
candidates = [(Int, Needle x)]
preferred forall a. a -> [a] -> [a]
: [[(Int, Needle x)]]
other
               where ([(Int, Needle x)]
preferred, [[(Int, Needle x)]]
other) = case 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 -> ( forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall x y. WebLocally x y -> Int
_thisNodeId 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 (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap 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₁forall a. [a] -> [a] -> [a]
++[(Needle x, WebLocally x y)]
l₂)
                                       , forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall x y. WebLocally x y -> Int
_thisNodeId 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 (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap) 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₁] -> (forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall x y. WebLocally x y -> Int
_thisNodeId 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 (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap 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 = [(DualVector (Needle x), Needle x)]
-> [((DualVector (Needle x), Needle x), WebLocally x y)] -> [Int]
go [ (DualVector (Needle x)
dv,Needle x
v) forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ forall a. Floating a => a -> a
sqrt (DualVector (Needle x)
dvforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
v)
                                 | (Int
i,(Needle x
v,WebLocally x y
_)) <- WebLocally x y
meforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                 , let dv :: DualVector (Needle x)
dv = Norm (Needle x)
metricforall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle x
v ]
                                 [((DualVector (Needle x), Needle x), WebLocally x y)]
candidates
        where go :: [OSNeedle x] -> [OSNode x y] -> [WebNodeId]
              go :: [(DualVector (Needle x), Needle x)]
-> [((DualVector (Needle x), Needle x), WebLocally x y)] -> [Int]
go [(DualVector (Needle x), Needle x)]
existing [((DualVector (Needle x), Needle x), WebLocally x y)]
fillSrc = case [(DualVector (Needle x), Needle x)]
-> Maybe (DualVector (Needle x), ℝ)
constructUninhabitedCone [(DualVector (Needle x), Needle x)]
existing of
                    Maybe (DualVector (Needle x), ℝ)
Nothing -> forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> WebLocally x y
meforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                    Just (DualVector (Needle x), ℝ)
cone -> case (DualVector (Needle x), ℝ)
-> [((DualVector (Needle x), Needle x), WebLocally x y)]
-> Maybe
     (((DualVector (Needle x), Needle x), WebLocally x y),
      [((DualVector (Needle x), Needle x), WebLocally x y)])
findInCone (DualVector (Needle x), ℝ)
cone [((DualVector (Needle x), Needle x), WebLocally x y)]
fillSrc of
                      Just (((DualVector (Needle x), Needle x)
fv,WebLocally x y
filler),[((DualVector (Needle x), Needle x), WebLocally x y)]
fillSrc')
                              -> (WebLocally x y
fillerforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId) forall a. a -> [a] -> [a]
: [(DualVector (Needle x), Needle x)]
-> [((DualVector (Needle x), Needle x), WebLocally x y)] -> [Int]
go ((DualVector (Needle x), Needle x)
fvforall a. a -> [a] -> [a]
:[(DualVector (Needle x), Needle x)]
existing) [((DualVector (Needle x), Needle x), WebLocally x y)]
fillSrc'
                      Maybe
  (((DualVector (Needle x), Needle x), WebLocally x y),
   [((DualVector (Needle x), Needle x), WebLocally x y)])
Nothing -> forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> WebLocally x y
meforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
              constructUninhabitedCone :: [OSNeedle x] -> Maybe (CPCone x)
              constructUninhabitedCone :: [(DualVector (Needle x), Needle x)]
-> Maybe (DualVector (Needle x), ℝ)
constructUninhabitedCone [(DualVector (Needle x), Needle x)]
vs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Bool -> Bool
notforall κ (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 (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any`[(DualVector (Needle x), Needle x)]
vs)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
.(DualVector (Needle x), ℝ)
-> (DualVector (Needle x), Needle x) -> Bool
includes)
                                              forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a.
[(DualVector (Needle x), a)] -> (DualVector (Needle x), ℝ)
coneBetween forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Int -> [a] -> [[a]]
choices Int
dimension [(DualVector (Needle x), Needle x)]
vs
               where coneBetween :: [(Needle' x, a)] -> (Needle' x, ℝ)
                     coneBetween :: forall a.
[(DualVector (Needle x), a)] -> (DualVector (Needle x), ℝ)
coneBetween [(DualVector (Needle x), a)]
dvs = (DualVector (Needle x)
coneDir, (Variance (Needle x)
coMetricforall 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 = forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst 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 :: (DualVector (Needle x), ℝ)
-> [((DualVector (Needle x), Needle x), WebLocally x y)]
-> Maybe
     (((DualVector (Needle x), Needle x), WebLocally x y),
      [((DualVector (Needle x), Needle x), WebLocally x y)])
findInCone (DualVector (Needle x), ℝ)
cone (((DualVector (Needle x), Needle x)
po,WebLocally x y
pn):[((DualVector (Needle x), Needle x), WebLocally x y)]
ps) | (DualVector (Needle x), ℝ)
cone(DualVector (Needle x), ℝ)
-> (DualVector (Needle x), Needle x) -> Bool
`includes`(DualVector (Needle x), Needle x)
po  = forall a. a -> Maybe a
Just (((DualVector (Needle x), Needle x)
po,WebLocally x y
pn), [((DualVector (Needle x), Needle x), WebLocally x y)]
ps)
              findInCone (DualVector (Needle x)
coneDir, ℝ
_) (((DualVector (Needle x), Needle x)
po,WebLocally x y
pn):[((DualVector (Needle x), Needle x), WebLocally x y)]
_)
                | Just DualVector (Needle x)
wall <- WebLocally x y
pnforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                , DualSpaceWitness (Needle x)
DualSpaceWitness <- forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                , x
testp <- WebLocally x y
pnforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord forall x. Semimanifold x => x -> Needle x -> x
.+~^ (Variance (Needle x)
coMetricforall v. LSpace v => Norm v -> v -> DualVector v
<$|DualVector (Needle x)
wall)
                , (Norm (Needle x)
metric forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| x
testpforall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!WebLocally x y
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord) forall a. Ord a => a -> a -> Bool
> (Norm (Needle x)
metricforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd (DualVector (Needle x), Needle x)
po)
                    = forall a. Maybe a
Nothing
              findInCone (DualVector (Needle x), ℝ)
cone (((DualVector (Needle x), Needle x), WebLocally x y)
p:[((DualVector (Needle x), Needle x), WebLocally x y)]
ps) = forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (((DualVector (Needle x), Needle x), WebLocally x y)
pforall a. a -> [a] -> [a]
:) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (DualVector (Needle x), ℝ)
-> [((DualVector (Needle x), Needle x), WebLocally x y)]
-> Maybe
     (((DualVector (Needle x), Needle x), WebLocally x y),
      [((DualVector (Needle x), Needle x), WebLocally x y)])
findInCone (DualVector (Needle x), ℝ)
cone [((DualVector (Needle x), Needle x), WebLocally x y)]
ps
              findInCone (DualVector (Needle x), ℝ)
_ [] = forall a. Maybe a
Nothing
              includes :: CPCone x -> OSNeedle x -> Bool
              (DualVector (Needle x)
coneDir, ℝ
narrowing)includes :: (DualVector (Needle x), ℝ)
-> (DualVector (Needle x), Needle x) -> Bool
`includes`(DualVector (Needle x)
_, Needle x
v) = DualVector (Needle x)
coneDirforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
v forall a. Ord a => a -> a -> Bool
>= ℝ
narrowing
              candidates :: [OSNode x y]
              candidates :: [((DualVector (Needle x), Needle x), WebLocally x y)]
candidates = case 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 -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                                                [ (Scalar (Needle x)
distSq, ((DualVector (Needle x)
dv,Needle x
v) 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 = Norm (Needle x)
metricforall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle x
v
                                                      distSq :: Scalar (Needle x)
distSq = DualVector (Needle x)
dvforall 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 :: Norm (Needle x)
metric = WebLocally x y
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct
              coMetric :: Variance (Needle x)
coMetric = forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Norm (Needle x)
metric
       dimension :: Int
dimension = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis (Needle x))

choices :: Int -> [a] -> [[a]]
choices :: forall a. Int -> [a] -> [[a]]
choices Int
n [a]
l = forall {t} {a} {a}.
(Eq t, Num t) =>
t -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go Int
n [a]
l forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id []
 where go :: t -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go t
0 [a]
_ [a] -> [a]
f = ([a] -> [a]
f[]forall a. a -> [a] -> [a]
:)
       go t
_ [] [a] -> [a]
_ = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
       go t
n (a
x:[a]
xs) [a] -> [a]
f = t -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go t
n [a]
xs [a] -> [a]
f 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
. t -> [a] -> ([a] -> [a]) -> [[a]] -> [[a]]
go (t
nforall a. Num a => a -> a -> a
-t
1) [a]
xs ((a
xforall 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 :: forall (f :: * -> *) n a.
(Foldable f, Fractional n) =>
(a -> n) -> f a -> n
meanOf a -> n
f = forall {a} {a}. (Fractional a, Integral a) => (a, a) -> a
renormalise 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 (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
accforall a. Fractional 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
accforall a. Num a => a -> a -> a
+a -> n
f a
x, forall a. Enum a => a -> a
succ Int
n)

geometricMeanOf :: (Hask.Foldable f, Floating n) => (a -> n) -> f a -> n
geometricMeanOf :: forall (f :: * -> *) n a.
(Foldable f, Floating n) =>
(a -> n) -> f a -> n
geometricMeanOf a -> n
f = forall a. Floating a => a -> a
exp 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 (f :: * -> *) n a.
(Foldable f, Fractional n) =>
(a -> n) -> f a -> n
meanOf (forall a. Floating a => a -> a
log 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 :: forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> [(Cutplane x, y)]
webBoundary = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo 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
>>> forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList 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
>>> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Hask.concatMapforall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
`id`
        \WebLocally x y
info -> [ (forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane (WebLocally x y
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord) (forall v. DualVector v -> Stiefel1 v
Stiefel1 DualVector (Needle x)
wall), WebLocally x y
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
                 | Just DualVector (Needle x)
wall <- [WebLocally x y
infoforall s a. s -> Getting a s a -> a
^.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 :: forall a b y.
(Manifold a, Manifold b, LocallyCoercible a b,
 SimpleSpace (Needle b)) =>
PointsWeb a y -> PointsWeb b y
coerceWebDomain (PointsWeb Shaded a (Neighbourhood a y)
web) = forall a b. Shaded a (Neighbourhood a b) -> PointsWeb a b
PointsWeb
     forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y ξ υ.
(NonEmpty (x, y) -> NonEmpty (ξ, υ))
-> (Needle' x -> Needle' ξ)
-> (Shade x -> Shade ξ)
-> Shaded x y
-> Shaded ξ υ
unsafeFmapTree ( 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 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 (DualVector (Needle a))
bndry)
                            -> ( forall x ξ. LocallyCoercible x ξ => x -> ξ
locallyTrivialDiffeomorphism a
x
                               , forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y Vector Int
ngbs
                                       (forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Metric x -> Metric ξ
coerceNorm ([]::[(a,b)]) Metric a
lscl)
                                       (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 DualVector (Needle a) -> DualVector (Needle b)
crcNeedle' Maybe (DualVector (Needle a))
bndry) ) )
                      DualVector (Needle a) -> DualVector (Needle b)
crcNeedle' 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' :: DualVector (Needle a) -> DualVector (Needle b)
crcNeedle' = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle a)
                         , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle b) ) of
           (DualSpaceWitness (Needle a)
DualSpaceWitness, DualSpaceWitness (Needle b)
DualSpaceWitness) -> 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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle' x -+> Needle' ξ
coerceNeedle' ([]::[(a,b)])


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

type InterpolationSeq y = [InterpolationIv y]

mkInterpolationSeq_lin :: (x~ℝ, Geodesic y)
           => [(x,y)] -> InterpolationSeq y
mkInterpolationSeq_lin :: forall x y. (x ~ ℝ, Geodesic y) => [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin [(x
xψ,y
yψ), (x
xω,y
yω)]
       = forall (m :: * -> *) a. Monad m (->) => a -> m a
return forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall y. (ℝ, ℝ) -> (ℝ -> y) -> InterpolationIv y
InterpolationIv
           (x
xψ,x
xω)
           (\ℝ
x -> let drel :: D¹
drel = ℝ -> D¹
fromIntv0to1 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ
xforall a. Num a => a -> a -> a
-x
xψ)forall a. Fractional a => a -> a -> a
/(x
xωforall a. Num a => a -> a -> a
-x
xψ)
                  in D¹ -> y
yio D¹
drel )
 where Just D¹ -> y
yio = 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)
    = forall x y. (x ~ ℝ, Geodesic y) => [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin [(x, y)
p₀,(x, y)
p₁] forall a. Semigroup a => a -> a -> a
<> forall x y. (x ~ ℝ, Geodesic y) => [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin ((x, y)
p₁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 :: 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)]
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₁) <- 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₁] = forall a. Ord a => [a] -> [a]
sort [Int
il,Int
ir] ]
              ]
       (Graph
graph, Int -> (x, y)
gnodes) = 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 <- [forall x.
WithField ℝ Manifold x =>
Cutplane x -> (x, x) -> Maybe D¹
cutPosBetween Cutplane x
cp (x
x₀,x
x₁)]
                      , Just D¹ -> x
xi <- [forall x. Geodesic x => x -> x -> Maybe (D¹ -> x)
geodesicBetween x
x₀ x
x₁]
                      , Just D¹ -> y
yi <- [forall x. Geodesic x => x -> x -> Maybe (D¹ -> x)
geodesicBetween y
y₀ y
y₁]
                      ]



data GridPlanes x = GridPlanes {
        forall x. GridPlanes x -> Needle' x
_gridPlaneNormal :: Needle' x
      , forall x. GridPlanes x -> Needle x
_gridPlaneSpacing :: Needle x
      , forall x. GridPlanes x -> Int
_gridPlanesCount :: Int
      }
deriving instance (Show x, Show (Needle x), Show (Needle' x)) => Show (GridPlanes x)
data GridSetup x = GridSetup {
        forall x. GridSetup x -> x
_gridStartCorner :: x
      , forall 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 :: forall x y.
(x ~ ℝ, y ~ ℝ) =>
((x, x), Int) -> ((y, y), Int) -> GridSetup (x, y)
cartesianGrid2D ((x
x₀,x
x₁), Int
nx) ((y
y₀,y
y₁), Int
ny)
    = forall x. x -> [GridPlanes x] -> GridSetup x
GridSetup (x
x₀forall a. Num a => a -> a -> a
+x
dxforall a. Fractional a => a -> a -> a
/x
2, y
y₀forall a. Num a => a -> a -> a
+y
dyforall a. Fractional a => a -> a -> a
/y
2)
                [ forall x. Needle' x -> Needle x -> Int -> GridPlanes x
GridPlanes (ℝ
0,ℝ
1) (ℝ
0, y
dy) Int
ny, forall x. Needle' x -> Needle x -> Int -> GridPlanes x
GridPlanes (ℝ
1,ℝ
0) (x
dx, ℝ
0) Int
nx ]
 where dx :: x
dx = (x
x₁forall a. Num a => a -> a -> a
-x
x₀)forall a. Fractional a => a -> a -> a
/forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nx
       dy :: y
dy = (y
y₁forall a. Num a => a -> a -> a
-y
y₀)forall a. Fractional a => a -> a -> a
/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 :: 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
x₀ [GridPlanes Needle' x
dirΩ Needle x
spcΩ Int
nΩ, GridPlanes x
linePln])
    = [ ((x
x₀', GridPlanes x
linePln), 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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x. x -> Stiefel1 (Needle x) -> Cutplane x
Cutplane x
x₀' (forall v. DualVector v -> Stiefel1 v
Stiefel1 Needle' x
dirΩ))
      | Int
k <- [Int
0 .. Int
nΩforall a. Num a => a -> a -> a
-Int
1]
      , let x₀' :: x
x₀' = x
x₀forall x. Semimanifold x => x -> Needle x -> x
.+~^(forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k 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 :: 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
web GridSetup x
grid = ((x, GridPlanes x), [(x, y)]) -> [(x, Maybe y)]
finalLine
                                      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)
=<< 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)
          | forall (t :: * -> *) a. Foldable t => t a -> Int
length [(x, y)]
verts forall a. Ord a => a -> a -> Bool
< Int
2  = forall a. Int -> [a] -> [a]
take Int
nSpl forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (,forall (f :: * -> *) a. Alternative f => f a
empty)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>forall a. (a -> a) -> a -> [a]
iterate (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)
                     = forall a. Int -> [a] -> [a]
take Int
nSpl 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 = forall x y. (x ~ ℝ, Geodesic y) => [(x, y)] -> InterpolationSeq y
mkInterpolationSeq_lin forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                         [ (Needle' x
dx forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^ (x
xforall 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,ℝ
_) [] = (,forall (f :: * -> *) a. Alternative f => f a
empty)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>forall a. (a -> a) -> a -> [a]
iterate (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 forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((forall a. Ord a => a -> a -> Bool
<ℝ
te) 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. (a -> a) -> a -> [a]
iterate ((forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle x
dir)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 ℝ
tforall a. Ord a => a -> a -> Bool
<ℝ
tb then forall (f :: * -> *) a. Alternative f => f a
empty else forall (m :: * -> *) a. Monad m (->) => a -> m a
return 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 ]
                                     forall a. [a] -> [a] -> [a]
++ (x, ℝ) -> [InterpolationIv y] -> [(x, Maybe y)]
go (x, ℝ)
xtn [InterpolationIv y]
fs
              δt :: Scalar (Needle x)
δt = Needle' x
dxforall 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 :: 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 (xspec :: ((x, x), Int)
xspec@((x, x)
_,Int
nx)) ((y, y), Int)
yspec
       = [((ℝ, ℝ), Maybe z)] -> [(ℝ, [(ℝ, Maybe z)])]
go 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 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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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') = forall a. Int -> [a] -> ([a], [a])
splitAt Int
nx [((ℝ, ℝ), Maybe z)]
l
                             in (ℝ
y, forall a b. (a -> b) -> [a] -> [b]
map (\((ℝ
x,ℝ
_),Maybe z
z) -> (ℝ
x,Maybe z
z)) [((ℝ, ℝ), Maybe z)]
ln) 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 :: forall x y z.
(x ~ ℝ, y ~ ℝ, Geodesic z) =>
PointsWeb (x, y) z -> Int -> Int -> [(y, [(x, Maybe z)])]
sampleEntireWeb_2Dcartesian_lin PointsWeb (x, y) z
web Int
nx Int
ny
       = 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₀ = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fstforall (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₁ = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fstforall (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₀ = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (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₁ = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (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 = forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (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 :: forall x y. WebChunk x y -> PointsWeb x y
hardbakeChunk = forall x y. WebChunk x y -> PointsWeb x y
_thisChunk

entireWeb :: PointsWeb x y -> WebChunk x y
entireWeb :: forall x y. PointsWeb x y -> WebChunk x y
entireWeb PointsWeb x y
web = 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 :: forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x ((x, y), [(Needle x, y)])
localFocusWeb = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo 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
>>> 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 forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
`id`\WebLocally x y
n
           -> ( (WebLocally x y
nforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord, WebLocally x y
nforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
              , [ (Needle x
δx, WebLocally x y
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
                | (Int
_, (Needle x
δx, WebLocally x y
ngb)) <- WebLocally x y
nforall s a. s -> Getting a s a -> a
^.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 :: 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 y -> f y
fl forall (t :: * -> *) i w.
(Traversable t, Ord i) =>
(w -> f w) -> t (i, w) -> f (t w)
ct = 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 forall x y. WebChunk x y -> PointsWeb x y
hardbakeChunk 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 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 x y. PointsWeb x y -> WebChunk x y
entireWeb
 where twt :: WebChunk x y -> f (WebChunk x y)
twt = 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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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' :: 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))
ct WebChunk x y
domain
                  = $f (WebChunk x y)
String
String -> PlaceholderException
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 :: forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x y
origin [Int]
directCandidates = forall a b. (a -> b) -> [a] -> [b]
map [(Needle x, WebLocally x y)] -> [(Needle x, WebLocally x y)]
sortBCDistance 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 forall k a. Map k a
Map.empty 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 k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                      forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x y
originforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId, (Int
1, WebLocally x y
origin)) 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
originforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
               , WebLocally x y
ninfoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId 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
        | 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 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd
                                    forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
                                                 (forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList Map Int (Int, WebLocally x y)
next) )
                     forall a. a -> [a] -> [a]
: Map Int (Int, WebLocally x y)
-> Map Int (Int, WebLocally x y) -> [[(Needle x, WebLocally x y)]]
go (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)
                          (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
nforall 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))<-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
ninfoforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                             , forall k a. Ord k => k -> Map k a -> Bool
Map.notMember Int
nnid Map Int (Int, WebLocally x y)
previous Bool -> Bool -> 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
pforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. WebLocally x y
originforall s a. s -> Getting a s a -> a
^.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 = forall a b. (a -> b) -> [a] -> [b]
map forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd 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. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) 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 b. (a -> b) -> [a] -> [b]
map ((Needle x, WebLocally x y) -> Scalar (Needle x)
bcDistforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
        where bcDist :: (Needle x, WebLocally x y) -> Scalar (Needle x)
bcDist (Needle x
v,WebLocally x y
_)
                = forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq (WebLocally x y
originforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProduct) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
vforall v. AdditiveGroup v => v -> v -> v
^-^Needle x
seedBarycenterOffs
       seedBarycenterOffs :: Needle x
seedBarycenterOffs = forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV [Needle x]
ngbOffs forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
directCandidates 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
nforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. WebLocally x y
originforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord ]

webOnions :: ∀ x y . WithField ℝ Manifold x
            => PointsWeb x y -> PointsWeb x [[(x,y)]]
webOnions :: forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x [[(x, y)]]
webOnions = forall x y z.
WithField ℝ Manifold x =>
(WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y. WebLocally x y -> x
_thisNodeCoordforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall x y. WebLocally x y -> y
_thisNodeData 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
                                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 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
PointsWeb x y -> x -> Maybe (x, y)
nearestNeighbour = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo 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
                 -> 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) (forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
Maybe (Metric x)
-> Shaded x y -> x -> Maybe (Int, ([Shaded x y], (x, y)))
positionIndex 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
_ Seminorm (Needle x)
locMetr Maybe (Needle' x)
_))))
           = forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd 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 (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
              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 b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x y
cforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Metric x)
nodeLocalScalarProductforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|)
                           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 v. AdditiveGroup v => v -> v -> v
^-^Needle x
vc))
              forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (forall v. AdditiveGroup v => v
zeroV, (x
xc, WebLocally x y
cforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData))
                forall a. a -> [a] -> [a]
: [ (Needle x
δx, (WebLocally x y
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord, WebLocally x y
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData))
                  | (Int
_, (Needle x
δx, WebLocally x y
ngb)) <- WebLocally x y
cforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours ]
        where Just Needle x
vc = x
xforall 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 :: 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 z
f = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo 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
>>> 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 :: forall x (m :: * -> *) y.
(WithField ℝ Manifold x, Applicative m) =>
(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)
      = 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 -> 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) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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 :: forall x y.
ModellableRelation x y =>
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
                ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                , 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 forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally 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)
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData) )
                          forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (forall v. AdditiveGroup v => v
zeroV,WebLocally x (Shade' y)
info) forall a. a -> [a] -> [a]
: [(Needle x, WebLocally x (Shade' y))]
envi
                          of
               Just (AffineModel Shade y
_ Shade (Needle x +> Needle y)
j :: AffineModel x y) -> forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade (Needle x +> Needle y)
j
        where [(Needle x, WebLocally x (Shade' y))]
_:[(Needle x, WebLocally x (Shade' y))]
directEnvi:[[(Needle x, WebLocally x (Shade' y))]]
remoteEnvi = 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 forall a. [a] -> [a] -> [a]
++ 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 :: forall x y.
ModellableRelation x y =>
PointsWeb x (Shade' y) -> PointsWeb x (Shade' (LocalLinear x y))
differentiateUncertainWebFunction = forall x y z.
WithField ℝ Manifold x =>
(WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb 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 :: forall x y.
ModellableRelation x y =>
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
                ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                , 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 forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally 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)
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData) )
                          forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (forall v. AdditiveGroup v => v
zeroV,WebLocally x (Shade' y)
info) 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)
                        -> forall (shade :: * -> *) x y.
(IsShade shade, SimpleSpace x, SimpleSpace y, Scalar x ~ Scalar y,
 Num' (Scalar x)) =>
(x +> y) -> shade x -> shade y
linIsoTransformShade (ℝ
2forall v. VectorSpace v => Scalar v -> v -> v
*^forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade 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 = 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 forall a. [a] -> [a] -> [a]
++ 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 :: forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
PointsWeb x (Shade' y) -> [(x, ㄇ x y)]
localModels_CGrid = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
Hask.concatMap WebLocally x (Shade' y) -> [(x, ㄇ x y)]
theCGrid 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 (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList 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 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 forall x. Semimanifold x => x -> Needle x -> x
.-~^ Needle x
δxforall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
2
                         , forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
LocalDataPropPlan x (Shade' y) -> ㄇ x y
propagationCenteredModel
                             ( forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                    x
pn
                                    (forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                    (WebLocally x (Shade' y)
ngbNodeforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                    (WebLocally x (Shade' y)
nodeforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                    (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 (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall x y. WebLocally x y -> y
_thisNodeData)
                                      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 (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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. [a] -> [a]
tail
                                           forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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)
nodeforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId] )
                                          ) )
                       | (Int
nid, (Needle x
δx, WebLocally x (Shade' y)
ngbNode)) <- WebLocally x (Shade' y)
nodeforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                       , Int
nid forall a. Ord a => a -> a -> Bool
> WebLocally x (Shade' y)
nodeforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId
                       , let pn :: x
pn = WebLocally x (Shade' y)
ngbNodeforall s a. s -> Getting a s a -> a
^.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 :: forall s v y.
(RealFloat'' s, Object (Affine s) y, Object (Affine s) v,
 LinearSpace v, Scalar v ~ s) =>
Affine s y (v, y)
acoSnd = forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @y (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @y (
           forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @y (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @v (case
              ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @v
              , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle v), forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle y)
              , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @y
              ) of
   (LinearManifoldWitness v
LinearManifoldWitness, DualSpaceWitness v
DualSpaceWitness (Needle v)
DualSpaceWitness, DualSpaceWitness (Needle y)
DualSpaceWitness, SemimanifoldWitness y
SemimanifoldWitness)
       -> forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall v. AdditiveGroup v => v
zeroV forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& 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 :: forall x y.
ModellableRelation x y =>
PointsWeb x (Shade' y)
-> PointsWeb x (Shade' (Needle x ⊗〃+> Needle y))
differentiate²UncertainWebFunction = forall x y z.
WithField ℝ Manifold x =>
(WebLocally x y -> z) -> PointsWeb x y -> PointsWeb x z
localFmapWeb 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 :: forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> WebLocally x (Shade' y) -> Maybe (Shade' y)
rescanPDELocally = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x
                        , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness 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 forall a. Maybe a -> Bool
isJust forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (Shade' y)
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
              then forall (m :: * -> *) a. Monad m (->) => a -> m a
return forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (Shade' y)
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData
              else let xc :: x
xc = WebLocally x (Shade' y)
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord
                       yc :: y
yc = WebLocally x (Shade' y)
infoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeDataforall κ (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 (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr
                   in case DifferentialEqn ㄇ x y
f forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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)
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeDataforall κ (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 (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtrforall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!y
yc) forall v. AdditiveGroup v => v -> v -> v
^+^ Needle y
v)
                                     | (Int
_,(Needle x
δx,WebLocally x (Shade' y)
ngb))<-WebLocally x (Shade' y)
infoforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                     , Needle y
v <- forall v.
(FiniteDimensional v, IEEE (Scalar v)) =>
Seminorm v -> [v]
normSpanningSystem'
                                              (WebLocally x (Shade' y)
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeDataforall κ (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 x. Lens' (Shade' x) (Metric x)
shadeNarrowness)] of
                        LocalDifferentialEqn ㄇ x y -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y)))
rescan -> forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst
                             ( ㄇ x y -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y)))
rescan forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ case forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id 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 x y. WebLocally x y -> y
_thisNodeData)
                                               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)
=<< (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
ㄇ)
                                 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
>>= forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's 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. a -> [a] -> NonEmpty a
:|[WebLocally x (Shade' y)
infoforall s a. s -> Getting a s a -> a
^.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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> [(x, y)] -> PointsWeb x y
unlinkedFromWebNodes MetricChoice x
metricf
                           [(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) = forall a b. Shaded a (Neighbourhood a b) -> PointsWeb a b
PointsWeb forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
          forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
iover (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 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 (DualVector (Needle x))
bound)
                -> let neighbours :: [Int]
neighbours = Graph
gr forall i e. Ix i => Array i e -> i -> e
PArr.! Int
wi
                       neighbourwis :: [Int]
neighbourwis = (Map Int Int
vertToWebNode forall k a. Ord k => Map k a -> k -> a
Map.!) 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 forall x y.
y
-> Vector Int -> Metric x -> Maybe (Needle' x) -> Neighbourhood x y
Neighbourhood y
y
                                    (forall a. Unbox a => [a] -> Vector a
UArr.fromList forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Num a => a -> a -> a
subtract Int
wiforall (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
                                    (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd (forall i v.
(SimpleSpace v, Scalar v ~ ℝ) =>
Norm v -> [(i, v)] -> ([i], Maybe (DualVector v))
bestNeighbours Metric x
sclPr
                                            [ ((), forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst (Int -> (x, y)
dataLookup Int
ni)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 = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Int, Int)]
assocs
              vertToWebNode :: Map Int Int
vertToWebNode = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swapforall (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 = forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [Int
vert | Neighbourhood Int
vert Vector Int
_ Metric x
_ Maybe (DualVector (Needle x))
_ <- 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 :: forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
PointsWeb x y -> (Graph, Int -> (x, y))
toGraph PointsWeb x y
wb = forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (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 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})
                (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 = forall a. Vector a -> [a]
Arr.toList
            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 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
iforall a. Num a => a -> a -> a
+) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Unbox a => Vector a -> [a]
UArr.toList Vector Int
ngbs))
            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. [a] -> Vector a
Arr.fromList 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 (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc PointsWeb x y
wb




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

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

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

intersectors :: ConvexSet x -> Maybe (NonEmpty (Shade' x))
intersectors :: forall x. ConvexSet x -> Maybe (NonEmpty (Shade' x))
intersectors (ConvexSet Shade' x
h []) = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Shade' x
hforall a. a -> [a] -> NonEmpty a
:|[])
intersectors (ConvexSet Shade' x
_ (Shade' x
i:[Shade' x]
sts)) = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Shade' x
iforall a. a -> [a] -> NonEmpty a
:|[Shade' x]
sts)
intersectors ConvexSet 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 = forall a. Semigroup a => NonEmpty a -> a
sconcat (ConvexSet x
aforall a. a -> [a] -> NonEmpty a
:|[ConvexSet x
b])
  sconcat :: NonEmpty (ConvexSet x) -> ConvexSet x
sconcat NonEmpty (ConvexSet x)
csets
    | Just NonEmpty (Shade' x)
allIntersectors <- forall a. Semigroup a => NonEmpty a -> a
sconcat forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse forall x. ConvexSet x -> Maybe (NonEmpty (Shade' x))
intersectors NonEmpty (ConvexSet x)
csets
    , IntersectT NonEmpty (Shade' x)
ists <- forall (s :: * -> *) x.
(s x -> s x -> Maybe (s x)) -> IntersectT s x -> IntersectT s x
rmTautologyIntersect forall {f :: * -> *} {y}.
(Refinable y, Alternative f) =>
Shade' y -> Shade' y -> f (Shade' y)
perfectRefine forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (s :: * -> *) x. NonEmpty (s x) -> IntersectT s x
IntersectT NonEmpty (Shade' x)
allIntersectors
    , Just Shade' x
hull' <- forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's NonEmpty (Shade' x)
ists
                 = forall x. Shade' x -> [Shade' x] -> ConvexSet x
ConvexSet Shade' x
hull' (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Shade' x)
ists)
    | Bool
otherwise  = forall x. ConvexSet x
EmptyConvex
   where perfectRefine :: Shade' y -> Shade' y -> f (Shade' y)
perfectRefine Shade' y
sh₁ Shade' y
sh₂
           | Shade' y
sh₁forall y. Refinable y => Shade' y -> Shade' y -> Bool
`subShade'`Shade' y
sh₂   = 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₂forall y. Refinable y => Shade' y -> Shade' y -> Bool
`subShade'`Shade' y
sh₁   = 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           = forall (f :: * -> *) a. Alternative f => f a
empty



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

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


newtype InformationMergeStrategy n m y' y = InformationMergeStrategy
    { forall (n :: * -> *) (m :: * -> *) y' y.
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 :: forall y x.
(NonEmpty y -> y) -> InformationMergeStrategy [] Identity (x, y) y
naïve NonEmpty y -> y
merge = forall (n :: * -> *) (m :: * -> *) y' y.
(y -> n y' -> m y) -> InformationMergeStrategy n m y' y
InformationMergeStrategy (\y
o [(x, y)]
n -> forall a. a -> Identity a
Identity 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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ y
o forall a. a -> [a] -> NonEmpty a
:| 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 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 :: forall y (m :: * -> *) x.
(NonEmpty y -> m y) -> InformationMergeStrategy [] m (x, y) y
inconsistencyAware NonEmpty y -> m y
merge = 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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ y
o forall a. a -> [a] -> NonEmpty a
:| 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 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 :: forall υ x.
(NonEmpty υ -> Maybe υ)
-> InformationMergeStrategy
     [] (Except (PropagationInconsistency x υ)) (x, υ) υ
indicateInconsistencies NonEmpty υ -> Maybe υ
merge = forall (n :: * -> *) (m :: * -> *) y' y.
(y -> n y' -> m y) -> InformationMergeStrategy n m y' y
InformationMergeStrategy
           (\υ
o [(x, υ)]
n -> case NonEmpty υ -> Maybe υ
merge forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ υ
o forall a. a -> [a] -> NonEmpty a
:| 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 forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd [(x, υ)]
n of
               Just υ
r  -> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure υ
r
               Maybe υ
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x υ. [(x, υ)] -> υ -> PropagationInconsistency x υ
PropagationInconsistency [(x, υ)]
n υ
o )

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

maybeAlt :: Hask.Alternative f => Maybe a -> f a
maybeAlt :: forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeAlt (Just a
x) = 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 = 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 :: forall x y (m :: * -> *) (ㄇ :: * -> * -> *) iy.
(ModellableRelation x y, 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
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
                           = 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 (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 forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter (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)
                           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 (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 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 :: forall x y (m :: * -> *) (ㄇ :: * -> * -> *) iy.
(ModellableRelation x y, MonadPlus m, 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
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
            = 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 (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 forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 s a. State s a -> s -> a
`evalState`Int
7438)
            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 (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 <- forall (m :: * -> *) s. Monad m => StateT s m s
get
               let i :: Int
i = Int
r forall a. Integral a => a -> a -> a
`mod` forall x y. Shaded x y -> Int
nLeaves (forall x y. PointsWeb x y -> Shaded x (Neighbourhood x y)
webNodeRsc PointsWeb x iy
oldWeb)
                   m :: Int
m = Int
2forall a. Num a => a -> Int -> a
^Int
31 forall a. Num a => a -> a -> a
- Int
1
                   a :: Int
a = Int
963345    :: Int  -- revised Park-Miller
               forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Int
aforall a. Num a => a -> a -> a
*Int
r)forall a. Integral a => a -> a -> a
`mod`Int
m
               forall (m :: * -> *) a. Monad m (->) => a -> m a
return ( PointsWeb x iy
oldWeb
                      , 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
                       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)
=<<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
                      ))
            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 (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 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 :: forall x y (m :: * -> *) badness (ㄇ :: * -> * -> *) iy.
(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 (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
      = 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 (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 forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 (f :: * -> *) a. Functor f => (a -> f a) -> a -> Cofree f a
coiter (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)
      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 (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 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 :: 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
       = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo
           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
>>> 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 (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> WebLocally x (Shade' y) -> Maybe (Shade' y)
rescanPDELocally DifferentialEqn ㄇ x y
f 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 (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
shadingforall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$))
           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
>>> forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x ((x, y), [(Needle x, y)])
localFocusWeb 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
>>> 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
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData :: iy
             in if forall a. Maybe a -> Bool
isJust forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy
me forall s a. s -> Getting a s a -> a
^. forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                 then 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
                  []  -> 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)))]
_ -> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [ forall (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeAlt Maybe (Shade' y)
sj
                                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ð -> 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
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
δ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
. (Embedding (->) (Shade' y) iy
shadingforall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy iy
oldValue 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 (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList
                                  forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x iy
ngbInfoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord,)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>
                                     forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc
                                       DifferentialEqn ㄇ x y
f (forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                             (WebLocally x iy
ngbInfoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                             (forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                             Shade' y
ngbShyð
                                             Shade' y
shy
                                             (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 (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
shadingforall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 x y. WebLocally x y -> y
_thisNodeData))
                                               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 (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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. [a] -> [a]
tail forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x iy
ngbInfo
                                                                     [WebLocally x iy
meforall s a. s -> Getting a s a -> a
^.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
                                  ]
                            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
>>= 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
shadingforall (c :: * -> * -> *) a b.
(Function c, Object c a, Object c b) =>
Embedding c a b -> a -> b
$->Shade' y
shy)
              Maybe (Shade' y)
_ -> 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 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 :: 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
targetNode InformationMergeStrategy [] m (x, Shade' y) iy
strategy Embedding (->) (Shade' y) iy
shading DifferentialEqn ㄇ x y
f
       = 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) -> forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT 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 forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ WebLocally x iy
stepEndforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData
                in case forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc
                                DifferentialEqn ㄇ x y
f
                                (LocalDataPropPlan{
                                   _sourcePosition :: x
_sourcePosition = WebLocally x iy
stepStartforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord
                                 , _targetPosOffset :: Needle x
_targetPosOffset = (WebLocally x iy
stepEndforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                                        forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! (WebLocally x iy
stepStartforall s a. s -> Getting a s a -> a
^.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
                                     = (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 (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
shadingforall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 x y. WebLocally x y -> y
_thisNodeData))
                                               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 (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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. [a] -> [a]
tail forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion WebLocally x iy
stepStart
                                                                  [WebLocally x iy
stepEndforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId])
                                 }) of
                          Maybe (Shade' y)
Nothing -> forall a. HasCallStack => a
undefined
                              forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> 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
stepEndforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData) []
                          Just Shade' y
propd -> (, Shade' y
propd)
                                  forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> 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
stepEndforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                        [ ( WebLocally x iy
stepEndforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord, Shade' y
apriori )
                                        , ( WebLocally x iy
stepStartforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord, Shade' y
propd ) ] )
            (\WebLocally x iy
startPoint StateT (Shade' y) m υ
pathTrav
               -> forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (Shade' y) m υ
pathTrav forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Embedding (->) (Shade' y) iy
shading forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ WebLocally x iy
startPointforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)


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

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

averaging :: VectorSpace a => [a] -> Average a
averaging :: forall a. VectorSpace a => [a] -> Average a
averaging [a]
l = forall a. Int -> a -> Average a
Average (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) (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 :: 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
      =    -- 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.
         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 forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst 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 w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT :: WriterT (Average badness) m (PointsWeb x iy)
                                        -> m (PointsWeb x iy, Average badness))
         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 (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
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData :: iy
                 badHere :: iy -> ℝ
badHere = x -> iy -> badness
badness forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord
                 oldBadness :: ℝ
oldBadness = iy -> ℝ
badHere iy
oldValue
             in if forall a. Maybe a -> Bool
isJust forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x iy
me forall s a. s -> Getting a s a -> a
^. forall x y. Lens' (WebLocally x y) (Maybe (Needle' x))
webBoundingPlane
                 then forall (m :: * -> *) a. Monad m (->) => a -> m a
return iy
oldValue
                 else case WebLocally x iy
meforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours of
                  [] -> 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))]
_ -> forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT 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 (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, 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)))
                       forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [ 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
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
δ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
. (Embedding (->) (Shade' y) iy
shadingforall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 (n :: * -> *) (m :: * -> *) y' y.
InformationMergeStrategy n m y' y -> y -> n y' -> m y
mergeInformation InformationMergeStrategy [] m (x, Shade' y) iy
strategy iy
oldValue 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 (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList
                                  forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (WebLocally x iy
ngbInfoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord,)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>
                                     forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc
                                       DifferentialEqn ㄇ x y
f (forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                             (WebLocally x iy
ngbInfoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                             (forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                             (Embedding (->) (Shade' y) iy
shading forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ WebLocally x iy
ngbInfoforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData)
                                             (Embedding (->) (Shade' y) iy
shading forall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> a
>-$ iy
oldValue)
                                             (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 (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
shadingforall (c :: * -> * -> *) b a.
(Function c, Object c b, Object c a) =>
Embedding c a b -> b -> 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 x y. WebLocally x y -> y
_thisNodeData))
                                               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 (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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. [a] -> [a]
tail forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y.
WithField ℝ Manifold x =>
WebLocally x y -> [Int] -> [[(Needle x, WebLocally x y)]]
localOnion
                                                        WebLocally x iy
ngbInfo [WebLocally x iy
meforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId] )
                                          )
                                  | (Int
_, (Needle x
δx, WebLocally x iy
ngbInfo)) <- WebLocally x iy
meforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                  ]
                            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
>>= 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 -> forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ do
                       (t (i, w)
branchResults,[(i, ℝ)]
improvements)
                         <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse
                                          (\(i
i,w
branch) -> 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,)
                                                          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 (m :: * -> *) w w' a.
Functor m (->) (->) =>
(w -> w') -> WriterT w m a -> WriterT w' m a
censor (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure 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,) 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. Fractional a => Average a -> a
average)
                                                          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, ℝ
_) = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) [(i, ℝ)]
improvements
                       (t w
branchResults',[(i, ℝ)]
improvements')
                         <- forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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
iforall a. Eq a => a -> a -> Bool
==i
best
                                             then forall (m :: * -> *) w w' a.
Functor m (->) (->) =>
(w -> w') -> WriterT w m a -> WriterT w' m a
censor (forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure 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,) 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. Fractional a => Average a -> a
average)
                                                              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 forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (m :: * -> *) a. Monad m (->) => a -> m a
return (w
branch, 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
                       forall (m :: * -> *) a. Monad m (->) => a -> m a
return ( t w
branchResults'
                              , 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
(*) (forall a. VectorSpace a => [a] -> Average a
averaging forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(i, ℝ)]
improvements)
                                           (forall a. VectorSpace a => [a] -> Average a
averaging forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(i, ℝ)]
improvements') )
                 )
          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.
              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 -> 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
shadingforall (c :: * -> * -> *) a b.
(Function c, Object c a, Object c b) =>
Embedding c a b -> a -> b
$->)
                                         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 (f :: * -> *) a. Alternative f => Maybe a -> f a
maybeAlt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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)
            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 (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
shadingforall (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 :: forall (m :: * -> *) w w' a.
Functor m (->) (->) =>
(w -> w') -> WriterT w m a -> WriterT w' m a
censor = forall (m :: * -> *) a w (n :: * -> *) b w'.
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT 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 (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 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 :: * -> * -> *) 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 :: forall (m :: * -> *) x a.
InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency InconsistencyStrategy m x a
AbortOnInconsistency a
_ Maybe a
i = Maybe a
i
handleInconsistency InconsistencyStrategy m x a
IgnoreInconsistencies a
_ (Just a
v) = forall a. a -> Identity a
Identity a
v
handleInconsistency InconsistencyStrategy m x a
IgnoreInconsistencies a
b Maybe a
_ = forall a. a -> Identity a
Identity a
b
handleInconsistency (HighlightInconsistencies a
_) a
_ (Just a
v) = forall a. a -> Identity a
Identity a
v
handleInconsistency (HighlightInconsistencies a
b) a
_ Maybe a
_ = forall a. a -> Identity a
Identity a
b

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


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

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

oldAndNew' :: OldAndNew d -> [(Bool, d)]
oldAndNew' :: forall d. OldAndNew d -> [(Bool, d)]
oldAndNew' (Just d
x, [d]
l) = (Bool
True, d
x) forall a. a -> [a] -> [a]
: 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,) 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 :: 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
badness' PointsWeb x (SolverNodeState x y)
oldState
            = 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 forall x y.
ModellableRelation x y =>
PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
recomputeJacobian 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))
filterGo 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 
               = 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 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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
                 | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Needle x, WebLocally x (SolverNodeState x y))]
neighbourInfo = 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,) 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 b. (a -> b) -> [a] -> [b]
map (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (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 forall a. HasCallStack => a
undefined)
                                           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 = 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 (forall (m :: * -> *) x a.
InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency InconsistencyStrategy m x (Shade' y)
strategy Shade' y
thisShy) [
                                       forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc DifferentialEqn ㄇ x y
f
                                        (forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                           (WebLocally x (SolverNodeState x y)
neighforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                           (forall v. AdditiveGroup v => v -> v
negateV Needle x
δx)
                                           (forall x. ConvexSet x -> Shade' x
convexSetHull forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (SolverNodeState x y)
neighforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData
                                                                  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 x y. Lens' (SolverNodeState x y) (ConvexSet y)
solverNodeStatus)
                                           Shade' y
thisShy
                                           [ forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (forall x. ConvexSet x -> Shade' x
convexSetHull
                                                     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 x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus 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 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)
neighforall s a. s -> Getting a s a -> a
^.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 = forall x y. WebLocally x y -> x
_thisNodeCoord WebLocally x (SolverNodeState x y)
wl :: x
                     thisShy :: Shade' y
thisShy = forall x. ConvexSet x -> Shade' x
convexSetHull 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 x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y. WebLocally x y -> y
_thisNodeData WebLocally x (SolverNodeState x y)
wl
                     neighbourInfo :: [(Needle x, WebLocally x (SolverNodeState x y))]
neighbourInfo = forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall x y. WebLocally x y -> [(Int, (Needle x, WebLocally x y))]
_nodeNeighbours WebLocally x (SolverNodeState x y)
wl

       totalAge :: Int
totalAge = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y. SolverNodeState x y -> Int
_solverNodeAge 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 = (ℝ
1forall 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
$ 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 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 x. Lens' (Shade' x) (Metric x)
shadeNarrowness forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm ℝ
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
             = 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 (forall x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> PointsWeb x y -> PointsWeb x y
smoothenWebTopology MetricChoice x
mf
                                     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 x y.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
MetricChoice x -> [((x, [Int + Needle x]), y)] -> PointsWeb x y
fromTopWebNodes MetricChoice x
mf 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 (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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 (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, [Int + Needle x]), SolverNodeState x y)]
retraceBonds
                                        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 (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList 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 x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo 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 x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo)
             forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Hask.traverse (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))
localChange) PointsWeb
  x (WebLocally x (SolverNodeState x y), [(Shade' y, badness)])
preproc'd
        where smallBadnessGradient, largeBadnessGradient :: ℝ
              (ℝ
smallBadnessGradient, ℝ
largeBadnessGradient)
                  = ( [badness]
badnessGradRatedforall a. [a] -> Int -> a
!!(Int
nforall a. Integral a => a -> a -> a
`div`Int
4), [badness]
badnessGradRatedforall a. [a] -> Int -> a
!!(Int
nforall a. Num a => a -> a -> a
*Int
3forall a. Integral a => a -> a -> a
`div`Int
4) )
               where n :: Int
n = case forall (t :: * -> *) a. Foldable t => t a -> Int
length [badness]
badnessGradRated of
                           Int
0 -> forall a. HasCallStack => String -> a
error String
"No statistics available for badness-grading."
                           Int
l -> Int
l
                     badnessGradRated :: [badness]
                     badnessGradRated :: [badness]
badnessGradRated = forall a. Ord a => [a] -> [a]
sort [ badness
ngBad forall a. Fractional a => a -> a -> a
/ ℝ
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) <- 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
ngBadforall a. Ord a => a -> a -> Bool
>ℝ
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
               | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, (Needle x, WebLocally x (SolverNodeState x y)))]
ngbs  = forall (m :: * -> *) a. Monad m (->) => a -> m a
return ( forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (x
x, forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo ConvexSet y
shy Shade' (LocalLinear x y)
prevJacobi
                                                           ℝ
prevBadness (Int
ageforall a. Num a => a -> a -> a
+Int
1))
                                     , [] )
               | Bool
otherwise  = do
                      let (Int
environAge, Int
unfreshness)
                             = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximumforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int
age forall a. a -> [a] -> [a]
: (forall x y. SolverNodeState x y -> Int
_solverNodeAge 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 x y. WebLocally x y -> y
_thisNodeData
                                                               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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd 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 forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Shade' y
_, ℝ
badnessN)
                                      -> ℝ
badnessN forall a. Fractional a => a -> a -> a
/ ℝ
prevBadness forall a. Ord a => a -> a -> Bool
> ℝ
smallBadnessGradient)
                                     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 forall a. Ord a => a -> a -> Bool
< Int
environAge   -- point is an obsolete step-stone;
                          -> forall (m :: * -> *) a. Monad m (->) => a -> m a
return (forall (f :: * -> *) a. Alternative f => f a
empty,forall (f :: * -> *) a. Alternative f => f a
empty)    -- do not further use it.
                        Maybe (Shade' y, ℝ)
_otherwise -> do
                          ConvexSet y
shy' <- forall (m :: * -> *) x a.
InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency (forall x. Shade' x -> ConvexSet x
ellipsoidforall (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
                                  forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((ConvexSet y
shyforall a. Semigroup 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 x. Shade' x -> ConvexSet x
ellipsoid)
                                   forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's (forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. [a] -> NonEmpty a
NE.fromList [(Shade' y, badness)]
ngbProps)
                          ℝ
newBadness
                               <- forall (m :: * -> *) x a.
InconsistencyStrategy m x a -> a -> Maybe a -> m a
handleInconsistency (x -> Shade' y -> ℝ
badness x
xforall (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
                                      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        -> forall (f :: * -> *) a. Alternative f => f a
empty
                             ConvexSet Shade' y
hull' [Shade' y]
_  -> forall (m :: * -> *) a. Monad m (->) => a -> m a
return 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 = forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo ConvexSet y
shy' Shade' (LocalLinear x y)
prevJacobi
                                                     ℝ
newBadness (Int
ageforall a. Num a => a -> a -> a
+Int
1)
                          [(x, SolverNodeState x y)]
stepStones <-
                            if Int
unfreshness forall a. Ord a => a -> a -> Bool
< Int
3
                             then forall (m :: * -> *) a. Monad m (->) => a -> m a
return []
                             else 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 forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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 (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall a b. [a] -> [b] -> [(a, b)]
zip (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall x y. WebLocally x y -> y
_thisNodeDataforall κ (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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (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)
                                          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 forall a. Ord a => a -> a -> Bool
> Int
0
                                  , ℝ
badnessGrad <- ℝ
nBadnessProp'd forall a. Fractional a => a -> a -> a
/ ℝ
prevBadness
                                  , ℝ
badnessGrad forall a. Ord a => a -> a -> Bool
> ℝ
largeBadnessGradient -> do
                                        let stepV :: Needle x
stepV = Needle x
vNforall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
2
                                            xStep :: x
xStep = x
x forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
stepV
                                            aprioriInterpolate :: Shade' y
                                            Just Shade' y
aprioriInterpolate
                                               = forall x. Geodesic x => x -> x -> Maybe x
middleBetween Shade' y
hull Shade' y
hullN
                                        case forall y. Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's 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)
=<<
                                               (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. [a] -> NonEmpty a
NE.fromList
                                               [ forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc DifferentialEqn ㄇ x y
f
                                                   (forall x y.
x -> Needle x -> y -> y -> [(Needle x, y)] -> LocalDataPropPlan x y
LocalDataPropPlan
                                                      (WebLocally x (SolverNodeState x y)
nforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord)
                                                      (Needle x
stepV forall v. AdditiveGroup v => v -> v -> v
^-^ Needle x
δx)
                                                      (forall x. ConvexSet x -> Shade' x
convexSetHull forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                                                        WebLocally x (SolverNodeState x y)
nforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeDataforall κ (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 x y. Lens' (SolverNodeState x y) (ConvexSet y)
solverNodeStatus)
                                                      Shade' y
aprioriInterpolate
                                                      (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (forall x. ConvexSet x -> Shade' x
convexSetHull
                                                               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 x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus
                                                               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 x y. WebLocally x y -> y
_thisNodeData)
                                                              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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd
                                                              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)
nforall s a. s -> Getting a s a -> a
^.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 -> forall (m :: * -> *) a. Monad m (->) => a -> m a
return
                                               [( x
xStep
                                                , forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo (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)
_ -> forall (m :: * -> *) a. Monad m (->) => a -> m a
return []
                               Int
_otherwise -> forall (m :: * -> *) a. Monad m (->) => a -> m a
return []
                          let updated :: (x, SolverNodeState x y)
updated = (x
x, SolverNodeState x y
updatedNode)
                          forall (m :: * -> *) a. Monad m (->) => a -> m a
return forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (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, [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, forall a b. b -> Either a b
Right 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fstforall (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 forall d. OldAndNew d -> [d]
oldAndNew forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (OldAndNew (x, SolverNodeState x y))
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData of
                                          [] -> [ (x
xNforall 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))
ngbforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                                                , Int
nnId forall a. Eq a => a -> a -> Bool
/= Int
myId
                                                , (x
xN,SolverNodeState x y
_) <- forall d. OldAndNew d -> [d]
oldAndNew forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ WebLocally x (OldAndNew (x, SolverNodeState x y))
nnWebforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData ]
                                          [(x, SolverNodeState x y)]
l -> [(x
xNforall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
x, WebLocally x (OldAndNew (x, SolverNodeState x y))
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) Int
thisNodeId) | (x
xN,SolverNodeState x y
_) <- [(x, SolverNodeState x y)]
l]
                              ]
                           possibleConflicts :: [Scalar (Needle x)]
possibleConflicts = [ 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 forall a. Ord a => a -> a -> Bool
> Int
myId ]
                     , Bool
isOld Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Scalar (Needle x)]
possibleConflicts
                         Bool -> Bool -> Bool
|| forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Scalar (Needle x)]
possibleConflicts forall a. Ord a => a -> a -> Bool
> Scalar (Needle x)
oldMinDistSq forall a. Fractional a => a -> a -> a
/ Scalar (Needle x)
4
                     ]
               where focused :: [(Bool, (x, SolverNodeState x y))]
focused = forall d. OldAndNew d -> [(Bool, d)]
oldAndNew' 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)))
locWebforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeDataforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) y
thisNodeData
                     knownNgbs :: [(Needle x, WebLocally x (OldAndNew (x, SolverNodeState x y)))]
knownNgbs = forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall x y. WebLocally x y -> y
_thisNodeData 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 :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd 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)))
locWebforall s a. s -> Getting a s a -> a
^.forall x y.
Lens' (WebLocally x y) [(Int, (Needle x, WebLocally x y))]
nodeNeighbours
                     oldMinDistSq :: Scalar (Needle x)
oldMinDistSq = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ 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))
ngbforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (WebLocally x y) x
thisNodeCoord 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 :: forall x y.
ModellableRelation x y =>
PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
recomputeJacobian = forall x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x (WebLocally x y)
webLocalInfo
                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
>>> 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 ((forall x y. WebLocally x y -> y
_thisNodeData
                           forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& forall x y.
ModellableRelation x y =>
WebLocally x (Shade' y) -> Shade' (LocalLinear x y)
differentiateUncertainWebLocally
                                   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 (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 (forall x. ConvexSet x -> Shade' x
convexSetHull 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 x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus))
                          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 forall a b. a -> (a -> b) -> b
& forall x y x.
Lens
  (SolverNodeState x y)
  (SolverNodeState x y)
  (Shade' (LocalLinear x y))
  (Shade' (LocalLinear x y))
solverNodeJacobian 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 :: forall x y (ㄇ :: * -> * -> *) (m :: * -> *).
(ModellableRelation x y, AffineManifold y, LocalModel ㄇ,
 Monad m) =>
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
    = forall a b. (a -> b) -> [a] -> [b]
map (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 (forall x. ConvexSet x -> Shade' x
convexSetHull 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 x y. SolverNodeState x y -> ConvexSet y
_solverNodeStatus))
    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 (m :: * -> *) x y a.
InconsistencyStrategy m x y -> (a -> m a) -> a -> [a]
itWhileJust InconsistencyStrategy m x (Shade' y)
strategy (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)
    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 x y.
ModellableRelation x y =>
PointsWeb x (SolverNodeState x y)
-> PointsWeb x (SolverNodeState x y)
recomputeJacobian
    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 (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)]
_) -> forall x y.
ConvexSet y
-> Shade' (LocalLinear x y) -> ℝ -> Int -> SolverNodeState x y
SolverNodeInfo (forall x. Shade' x -> ConvexSet x
ellipsoid Shade' y
shy)
                                           (forall x. x -> Metric x -> Shade' x
Shade' forall v. AdditiveGroup v => v
zeroV forall a. Monoid a => a
mempty)
                                           (x -> Shade' y -> ℝ
badness x
x Shade' y
shy)
                                           Int
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 x y.
WithField ℝ Manifold x =>
PointsWeb x y -> PointsWeb x ((x, y), [(Needle x, y)])
localFocusWeb