update for new variable-precision
[ruff:ruff.git] / Fractal / Mandelbrot / ExternalAngle.hs
1 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2 {- |
3 Module      :  Fractal.Mandelbrot.ExternalAngle
4 Copyright   :  (c) Claude Heiland-Allen 2010-2012
5 License     :  BSD3
6
7 Maintainer  :  claudiusmaximus@goto10.org
8 Stability   :  unstable
9 Portability :  DeriveDataTypeable, GeneralizedNewtypeDeriving
10
11 External angles and tuning transformations.
12
13 Described with examples in (and in many others) G Pastor et al's paper
14 /Operating with external arguments in the Mandelbrot set antenna/
15 <http://www.iec.csic.es/~fausto/publica/Pastor02_pre.pdf>.
16
17 -}
18 module Fractal.Mandelbrot.ExternalAngle
19   ( ExternalAngle(ExternalAngle)
20   , wrapAngle
21   , doubleAngle
22   , doublingPreimages
23   , ExternalAnglePair(ExternalAnglePair)
24   , externalAnglePair
25   , BinaryAngle(BinaryAngle)
26   , fromBinaryAngle
27   , toBinaryAngle
28   , BinaryAnglePair(BinaryAnglePair)
29   , fromBinaryAnglePair
30   , toBinaryAnglePair
31   , tuneBinary
32   , tuneBinaryPair
33   , tune
34   , tunePair
35   , Period(Period)
36   , anglePeriod
37   , Preperiod(Preperiod)
38   , anglePreperiod
39   ) where
40
41 import Data.Data (Data())
42 import Data.Typeable (Typeable())
43 import Data.Bits (testBit)
44 import Data.List (genericLength)
45 import Data.Ratio ((%), numerator, denominator)
46
47 import Fractal.Mandelbrot.Utils (fromBits, genericElemIndex)
48
49 -- | External angles define external rays, which land on the boundary.
50 --   In particular, each hyperbolic component has two rays that land at
51 --   its root (by convention the unique hyperbolic of period 1 has
52 --   external angles 0 and 1).
53 newtype ExternalAngle = ExternalAngle Rational
54   deriving (Eq, Ord, Read, Show, Data, Typeable, Enum, Num, Fractional, Real, RealFrac)
55
56 -- | Wrap an external angle into [0, 1).
57 wrapAngle :: ExternalAngle -> ExternalAngle
58 wrapAngle a
59   | f < 0 = 1 + f
60   | otherwise = f
61   where
62     (_, f) = properFraction a :: (Integer, ExternalAngle)
63
64 -- | External angle doubling map.
65 doubleAngle :: ExternalAngle -> ExternalAngle
66 doubleAngle a = wrapAngle (2 * a)
67
68 -- | Pre-images under angle doubling.
69 doublingPreimages :: ExternalAngle -> (ExternalAngle, ExternalAngle)
70 doublingPreimages e0 = let e = wrapAngle e0 in (e / 2, (e + 1) / 2)
71
72 -- | A pair of external angles whose rays land at the root of the same
73 --   hyperbolic component, moreover @'ExternalAnglePair' lo hi@ also
74 --   satisfies @lo < hi@.
75 data ExternalAnglePair = ExternalAnglePair ExternalAngle ExternalAngle
76   deriving (Eq, Ord, Read, Show, Data, Typeable)
77
78 -- | Put a pair of external angles that land at the root of the same
79 --   hyperbolic component into proper order.  The precondition is not
80 --   checked.
81 externalAnglePair :: ExternalAngle -> ExternalAngle -> ExternalAnglePair
82 externalAnglePair x y | x < y  = ExternalAnglePair x y
83                       | x > y  = ExternalAnglePair y x
84                       | x == 0 = ExternalAnglePair 0 1
85                       -- deliberately unhandled case
86
87 -- | Binary representation of a (pre-)periodic external angle.
88 --   Big endian lists of bits for pre-period and period.
89 data BinaryAngle = BinaryAngle [Bool] [Bool]
90   deriving (Eq, Ord, Read, Show, Data, Typeable)
91
92 -- | A pair of binary angles whose rays land at the root of the same
93 --   hyperbolic component, with ordering constraints similar to
94 --   'ExternalAnglePair'.
95 data BinaryAnglePair = BinaryAnglePair BinaryAngle BinaryAngle
96   deriving (Eq, Ord, Read, Show, Data, Typeable)
97
98 -- | Convert an angle from binary representation.
99 fromBinaryAngle :: BinaryAngle -> ExternalAngle
100 fromBinaryAngle (BinaryAngle pre per)
101   | n == 0    = ExternalAngle $  fromBits pre % (2 ^ m)
102   | otherwise = ExternalAngle $ (fromBits pre % (2 ^ m)) + (fromBits per % (2 ^ m * (2 ^ n - 1)))
103   where
104     m, n :: Integer
105     m = genericLength pre
106     n = genericLength per
107
108 -- | Convert an angle to binary representation.
109 toBinaryAngle :: ExternalAngle -> BinaryAngle
110 toBinaryAngle e@(ExternalAngle a)
111   | a == 0 = BinaryAngle [] []
112   | even (denominator a) =
113       let BinaryAngle pre per = toBinaryAngle (doubleAngle e)
114           b = a >= 1/2
115       in  BinaryAngle (b:pre) per
116   | otherwise =
117       let (t, p):_ = dropWhile ((1 /=) . denominator . fst) . map (\q -> (a * (2^q - 1), q)) $ [ 1 ..]
118           s = numerator t
119           per = [ s `testBit` i | i <- [p - 1, p - 2 .. 0] ]
120       in  BinaryAngle [] per
121
122 -- | Convert an angle pair from binary representation.
123 fromBinaryAnglePair :: BinaryAnglePair -> ExternalAnglePair
124 fromBinaryAnglePair (BinaryAnglePair x y) = ExternalAnglePair (fromBinaryAngle x) (fromBinaryAngle y)
125
126 -- | Convert an angle pair to binary representation.
127 toBinaryAnglePair :: ExternalAnglePair -> BinaryAnglePair
128 toBinaryAnglePair (ExternalAnglePair x y) = BinaryAnglePair (toBinaryAngle x) (toBinaryAngle y)
129
130 -- | Tuning transformation for binary represented periodic angles.
131 --   Probably only valid for angle pairs presenting ray pairs.
132 tuneBinary :: BinaryAngle -> BinaryAnglePair -> BinaryAngle
133 tuneBinary (BinaryAngle tpre tper) (BinaryAnglePair (BinaryAngle [] per0) (BinaryAngle [] per1))
134   = BinaryAngle (concatMap f tpre) (concatMap f tper)
135   where
136     f False = per0
137     f True  = per1
138 -- tuneBinary unhandled case, FIXME
139
140 -- | Tuning transformation lifted to binary pairs.
141 tuneBinaryPair :: BinaryAnglePair -> BinaryAnglePair -> BinaryAnglePair
142 tuneBinaryPair (BinaryAnglePair x y) t0t1 = BinaryAnglePair (tuneBinary x t0t1) (tuneBinary y t0t1)
143
144 -- | Tuning transformation for external angles.  The implementation
145 --   transits via binary angles.
146 tune :: ExternalAngle -> ExternalAnglePair -> ExternalAngle
147 tune t t0t1 = fromBinaryAngle $ tuneBinary (toBinaryAngle t) (toBinaryAnglePair t0t1)
148
149 -- | Tuning transformation lifted to pairs.  The implementation
150 --   transits via binary angle pairs.
151 tunePair :: ExternalAnglePair -> ExternalAnglePair -> ExternalAnglePair
152 tunePair xy t0t1 = fromBinaryAnglePair (tuneBinaryPair (toBinaryAnglePair xy) (toBinaryAnglePair t0t1))
153
154 -- | Periods.
155 newtype Period = Period Integer
156   deriving (Eq, Ord, Read, Show, Data, Typeable, Enum, Num, Integral, Real)
157
158 -- | The period of an external angle, or 'Nothing' when it is pre-periodic.
159 anglePeriod :: ExternalAngle -> Maybe Period
160 anglePeriod e@(ExternalAngle r)
161   | even (denominator r) = Nothing
162   | otherwise = (1 +) `fmap` (genericElemIndex e . drop 1 . iterate doubleAngle) e
163
164 -- | Pre-periods.
165 newtype Preperiod = Preperiod Integer
166   deriving (Eq, Ord, Read, Show, Data, Typeable, Enum, Num, Integral, Real)
167
168 -- | The pre-period of an external angle, 0 when it is strictly periodic.
169 anglePreperiod :: ExternalAngle -> Preperiod
170 anglePreperiod e = let BinaryAngle pre _ = toBinaryAngle e in genericLength pre