Exam II - Take home solutions

In this problem, we’ve got to investigate the behavior of f(z)=z+(z^7)+(z^10).

Note: When typesetting an exponent in TEX, you need to enclose a string of length larger than one in {braces}. Thus, (x^10) is written $x^{10}$. Otherwise, the 0 drops off and you get (x^1)0.

Problem 1

We’ve just got to generate a simple image of the Julia set.

f[z_] = z+z^7+z^10;
JuliaSetPlot[f[z],z]

Problem 2

Show that f(x)>x for x>0.

This is not supposed to be hard. f(x)=x+(x^7)+(x^10) so f(x)>x iff x+(x^7)+(x^10)>x or (x^7)+(x^10)>0, which is certainly true for all x>0.

Problem 3

Find an attractive orbit on the negative real axis.

We’ll start by finding a negative critical point. Here’s the snazziest way to find it.

sol = NSolve[f'[x]==0&&x<0,x]

The point behind finding a critical point is, if there is an attractive orbit, it must attract the critical point. So, let’s iterate from here.

x0 = x/.First[sol];
orbitPlusOne = NestList[f,x0,2000][[-4;;]]

I guess we’ve shown that the critical point is attracted to this orbit so we don’t really need to check how attractive it is. It’s not hard to do so, though. Perhaps, we could just compute (((f^3)))'((Subscript[z, i])), where (Subscript[z, i]) is one of the terms in the orbit.

F[z_] = Nest[f,z,3];
F'[Last[orbitPlusOne]]

Or, we could check f'((Subscript[z, 1]))f'((Subscript[z, 2]))f'((Subscript[z, 3])), where (Subscript[z, 1])->(Subscript[z, 2])->(Subscript[z, 3])->(Subscript[z, 1]) are the terms in the orbit.

Times@@(f'/@orbitPlusOne[[2;;]])

Problem 4

Show that f(x)<x for -1<x<0.

Now, f(x)<x iff x+(x^7)+(x^10)<x or (x^7)+(x^10)<0. Now, it’s easy to check that (x^7)+(x^10)<0 for x=-1/2. Furthermore, f(-1)=f(0)=0 but f(x)≠0 for any x∈(-1,0). Thus, by continuity, (x^7)+(x^10)<0 for -1<x<0.

Problem 5

Show that the Julia set has three fold rotational symmetry by showing that f is invariant under the conjugation φ(z)=(e^(2π i/3))z.

I guess we need to show that φ∘f∘(φ^(-1))=f, where of course (φ^(-1))(z)=(e^(-2π i/3))z. This is not too hard to do by hand:

({{φ(f((φ^(-1))(z))), =, (e^(2π i/3))(((e^(-2π i/3))z)+((((e^(-2π i/3))z))^7)+((((e^(-2π i/3))z))^10))}, { , =, (e^(2π i/3))((e^(-2π i/3))z+(e^(-14π i/3))(z^7)+(e^(-20π i/3))(z^10))}, { , =, z+(z^7)+(z^10)}})

We can also auto do it with Mathematica:

Exp[2Pi*I/3]f[Exp[-2Pi*I/3]z]//Expand

Addendum

We can generate a really nice image using the Leau-Fatou flower theorem.

classifyArg = Compile[
{{z,_Complex},{z0,_Complex},{v,_Complex},{n,_Integer}},
Module[{check,check2},
check=n(Arg[((z-z0)/(-v))]+Pi)/(2Pi);
check2=Ceiling[check];
If[check==check2,0,check2]],
CompilationTarget -> "C",
RuntimeOptions->"Speed"];

Clear[f,a,v,n];
f[z_]= z+z^7+z^10;
n = 6;
a = Coefficient[f[z],z,n+1];
v = Last[v /. NSolve[a*(v^n)==1,v]]

Clear[f];
f=Compile[{{z,_Complex}},
z+z^7+z^10];
it = With[{f=f},
Compile[{{z0,_Complex}},
Module[{z,i, bail},
z=z0;
i = 0;
bail=100;
While[Abs[z]≤2 && i++<bail,
z = f[z]];
z],CompilationTarget -> "C",
RuntimeOptions->"Speed",
RuntimeAttributes->{Listable}, Parallelization->True]];
stepSize = 0.001;
pts = Table[x+I*y,{y,1.2,-1.2,-stepSize},
{x,-1.2,1.2,stepSize}];
data = it[pts];//AbsoluteTiming

classify = With[{classifyArg = classifyArg,v=v,n=n},
Compile[{{z,_Complex}},
Which[Abs[z]>2,0,
True,classifyArg[z,0.0+0.0I,v,n]],
CompilationTarget -> "C",
RuntimeOptions->"Speed"]];
classified = Map[classify,data,{2}];
kernel = {
{1,1,1},
{1,-8,1},
{1,1,1}
};
convolvedData = ListConvolve[kernel,classified];
ArrayPlot[Sign[convolvedData],Frame->False,
AspectRatio -> Automatic]