re-organize into Numeric and Symbolic
[ruff:ruff.git] / Fractal / Mandelbrot / Symbolic / KneadingSequence.hs
1 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
2 {- |
3 Module      :  Fractal.Mandelbrot.KneadingSequence
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 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 module Fractal.Mandelbrot.Symbolic.KneadingSequence
17   ( Knead(..)
18   , Kneading(..)
19   , kneading
20   , kneadingPeriod
21   , unwrapKneading
22   ) where
23
24 import Data.Data (Data())
25 import Data.Typeable (Typeable())
26 import Data.List (genericLength, genericSplitAt, genericTake)
27 import Data.Maybe (isJust, listToMaybe)
28
29 import Fractal.Mandelbrot.Symbolic.ExternalAngle (doubleAngle, doublingPreimages, ExternalAngle, Period(Period), wrapAngle)
30 import Fractal.Mandelbrot.Utils (strictlyWithin, strictlyWithout)
31
32 -- | Elements of kneading sequences.
33 data Knead
34   = Zero
35   | One
36   | Star
37   deriving (Read, Show, Eq, Ord, Enum, Bounded, Data, Typeable)
38
39 -- | Kneading sequences.  Note that the 'Aperiodic' case has an infinite list.
40 data Kneading
41   = Aperiodic [Knead]
42   | PrePeriodic [Knead] [Knead]
43   | StarPeriodic [Knead]
44   | Periodic  [Knead]
45   deriving (Read, Show, Eq, Ord, Data, Typeable)
46
47 -- | The kneading sequence for an external angle.
48 kneading :: ExternalAngle -> Kneading
49 kneading a0'
50   | a0 == 0 = StarPeriodic [Star]
51   | otherwise = fst kneads
52   where
53     a0 = wrapAngle a0'
54     lh = doublingPreimages a0
55     kneads = kneading' 1 (doubleAngle a0)
56     ks = (a0, One) : snd kneads
57     kneading' :: Integer -> ExternalAngle -> (Kneading, [(ExternalAngle, Knead)])
58     kneading' n a
59       | isJust i = case i of
60           Just 0 -> case last qs of
61             Star -> (StarPeriodic qs, [])
62             _    -> (Periodic qs, [])
63           Just j -> let (p, q) = genericSplitAt j qs
64                     in (PrePeriodic p q, [])
65           -- unreachable
66       | a `strictlyWithin`  lh = ((a, One ):) `mapP` k
67       | a `strictlyWithout` lh = ((a, Zero):) `mapP` k
68       | otherwise              = ((a, Star):) `mapP` k
69       where
70         k = kneading' (n+1) (doubleAngle a)
71         ps = genericTake n ks
72         qs = map snd ps
73         i = fmap fst . listToMaybe . filter ((a ==) . fst . snd) . zip [(0 :: Integer) ..] $ ps
74         mapP f ~(x, y) = (x, f y)
75
76 -- | The period of a kneading sequence, or 'Nothing' when it isn't periodic.
77 kneadingPeriod :: Kneading -> Maybe Period
78 kneadingPeriod (StarPeriodic k) = Just (Period $ genericLength k)
79 kneadingPeriod (Periodic k) = Just (Period $ genericLength k)
80 kneadingPeriod _ = Nothing
81
82 -- | Unwrap a kneading sequence to an infinite list.
83 unwrapKneading :: Kneading -> [Knead]
84 unwrapKneading (Aperiodic vs) = vs
85 unwrapKneading (PrePeriodic us vs) = us ++ cycle vs
86 unwrapKneading (StarPeriodic vs) = cycle vs
87 unwrapKneading (Periodic vs) = cycle vs