(* You should be able to copy and paste this text file directly into Mathematica.  These notes will be interpreted as commented code. *)






(* Problem 1: Code for producing plots of attracting basins *)

ply[x_] := 1/2*x - 2 x^2 + x^3
ineqs0 = -0.2 < x < 0.2; 
(* You will need to replace this range with the actual immediate basin!  This interval must be something contained in the immediate basin in order for the calculations below to function properly. *)

ineqs1 = Quiet[Reduce[ReplaceAll[ineqs0, x -> ply[x]], x]];
ineqs2 = Quiet[Reduce[ReplaceAll[ineqs1, x -> ply[x]], x]];
ineqs3 = Quiet[Reduce[ReplaceAll[ineqs2, x -> ply[x]], x]];
ineqs4 = Quiet[Reduce[ReplaceAll[ineqs3, x -> ply[x]], x]];
ineqs5 = Quiet[Reduce[ReplaceAll[ineqs4, x -> ply[x]], x]];

(* This computes the first five successive inverse images of the initial interval given by "ineqs0" under the polynomial ply[x]. *)

basinplot = NumberLinePlot[{ineqs1, ineqs2, ineqs3, ineqs4, ineqs5}, {x, -0.5, 2.5}]

(* This plots the first five inverse images of the initial interval *)





(* Problems 1, 2, 4: Code that can export graphics to a file *)

Directory[]
       (* This will return the location of Mathematica's current output directory. *)
       (* If you wish to change the directory, use SetDirectory["C:/yourdirectorypathname"] .  The cloud version should automatically default to making output graphics in your main cloud folder. *)

Export["diagram_1.png", basinplot, ImageResolution -> 100]
       (* This will export your basin diagram in png format to the indicated filename in the output directory *)
       (* Mathematica supports many export filetypes.  If you are using a TeX compiler, the eps graphic format is well supported.  The instructor typically uses png. *)
       (* Different graphics formats have varying quality.  Consult wikipedia or the CS department for more information on graphics formats. *)

Export["diagram_1.png", orbPic, ImageResolution -> 400, ImageSize -> 900]
       (* Higher resolutions and larger output sizes will take correspondingly longer.  *)
       (* ImageResolution is in dpi, while ImageSize represents width in pixels *)









(* Problems 2, 4: Code for producing bifurcation diagrams *)

f[x_] := L x - x^3
fixedpointdiagram = ContourPlot[f[x] - x == 0, {L, -2, 3}, {x, -2, 2}]

(* This code will produce the bifurcation diagram for the fixed points of the family f[x] = L x - x^3 *)

(* The function ContourPlot[rel , {x,xmin,xmax}, {y,ymin,ymax}] will plot all points (x,y) satisfying the relation rel inside the region xmin <= x <= xmax, ymin <= y <= ymax *)



g[x_] := Simplify[((f[f[x]] - x)/(f[x] - x))]
twocyclediagram = ContourPlot[g[x] == 0, {L, -2, 3}, {x, -2, 2}, ContourStyle -> RGBColor[0.89, 0.8, 0.08]]

(* This code will produce the bifurcation diagram for the period-2 points of the family f[x] = L x - x^3 *)

(* The option ContourStyle -> RGBColor[0.89, 0.8, 0.08] is used to change the color of the  contour *)



fulldiagram1 = Show[fixedpointdiagram, twocyclediagram]

(* The function Show[] will combine any number of graphics objects.  In our case, it will combine the two contour plots to make the full bifurcation diagram *)



fulldiagram2 = ContourPlot[{f[x] - x == 0, g[x] == 0}, {L, -2, 3}, {x, -2, 2}]

(* ContourPlot is also capable of plotting several contours at once: for example, ContourPlot[{rel1, rel2, rel3}, {x,xmin,xmax}, {y,ymin,ymax}] will plot the three relations rel1, rel2, rel3 *)

(* In this case, Mathematica automatically gives each contour a different color *)






(* Problem 3: Code to compute Schwarzian derivatives *)

SchwarzianDerivative[f_][x_] := Derivative[3][f][x]/Derivative[1][f][x] - 3/2 (Derivative[2][f][x]/Derivative[1][f][x])^2
       (* This will define a new operator, SchwarzianDerivative.  To use it, apply it to a function and then apply that new "function" to an argument *)

g[x_] := Sin[2x]
SchwarzianDerivative[g][x]
       (* This should return the Schwarzian derivative of sin(2x), which is -4-6tan(2x)^2 *)