re-organize into Numeric and Symbolic
[ruff:ruff.git] / Fractal / Mandelbrot / Numeric / Atom.hs
1 {-# LANGUAGE BangPatterns, DeriveDataTypeable, Rank2Types #-}
2 {- |
3 Module      :  Fractal.Mandelbrot.Numeric.Atom
4 Copyright   :  (c) Claude Heiland-Allen 2011,2012
5 License     :  BSD3
6
7 Maintainer  :  claudiusmaximus@goto10.org
8 Stability   :  unstable
9 Portability :  BangPatterns, DeriveDataTypeable, Rank2Types
10
11 Mu-atom refinement.
12
13 -}
14 module Fractal.Mandelbrot.Numeric.Atom
15   ( Atom(..)
16   , AtomShape(Cardioid, Circular)
17   , addressShape
18   , convergeAtom
19   , convergeNucleusBond
20   , convergeNucleus
21   , convergeBond
22   , convergeInternal
23   , analyseShape
24   ) where
25
26 --import Debug.Trace (trace)
27
28 import Data.Data (Data)
29 import Data.Typeable (Typeable)
30
31 import Control.Monad (liftM2)
32 import Data.Maybe (isNothing, fromJust)
33
34 import qualified Data.Complex as X
35 import Numeric.VariablePrecision
36   ( VariablePrecision, NaturalNumber, Zero, SuccessorTo
37   , VFloat, adjustPrecision, (-@?), precision
38   , VComplex, (.*), toComplex, magnitude2, realPart, imagPart
39   , fromComplexDouble, sqr, scaleComplex
40   , toDouble, F53, F24)
41
42 import Fractal.Mandelbrot.Symbolic.ExternalAngle (Period)
43 import Fractal.Mandelbrot.Symbolic.InternalAngle (InternalAngle)
44 import Fractal.Mandelbrot.Symbolic.AngledInternalAddress (AngledInternalAddress, splitAddress)
45
46 -- | An atom is a particular hyperbolic component, expressed in terms of
47 --   its concrete location in the complex plane.
48 data Atom p =
49   Atom
50   { atomNucleus :: VComplex p
51   , atomSize    :: F24
52   , atomOrientation :: Double
53   , atomPeriod  :: Period
54   , atomShape :: AtomShape
55   }
56   deriving (Eq, Read, Show, Typeable)
57
58 -- | The shape of an atom.
59 data AtomShape = Cardioid | Circular
60   deriving (Eq, Ord, Enum, Bounded, Read, Show, Data, Typeable)
61
62 -- | The shape of the atom corresponding to an address.
63 addressShape :: AngledInternalAddress {- ^ address -} -> AtomShape
64 addressShape addr = case splitAddress addr of
65   (_, []) -> Cardioid
66   _ -> Circular
67
68 -- | Given the period and approximate nucleus location, refine this
69 --   estimate to an atom description, with incrementally increased
70 --   precision until the size is known to sufficiently useful effective
71 --   precision.
72 convergeAtom :: NaturalNumber p => Period {- ^ period -} -> VComplex p {- ^ nucleus estimate -} -> (forall r . NaturalNumber r => Maybe (Atom r) -> a) -> a
73 convergeAtom period c f = convergeNucleusBond period c $ \mnb -> case mnb of
74   Just (nucleus, bond) ->
75     let delta = bond - nucleus
76     in  case analyseShape period nucleus of
77        Just shape -> f (Just Atom
78         { atomNucleus = nucleus
79         , atomSize = sqrt (adjustPrecision (magnitude2 delta))
80         , atomOrientation = X.phase . toD . toComplex . signum . adjustPrecision $ delta -- FIXME weird
81         -- the above weird is down to
82         --   1. use X.phase because VComplex.phase currently transits via Double anyway
83         --   2. use toC to remove excess precision of the argument
84         --   3. signum uses VFloat.sqrt, which is more expensive on more precise VComplex
85         --   4. signum is needed to avoid risk of underflow when converting to Double
86         , atomPeriod = period
87         , atomShape = shape
88         })
89        Nothing -> f (Nothing :: Maybe (Atom Zero))
90   Nothing -> f (Nothing :: Maybe (Atom Zero))
91
92 toD :: X.Complex F53 -> X.Complex Double
93 toD (x X.:+ y) = toDouble x X.:+ toDouble y
94
95 -- | Given the period and approximate nucleus location, successively
96 --   refine this estimate to the true nucleus and 1/2 bond point, with
97 --   incrementally increased precision until the difference between the
98 --   nucleus and bond is known to a sufficiently useful effective
99 --   precision.
100 convergeNucleusBond :: NaturalNumber p => Period {- ^ period -} -> VComplex p {- ^ nucleus estimate -} -> (forall r . NaturalNumber r => Maybe (VComplex r, VComplex r) -> a) -> a
101 convergeNucleusBond p c f = do
102   case (do
103     n <- convergeNucleus p c
104     b <- convergeBond p n (1/2)
105     return (n, b)) of
106     Nothing -> f (Nothing :: Maybe (VComplex Zero, VComplex Zero))
107     mnb@(Just (n, b)) ->
108       if magnitude2 (n - b) > encodeFloat 1 (2 * (accuracy - fromIntegral (precision c)))
109         then f mnb
110         else convergeNucleusBond p (bumpPrecision n) f
111   where
112     accuracy = 8 -- desired meaningful number of bits of delta
113
114 --bumpPrecision8 :: (VariablePrecision t, NaturalNumber p) => t p -> t (SuccessorTo (SuccessorTo (SuccessorTo (SuccessorTo (SuccessorTo (SuccessorTo (SuccessorTo (SuccessorTo p))))))))
115 --bumpPrecision8 = adjustPrecision
116
117 bumpPrecision :: (VariablePrecision t, NaturalNumber p) => t p -> t (SuccessorTo p)
118 bumpPrecision = adjustPrecision
119
120 -- | Given the period and approximate location, successively refine
121 --   this estimate to a nucleus.
122 --
123 --   The algorithm is based on Robert Munafo's page
124 --   /Newton-Raphson method/
125 --   <http://mrob.com/pub/muency/newtonraphsonmethod.html>.
126 --
127 convergeNucleus :: NaturalNumber p => Period {- ^ period -} -> VComplex p {- ^ nucleus estimate -} -> Maybe (VComplex p)
128 convergeNucleus p c0 = go c0
129   where
130     accuracy = 4 -- converged when delta changed at most this many least significant bits
131     go !c = step p 0 0
132       where
133         er = 65536
134         er2 = er * er
135         huge z = not (magnitude2 z < er2)
136 --        tiny d = not (magnitude2 d > encodeFloat 1 (2 * (accuracy - precision d)))
137         step !q !z !d
138           | huge z = Nothing
139           | q == 0 = case c - z / d of
140               c' | huge c' -> Nothing
141                  | (c -@? c') < accuracy -> Just c'
142                  | otherwise -> go c'
143           | otherwise = step (q - 1) (sqr z + c) (scaleComplex 1 (z * d) + 1)
144
145 -- | Find a bond point to an atom at a particular internal angle.
146 convergeBond :: NaturalNumber p => Period {- ^ period -} -> VComplex p {- ^ nucleus -} -> InternalAngle {- ^ angle -} -> Maybe (VComplex p)
147 convergeBond p c a = convergeInternal p c 1 a
148
149 -- | Find an internal point within an atom.  The supplied radius should
150 --   be between 0 and 1.
151 convergeInternal :: NaturalNumber p => Period {- ^ period -} -> VComplex p {- ^ nucleus -} -> VFloat p {- ^ radius -} -> InternalAngle {- ^ angle -} -> Maybe (VComplex p)
152 convergeInternal p c0 r0 a0 = go c0 c0
153   where
154     accuracy = 8 -- converged when delta changed at most this many least significant bits
155     b0 = r0 .* (adjustPrecision . fromComplexDouble . X.cis $ 2 * pi * realToFrac a0)
156     go !z1 !c1 = step p z1 1 0 0 0 c1 z1
157     er = 65536
158     er2 = er * er
159     huge z = not (magnitude2 z < er2)
160     next !dz !dc !dm !c1 !z1
161       | dm == 0 = Nothing
162       | huge z1 = Nothing
163       | huge c1 = Nothing
164 --          | (z1' =~= z1) accuracy && (c1' =~= c1) accuracy = Just c1'
165       | accurate = Just c1'
166       | otherwise = go z1' c1'
167       where
168         accurate = accurateZ && accurateC
169         accurateZ = deltaZ < encodeFloat 1 (2 * (accuracy - floatDigits deltaZ))
170         accurateC = deltaC < encodeFloat 1 (2 * (accuracy - floatDigits deltaC))
171         deltaZ = magnitude2 (z1' - z1)
172         deltaC = magnitude2 (c1' - c1)
173         z1' = z1 + dz / dm
174         c1' = c1 + dc / dm
175     step !q !a !b !c !d !e !c1 !z1
176       | q == 0 = next d0 d1 m c1 z1
177       | otherwise = step (q - 1) (sqr a + c1) (scaleComplex 1 (a * b)) (scaleComplex 1 (sqr b + a * c)) (scaleComplex 1 (a * d) + 1) (scaleComplex 1 (a * e + b * d)) c1 z1
178       where
179         y0 = z1 - a
180         y1 = b0 - b
181         b1 = b - 1
182         m = b1 * e - d * c
183         d0 = y0 * e - d * y1
184         d1 = b1 * y1 - y0 * c
185
186 {-
187 (=~=) :: NaturalNumber p => VComplex p -> VComplex p -> Int -> Bool
188 z =~= w = \acc ->
189   let mexp k
190         | 0 == k = Nothing
191         | isNaN k = Nothing
192         | isInfinite k = Nothing
193         | otherwise = Just (exponent k)
194       cexp q = case (mexp (realPart q), mexp (imagPart q)) of
195         (Nothing, Nothing) -> Nothing
196         (Just x, Nothing) -> Just x
197         (Nothing, Just x) -> Just x
198         (Just x, Just y) -> Just (x `max` y)
199       e = cexp z
200       f = cexp w
201       g = cexp (z - w)
202       p = fromIntegral (precision z)
203   in  case g of
204         Nothing -> True
205         Just g' -> case liftM2 max e f of
206           Nothing -> False
207           Just ef' -> ef' - g' > p - acc
208 -}
209
210 -- | Given a period and nucleus, determine the shape of the corresponding
211 --   atom.  Might explode with division by zero if the precision of the
212 --   nucleus isn't sufficient.
213 analyseShape :: NaturalNumber p => Period {- ^ period -} -> VComplex p {- ^ nucleus -} -> Maybe AtomShape
214 analyseShape p n
215   | failed = Nothing
216   | ma > mi * threshold = Just Cardioid
217   | otherwise = Just Circular
218   where
219     failed = isNothing mdeltas || mi == 0
220     threshold = 2 * 2  -- empirical guess, 1 == perfect circle
221     ma = maximum deltas
222     mi = minimum deltas
223     deltas = fromJust mdeltas
224     mdeltas = sequence
225       [ (magnitude2 . (n -)) `fmap` convergeBond p n a
226       | a <- [1/17, 1/3, 1/2, 2/3, 16/17 ] -- somewhat arbitrary
227       ]