{-# LANGUAGE CPP                   #-}
{-# LANGUAGE ExplicitForAll        #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Path.IteratedSubset
-- Copyright   :  (c) 2012 Brent Yorgey
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  byorgey@cis.upenn.edu
--
-- Generate fractal trails by the \"iterated subset\" construction,
-- iteratively replacing each segment with a given pattern.
--
-----------------------------------------------------------------------------

module Diagrams.TwoD.Path.IteratedSubset
       (
         -- * Iterated subset algorithm
         -- ** Simplified version
         refineSegment, iterTrail

         -- ** General version
         -- $ventrella
       , GeneratorSegment(..), mkGS, mkGS3, Generator
       , refineGeneratorSegment, iterGenerator

         -- ** Utilities
       , averageLine
       , bevelLine

       , showGenerator

         -- * Examples

         -- ** Example seed trails
         -- $seeds

       , koch
       , levy
       , zag
       , sqUp
       , sqUpDown

         -- ** Example generators
         -- $gens

       , dragonGen
       , polyaGen
       , terDragonGen
       , invTerDragonGen
       , ventrella56b
       , yinDragonGen
       , ventrella67
       , innerFlipQuartetGen
       , antiGosperGen
       , mandelbrotSnowflakeGen

         -- ** Other stuff
         -- $other

       , snowflake

       , IterTrailConfig(..), randITC, drawITC, drawITCScaled
       , randIterGrid
       ) where

-- Diagrams.Core.Points needed for V (Point a) instance on GHC < 7.6
import           Diagrams.Core.Points       ()
import           Diagrams.Prelude

import           Control.Monad              (replicateM)
import           Control.Monad.Random       (evalRandIO, getRandom, getRandomR)
import           Control.Monad.Random.Class (MonadRandom)
import           Data.Bits                  (xor)
import           Data.Maybe                 (mapMaybe)
import           Data.Typeable
import           System.Random              (Random)

import qualified Diagrams.TwoD.Layout.Grid  as LG

------------------------------------------------------------
-- Iterated subset algorithm (simplified version)
------------------------------------------------------------

-- | Given a \"seed pattern\", produce a list of successive
--   refinements: the zeroth trail in the output list is a horizontal
--   unit segment, and the nth trail is formed by replacing each
--   segment of the seed pattern with the (n-1)st trail.
--   (Equivalently, the nth trail consists of the (n-1)st trail with
--   every segment replaced by the seed pattern.)
--
--   See 'iterGenerator' for a more sophisticated variant which can
--   associate one of four orientations with each segment of the seed
--   pattern.
--
--   > import Diagrams.TwoD.Path.IteratedSubset
--   > iterTrailEx = vsep 0.3 . map strokeLine . take 5
--   >             $ iterTrail koch
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_iterTrailEx.svg#diagram=iterTrailEx&width=200>>
iterTrail :: RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail :: forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail Trail' Line V2 n
seed' = forall a. (a -> a) -> a -> [a]
iterate (\Trail' Line V2 n
tr -> forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment Trail' Line V2 n
tr) forall a b. (a -> b) -> a -> b
$ [V2 n]
offs)
                         (forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX])
  where offs :: [V2 n]
offs = forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
seed'

-- | Use a trail to \"refine\" a linear segment (represented by a
--   vector), returning a scaled and/or rotated copy of the trail with
--   the same endpoint as the segment.
refineSegment :: RealFloat n =>
                 Trail' Line V2 n -> V2 n ->
                 Maybe (Trail' Line V2 n)
refineSegment :: forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment Trail' Line V2 n
t V2 n
sOff
  | V2 n
tOff forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a. (Additive f, Num a) => f a
zero Bool -> Bool -> Bool
|| V2 n
sOff forall a. Eq a => a -> a -> Bool
== forall (f :: * -> *) a. (Additive f, Num a) => f a
zero = forall a. Maybe a
Nothing
  | Bool
otherwise                    = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Trail' Line V2 n
t forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n a.
(InSpace v n a, Eq n, Fractional n, Transformable a) =>
n -> a -> a
scale n
k forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
Angle n -> t -> t
rotate Angle n
r
  where
    tOff :: V2 n
tOff = forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> v n
lineOffset Trail' Line V2 n
t
    k :: n
k    = forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 n
sOff forall a. Fractional a => a -> a -> a
/ forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm V2 n
tOff
    r :: Angle n
r    = (V2 n
sOffforall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta) forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (V2 n
tOffforall s a. s -> Getting a s a -> a
^.forall (t :: * -> *) n.
(HasTheta t, RealFloat n) =>
Lens' (t n) (Angle n)
_theta)

------------------------------------------------------------
-- Generators
------------------------------------------------------------

-- $ventrella
-- Much of the approach here is taken from Jeffrey Ventrella,
-- /Brain-filling Curves/. EyeBrain Books, 2nd edition, 2012. ISBN
-- 9780983054627. <http://www.fractalcurves.com/>,
-- <http://www.brainfillingcurves.com/>
--
-- Each generator consists of a sequence of linear segments with
-- endpoints on a square or triangular grid.  Each segment can also
-- have one of four orientations which determines how it is replaced
-- by a copy of the entire fractal path.  Generators are classified by
-- the distance between their start and end points; generators for
-- which the sum of the squared lengths of their segments is equal to
-- the square of this overall distance have fractal dimension 2 and
-- thus are candidates to be space-filling curves.

-- | A /generator segment/ is a vector along with two bits' worth of
--   orientation information: whether there is a reflection swapping
--   its start and end, and whether there is a reflection across its
--   axis.  When a generator segment is replaced by a complex path,
--   the endpoints of the path will match the endpoints of the
--   segment, but the path may first have some reflections applied to
--   it according to the orientation of the segment.
data GeneratorSegment n = GS (V2 n) Bool Bool

-- | A generator is a sequence of consecutive generator segments.
type Generator n = [GeneratorSegment n]

generatorSegmentOffset :: GeneratorSegment n -> V2 n
generatorSegmentOffset :: forall n. GeneratorSegment n -> V2 n
generatorSegmentOffset (GS V2 n
v Bool
_ Bool
_) = V2 n
v

generatorToLine :: (Floating n, Ord n) => Generator n -> Trail' Line V2 n
generatorToLine :: forall n. (Floating n, Ord n) => Generator n -> Trail' Line V2 n
generatorToLine = forall t. TrailLike t => [Vn t] -> t
fromOffsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n. GeneratorSegment n -> V2 n
generatorSegmentOffset

-- | Create a graphical representation of a generator, using half
--   arrowheads to show the orientation of each segment.
showGenerator
  :: (Renderable (Path V2 n) b, TypeableFloat n)
  => Generator n -> QDiagram b V2 n Any
showGenerator :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Generator n -> QDiagram b V2 n Any
showGenerator Generator n
g = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
showGenSeg (forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Located (Trail v n) -> [t]
explodeTrail (forall l (v :: * -> *) n. Trail' l v n -> Trail v n
Trail (forall n. (Floating n, Ord n) => Generator n -> Trail' Line V2 n
generatorToLine Generator n
g) forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin)) Generator n
g
  where
    showGenSeg
      :: (Renderable (Path V2 n) b, TypeableFloat n)
      => Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
    showGenSeg :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
Located (Trail V2 n) -> GeneratorSegment n -> QDiagram b V2 n Any
showGenSeg Located (Trail V2 n)
locTr (GS V2 n
_ Bool
flip1 Bool
_) =
      let locTr' :: Located (Trail V2 n)
locTr' = if Bool
flip1 then forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> Located (Trail v n)
reverseLocTrail Located (Trail V2 n)
locTr else Located (Trail V2 n)
locTr
      in  forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
ArrowOpts n -> Point V2 n -> V2 n -> QDiagram b V2 n Any
arrowAt' (forall d. Default d => d
with forall a b. a -> (a -> b) -> b
& forall n. Lens' (ArrowOpts n) (ArrowHT n)
arrowHead forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall n. RealFloat n => ArrowHT n
halfDart) (forall a. Located a -> Point (V a) (N a)
loc Located (Trail V2 n)
locTr') (forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail v n -> v n
trailOffset (forall a. Located a -> a
unLoc Located (Trail V2 n)
locTr'))


-- | Make a generator segment by specifying an x component, a y
--   component, a \"horizontal\" orientation (1 means normal, -1 means
--   reversing the start and end of the segment) and a \"vertical\"
--   orientation (1 means normal, -1 means reflecting across the axis
--   of the segment).  This corresponds to the notation used by
--   Ventrella in /Brainfilling Curves/.
mkGS :: (n, n, Int, Int) -> GeneratorSegment n
mkGS :: forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS (n
x, n
y, Int
flip1, Int
flip2)
  = forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv (forall n. (n, n) -> V2 n
r2 (n
x,n
y)) Int
flip1 Int
flip2

-- | Make a generator segment on a triangular grid, by specifying a
--   segment on a square grid and then applying a shear and a scale to
--   transform the square grid into a triangular grid, as in the
--   diagram below:
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_gridTransform.svg#diagram=gridTransform&width=400>>
mkGS3 :: Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3 :: forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3 (n
x, n
y, Int
flip1, Int
flip2)
  = forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv (forall n. (n, n) -> V2 n
r2 (n
x,n
y) forall a b. a -> (a -> b) -> b
# forall n t. (InSpace V2 n t, Transformable t) => n -> t -> t
shearX n
0.5 forall a b. a -> (a -> b) -> b
# forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Fractional n, Transformable t) =>
n -> t -> t
scaleY (forall a. Floating a => a -> a
sqrt n
3 forall a. Fractional a => a -> a -> a
/ n
2)) Int
flip1 Int
flip2

-- > sqGrid =
-- >   mconcat
-- >   [ vec (-1) 1
-- >   , vec 0 1
-- >   , vec 1 0
-- >   , vec 1 (-1)
-- >   , vec 0 (-1)
-- >   , vec (-1) 0
-- >   , replicate 4 (hcat $ replicate 4 (square 1)) # vcat # centerXY # lw thin # lc gray
-- >   ]
-- >   where
-- >     vec x y = arrowAt origin (x ^& y)
-- >
-- > gridTransform = hcat' (with & catMethod .~ Distrib & sep .~ 3.5)
-- >   [ sqGrid
-- >   , arrow 2 # lc blue # centerX
-- >   , sqGrid # shearX 0.5 # scaleY (sqrt 3 / 2)
-- >   ]

-- | General interface used by both mkGS3 and mkGS.
mkGSv :: V2 n -> Int -> Int -> GeneratorSegment n
mkGSv :: forall n. V2 n -> Int -> Int -> GeneratorSegment n
mkGSv V2 n
v Int
flip1 Int
flip2 = forall n. V2 n -> Bool -> Bool -> GeneratorSegment n
GS V2 n
v (Int
flip1 forall a. Ord a => a -> a -> Bool
< Int
0) (Int
flip2 forall a. Ord a => a -> a -> Bool
< Int
0)

-- | Use a trail to \"refine\" a generator segment, returning a scaled
--   and/or rotated copy of the trail with the same endpoints as the
--   segment, and with appropriate reflections applied depending on
--   the orientation of the segment.
refineGeneratorSegment :: RealFloat n =>
                          Trail' Line V2 n -> GeneratorSegment n ->
                          Maybe (Trail' Line V2 n)
refineGeneratorSegment :: forall n.
RealFloat n =>
Trail' Line V2 n -> GeneratorSegment n -> Maybe (Trail' Line V2 n)
refineGeneratorSegment Trail' Line V2 n
t (GS V2 n
sOff Bool
flipX Bool
flipY)
  = forall n.
RealFloat n =>
Trail' Line V2 n -> V2 n -> Maybe (Trail' Line V2 n)
refineSegment (Trail' Line V2 n
t forall a b. a -> (a -> b) -> b
# forall n.
(Ord n, Floating n) =>
Bool -> Bool -> Trail' Line V2 n -> Trail' Line V2 n
doFlips Bool
flipX Bool
flipY) V2 n
sOff

doFlips :: (Ord n, Floating n) => Bool -> Bool -> Trail' Line V2 n -> Trail' Line V2 n
doFlips :: forall n.
(Ord n, Floating n) =>
Bool -> Bool -> Trail' Line V2 n -> Trail' Line V2 n
doFlips Bool
flipX Bool
flipY
  = (if Bool
flipX forall a. Bits a => a -> a -> a
`xor` Bool
flipY then forall (v :: * -> *) n t.
(InSpace v n t, R2 v, Transformable t) =>
t -> t
reflectY else forall a. a -> a
id)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if Bool
flipX then forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Line v n -> Trail' Line v n
reverseLine else forall a. a -> a
id)

{-
doFlips flipX flipY
  = (if flipY then reflectY else id) . (if flipX then (reflectY . reverseLine) else id)

   flipX / flipY   T         F
        T     reverseLine    reflectY . reverseLine
        F      reflectY      id

   flipX `xor` flipY -> reflectY
   flipX -> reverseLine
-}

-- | Given a generator, produce a list of successive refinements: the
--   zeroth trail in the output list is a horizontal unit segment, and
--   the nth trail is formed by refining each segment of the generator
--   with the (n-1)st trail.
--
--   > import Diagrams.TwoD.Path.IteratedSubset
--   > iterGenEx = hsep 0.3 . map strokeLine . take 7
--   >           $ iterGenerator dragonGen
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_iterGenEx.svg#diagram=iterGenEx&width=400>>
iterGenerator :: RealFloat n => Generator n -> [Trail' Line V2 n]
iterGenerator :: forall n. RealFloat n => Generator n -> [Trail' Line V2 n]
iterGenerator Generator n
g = forall a. (a -> a) -> a -> [a]
iterate (\Trail' Line V2 n
tr -> forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall n.
RealFloat n =>
Trail' Line V2 n -> GeneratorSegment n -> Maybe (Trail' Line V2 n)
refineGeneratorSegment Trail' Line V2 n
tr) forall a b. (a -> b) -> a -> b
$ Generator n
g)
                          (forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX])

------------------------------------------------------------
-- Examples
------------------------------------------------------------

--------------------------------------------------
-- Example seed trails

-- $seeds

-- These are just a few sample seed trails which give interesting
-- results, but by no means the only ones!  Use them directly, or use
-- them as inspiration for creating your own seed trails.
--
-- All these seed trails can be seen as generators with homogeneous
-- orientation.  For more complex/interesting generators, see the
-- section of generators below.

-- > import Diagrams.TwoD.Path.IteratedSubset
-- > showTrail n t = hcat' (with & sep .~ 0.2) [ iters !! 1, iters !! n ]
-- >             # frame 0.5
-- >   where iters = map strokeLine $ iterTrail t

-- | Seed for the Koch curve (side of the famous Koch 'snowflake').
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_kochD.svg#diagram=kochD&width=400>>
koch :: (TrailLike t, V t ~ V2, N t ~ n) => t
koch :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
koch = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (n
1forall a. Fractional a => a -> a -> a
/n
6), forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX forall a b. a -> (a -> b) -> b
# forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (-n
1forall a. Fractional a => a -> a -> a
/n
6), forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > kochD = showTrail 4 koch

-- | Seed for the Lévy dragon curve.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_levyD.svg#diagram=levyD&width=400>>
levy :: (TrailLike t, V t ~ V2, N t ~ n) => t
levy :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
levy = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > levyD = showTrail 9 levy

-- | Strange zig-zag seed that produces a dense fractal path with lots
--   of triangles.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_zagD.svg#diagram=zagD&width=400>>
zag :: (TrailLike t, V t ~ V2, N t ~ n) => t
zag :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
zag = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, (-n
0.5) forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
^& n
1, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > zagD = showTrail 5 zag

-- | A \"square impulse\" seed which produces a quadratic von Koch
--   curve.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_sqUpD.svg#diagram=sqUpD&width=400>>
sqUp :: (TrailLike t, V t ~ V2, N t ~ n) => t
sqUp :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
sqUp = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > sqUpD = showTrail 3 sqUp

-- | A \"double square impulse\" seed which produces fantastic
--   rectilinear spiral patterns.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_sqUpDownD.svg#diagram=sqUpDownD&width=400>>
sqUpDown :: (TrailLike t, V t ~ V2, N t ~ n) => t
sqUpDown :: forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
sqUpDown = forall t. TrailLike t => [Vn t] -> t
fromOffsets [forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, n
2 forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unit_Y, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX, forall (v :: * -> *) n. (R2 v, Additive v, Num n) => v n
unitY, forall (v :: * -> *) n. (R1 v, Additive v, Num n) => v n
unitX]

-- > sqUpDownD = showTrail 3 sqUpDown

--------------------------------------------------
-- Example generators
--------------------------------------------------

-- $gens
-- Many of these generators are taken from Jeffrey Ventrella,
-- /Brain-filling Curves/, which has a large number of other examples
-- as well (see <http://www.brainfillingcurves.com/>).

-- > import Diagrams.TwoD.Path.IteratedSubset
-- >
-- > illustrateGen k g
-- >     = hcat' (with & sep .~ 0.2) [ showGenerator g, iters !! 2, iters !! k ]
-- >     # frame 0.5
-- >   where iters = map strokeLine $ iterGenerator g

-- | Generator for the classic Harter-Heighway Dragon (Ventrella
--   p. 52, sqrt 2 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_dragonD.svg#diagram=dragonD&width=400>>
dragonGen :: Generator Double
dragonGen :: Generator Double
dragonGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
1, Double
0,  Int
1,  Int
1)
    , (Double
0, Double
1, -Int
1, -Int
1)
    ]

-- > dragonD = illustrateGen 7 dragonGen

-- | Generator for the Pólya sweep (Ventrella p. 52, sqrt 2 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_polyaD.svg#diagram=polyaD&width=400>>
polyaGen :: Generator Double
polyaGen :: Generator Double
polyaGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
1, Double
0,  Int
1, -Int
1)
    , (Double
0, Double
1, -Int
1,  Int
1)
    ]

-- > polyaD = illustrateGen 7 polyaGen

-- | Generator for the Ter-Dragon (Ventrella p. 55, sqrt 3 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_terDragonD.svg#diagram=terDragonD&width=400>>
terDragonGen :: Generator Double
terDragonGen :: Generator Double
terDragonGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1, Int
1, Int
1)
    , (Double
1, -Double
1, Int
1, Int
1)
    , (Double
0,  Double
1, Int
1, Int
1)
    ]

-- > terDragonD = illustrateGen 5 terDragonGen

-- | Inverted Ter-Dragon (Ventrella p. 56, sqrt 3 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_invTerDragonD.svg#diagram=invTerDragonD&width=400>>
invTerDragonGen :: Generator Double
invTerDragonGen :: Generator Double
invTerDragonGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1, -Int
1, Int
1)
    , (Double
1, -Double
1, -Int
1, Int
1)
    , (Double
0,  Double
1, -Int
1, Int
1)
    ]

-- > invTerDragonD = illustrateGen 5 invTerDragonGen

-- | Ventrella p. 56b, sqrt 3 family.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_ventrella56bD.svg#diagram=ventrella56bD&width=400>>
ventrella56b :: Generator Double
ventrella56b :: Generator Double
ventrella56b
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1, -Int
1, Int
1)
    , (Double
1, -Double
1,  Int
1, Int
1)
    , (Double
0,  Double
1, -Int
1, Int
1)
    ]

-- > ventrella56bD = illustrateGen 5 ventrella56b

-- | Yin Dragon (Ventrella p. 59, sqrt 3 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_yinDragonD.svg#diagram=yinDragonD&width=400>>
yinDragonGen :: Generator Double
yinDragonGen :: Generator Double
yinDragonGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (Double
0,  Double
1,  Int
1,  Int
1)
    , (Double
0,  Double
1, -Int
1, -Int
1)
    , (Double
1, -Double
1,  Int
1,  Int
1)
    ]

-- > yinDragonD = illustrateGen 6 yinDragonGen

-- | Ventrella p. 67, sqrt 4 family.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_ventrella67D.svg#diagram=ventrella67D&width=400>>
ventrella67 :: Generator Double
ventrella67 :: Generator Double
ventrella67
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
1,  Double
1, -Int
1, -Int
1)
    , (Double
1,  Double
0,  Int
1,  Int
1)
    , (Double
0, -Double
1,  Int
1,  Int
1)
    ]

-- > ventrella67D = illustrateGen 6 ventrella67

-- | "Inner-flip Quartet" (Ventrella p. 85, sqrt 5 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_innerFlipQuartetD.svg#diagram=innerFlipQuartetD&width=600>>
innerFlipQuartetGen :: Generator Double
innerFlipQuartetGen :: Generator Double
innerFlipQuartetGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. (n, n, Int, Int) -> GeneratorSegment n
mkGS
    [ (Double
0,  Double
1,  Int
1, -Int
1)
    , (Double
0,  Double
1, -Int
1,  Int
1)
    , (Double
1,  Double
0, -Int
1,  Int
1)
    , (Double
0, -Double
1,  Int
1, -Int
1)
    , (Double
1,  Double
0, -Int
1,  Int
1)
    ]

-- > innerFlipQuartetD = illustrateGen 5 innerFlipQuartetGen

-- | \"Anti-Gosper\" (Ventrella p. 97, sqrt 7 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_antiGosperD.svg#diagram=antiGosperD&width=600>>
antiGosperGen :: Generator Double
antiGosperGen :: Generator Double
antiGosperGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ ( Double
1,  Double
0,  Int
1,  Int
1)
    , ( Double
0,  Double
1,  Int
1,  Int
1)
    , (-Double
1,  Double
0, -Int
1, -Int
1)
    , (-Double
1,  Double
1, -Int
1, -Int
1)
    , ( Double
1,  Double
0,  Int
1,  Int
1)
    , ( Double
1,  Double
0, -Int
1, -Int
1)
    , ( Double
1, -Double
1, -Int
1, -Int
1)
    ]

-- > antiGosperD = illustrateGen 4 antiGosperGen

-- | "Mandelbrot Snowflake Sweep #2" (Ventrella p. 197, sqrt 27 family).
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_mandelSnowD.svg#diagram=mandelSnowD&width=600>>
mandelbrotSnowflakeGen :: Generator Double
mandelbrotSnowflakeGen :: Generator Double
mandelbrotSnowflakeGen
  = forall a b. (a -> b) -> [a] -> [b]
map forall n. Floating n => (n, n, Int, Int) -> GeneratorSegment n
mkGS3
    [ (-Double
1,  Double
2,  Int
1, -Int
1)
    , (-Double
1,  Double
2,  Int
1,  Int
1)
    , ( Double
1,  Double
1,  Int
1,  Int
1)
    , ( Double
2, -Double
1,  Int
1,  Int
1)
    , (-Double
1,  Double
0,  Int
1,  Int
1)
    , (-Double
1,  Double
0,  Int
1, -Int
1)
    , ( Double
0, -Double
1,  Int
1, -Int
1)
    , ( Double
1, -Double
1,  Int
1, -Int
1)
    , ( Double
1,  Double
1,  Int
1,  Int
1)
    , ( Double
0, -Double
1,  Int
1,  Int
1)
    , ( Double
0, -Double
1,  Int
1, -Int
1)
    , ( Double
1,  Double
1,  Int
1, -Int
1)
    , ( Double
1,  Double
1,  Int
1,  Int
1)
    ]

-- > mandelSnowD = illustrateGen 3 mandelbrotSnowflakeGen

-- | Perform a \"level-1 smoothing\" by replacing a list of segments by
--   the segments between their midpoints.  Can be a useful technique
--   for visualizing degenerate space-filling curves, /e.g./ which
--   touch at corners or even share entire edges.
averageLine :: (Metric v, Floating n, Ord n) => Trail' Line v n -> Trail' Line v n
averageLine :: forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
Trail' Line v n -> Trail' Line v n
averageLine = forall t. TrailLike t => [Vn t] -> t
fromOffsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
0.5) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> [a]
tail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

-- | Bevel a line by \"chopping off each corner\", connecting points 1/3
--   and 2/3 of the way along each segment.  Can be a useful technique
--   for visualizing degenerate space-filling curves, /e.g./ which touch
--   at corners or even share entire edges.
bevelLine :: (Metric v, Floating n, Ord n) => Trail' Line v n -> Trail' Line v n
bevelLine :: forall (v :: * -> *) n.
(Metric v, Floating n, Ord n) =>
Trail' Line v n -> Trail' Line v n
bevelLine = forall t. TrailLike t => [Vn t] -> t
fromOffsets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\v n
v1 v n
v2 -> [v n
v1 forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
3, (v n
v1 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ v n
v2) forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ n
3]) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> [a]
tail) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) n. Segment Closed v n -> v n
segOffset forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments

--------------------------------------------------
-- Miscellaneous examples

-- $other
-- A random collection of other fun things you can do with 'iterTrail'
-- or 'iterGenerator'.  There is no particular emphasis on making
-- these configurable or generic; the point is just to suggest some
-- fun things you can do.  If you want to play with them, copy the
-- source code and modify it as you see fit.

-- | The famous Koch snowflake, made by putting three Koch curves
--   together. @snowflake n@ yields an order-@n@ snowflake.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_snowflake4.svg#diagram=snowflake4&width=300>>
snowflake :: RealFloat n => Int -> Trail V2 n
snowflake :: forall n. RealFloat n => Int -> Trail V2 n
snowflake Int
n = forall a. Int -> (a -> a) -> a -> [a]
iterateN Int
3 (forall n t.
(InSpace V2 n t, Transformable t, Floating n) =>
n -> t -> t
rotateBy (-n
1forall a. Fractional a => a -> a -> a
/n
3)) Trail' Line V2 n
edge
            # mconcat
            # glueLine
            # wrapTrail
  where edge :: Trail' Line V2 n
edge = forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail forall t n. (TrailLike t, V t ~ V2, N t ~ n) => t
koch forall a. [a] -> Int -> a
!! Int
n

-- > import Diagrams.TwoD.Path.IteratedSubset
-- > snowflake4 = snowflake 4 # strokeT # centerXY # pad 1.1

--------------------------------------------------
-- Generating random iterated subset fractals

-- | Parameters to generate an iterated subset fractal.
data IterTrailConfig n = ITC { forall n. IterTrailConfig n -> Trail' Line V2 n
seed :: Trail' Line V2 n -- ^ The seed trail
                           , forall n. IterTrailConfig n -> Colour Double
color  :: Colour Double  -- ^ The line color to use
                           , forall n. IterTrailConfig n -> Int
iters  :: Int            -- ^ Number of iterations
                           }

-- | Generate a random 'IterTrailConfig'.  This features many
--   hard-coded values.  If you want to play with it just copy the
--   code and modify it to suit.
randITC ::
  (MonadRandom m,
#if MIN_VERSION_base(4,9,0)
#else
   Applicative m,
#endif
   Ord n, Floating n, Random n) =>
           m (IterTrailConfig n)
randITC :: forall (m :: * -> *) n.
(MonadRandom m, Ord n, Floating n, Random n) =>
m (IterTrailConfig n)
randITC = do
  -- use between two and five segments for the seed pattern
  Int
nSegs   <- forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
2,Int
5)

  -- should we make the seed pattern a cubic spline?
  Bool
spline  <- forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom

  -- generate a random list of linear segments drawn from (-1,1)^2.
  [Point V2 n]
s       <- forall t. TrailLike t => [Vn t] -> t
fromOffsets forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
nSegs (forall c. Coordinates c => PrevDim c -> FinalCoord c -> c
(^&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (-PrevDim (V2 n)
1,PrevDim (V2 n)
1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (-FinalCoord (V2 n)
1,FinalCoord (V2 n)
1))

  -- generate a random color.
  Colour Double
c       <- forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom

  -- generate a random number of iterations, with a lower bound of 3
  -- (since fewer is not very interesting) and an upper bound chosen
  -- to ensure we won't get more than 10000 segments in the final
  -- path.
  Int
i       <- forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
3, forall a b. (RealFrac a, Integral b) => a -> b
floor (forall a. Floating a => a -> a -> a
logBase (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nSegs :: Double) Double
10000))
  let s' :: Trail' Line V2 n
s'
        | Bool
spline    = forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t, Fractional (v n)) =>
Bool -> [Point v n] -> t
cubicSpline Bool
False [Point V2 n]
s
        | Bool
otherwise = forall t. TrailLike t => [Point (V t) (N t)] -> t
fromVertices [Point V2 n]
s
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall n.
Trail' Line V2 n -> Colour Double -> Int -> IterTrailConfig n
ITC Trail' Line V2 n
s' Colour Double
c Int
i

-- | Generate an iterated subset fractal based on the given parameters.
drawITC :: (Renderable (Path V2 n) b, TypeableFloat n) =>
           IterTrailConfig n -> QDiagram b V2 n Any
drawITC :: forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITC (ITC Trail' Line V2 n
s Colour Double
c Int
i) = (forall n. RealFloat n => Trail' Line V2 n -> [Trail' Line V2 n]
iterTrail Trail' Line V2 n
s forall a. [a] -> Int -> a
!! Int
i) forall a b. a -> (a -> b) -> b
# forall n b.
(TypeableFloat n, Renderable (Path V2 n) b) =>
Trail' Line V2 n -> QDiagram b V2 n Any
strokeLine forall a b. a -> (a -> b) -> b
# forall n a.
(InSpace V2 n a, Typeable n, Floating n, HasStyle a) =>
Colour Double -> a -> a
lc Colour Double
c

-- | Like 'drawITC', but also scales, centers, and pads the result so
-- that it fits nicely inside a 4x4 box.
drawITCScaled
  :: (Renderable (Path V2 n) b, RealFloat n, Typeable n)
  => IterTrailConfig n -> QDiagram b V2 n Any
drawITCScaled :: forall n b.
(Renderable (Path V2 n) b, RealFloat n, Typeable n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITCScaled IterTrailConfig n
itc
  = forall n b.
(Renderable (Path V2 n) b, TypeableFloat n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITC IterTrailConfig n
itc
  # sized (dims2D 4 4)
  # centerXY
  # pad 1.1

-- | Create a grid of 25 random iterated subset fractals.  Impress
--   your friends!
--
-- <<diagrams/src_Diagrams_TwoD_Path_IteratedSubset_randIterGridEx.svg#diagram=randIterGridEx&width=500>>
randIterGrid :: (Renderable (Path V2 n) b, Random n, TypeableFloat n) =>
                IO (QDiagram b V2 n Any)
randIterGrid :: forall n b.
(Renderable (Path V2 n) b, Random n, TypeableFloat n) =>
IO (QDiagram b V2 n Any)
randIterGrid = do
  [IterTrailConfig n]
itcs <- forall a. Rand StdGen a -> IO a
evalRandIO (forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
25 forall (m :: * -> *) n.
(MonadRandom m, Ord n, Floating n, Random n) =>
m (IterTrailConfig n)
randITC)
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall n b.
TypeableFloat n =>
[QDiagram b V2 n Any] -> QDiagram b V2 n Any
LG.gridCat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall n b.
(Renderable (Path V2 n) b, RealFloat n, Typeable n) =>
IterTrailConfig n -> QDiagram b V2 n Any
drawITCScaled forall a b. (a -> b) -> a -> b
$ [IterTrailConfig n]
itcs)

-- > import Diagrams.TwoD.Path.IteratedSubset
-- > randIterGridEx = randIterGrid