re-organize into Numeric and Symbolic
[ruff:ruff.git] / Fractal / Mandelbrot / Symbolic / InternalAddress.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {- |
3 Module      :  Fractal.Mandelbrot.Symbolic.InternalAddress
4 Copyright   :  (c) Claude Heiland-Allen 2010-2012
5 License     :  BSD3
6
7 Maintainer  :  claudiusmaximus@goto10.org
8 Stability   :  unstable
9 Portability :  DeriveDataTypeable
10
11 Implementation of ideas from Dierk Schleicher's paper
12 /Internal Addresses Of The Mandelbrot Set And Galois Groups Of Polynomials (version of February 5, 2008)/
13 <http://arxiv.org/abs/math/9411238v2>.
14
15 -}
16
17 module Fractal.Mandelbrot.Symbolic.InternalAddress
18   ( InternalAddress(InternalAddress)
19   , internalAddress
20   , internalFromList
21   , internalToList
22   , associatedKneadings
23   , upperKneading
24   , lowerKneading
25   ) where
26
27 import Data.Data (Data())
28 import Data.Typeable (Typeable())
29 import Data.List (genericLength, genericTake)
30
31 import Fractal.Mandelbrot.Symbolic.ExternalAngle (Period)
32 import Fractal.Mandelbrot.Symbolic.KneadingSequence (Knead(..), Kneading(Aperiodic, Periodic, StarPeriodic), unwrapKneading)
33 import Fractal.Mandelbrot.Utils (divisors)
34
35 -- | Internal addresses are a non-empty sequence of strictly increasing
36 --   periods beginning with '1'.
37 newtype InternalAddress = InternalAddress [Period]
38   deriving (Read, Show, Eq, Ord, Data, Typeable)
39
40 -- | Construct a valid 'InternalAddress', checking the precondition.
41 internalFromList :: [Period] -> Maybe InternalAddress
42 internalFromList x0s@(1:_) = InternalAddress `fmap` fromList' 0 x0s
43   where
44     fromList' n [x]    | x > n = Just [x]
45     fromList' n (x:xs) | x > n = (x:) `fmap` fromList' x xs
46     fromList' _ _ = Nothing
47 internalFromList _ = Nothing
48
49 -- | Extract the sequence of periods.
50 internalToList :: InternalAddress -> [Period]
51 internalToList (InternalAddress xs) = xs
52
53 -- | Construct an 'InternalAddress' from a kneading sequence.
54 internalAddress :: Kneading -> Maybe InternalAddress
55 internalAddress (StarPeriodic [Star])      = Just (InternalAddress [1])
56 internalAddress (StarPeriodic v@(One:_))   = Just . InternalAddress . address'per (genericLength v) $ v
57 internalAddress (Periodic     v@(One:_))   = Just . InternalAddress . address'per (genericLength v) $ v
58 internalAddress k@(Aperiodic    (One:_))   = Just . InternalAddress . address'inf . unwrapKneading $ k
59 internalAddress _ = Nothing
60
61 address'inf :: [Knead] -> [Period]
62 address'inf v = address' v
63
64 address'per :: Period -> [Knead] -> [Period]
65 address'per p v = takeWhile (<= p) $ address' v
66
67 address' :: [Knead] -> [Period]
68 address' v = address'' 1 [One]
69   where
70     address'' sk vk = sk : address'' sk' vk'
71       where
72         sk' = (1 +) . genericLength . takeWhile id . zipWith (==) v . cycle $ vk
73         vk' = genericTake sk' (cycle v)
74
75 -- | A star-periodic kneading sequence's upper and lower associated
76 --   kneading sequences.
77 associatedKneadings :: Kneading -> Maybe (Kneading, Kneading)
78 associatedKneadings (StarPeriodic k) = Just (Periodic a, Periodic abar)
79   where
80     n = genericLength k
81     abar:_ = filter (and . zipWith (==) a' . cycle) . map (`genericTake` a') . divisors $ n
82     (a, a') = if ((n `elem`) . internalToList) `fmap` internalAddress (Periodic a1) == Just True then (a1, a2) else (a2, a1)
83     a1 = map (\s -> case s of Star -> Zero ; t -> t) k
84     a2 = map (\s -> case s of Star -> One  ; t -> t) k
85 associatedKneadings _ = Nothing
86
87 -- | The upper associated kneading sequence.
88 upperKneading :: Kneading -> Maybe Kneading
89 upperKneading = fmap fst . associatedKneadings
90
91 -- | The lower associated kneading sequence.
92 lowerKneading :: Kneading -> Maybe Kneading
93 lowerKneading = fmap snd . associatedKneadings