perturbation based calculations
[maximus:emndl.git] / GridScan.hs
1 {-
2     emndl -- exponentially transformed Mandelbrot Set renderer
3     Copyright (C) 2011  Claude Heiland-Allen <claude@mathr.co.uk>
4
5     This program is free software: you can redistribute it and/or modify
6     it under the terms of the GNU General Public License as published by
7     the Free Software Foundation, either version 3 of the License, or
8     (at your option) any later version.
9
10     This program is distributed in the hope that it will be useful,
11     but WITHOUT ANY WARRANTY; without even the implied warranty of
12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13     GNU General Public License for more details.
14
15     You should have received a copy of the GNU General Public License
16     along with this program.  If not, see <http://www.gnu.org/licenses/>.
17 -}
18
19 module GridScan (gridEdge, gridShow, gridConverge, gridStep, gridScan, gridSpace) where
20
21 import Control.Parallel.Strategies (parMap, rseq)
22 import Data.Array.IArray (Array, listArray, IArray(bounds), inRange, assocs, elems, indices, (!))
23 import Data.Maybe (catMaybes, isJust, isNothing)
24 import Data.Number.MPFR (set, Precision, RoundMode(Near), sqr, getPrec, mulw)
25
26 import Number (I, R, C)
27 import Complex (Complex ((:+)), magnitude2)
28
29 data GridScan = GridScan I (Array (I,I) (Maybe C)) (I -> I -> C)
30
31 gridSize :: I
32 gridSize = 64
33
34 gridRadius :: R
35 gridRadius = 2
36
37 gridOffset :: I
38 gridOffset = gridSize `div` 2
39
40 gridScan :: C -> R -> GridScan
41 gridScan c0 r0 = GridScan 0 (listArray ((0,0),(gridSize - 1, gridSize - 1)) (replicate (gridSize * gridSize) (Just z))) f
42   where
43     s = gridSpace r0
44     p = ceiling $ 5 - logBase 2 s
45     z = set Near p 0 :+ set Near p 0
46     f i j =
47       let x = s * (fromIntegral (i - gridOffset))
48           y = s * (fromIntegral (j - gridOffset))
49           re :+ im = c0 + (x :+ y)
50       in  set Near p re :+ set Near p im
51
52 gridSpace :: R -> R
53 gridSpace r0 = r0 * gridRadius / fromIntegral gridOffset
54
55 gridStep :: GridScan -> GridScan
56 gridStep (GridScan n pixels coords) =
57   let m = (5 * n `div` 4) `max` 1000
58       d = m - n
59       g _ _ o@Nothing = o
60       g k0 c@(r:+_) (Just z0) = go k0 z0
61         where
62           p = getPrec r
63           go 0 z = z `seq` Just z
64           go k z = z `seq` let z' = sqr' p z + c in if magnitude2 z' > 4 then Nothing else go (k - 1) z'
65       ps = parMap rseq (\((i,j),e) -> g d (coords i j) e) . assocs $ pixels
66       pixels' = listArray (bounds pixels) ps
67   in  GridScan m pixels' coords
68
69 sqr' :: Precision -> C -> C
70 sqr' p (r:+i) =
71   let r2 = sqr Near p r
72       i2 = sqr Near p i
73       ri = mulw Near p (r * i) 2
74   in  (r2 - i2) :+ ri
75
76 gridConverge :: [GridScan] -> GridScan
77 gridConverge (GridScan _ p _ : gs@(g@(GridScan _ q _) : _))
78   | fp == m = gridConverge gs
79   | fp == f q = g
80   | otherwise = gridConverge gs
81   where
82     fp = f p
83     f = length . catMaybes . elems
84     m = gridSize * gridSize
85 gridConverge _ = error "GridScan.gridConverge: list too short"
86
87 gridEdge :: GridScan -> [C]
88 gridEdge (GridScan _ pixels coords) =
89   let b = bounds pixels
90       edge (i, j) = isNothing (pixels ! (i, j)) && any isJust [pixels ! (i',j') | i' <- [i-2 .. i+2], j' <- [j-2 .. j+2], inRange b (i',j')]
91   in  map (uncurry coords) . filter edge . indices $ pixels
92
93 gridShow :: GridScan -> String
94 gridShow (GridScan _ a _) = unlines [ [ block (isJust (a ! (i,j))) (isJust (a ! (i, j - 1))) | i <- [i0 .. i1] ] | j <- [j1, j1 - 2 .. j0] ]
95   where
96     ((i0,j0),(i1,j1)) = bounds a
97     block False False = ' '
98     block True False = '\x2580'
99     block False True = '\x2584'
100     block True True = '\x2588'