test/Trees-and-Webs.ipynb

{
 "cells": [
  {
   "cell_type": "code",
   "execution_count": 1,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "{-# LANGUAGE FlexibleContexts, GADTs, TypeOperators #-}\n",
    "import Data.Manifold.TreeCover\n",
    "import Data.Manifold.Web\n",
    "import Data.Manifold.Web.Internal\n",
    "import qualified Data.Graph as Graph\n",
    "import Data.Manifold.Types\n",
    "import Data.VectorSpace\n",
    "import Linear.V2\n",
    "import Data.AffineSpace\n",
    "import Math.LinearMap.Category\n",
    "import Data.Random\n",
    "import Data.Random.Manifold\n",
    "\n",
    "import Control.Arrow\n",
    "import Control.Applicative (empty)\n",
    "import Data.Foldable (toList, forM_)\n",
    "import Data.Traversable (forM)"
   ]
  },
  {
   "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": "markdown",
   "metadata": {},
   "source": [
    "From [diagrams](http://projects.haskell.org/diagrams):"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 3,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "import Diagrams.Prelude ( Point(P), r2, circle, (&), (#), (^.), (^&), _1, moveTo\n",
    "                        , fc, lc, opacity, red, blue, white\n",
    "                        , fromVertices )\n",
    "import Diagrams.CubicSpline"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Functions for plotting a 2D tree/web structures. Trees with lines for twigs and circles for leaves."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 4,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "prettyTreePlot :: ShadeTree ℝ² -> [DynamicPlottable]\n",
    "prettyTreePlot tr = [ plot [ shapePlot $ circle 0.03 & moveTo p & opacity 0.2 | p <- ps ]\n",
    "                    , plot $ onlyNodes tr ]\n",
    "                 ++ [unitAspect]\n",
    " where ps = map P $ onlyLeaves_ tr\n",
    " \n",
    "prettyWebPlot :: PointsWeb ℝ² () -> [DynamicPlottable]\n",
    "prettyWebPlot w = [ shapePlot $ cubicSpline False [P r₁, P m, P r₂]\n",
    "                  | ((r₁@(V2 x₁ y₁),()),(r₂@(V2 x₂ y₂),())) <- edg\n",
    "                  , let m = V2 ((x₁+2*x₂)/3 + (y₂-y₁)/19)\n",
    "                               ((y₁+2*y₂)/3 + (x₁-x₂)/19) ]\n",
    " where edg = map (gnodes *** gnodes) $ Graph.edges graph\n",
    "       (graph, gnodes) = toGraph w\n",
    "\n",
    "plotTreeAndWeb :: ShadeTree ℝ² -> IO ()\n",
    "plotTreeAndWeb tr = do\n",
    "    plotWindow $ prettyTreePlot tr # map (tint white)\n",
    "              ++ prettyWebPlot web # map (tweakPrerendered $ opacity 0.7)\n",
    "              ++ [plot [ plot [ plot p & tweakPrerendered (opacity 0.3)\n",
    "                              , shapePlot (circle 0.03 & moveTo (P pp)) ]\n",
    "                          & tint red\n",
    "                       | (p@(Cutplane pp _),_) <- webBoundary web ]]\n",
    "    return ()\n",
    " where web = fromShadeTree euclideanMetric tr"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Simple cartesian grid within a disk:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 5,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": []
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "cartTree :: ShadeTree ℝ²\n",
    "cartTree = fromLeafPoints\n",
    "              [ (x^&y) | x<-[0, 0.15 .. 4]\n",
    "                       , y<-[0, 0.2 .. 4]\n",
    "                       , (x-2)^2 + (y-2)^2 < 4 ]\n",
    "\n",
    "plotTreeAndWeb cartTree"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![visualisation of tree-cover and points-web of cartesian-disk cloud](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/TreesAndWebs/2D-cartesiandisk.png)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Regular (slightly stretched) hexagonal-honeycomb grid"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 6,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": []
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "honeycombTree = fromLeafPoints $\n",
    "           [V2 x y | x<-[-2,-1..6], y<-[-1, 0.8..6]]\n",
    "        ++ [V2 x y | x<-[-1.5,-0.5..6], y<-[-0.7, 1.1 ..6]]\n",
    "        ++ [V2 x y | x<-[-1.5,-0.5..6], y<-[-0.1, 1.7 ..6]]\n",
    "        ++ [V2 x y | x<-[-2,-1..6], y<-[0.2, 2.0..6]]\n",
    "\n",
    "plotTreeAndWeb honeycombTree"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![visualisation of tree-cover and points-web of hexagonal points arrangement](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/TreesAndWebs/2D-hexa-honeycomb.png)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Regular (slightly stretched) hexagonal grid"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 7,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": []
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "hexagonTree = fromLeafPoints $\n",
    "           [V2 x y | x<-[-2,-1.7..2], y<-[-1,-0.6..2]]\n",
    "        ++ [V2 x y | x<-[-1.85,-1.55..2], y<-[-0.8,-0.4..2]]\n",
    "\n",
    "plotTreeAndWeb hexagonTree"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![visualisation of tree-cover and points-web of hexagonal points arrangement](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/TreesAndWebs/2D-hexagonal.png)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### <a id='pseudorandomCloudTree'></a>Cloud of 405 sort-of random points:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 8,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": [
       "GraphWindowSpecR2{lBound=-1.8415873015873014, rBound=3.6415873015873013, bBound=-0.5153968253968253, tBound=4.51063492063492, xResolution=640, yResolution=480}"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "scatterTree = let\n",
    "    tps₀ = [(0,0), (0,1), (1,1), (1,2), (2,2)]\n",
    "    tps₁ = [p .+^ v^/3 | p<-tps₀, v <- [(0,0), (-1,1), (1,2)]]\n",
    "    tps₂ = [p .+^ v^/4 | p<-tps₁, v <- [(0,0), (-1,1), (1,2)]]\n",
    "    tps₃ = [p .+^ v^/5 | p<-tps₂, v <- [(0,0), (-2,1), (1,2)]]\n",
    "    tps₄ = [p .+^ v^/7 | p<-tps₃, v <- [(0,1), (-1,1), (1,2)]]\n",
    "     in fromLeafPoints $ r2<$>tps₄\n",
    "plotTreeAndWeb scatterTree\n",
    "((_,exampleTwiglet), exampleTwigEnviron) = twigsWithEnvirons scatterTree !! 5\n",
    "plotWindow $ prettyTreePlot scatterTree\n",
    "                 # map (tweakPrerendered (opacity 0.3) . tint white)\n",
    "          ++ prettyTreePlot exampleTwiglet\n",
    "                 # map (tint blue)\n",
    "          ++ concat (prettyTreePlot . snd <$> exampleTwigEnviron)\n",
    "                 # map (tweakPrerendered (opacity 0.3) . tint red)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "![visualisation of tree-cover and points-wed of pseudorandom-point cloud](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/TreesAndWebs/2D-scatter.png)\n",
    "![visualisation of a lowest-level twigs and its neighbours in the tree-cover of a pseudorandom-point cloud](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/TreesAndWebs/2D-scatter_twig-environs.png)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### 1000 actually-random, normally-distributed points<!--, with focus on one local point-group and its neighbours-->:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 9,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": []
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "randomTr <- fmap fromLeafPoints . forM [0..1000] $ \\_->\n",
    "     runRVar (sample $ (1^&1):±[1^&0, 0^&1]) StdRandom :: IO ℝ²\n",
    "\n",
    "plotTreeAndWeb randomTr"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {
    "collapsed": true
   },
   "source": [
    "![visualisation of tree-cover and points-web of pseudorandom-point cloud](https://raw.githubusercontent.com/leftaroundabout/manifolds/master/manifolds/images/examples/TreesAndWebs/2D-normaldistrib.png)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": 10,
   "metadata": {},
   "outputs": [
    {
     "data": {
      "text/plain": [
       "GraphWindowSpecR2{lBound=-3.5006165292147085, rBound=6.590753178131834, bBound=-3.1213004543071725, tBound=5.331082839866875, xResolution=640, yResolution=480}"
      ]
     },
     "metadata": {},
     "output_type": "display_data"
    }
   ],
   "source": [
    "let web = fromShadeTree euclideanMetric randomTr :: PointsWeb ℝ² ()\n",
    " in plotWindow [\n",
    "      plotLatest [ plotMultiple\n",
    "           [ lineSegPlot [(x,y) | V2 x y<-path]\n",
    "           | path <- pathsTowards i (localFmapWeb _thisNodeCoord web) ]\n",
    "          & plotDelay 2\n",
    "       | i <- [0..] ]\n",
    "     , plot (prettyWebPlot web) & tweakPrerendered (opacity 0.2)\n",
    "     ]"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": []
  }
 ],
 "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
}