{
 "cells": [
  {
   "cell_type": "code",
   "execution_count": 1,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "{-# LANGUAGE FlexibleContexts, TypeFamilies, TypeOperators, ScopedTypeVariables, UnicodeSyntax #-}\n",
    "import Prelude ()\n",
    "import Control.Category.Constrained.Prelude\n",
    "import Control.Arrow.Constrained\n",
    "\n",
    "import Data.Manifold\n",
    "import Data.Manifold.Web\n",
    "\n",
    "import Data.Manifold.TreeCover\n",
    "import Data.Manifold.Riemannian\n",
    "import Linear.V2\n",
    "import Math.LinearMap.Category\n",
    "import Data.VectorSpace\n",
    "import Data.Foldable (toList)\n",
    "import Data.Semigroup (Option(..))\n",
    "import Data.Maybe (mapMaybe)\n",
    "import Control.Monad (replicateM)\n",
    "import Control.Lens\n",
    ":opt no-lint"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "From [dynamic-plot](http://hackage.haskell.org/packages/dynamic-plot):"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 2,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "import Graphics.Dynamic.Plot.R2"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 5,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "import Data.Colour\n",
    "import Data.Colour.Names\n",
    "import Diagrams.Prelude (opacity, fromVertices, Point(P))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 6,
   "metadata": {},
   "outputs": [],
   "source": [
    "(...) :: Colour ℝ -> Colour ℝ -> Shade (Colour ℝ)\n",
    "c₀...c₁ = case rangeOnGeodesic c₀ c₁ of\n",
    "    Just interp -> interp (0 :±[1] :: Shade ℝ)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 7,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": [
       "Just (ColourNeedle {getRGBNeedle = RGB {channelRed = 0.0, channelGreen = 0.0, channelBlue = 0.0}})"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "toInterior =<< ($ 0) <$> (interpolate blue yellow :: Maybe (ℝ -> Colour ℝ))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 8,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": [
       "[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]"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "let Just interp = interpolate blue yellow :: Maybe (ℝ->Colour ℝ)\n",
    "    Just c₀ = toInterior (interp 1e-17)\n",
    "    Just c₁ = toInterior (interp $ -1)\n",
    "    Just c₂ = toInterior (interp 1)\n",
    "  in [fromInterior c₀, fromInterior c₁, fromInterior c₂ :: Colour ℝ]"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 9,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": [
       "Data.Colour.SRGB.Linear.rgb 0.19031803090275284 0.8692737099119894 0.6772205205892864"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    },
    {
     "data": {
      "text/plain": [
       "[Data.Colour.SRGB.Linear.rgb 5.126945837404324e-2 0.7454042095403874 0.6307571363461468,Data.Colour.SRGB.Linear.rgb 5.12694583740434e-2 0.7454042095403874 0.6307571363461468]"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "fromInterior $ (head . pointsShades $ mapMaybe toInterior\n",
    "   [turquoise, beige :: Colour ℝ]\n",
    "     :: Shade (Colour ℝ))^.shadeCtr :: Colour ℝ\n",
    "[turquoise, fromInterior ((turquoise...turquoise)^.shadeCtr) :: Colour ℝ]"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 10,
   "metadata": {},
   "outputs": [],
   "source": [
    "iWeb :: PointsWeb ℝ² (Colour ℝ)\n",
    "iWeb = fromWebNodes euclideanMetric\n",
    "   [     (V2 0.5 0, blue),    (V2 1.5 0, beige),   (V2 2.5 0, teal)\n",
    "   , (V2 0 1, red),  (V2 1 1, violet),(V2 2 1, green),  (V2 3 1, turquoise)\n",
    "   , (V2 0 2, gray), (V2 1 2, indigo),(V2 2 2, crimson),(V2 3 2, orange)\n",
    "   , (V2 0 3, brown),(V2 1 3, black), (V2 2 3, cyan),   (V2 3 3, royalblue) ]\n",
    "-- plotWindow [plot iWeb, dynamicAxes]"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![Simple “Guroud shaded” web of some colours](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/WebSampling/simpleColourWeb.png)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 11,
   "metadata": {},
   "outputs": [],
   "source": [
    "uWeb :: PointsWeb ℝ² (Shade (Colour ℝ))\n",
    "uWeb = fromWebNodes euclideanMetric\n",
    "   [ (V2 0 0, blue...yellow),(V2 1 0, beige...red),   (V2 2 0, grey...teal)\n",
    "   , (V2 0 1, red...grey),   (V2 1 1, green...violet),(V2 2 1, orange...cyan)\n",
    "   , (V2 0 2, gray...green), (V2 1 2, blue...gold),   (V2 2 2, red...lightgreen) ]\n",
    "-- plotWindow [plot uWeb, dynamicAxes]"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![Web of “uncertain colours”, rendered as random pertubations (“noise”)](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/WebSampling/noisyColourWeb.png)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 12,
   "metadata": {},
   "outputs": [],
   "source": [
    "colourscheme :: Shade' ℝ -> Shade (Colour ℝ)\n",
    "colourscheme (Shade' u du) = interp (Shade u $ dualNorm du :: Shade ℝ)\n",
    " where Just interp = rangeOnGeodesic darkblue orange"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 13,
   "metadata": {},
   "outputs": [],
   "source": [
    "gaußianPeak :: [ℝ²] -> ℝ -> PointsWeb ℝ² (Shade' ℝ)\n",
    "gaußianPeak ps δy = fromWebNodes euclideanMetric\n",
    "       [ (xy, exp (-2*magnitudeSq xy) |±|[δy]) | xy <- ps ]"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 14,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "import System.Random\n",
    "\n",
    "randomPts :: [ℝ²] <- replicateM 100 $ do\n",
    "   x <- randomRIO (-2,2)\n",
    "   y <- randomRIO (-1,2)\n",
    "   return $ V2 x y\n",
    "\n",
    "hexagonal :: [ℝ²]\n",
    "hexagonal = [V2 x y | x <- [-2, -1.8..2], y<-[-1, -0.7 .. 2]]\n",
    "         ++ [V2 x y | x <- [-1.9, -1.7..2], y<-[-0.85, -0.55 .. 2]]"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 15,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": []
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "forM_ [0.0001{-, 0.1-}] $ \\δ ->\n",
    " forM_ [-- [V2 x y | x<-[-2,-1.8..2], y<-[-1,-0.8..2]]\n",
    "       --, [V2 x y | x<-[-2,-1.9..2], y<-[-1,-0.8..2]]\n",
    "        randomPts\n",
    "       , hexagonal\n",
    "       ] $ \\ps -> do\n",
    "  let f = gaußianPeak ps δ\n",
    "      f' = differentiateUncertainWebFunction f\n",
    "      f'' = differentiate²UncertainWebFunction f\n",
    "  mapM_ (plotWindow . (:[dynamicAxes]))\n",
    "   [ plot $ fmap colourscheme f\n",
    "   --, plot $ fmap (colourscheme . linIsoTransformShade (arr $ LinearFunction ($V2 1 0))) f'\n",
    "   --, plot $ fmap (colourscheme . linIsoTransformShade (arr $ LinearFunction ($V2 0 1))) f'\n",
    "    , plot $ fmap (colourscheme . linIsoTransformShade (arr $ LinearFunction ($squareV (V2 1 0)))) f''\n",
    "   --, prettyWebPlot f\n",
    "   ]"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![Noisy-sampled Gaußian peak function in 2D on a cartesian grid, and its finite-difference partial derivatives](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/WebSampling/noisyGaussianPeak+derivatives_cartesianSampled.png)"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "Haskell",
   "language": "haskell",
   "name": "haskell"
  },
  "language_info": {
   "codemirror_mode": "ihaskell",
   "file_extension": ".hs",
   "name": "haskell",
   "version": "8.2.1"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 1
}