update for new variable-precision
[ruff:ruff.git] / Fractal / Mandelbrot / RayTraceForward4Converge.hs
1 {-# LANGUAGE FlexibleContexts, Rank2Types #-}
2 {- |
3 Module      :  Fractal.Mandelbrot.RayTraceForward4Converge
4 Copyright   :  (c) Claude Heiland-Allen 2012
5 License     :  BSD3
6
7 Maintainer  :  claudiusmaximus@goto10.org
8 Stability   :  unstable
9 Portability :  Rank2Types
10
11 Heuristics to detect convergence of 'RayTraceForward4'.
12
13 The general idea is as follows:
14
15   * the outer ray pair lands at one point;
16
17   * the inner ray pair lands at another point;
18
19   * these two points are separated by a finite non-zero distance (the
20     length of the hyperbolic component);
21
22   * the aspect ratio of the quadrilateral formed by the four ray
23     ends might provide a reasonable termination heuristic: when it is
24     sufficiently long and skinny (with the long axis between the two
25     ray pairs) then the ray ends are probably approaching the cusps, and
26     their midpoint and length of long axis probably provide a good
27     estimate to the location and size of the hyperbolic component.
28
29 Examples:
30
31 > convergeRays (ExternalAnglePair (11 / 75) (51264 / 349525)) (\c r -> show (c, r))
32
33 -}
34 module Fractal.Mandelbrot.RayTraceForward4Converge
35   ( convergeRays
36   ) where
37
38 import Numeric.VariablePrecision
39   ( NaturalNumber, precision, adjustPrecision
40   , VFloat, VComplex, magnitude2, magnitude, scaleComplex
41   )
42
43 import Fractal.Mandelbrot.ExternalAngle (ExternalAnglePair(ExternalAnglePair), tunePair)
44 import Fractal.Mandelbrot.RayTraceForward4 (RayTraceForward4Callback(RayTraceForward4Callback), rayTraceForward4, rayTraceForwardStart4)
45
46 -- | Given a ray pair converging at the root of a hyperbolic component,
47 --   find an estimate of its center and location using 'RayTraceForward4'.
48 convergeRays :: ExternalAnglePair -> (forall r . NaturalNumber r => VComplex r -> VFloat r -> a) -> a
49 convergeRays o@(ExternalAnglePair ol oh) f =
50   let ExternalAnglePair il ih = tunePair h o
51       h = ExternalAnglePair (1/3) (2/3)
52       callback = RayTraceForward4Callback $ \continue zs -> case raysConverged f zs of
53         Nothing -> rayTraceForward4 continue callback
54         Just j -> j
55   in  rayTraceForward4 (rayTraceForwardStart4 (ol, oh, il, ih)) callback
56
57 -- | Lift convergence heuristics to multi-precision input.
58 raysConverged
59   :: (NaturalNumber p, NaturalNumber q, NaturalNumber s, NaturalNumber t)
60   => (forall r . NaturalNumber r => VComplex r -> VFloat r -> a)
61   -> (VComplex p, VComplex q, VComplex s, VComplex t)
62   -> Maybe a
63 raysConverged f = upConvert4 (raysConverged' f)
64
65 -- | Convergence heuristics.
66 raysConverged'
67   :: NaturalNumber r
68   => (VComplex r -> VFloat r -> a)
69   -> (VComplex r, VComplex r, VComplex r, VComplex r)
70   -> Maybe a
71 raysConverged' f (a0, a1, b0, b1)
72   | converged = Just (f c (magnitude (a - b)))
73   | otherwise = Nothing
74   where
75     a = scaleComplex (-1) (a0 + a1)
76     b = scaleComplex (-1) (b0 + b1)
77     c = scaleComplex (-1) (a  + b )
78     d0 = magnitude2 (a0 - b0)
79     d1 = magnitude2 (a1 - b1)
80     da = magnitude2 (a1 - a0)
81     db = magnitude2 (b1 - b0)
82     converged = d0 + d1 > scaleFloat log2sqrtk (da + db) && d0 > 0 && d1 > 0 && da > 0 && db > 0
83     log2sqrtk = 1  -- FIXME needs tuning re performance vs accuracy
84
85 -- | Increase precision of all to the maximum precision of all.
86 upConvert4
87   :: (NaturalNumber p, NaturalNumber q, NaturalNumber s, NaturalNumber t)
88   => (forall r . NaturalNumber r => (VComplex r, VComplex r, VComplex r, VComplex r) -> a)
89   -> (VComplex p, VComplex q, VComplex s, VComplex t)-> a
90 upConvert4 f (a, b, c, d)
91   | p >= m = f (a , b', c', d')
92   | q >= m = f (a', b , c', d')
93   | s >= m = f (a', b', c , d')
94   | t >= m = f (a', b', c', d )
95   where
96     m = maximum [p, q, s, t]
97     p = precision a
98     q = precision b
99     s = precision c
100     t = precision d
101     a', b', c', d' :: NaturalNumber r => VComplex r
102     a' = adjustPrecision a
103     b' = adjustPrecision b
104     c' = adjustPrecision c
105     d' = adjustPrecision d