Basic Plotting

Code for Chapter Opening Art

epi[radii_,speeds_,offsets_][t_]:=Fold[#1+#2[[1]] {Cos[#2[[2]] t+#2[[3]]],Sin[#2[[2]] t+#2[[3]]]}&,0,Transpose[{radii,speeds,offsets}]];
COAData={{{1,(1/2),(1/4)},{-2,5,19},{0,0,0}},{{1,0.8,0.4,0.2,0.4,0.2},{1,10,-17,-26,28,37},{0,-(π/2),-(π/2),0,0,(π/2)}},{{1,(1/2),(1/4)},{1,3,80},{0,0,0}},{{1,(1/2),(1/4)},{1,4,31},{0,0,0}}};

GraphicsGrid[Partition[Table[ParametricPlot[Evaluate[(epi @@ COAData[[i]])[t], {t,0,2π}], AspectRatio->1,ImageSize-> 160,FrameTicks->!True,Frame->True, Axes->False, PlotStyle->{Thickness[0.008]},FrameStyle->Thickness[.004], ColorFunction ->(Hue[#3]&), Background->Black], {i,4}],2]]

.  Plot

Plot[3 Cos[x]+2 Cos[2 x]+Cos[3 x],{x,-3 π,3 π}]

Options[Plot][[All,1]]

{AlignmentPoint,AspectRatio,Axes,AxesLabel,AxesOrigin,AxesStyle,Background,BaselinePosition,BaseStyle,ClippingStyle,ColorFunction,ColorFunctionScaling,ColorOutput,ContentSelectable,DefaultAxesStyle,DefaultBaseStyle,DefaultFrameStyle,DefaultLabelStyle,DisplayFunction,Epilog,Evaluated,EvaluationMonitor,Exclusions,ExclusionsStyle,Filling,FillingStyle,FormatType,Frame,FrameLabel,FrameStyle,FrameTicks,FrameTicksStyle,GridLines,GridLinesStyle,ImageMargins,ImagePadding,ImageSize,LabelStyle,MaxRecursion,Mesh,MeshFunctions,MeshShading,MeshStyle,Method,PerformanceGoal,PlotLabel,PlotPoints,PlotRange,PlotRangeClipping,PlotRangePadding,PlotRegion,PlotStyle,Prolog,RegionFunction,RotateLabel,Ticks,TicksStyle,WorkingPrecision}

?PlotRange

Plot[3 Cos[x]+2 Cos[2 x]+Cos[3 x],{x,-3 π,3 π},AxesOrigin->{-3π, 0},Ticks->{{-4,0,4}, Automatic},AxesLabel->{x,y},PlotStyle->{Thickness[0.005], Black}]

Plot[{-1,1} (Sqrt[1-(x^2)]),{x,-1,1},PlotStyle->{Thickness[0.005],Black},AspectRatio->Automatic]

Plot[3 Cos[x]+2 Cos[2 x]+Cos[3 x],{x,-3 π,3 π},PlotRange->{-4,7},Frame->True,FrameTicks->{{Automatic, None}, {Range[-3 π,3π, π],None}},Axes->None,PlotStyle->{Thick, Black}]

SetOptions[{Plot,ListPlot,ParametricPlot,PolarPlot, ListLinePlot},Frame->True,Axes->None, FrameTicks->{{Automatic,None}, {Automatic, None}}];
SetOptions[{Plot,ParametricPlot,PolarPlot, ListPlot, ListLinePlot},PlotStyle->{{Thick, Black}}];

.  An ArcSin Curiosity

f[x_]:=Sin[x]+ArcSin[x]

Plot[f[x],{x,-0.8,0.8},FrameTicks->{{{-1,0,1}, None},{ Range[-0.8, 0.8, 0.4],None}}]

Plot[f[x],{x,-1,1},FrameTicks->{{{-1,0,1}, None},{Range[-0.8, 0.8, 0.4], None}},Epilog->Text[Style["Curvy!",FontSize->16],{0.6,2.}]]

ser=Series[f[x],{x,0,14}]

Normal[ser]

.3  Adaptive Plotting

Plot[Sin[x],{x,-30,30},PlotPoints->6,MaxRecursion->3]

Plot[Sin[x],{x,0,10},Mesh->All,MeshStyle->PointSize[0.02],PlotStyle->{Thick,Gray}]

Plot[Sin[x],{x,0,10},Mesh->All,MeshStyle->PointSize[0.02],PlotStyle->{Thick,Gray},PlotPoints->10,MaxRecursion->0]

Reap[p=Plot[Sin[x],{x,0,10},PlotPoints->10,MaxRecursion->0,EvaluationMonitor:>Sow[x]];]

Manipulate[Plot[Sin[x],{x,0,π},Method->{Refinement->{ControlValue->(90-n) °}},Mesh->All,MeshStyle->{Red,PointSize[Large]},PlotPoints->8],{n,0,90,2}]

Show[{Plot[Sin[x],{x,-3,0}],Plot[Cos[x],{x,0,3}]},PlotRange->All]

Short[InputForm[p]]

Short[Cases[p,_Line,∞]]

Short[Cases[p,Line[x_] :> x,∞]]

.4  Plotting Tables and Tabling Plots

Plot[{Sin[x],ArcSin[x]},{x,-1,1}]

Plot[Tooltip[{Sin[x],ArcSin[x]}],{x,-1,1}]

Plot[Evaluate[Table[c Sin[x+c],{c,0.2,0.4,0.2}]],{x,0,2 π},PlotStyle->{{Gray,Thick},{Black,Thick}}]

Plot[Table[c Sin[x+c],{c,0.2,1,0.2}],{x,0,2 π},PlotStyle->{{Gray,Thick},{Black,Thick}}]

Plot[D[(x^2),x], {x,0,1}]

f[x_]:=Sin[x]+3 (E^(Cos[x]))
Plot[Evaluate[(∂_x)Nest[f,x,4]],{x,-1,1},PlotRange->All]

Clear[f]; Nest[f,x,4]

NestList[f,x,4]

NestList[Cos,0.8,15]

Nest[Cos,0.8,100]

Plot[Evaluate[Table[Tooltip[Nest[Cos,x,i],i], {i, 10}]],{x,-5,5},PlotRange->{0.4,1.05},PlotStyle->Table[{Thick,GrayLevel[If[EvenQ[i],0,0.7]]},{i,10}]]

Plot[Nest[Sin,x,100],{x,-5,5}]

.5  Dealing with Discontinuities

Plot[Sec[x],{x,-2 π,2 π}]

Plot[Sec[x],{x,-2 π,2 π},Exclusions->Range[-((3 π)/2),((3 π)/2),π],FrameTicks->{{Automatic,None},{Range[-2 π,2 π,π],None}}]

Plot[((Sec[x])/(1+(x^2) Tan[x])),{x,-((5 π)/2),((5 π)/2)},Exclusions->{Cos[x]==0,1+(x^2) Tan[x]==0},ExclusionsStyle->{{Dashing[0.02], Gray, Thickness[0.008]}},FrameTicks->{{Automatic,None},{Range[-2 π,2 π,π],None}}]

Plot[Floor[(x^2)],{x,0,3}]

Plot[PrimePi[x],{x,0,50},"SymbolicPiecewiseSubdivision"->True]

.6  ListPlot

Fibonacci[Range[0,10]]

ListPlot[Fibonacci[Range[0,50]],PlotStyle->{PointSize[0.02],Black},PlotRange->{-2 (10^9),1.4 (10^10)}]

ListPlot[Table[{n,Log[Fibonacci[n]]},{n,1,100}]]

linearApprox=Fit[Table[{n,Log[Fibonacci[n]]},{n,50,100}],{1,n},n]

approx=Simplify[(E^linearApprox)]

expApprox=approx/.(E^(a_ n)):>((((E^a)))^n)

expApprox/.n->10000
N[Fibonacci[10000]]

expCoeffs=(E^(CoefficientList[linearApprox,n]))

RootApproximant[expCoeffs]

N[{((GoldenRatio^n)/(Sqrt[5]))/.n->100,Fibonacci[100]}]

ϕ=N[GoldenRatio,25];{Fibonacci[100],(((ϕ^100)-(((1-ϕ))^100))/(Sqrt[5]))}

FunctionExpand[Fibonacci[n]]

Simplify[%, n∈Integers]

RSolve[{F[n]==F[n-1]+a F[n-2],F[0]==0,F[1]==1},F[n],n]

IntegerDigits[25!]

DeleteCases[%, 0]

Clear[f];
f[n_]:=Last[DeleteCases[IntegerDigits[n!],0]]

data=Table[{n,f[n]},{n,0,100}];
ListPlot[data]

ListLinePlot[data]

ListLinePlot[data,Mesh->All,MeshStyle->PointSize[0.014],PlotRange->{0,9},AspectRatio->1/3,PlotStyle->{Black,Thickness[0.003]}]

freqs = Sort[Tally[Table[f[n], {n, 0, 1000}]]]

BarChart[Last/@freqs,ChartLabels->Placed[ Last/@ freqs, Top],PlotRange->{0,320}, Epilog->Text[2, {0.5, 20}]]

.7  ParametricPlot

ParametricPlot[{Cos[t],Sin[t]},{t,0,2π},PlotStyle->Thick,ColorFunction-> (Hue[#3]&)]

ParametricPlot[{Sin[5 t] Cos[2 t],Sin[3 t] Sin[2 t]},{t,0,2 π},PlotStyle->{Thickness[0.016 ]},ColorFunction ->(Hue[ #3]&)]

Manipulate[ParametricPlot[{Sin[5 t] Cos[2 t],Sin[3 t] Sin[2 t]},{t,0,tmax},PlotStyle->Thickness[0.016],PlotRange->{{-1.05,1.05},{-1.05,1.05}},ColorFunction -> (Hue[#3 tmax/(2π)]&)],{tmax,0.01,2 π}]

plotlist=Table[ParametricPlot[{Sin[5 t] Cos[2 t],Sin[3 t] Sin[2 t]},{t,0,tmax},PlotStyle->Thickness[0.016],PlotRange->1.1,ColorFunction->(Hue[#3 tmax/(2π)]&)],{tmax,0.01,2 π,(1/40) (2 π-0.01)}];

ListAnimate[plotlist,AnimatorElements->All,AnimationRunning->False]

PolarPlot[Sin[3 θ],{θ,0, π}, ColorFunction -> (Hue[#3]&)]

PolarPlot[(E^(Sin[θ]))-2 Cos[4 θ]+((Sin[θ/12])^5),{θ,0,24 π},PlotRange->{{-4,4},{-3.2,4.3}},PlotStyle->{Thickness[0.005],Black}]

f={Sin[5 t] Cos[2 t],Sin[3 t] Sin[2 t]};
fd=Norm[D[f,t]]; 
n=20;
ParametricPlot[f,{t,0, 2π},PlotStyle->Thick,Mesh->n,MeshFunctions->{(fd/. t-> #3)&},
MeshStyle ->None,MeshShading->(Hue/@Range[0,0.5,0.5/(n-1)])]

RI={((29 Cos[t])/18)+(13/36) Cos[3 t]+(1/36) Cos[5 t],((41 Sin[t])/36)+(11/72) Sin[3 t]+(1/72) Sin[5 t]};

fd=Norm[D[RI,t]];
ParametricPlot[RI,{t,0,2 π},PlotStyle->Thick,Mesh->n,MeshFunctions->{fd/.t->#3&},MeshStyle->None,MeshShading->Hue/@Range[0,0.5,(0.5/(n-1))], Frame->True, Axes->False]

StarrPlot[a_,b_,c_,opts___]:=ParametricPlot[(2+(1/2) Sin[a t]) {Cos[t+((Sin[b t])/c)],Sin[t+((Sin[b t])/c)]},{t,0,2 π},opts,PlotRange->3,PlotPoints->100,PlotLabel-> StringForm["a = ``, b = ``, c = ``",a,b,c]]

StarrPlot[8,16,4]

GraphicsGrid[{{StarrPlot[9,16,4],StarrPlot[9,6,6]},{StarrPlot[8,16,16],StarrPlot[6,18,18]}}]

Manipulate[StarrPlot[a,b,c],{a,1,20,1},{b,1,20,1},{c,1,20,1}]

ParametricPlot[{Cos[t],Sin[t]}+(1/2) {Cos[7 t],Sin[7 t]}+(1/3) {Cos[-17 t+(π/2)],Sin[-17 t+(π/2)]},{t,0,2 π}]

f1[t_,s1_]:={Cos[s1 t],Sin[s1 t]};
f2[t_, r2_, s2_]:=r2 {Cos[s2 t],Sin[s2 t]};
f3[t_, r3_, s3_,offset_]:=r3 {Cos[s3 t+offset],Sin[s3 t+offset]};
epi[r2_, r3_,  s1_,s2_, s3_,offset_][t_]:=f1[t,s1]+f2[t,r2, s2]+f3[t, r3,  s3,offset];

Manipulate[ParametricPlot[epi[r2,r3,s1,s2,s3,offset][t],{t,0,2 π},PlotPoints->100,PlotRange->{{-2,2},{-2,2}}],{{r2,0.5},0.1,1},{{r3,0.25},0.1,1},{{s1,1},-2,2,1},{{s2,4},-5,5,1},{{s3,19},-19,19,1},{{offset,(π/2)},0,π},ControlPlacement->Left]

.  Difficult Plots

poly=Normal[Series[Cos[x], {x,0,200}]];
N[poly[[{1,2,3,-3,-2,-1}]]]

Plot[poly,{x,0, 100}, PlotRange->{-2, 2}, PlotStyle->{Thickness[0.0016], Black}]

poly/.x->70//Short

N[poly/.x->70]

poly /. x-> 70.

(10^15)+(1./1000)-(10^15)

poly /. x-> N[70,20]

Precision[%]

poly /. x-> N[70,200]

Precision[%]

Plot[poly,{x,0,100},WorkingPrecision->200,PlotRange->{-1.3,2}]

N[Sin[(10^40)]]

ans=Sin[SetPrecision[10^40, 16]]
Precision[ans]

N[Sin[(10^40)],20]

N[Sin[(10^80)],20]

$MaxExtraPrecision= 1000; N[Sin[(10^80)],20]

PrecisePlot[f_,{x_,a_,b_},opts___]:=Plot[
N[f/. x -> Rationalize[y,10^-3],3],{y,a,b},
Evaluate[Sequence@@FilterRules[{opts},Options[Plot]]]]

Options[PrecisePlot]={PrecisionGoal->6};
PrecisePlot[f_,{x_,a_,b_},opts___]:=Module[{g,pg},
pg=PrecisionGoal/.{opts}/.Options[PrecisePlot];
SetAttributes[g,NumericFunction];
g[z_?InexactNumberQ]:=Evaluate[f/.x->z]; 
Plot[N[g[SetPrecision[y,∞]],pg],{y,a,b},
Evaluate[Sequence@@FilterRules[{opts},Options[Plot]]]]];

PrecisePlot[poly,{x,0,100},PlotRange->{-1.3,3},MaxRecursion->3]

s=Expand[(10^12) (((1-x))^10)]