{-# LANGUAGE FlexibleContexts, TypeFamilies, TypeOperators, ScopedTypeVariables, UnicodeSyntax #-}
import Prelude ()
import Control.Category.Constrained.Prelude
import Control.Arrow.Constrained
import Data.Manifold
import Data.Manifold.Web
import Data.Manifold.TreeCover
import Data.Manifold.Riemannian
import Linear.V2
import Math.LinearMap.Category
import Data.VectorSpace
import Data.Foldable (toList)
import Data.Semigroup (Option(..))
import Data.Maybe (mapMaybe)
import Control.Monad (replicateM)
import Control.Lens
:opt no-lint
From dynamic-plot:
import Graphics.Dynamic.Plot.R2
import Data.Colour
import Data.Colour.Names
import Diagrams.Prelude (opacity, fromVertices, Point(P))
(...) :: Colour ℝ -> Colour ℝ -> Shade (Colour ℝ)
c₀...c₁ = case rangeOnGeodesic c₀ c₁ of
Just interp -> interp (0 :±[1] :: Shade ℝ)
toInterior =<< ($ 0) <$> (interpolate blue yellow :: Maybe (ℝ -> Colour ℝ))
Just (ColourNeedle {getRGBNeedle = RGB {channelRed = 0.0, channelGreen = 0.0, channelBlue = 0.0}})
let Just interp = interpolate blue yellow :: Maybe (ℝ->Colour ℝ)
Just c₀ = toInterior (interp 1e-17)
Just c₁ = toInterior (interp $ -1)
Just c₂ = toInterior (interp 1)
in [fromInterior c₀, fromInterior c₁, fromInterior c₂ :: Colour ℝ]
[Data.Colour.SRGB.Linear.rgb 0.5 0.5 0.5,Data.Colour.SRGB.Linear.rgb 0.11920292202211757 0.11920292202211757 0.8807970779778824,Data.Colour.SRGB.Linear.rgb 0.8807970779778824 0.8807970779778824 0.11920292202211757]
fromInterior $ (head . pointsShades $ mapMaybe toInterior
[turquoise, beige :: Colour ℝ]
:: Shade (Colour ℝ))^.shadeCtr :: Colour ℝ
[turquoise, fromInterior ((turquoise...turquoise)^.shadeCtr) :: Colour ℝ]
Data.Colour.SRGB.Linear.rgb 0.19031803090275284 0.8692737099119894 0.6772205205892864
[Data.Colour.SRGB.Linear.rgb 5.126945837404324e-2 0.7454042095403874 0.6307571363461468,Data.Colour.SRGB.Linear.rgb 5.12694583740434e-2 0.7454042095403874 0.6307571363461468]
iWeb :: PointsWeb ℝ² (Colour ℝ)
iWeb = fromWebNodes euclideanMetric
[ (V2 0.5 0, blue), (V2 1.5 0, beige), (V2 2.5 0, teal)
, (V2 0 1, red), (V2 1 1, violet),(V2 2 1, green), (V2 3 1, turquoise)
, (V2 0 2, gray), (V2 1 2, indigo),(V2 2 2, crimson),(V2 3 2, orange)
, (V2 0 3, brown),(V2 1 3, black), (V2 2 3, cyan), (V2 3 3, royalblue) ]
-- plotWindow [plot iWeb, dynamicAxes]
uWeb :: PointsWeb ℝ² (Shade (Colour ℝ))
uWeb = fromWebNodes euclideanMetric
[ (V2 0 0, blue...yellow),(V2 1 0, beige...red), (V2 2 0, grey...teal)
, (V2 0 1, red...grey), (V2 1 1, green...violet),(V2 2 1, orange...cyan)
, (V2 0 2, gray...green), (V2 1 2, blue...gold), (V2 2 2, red...lightgreen) ]
-- plotWindow [plot uWeb, dynamicAxes]
colourscheme :: Shade' ℝ -> Shade (Colour ℝ)
colourscheme (Shade' u du) = interp (Shade u $ dualNorm du :: Shade ℝ)
where Just interp = rangeOnGeodesic darkblue orange
gaußianPeak :: [ℝ²] -> ℝ -> PointsWeb ℝ² (Shade' ℝ)
gaußianPeak ps δy = fromWebNodes euclideanMetric
[ (xy, exp (-2*magnitudeSq xy) |±|[δy]) | xy <- ps ]
import System.Random
randomPts :: [ℝ²] <- replicateM 100 $ do
x <- randomRIO (-2,2)
y <- randomRIO (-1,2)
return $ V2 x y
hexagonal :: [ℝ²]
hexagonal = [V2 x y | x <- [-2, -1.8..2], y<-[-1, -0.7 .. 2]]
++ [V2 x y | x <- [-1.9, -1.7..2], y<-[-0.85, -0.55 .. 2]]
forM_ [0.0001{-, 0.1-}] $ \δ ->
forM_ [-- [V2 x y | x<-[-2,-1.8..2], y<-[-1,-0.8..2]]
--, [V2 x y | x<-[-2,-1.9..2], y<-[-1,-0.8..2]]
randomPts
, hexagonal
] $ \ps -> do
let f = gaußianPeak ps δ
f' = differentiateUncertainWebFunction f
f'' = differentiate²UncertainWebFunction f
mapM_ (plotWindow . (:[dynamicAxes]))
[ plot $ fmap colourscheme f
--, plot $ fmap (colourscheme . linIsoTransformShade (arr $ LinearFunction ($V2 1 0))) f'
--, plot $ fmap (colourscheme . linIsoTransformShade (arr $ LinearFunction ($V2 0 1))) f'
, plot $ fmap (colourscheme . linIsoTransformShade (arr $ LinearFunction ($squareV (V2 1 0)))) f''
--, prettyWebPlot f
]