update for new variable-precision
[ruff:ruff.git] / Fractal / Mandelbrot / RayTraceForward.hs
1 {-# LANGUAGE BangPatterns, FlexibleContexts, Rank2Types #-}
2 {- |
3 Module      :  Fractal.Mandelbrot.RayTraceForward
4 Copyright   :  (c) Claude Heiland-Allen 2011-2012
5 License     :  BSD3
6
7 Maintainer  :  claudiusmaximus@goto10.org
8 Stability   :  unstable
9 Portability :  BangPatterns, FlexibleContexts, Rank2Types
10
11 Tracing external rays inwards from infinity with adaptive precision.
12
13 Example usage:
14
15 > main :: IO ()
16 > main = do
17 >   let callback = RayTraceForwardCallback $ \continue (x :+ y) _e ->
18 >          (show x ++ " " ++ show y) : rayTraceForward continue callback
19 >       ray angle = rayTraceForward (rayTraceForwardStart angle) callback
20 >   mapM_ (putStrLn . unlines . take 256 . ray) [0, 1/64 .. 63/64]
21
22 The algorithm is based on Tomoki Kawahira's paper
23 /An algorithm to draw external rays of the Mandelbrot set/
24 <http://www.math.nagoya-u.ac.jp/~kawahira/programs/mandel-exray.pdf>.
25
26 -}
27 module Fractal.Mandelbrot.RayTraceForward
28   ( RayTraceForwardCallback(RayTraceForwardCallback)
29   , RayTraceForward(rayTraceForward)
30   , rayTraceForwardStart
31   ) where
32
33 import qualified Data.Complex as X
34 import Numeric.VariablePrecision
35   ( NaturalNumber, SuccessorTo
36   , VariablePrecision(adjustPrecision), (.@~)
37   , VFloat, VComplex(..), magnitude2
38   , fromComplexFloat, fromComplexDouble, sqr, scaleComplex
39   , c8
40   )
41
42 import Fractal.Mandelbrot.ExternalAngle (ExternalAngle, doubleAngle)
43
44
45 -- | For each point on the ray, a callback gets passed the current
46 --   coordinates and epsilon, along with a continuation that can be
47 --   used to get more points.
48 data RayTraceForwardCallback a = RayTraceForwardCallback{ rayTraceForwardCallback :: NaturalNumber p => RayTraceForward a -> VComplex p -> VFloat p -> a }
49
50 -- | Step along the ray by one point, calling the callback.
51 data RayTraceForward  a = RayTraceForward { rayTraceForward  :: RayTraceForwardCallback a -> a }
52
53 -- | Initialize ray tracing for an external angle.
54 rayTraceForwardStart :: ExternalAngle -> RayTraceForward a
55 rayTraceForwardStart e = RayTraceForward{ rayTraceForward = rayTraceForwardStep (RayTraceForwardContext e 4 4 4 65536 1 (fromComplexFloat (X.mkPolar 65536 (realToFrac e)) .@~ c8) 0 0) }
56
57 data RayTraceForwardContext p =
58   RayTraceForwardContext
59   { rtfcAngle :: !ExternalAngle
60   , rtfcSharpness :: !Int -- number of steps to take within each dwell band
61   , rtfcPrecision :: !Int -- enough bits must be available to represent the delta with this much effective precision
62   , rtfcAccuracy  :: !Int -- scales epsilon relative to the length of the last step
63   , rtfcEscapeR :: !Double
64   , rtfcEpsilon2 :: !(VFloat p)
65   , rtfcLastC :: !(VComplex p)
66   , rtfcStepK :: !Int
67   , rtfcStepJ :: !Int
68   }
69
70 rayTraceForwardStep :: NaturalNumber q => RayTraceForwardContext q -> RayTraceForwardCallback a -> a
71 rayTraceForwardStep rtfc0 go = step rtfc0 go
72   where
73     step :: NaturalNumber q => RayTraceForwardContext q -> RayTraceForwardCallback a -> a
74     step rtfc g
75       | rtfcStepJ rtfc >= rtfcSharpness rtfc = step rtfc
76           { rtfcAngle = doubleAngle (rtfcAngle rtfc)
77           , rtfcStepK = rtfcStepK rtfc + 1
78           , rtfcStepJ = 0
79           } g
80       | otherwise = newton (rtfcLastC rtfc) (rtfcEpsilon2 rtfc) 0 g
81       where
82         limit = 64 -- FIXME arbitrary Newton iteration count limit
83         r0 = rtfcEscapeR rtfc ** ((1/2) ** (fromIntegral (rtfcStepJ rtfc + 1) / fromIntegral (rtfcSharpness rtfc)))
84         t0 = fromComplexDouble $ X.mkPolar r0 (2 * pi * realToFrac (rtfcAngle rtfc))
85         newton :: NaturalNumber p => VComplex p -> VFloat p -> Int -> RayTraceForwardCallback a -> a
86         newton !z !e2 !p f
87           | enoughBits && converged =
88               let lastC = adjustPrecision (rtfcLastC rtfc)
89                   eps' = scaleFloat (negate (2 * rtfcAccuracy rtfc)) (magnitude2 (z' - lastC))
90               in  rayTraceForwardCallback f (RayTraceForward (rayTraceForwardStep rtfc
91                     { rtfcStepJ = rtfcStepJ rtfc + 1
92                     , rtfcLastC = z'
93                     , rtfcEpsilon2 = eps'
94                     })) z' eps'
95           | enoughBits && p < limit = newton z' e2 (p + 1) f
96           | otherwise = newton (bumpPrecision z') (bumpPrecision e2) 0 f
97           where
98             enoughBits = negate (exponent e2) < 2 * (floatDigits e2 - rtfcPrecision rtfc)
99             converged  = delta < e2
100             delta = magnitude2 (z' - z)
101             d = (cc - adjustPrecision t0) / dd
102             z' = z - d
103             (cc, dd) = ncnd (rtfcStepK rtfc + 1)
104             ncnd 1 = (z, 1)
105             ncnd i = let (!nc, !nd) = ncnd (i - 1) in (sqr nc + z, scaleComplex 1 (nc * nd) + 1)
106   
107 bumpPrecision :: (VariablePrecision t, NaturalNumber p) => t p -> t (SuccessorTo p)
108 bumpPrecision = adjustPrecision