the degree of the multiplier of Misiurewicz points
Clash Royale CLAN TAG#URR8PPP
up vote
1
down vote
favorite
Define the iterated complex quadratic polynomial
$$beginalignedf^0phantom+1_c(z) &= z \ f_c^n + 1(z) &= (f_c^n(z))^2+cendaligned$$
A Misiurewicz point $M_q,p$ satisfies
$$f_c^q + p(0) = f_c^q(0)$$
where $q > 0$ is the preperiod and $p > 0$ is the period. The equation also has roots with lower preperiod (including $0$) and/or period, these should be discounted. By construction each $M_q,p$ is an algebraic integer. The multiplier $m$ of $c = M_q,p$ is defined as
$$ m = prod_n = q^q + p - 1 2 f_c^n(0) $$
and is also an algebraic integer.
Question: is the degree of the minimal polynomial of $m$ always equal to the degree of the minimal polynomial of $M_q,p$?
Here is a table of degrees of minimal polynomials of some $M_q,p$:
q p 1 2 3 4 5 6 7 8 9 10 11 12 13
0 1 1 3 6 15 27 63 120 252 495 1023 2010 4095
1 0 0 0 0 0 0 0 0 0 0 0 0
2 1 2 6 12 30 54 126 240 504 990 2046
3 3 3 12 24 60 108 252 480 1008 1980
4 7 8 21 48 120 216 504 960 2016
5 15 15 48 90 240 432 1008 1920
6 31 32 96 192 465 864 2016
7 63 63 189 384 960 1701
8 127 128 384 768 1920
9 255 255 768 1530
10 511 512 1533
11 1023 1023
12 2047
Calculated with this Haskell code:
-
Prints tables about Misiurewicz points in the Mandelbrot set.
Degree of the polynomials
-
-# LANGUAGE NoImplicitPrelude #-
-# LANGUAGE FlexibleContexts #-
import NumericPrelude hiding (divMod)
import MathObj.Polynomial
import MathObj.Polynomial.Core hiding (divMod, divModRev)
import Data.Tuple.HT (mapPair, mapFst, forcePair)
import Data.List.HT (switchL)
import qualified NumericPrelude.Base as P
import qualified Data.List as List
import Data.MemoTrie (memo, memo2)
import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr)
table :: [[String]] -> String
table = unlines . map (List.intercalate "t")
td :: Int -> [[String]]
td n = (( "deg M_q,p" : map show [ 1 .. n ]) :
[ map show $ q : [ d q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
tp :: Int -> [[String]]
tp n = (( "M_q,p": map show [ 1 .. n ]) :
[ show q : [ show . coeffs $ m q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
main' :: Int -> Int -> IO ()
main' n1 n2 = do
putStr . table . td $ n1
putStr . table . tp $ n2
main :: IO ()
main = do
args <- map reads `fmap` getArgs
case args of
[[(n1,"")], [(n2,"")]] -> main' n1 n2
_ -> hPutStrLn stderr "expected two integer arguments (eg 8 4)"
type P = T Integer
divideAll :: P -> P -> P
divideAll h g
| isZero h = h
| isOne g = h
| isZero g = error "/0"
| otherwise = case h `divMod` g of
(di, mo)
| isZero mo -> di `divideAll` g
| otherwise -> h
divideAlls :: P -> [P] -> P
divideAlls h = h
divideAlls h (g:gs) = divideAlls (h `divideAll` g) gs
c :: P
c = fromCoeffs [ 0, 1 ]
f :: P -> P
f z = z^2 + c
fn :: Int -> P
fn = memo fn_
where
fn_ 0 = 0
fn_ n = f (fn (n - 1))
m_raw :: Int -> Int -> P
m_raw = memo2 m_raw_
where
m_raw_ q p = fn (q + p) - fn q
m :: Int -> Int -> P
m = memo2 m_
where
m_ q p = fromCoeffs . normalize . coeffs $
m_raw q p `divideAlls`
[ mqp
| q' <- [ 0 .. q ]
, p' <- [ 1 .. p ]
, q' + p' < q + p
, p `mod` p' == 0
, let mqp = m q' p'
, not (isZero mqp)
]
d :: Int -> Int -> Int
d q p = case degree (m q p) of Just k -> k ; Nothing -> -1
isOne x = isZero (x - one)
-
the following is copy pasted from the source of
<https://hackage.haskell.org/package/numeric-prelude-0.4.3/docs/MathObj-Polynomial-Core.html>
with one minor modification: to assert y0=1 and omit the division /y0
this allows it to work with monic polynomials with Integer coefficients
-
divMod x y = mapPair (fromCoeffs, fromCoeffs) $ divMod1 (coeffs x) (coeffs y)
--divMod :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divMod1 x y =
mapPair (List.reverse, List.reverse) $
divModRev1 (List.reverse x) (List.reverse y)
-
snd $ Poly.divMod (repeat (1::Double)) [1,1]
-
-
--divModRev :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divModRev1 x y =
case dropWhile isZero y of
-> error "MathObj.Polynomial: division by zero"
y0:ys | isOne y0 ->
let -- the second parameter represents lazily (length x - length (normalize y))
aux xs' =
forcePair .
switchL
(, xs')
(P.const $
let (x0:xs) = xs'
q0 = x0
in mapFst (q0:) . aux (sub xs (scale q0 ys)))
in aux x (drop (length ys) x)
_ -> error "MathObj.Polynomial: division by non-monic"
algebraic-number-theory
add a comment |Â
up vote
1
down vote
favorite
Define the iterated complex quadratic polynomial
$$beginalignedf^0phantom+1_c(z) &= z \ f_c^n + 1(z) &= (f_c^n(z))^2+cendaligned$$
A Misiurewicz point $M_q,p$ satisfies
$$f_c^q + p(0) = f_c^q(0)$$
where $q > 0$ is the preperiod and $p > 0$ is the period. The equation also has roots with lower preperiod (including $0$) and/or period, these should be discounted. By construction each $M_q,p$ is an algebraic integer. The multiplier $m$ of $c = M_q,p$ is defined as
$$ m = prod_n = q^q + p - 1 2 f_c^n(0) $$
and is also an algebraic integer.
Question: is the degree of the minimal polynomial of $m$ always equal to the degree of the minimal polynomial of $M_q,p$?
Here is a table of degrees of minimal polynomials of some $M_q,p$:
q p 1 2 3 4 5 6 7 8 9 10 11 12 13
0 1 1 3 6 15 27 63 120 252 495 1023 2010 4095
1 0 0 0 0 0 0 0 0 0 0 0 0
2 1 2 6 12 30 54 126 240 504 990 2046
3 3 3 12 24 60 108 252 480 1008 1980
4 7 8 21 48 120 216 504 960 2016
5 15 15 48 90 240 432 1008 1920
6 31 32 96 192 465 864 2016
7 63 63 189 384 960 1701
8 127 128 384 768 1920
9 255 255 768 1530
10 511 512 1533
11 1023 1023
12 2047
Calculated with this Haskell code:
-
Prints tables about Misiurewicz points in the Mandelbrot set.
Degree of the polynomials
-
-# LANGUAGE NoImplicitPrelude #-
-# LANGUAGE FlexibleContexts #-
import NumericPrelude hiding (divMod)
import MathObj.Polynomial
import MathObj.Polynomial.Core hiding (divMod, divModRev)
import Data.Tuple.HT (mapPair, mapFst, forcePair)
import Data.List.HT (switchL)
import qualified NumericPrelude.Base as P
import qualified Data.List as List
import Data.MemoTrie (memo, memo2)
import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr)
table :: [[String]] -> String
table = unlines . map (List.intercalate "t")
td :: Int -> [[String]]
td n = (( "deg M_q,p" : map show [ 1 .. n ]) :
[ map show $ q : [ d q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
tp :: Int -> [[String]]
tp n = (( "M_q,p": map show [ 1 .. n ]) :
[ show q : [ show . coeffs $ m q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
main' :: Int -> Int -> IO ()
main' n1 n2 = do
putStr . table . td $ n1
putStr . table . tp $ n2
main :: IO ()
main = do
args <- map reads `fmap` getArgs
case args of
[[(n1,"")], [(n2,"")]] -> main' n1 n2
_ -> hPutStrLn stderr "expected two integer arguments (eg 8 4)"
type P = T Integer
divideAll :: P -> P -> P
divideAll h g
| isZero h = h
| isOne g = h
| isZero g = error "/0"
| otherwise = case h `divMod` g of
(di, mo)
| isZero mo -> di `divideAll` g
| otherwise -> h
divideAlls :: P -> [P] -> P
divideAlls h = h
divideAlls h (g:gs) = divideAlls (h `divideAll` g) gs
c :: P
c = fromCoeffs [ 0, 1 ]
f :: P -> P
f z = z^2 + c
fn :: Int -> P
fn = memo fn_
where
fn_ 0 = 0
fn_ n = f (fn (n - 1))
m_raw :: Int -> Int -> P
m_raw = memo2 m_raw_
where
m_raw_ q p = fn (q + p) - fn q
m :: Int -> Int -> P
m = memo2 m_
where
m_ q p = fromCoeffs . normalize . coeffs $
m_raw q p `divideAlls`
[ mqp
| q' <- [ 0 .. q ]
, p' <- [ 1 .. p ]
, q' + p' < q + p
, p `mod` p' == 0
, let mqp = m q' p'
, not (isZero mqp)
]
d :: Int -> Int -> Int
d q p = case degree (m q p) of Just k -> k ; Nothing -> -1
isOne x = isZero (x - one)
-
the following is copy pasted from the source of
<https://hackage.haskell.org/package/numeric-prelude-0.4.3/docs/MathObj-Polynomial-Core.html>
with one minor modification: to assert y0=1 and omit the division /y0
this allows it to work with monic polynomials with Integer coefficients
-
divMod x y = mapPair (fromCoeffs, fromCoeffs) $ divMod1 (coeffs x) (coeffs y)
--divMod :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divMod1 x y =
mapPair (List.reverse, List.reverse) $
divModRev1 (List.reverse x) (List.reverse y)
-
snd $ Poly.divMod (repeat (1::Double)) [1,1]
-
-
--divModRev :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divModRev1 x y =
case dropWhile isZero y of
-> error "MathObj.Polynomial: division by zero"
y0:ys | isOne y0 ->
let -- the second parameter represents lazily (length x - length (normalize y))
aux xs' =
forcePair .
switchL
(, xs')
(P.const $
let (x0:xs) = xs'
q0 = x0
in mapFst (q0:) . aux (sub xs (scale q0 ys)))
in aux x (drop (length ys) x)
_ -> error "MathObj.Polynomial: division by non-monic"
algebraic-number-theory
math.stackexchange.com/questions/2740655/… related
– Claude
17 hours ago
add a comment |Â
up vote
1
down vote
favorite
up vote
1
down vote
favorite
Define the iterated complex quadratic polynomial
$$beginalignedf^0phantom+1_c(z) &= z \ f_c^n + 1(z) &= (f_c^n(z))^2+cendaligned$$
A Misiurewicz point $M_q,p$ satisfies
$$f_c^q + p(0) = f_c^q(0)$$
where $q > 0$ is the preperiod and $p > 0$ is the period. The equation also has roots with lower preperiod (including $0$) and/or period, these should be discounted. By construction each $M_q,p$ is an algebraic integer. The multiplier $m$ of $c = M_q,p$ is defined as
$$ m = prod_n = q^q + p - 1 2 f_c^n(0) $$
and is also an algebraic integer.
Question: is the degree of the minimal polynomial of $m$ always equal to the degree of the minimal polynomial of $M_q,p$?
Here is a table of degrees of minimal polynomials of some $M_q,p$:
q p 1 2 3 4 5 6 7 8 9 10 11 12 13
0 1 1 3 6 15 27 63 120 252 495 1023 2010 4095
1 0 0 0 0 0 0 0 0 0 0 0 0
2 1 2 6 12 30 54 126 240 504 990 2046
3 3 3 12 24 60 108 252 480 1008 1980
4 7 8 21 48 120 216 504 960 2016
5 15 15 48 90 240 432 1008 1920
6 31 32 96 192 465 864 2016
7 63 63 189 384 960 1701
8 127 128 384 768 1920
9 255 255 768 1530
10 511 512 1533
11 1023 1023
12 2047
Calculated with this Haskell code:
-
Prints tables about Misiurewicz points in the Mandelbrot set.
Degree of the polynomials
-
-# LANGUAGE NoImplicitPrelude #-
-# LANGUAGE FlexibleContexts #-
import NumericPrelude hiding (divMod)
import MathObj.Polynomial
import MathObj.Polynomial.Core hiding (divMod, divModRev)
import Data.Tuple.HT (mapPair, mapFst, forcePair)
import Data.List.HT (switchL)
import qualified NumericPrelude.Base as P
import qualified Data.List as List
import Data.MemoTrie (memo, memo2)
import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr)
table :: [[String]] -> String
table = unlines . map (List.intercalate "t")
td :: Int -> [[String]]
td n = (( "deg M_q,p" : map show [ 1 .. n ]) :
[ map show $ q : [ d q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
tp :: Int -> [[String]]
tp n = (( "M_q,p": map show [ 1 .. n ]) :
[ show q : [ show . coeffs $ m q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
main' :: Int -> Int -> IO ()
main' n1 n2 = do
putStr . table . td $ n1
putStr . table . tp $ n2
main :: IO ()
main = do
args <- map reads `fmap` getArgs
case args of
[[(n1,"")], [(n2,"")]] -> main' n1 n2
_ -> hPutStrLn stderr "expected two integer arguments (eg 8 4)"
type P = T Integer
divideAll :: P -> P -> P
divideAll h g
| isZero h = h
| isOne g = h
| isZero g = error "/0"
| otherwise = case h `divMod` g of
(di, mo)
| isZero mo -> di `divideAll` g
| otherwise -> h
divideAlls :: P -> [P] -> P
divideAlls h = h
divideAlls h (g:gs) = divideAlls (h `divideAll` g) gs
c :: P
c = fromCoeffs [ 0, 1 ]
f :: P -> P
f z = z^2 + c
fn :: Int -> P
fn = memo fn_
where
fn_ 0 = 0
fn_ n = f (fn (n - 1))
m_raw :: Int -> Int -> P
m_raw = memo2 m_raw_
where
m_raw_ q p = fn (q + p) - fn q
m :: Int -> Int -> P
m = memo2 m_
where
m_ q p = fromCoeffs . normalize . coeffs $
m_raw q p `divideAlls`
[ mqp
| q' <- [ 0 .. q ]
, p' <- [ 1 .. p ]
, q' + p' < q + p
, p `mod` p' == 0
, let mqp = m q' p'
, not (isZero mqp)
]
d :: Int -> Int -> Int
d q p = case degree (m q p) of Just k -> k ; Nothing -> -1
isOne x = isZero (x - one)
-
the following is copy pasted from the source of
<https://hackage.haskell.org/package/numeric-prelude-0.4.3/docs/MathObj-Polynomial-Core.html>
with one minor modification: to assert y0=1 and omit the division /y0
this allows it to work with monic polynomials with Integer coefficients
-
divMod x y = mapPair (fromCoeffs, fromCoeffs) $ divMod1 (coeffs x) (coeffs y)
--divMod :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divMod1 x y =
mapPair (List.reverse, List.reverse) $
divModRev1 (List.reverse x) (List.reverse y)
-
snd $ Poly.divMod (repeat (1::Double)) [1,1]
-
-
--divModRev :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divModRev1 x y =
case dropWhile isZero y of
-> error "MathObj.Polynomial: division by zero"
y0:ys | isOne y0 ->
let -- the second parameter represents lazily (length x - length (normalize y))
aux xs' =
forcePair .
switchL
(, xs')
(P.const $
let (x0:xs) = xs'
q0 = x0
in mapFst (q0:) . aux (sub xs (scale q0 ys)))
in aux x (drop (length ys) x)
_ -> error "MathObj.Polynomial: division by non-monic"
algebraic-number-theory
Define the iterated complex quadratic polynomial
$$beginalignedf^0phantom+1_c(z) &= z \ f_c^n + 1(z) &= (f_c^n(z))^2+cendaligned$$
A Misiurewicz point $M_q,p$ satisfies
$$f_c^q + p(0) = f_c^q(0)$$
where $q > 0$ is the preperiod and $p > 0$ is the period. The equation also has roots with lower preperiod (including $0$) and/or period, these should be discounted. By construction each $M_q,p$ is an algebraic integer. The multiplier $m$ of $c = M_q,p$ is defined as
$$ m = prod_n = q^q + p - 1 2 f_c^n(0) $$
and is also an algebraic integer.
Question: is the degree of the minimal polynomial of $m$ always equal to the degree of the minimal polynomial of $M_q,p$?
Here is a table of degrees of minimal polynomials of some $M_q,p$:
q p 1 2 3 4 5 6 7 8 9 10 11 12 13
0 1 1 3 6 15 27 63 120 252 495 1023 2010 4095
1 0 0 0 0 0 0 0 0 0 0 0 0
2 1 2 6 12 30 54 126 240 504 990 2046
3 3 3 12 24 60 108 252 480 1008 1980
4 7 8 21 48 120 216 504 960 2016
5 15 15 48 90 240 432 1008 1920
6 31 32 96 192 465 864 2016
7 63 63 189 384 960 1701
8 127 128 384 768 1920
9 255 255 768 1530
10 511 512 1533
11 1023 1023
12 2047
Calculated with this Haskell code:
-
Prints tables about Misiurewicz points in the Mandelbrot set.
Degree of the polynomials
-
-# LANGUAGE NoImplicitPrelude #-
-# LANGUAGE FlexibleContexts #-
import NumericPrelude hiding (divMod)
import MathObj.Polynomial
import MathObj.Polynomial.Core hiding (divMod, divModRev)
import Data.Tuple.HT (mapPair, mapFst, forcePair)
import Data.List.HT (switchL)
import qualified NumericPrelude.Base as P
import qualified Data.List as List
import Data.MemoTrie (memo, memo2)
import System.Environment (getArgs)
import System.IO (hPutStrLn, stderr)
table :: [[String]] -> String
table = unlines . map (List.intercalate "t")
td :: Int -> [[String]]
td n = (( "deg M_q,p" : map show [ 1 .. n ]) :
[ map show $ q : [ d q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
tp :: Int -> [[String]]
tp n = (( "M_q,p": map show [ 1 .. n ]) :
[ show q : [ show . coeffs $ m q p | p <- [1 .. n], q + p <= n ]
| q <- [0 .. n] ])
main' :: Int -> Int -> IO ()
main' n1 n2 = do
putStr . table . td $ n1
putStr . table . tp $ n2
main :: IO ()
main = do
args <- map reads `fmap` getArgs
case args of
[[(n1,"")], [(n2,"")]] -> main' n1 n2
_ -> hPutStrLn stderr "expected two integer arguments (eg 8 4)"
type P = T Integer
divideAll :: P -> P -> P
divideAll h g
| isZero h = h
| isOne g = h
| isZero g = error "/0"
| otherwise = case h `divMod` g of
(di, mo)
| isZero mo -> di `divideAll` g
| otherwise -> h
divideAlls :: P -> [P] -> P
divideAlls h = h
divideAlls h (g:gs) = divideAlls (h `divideAll` g) gs
c :: P
c = fromCoeffs [ 0, 1 ]
f :: P -> P
f z = z^2 + c
fn :: Int -> P
fn = memo fn_
where
fn_ 0 = 0
fn_ n = f (fn (n - 1))
m_raw :: Int -> Int -> P
m_raw = memo2 m_raw_
where
m_raw_ q p = fn (q + p) - fn q
m :: Int -> Int -> P
m = memo2 m_
where
m_ q p = fromCoeffs . normalize . coeffs $
m_raw q p `divideAlls`
[ mqp
| q' <- [ 0 .. q ]
, p' <- [ 1 .. p ]
, q' + p' < q + p
, p `mod` p' == 0
, let mqp = m q' p'
, not (isZero mqp)
]
d :: Int -> Int -> Int
d q p = case degree (m q p) of Just k -> k ; Nothing -> -1
isOne x = isZero (x - one)
-
the following is copy pasted from the source of
<https://hackage.haskell.org/package/numeric-prelude-0.4.3/docs/MathObj-Polynomial-Core.html>
with one minor modification: to assert y0=1 and omit the division /y0
this allows it to work with monic polynomials with Integer coefficients
-
divMod x y = mapPair (fromCoeffs, fromCoeffs) $ divMod1 (coeffs x) (coeffs y)
--divMod :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divMod1 x y =
mapPair (List.reverse, List.reverse) $
divModRev1 (List.reverse x) (List.reverse y)
-
snd $ Poly.divMod (repeat (1::Double)) [1,1]
-
-
--divModRev :: (ZeroTestable.C a, Field.C a) => [a] -> [a] -> ([a], [a])
divModRev1 x y =
case dropWhile isZero y of
-> error "MathObj.Polynomial: division by zero"
y0:ys | isOne y0 ->
let -- the second parameter represents lazily (length x - length (normalize y))
aux xs' =
forcePair .
switchL
(, xs')
(P.const $
let (x0:xs) = xs'
q0 = x0
in mapFst (q0:) . aux (sub xs (scale q0 ys)))
in aux x (drop (length ys) x)
_ -> error "MathObj.Polynomial: division by non-monic"
algebraic-number-theory
edited 10 hours ago
asked 19 hours ago


Claude
2,416419
2,416419
math.stackexchange.com/questions/2740655/… related
– Claude
17 hours ago
add a comment |Â
math.stackexchange.com/questions/2740655/… related
– Claude
17 hours ago
math.stackexchange.com/questions/2740655/… related
– Claude
17 hours ago
math.stackexchange.com/questions/2740655/… related
– Claude
17 hours ago
add a comment |Â
active
oldest
votes
active
oldest
votes
active
oldest
votes
active
oldest
votes
active
oldest
votes
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
StackExchange.ready(
function ()
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmath.stackexchange.com%2fquestions%2f2872942%2fthe-degree-of-the-multiplier-of-misiurewicz-points%23new-answer', 'question_page');
);
Post as a guest
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
math.stackexchange.com/questions/2740655/… related
– Claude
17 hours ago