Pensieve Header: Generating the plots accompanying the QualitativeAnalysis handout.

Initialization

SetDirectory["C:\\drorbn\\AcademicPensieve\\Classes\\12-267\\QualitativeAnalysis"];

TagProperties[_] := {};
Options[CellExport] = {
PageWidth -> 6, CellFilter -> Identity, ExportFormat -> ".pdf", ExportOptions -> {}, Split -> False
};
CellExport[tag_String] := CellExport[tag, TagProperties[tag]];
CellExport[tag_String, OptionsPattern[]] := Module[
{cells, cell},
cells=OptionValue[CellFilter][Cases[
NotebookGet[EvaluationNotebook[]], c_Cell /; FreeQ[List@@c, Cell] && !FreeQ[c, CellTags->tag],
Infinity
]];
If[!OptionValue[Split],
If[Length[cells]≥1,
If[Length[cells]==1,
cells=Append[First[cells], PageWidth -> 72OptionValue[PageWidth]],
cells=Cell[CellGroup[cells], PageWidth -> 72OptionValue[PageWidth]]
];
Show[
Import[Export[tag<>OptionValue[ExportFormat],cells, Sequence@@OptionValue[ExportOptions]]],
ImageSize -> 120
]
],
k=0;
GraphicsRow[Table[
++k;
Show[
Import[Export[
tag<>"-"<>ToString[k]<>OptionValue[ExportFormat],
Append[cell, PageWidth -> 72OptionValue[PageWidth]],
Sequence@@OptionValue[ExportOptions]
]],
ImageSize -> 120
],
{cell, cells}
]]
]
];

J0

{(Subscript[J, 0])}=NDSolve[
(x^2)y''[x]+x y'[x]+(x^2)y[x]==0
&& y[1]==1 && y'[1]==0,
y[x], {x,1,50}
];
Plot[Evaluate[y[x] /. (Subscript[J, 0])], {x,1,50}]

CellExport["J0"]

{(Subscript[V, 0])}=NDSolve[
V''[x]+(1+(1/(4(x^2))))V[x]==0
&& V[1]==1 && V'[1]==1/2,
V[x], {x,1,50}
];
Plot[Evaluate[{y[x] /. (Subscript[J, 0]), V[x] /. (Subscript[V, 0])}], {x,1,50}]

CellExport["J0V0"]

zs=Table[BesselJZero[0,k], {k,10}] // N

zs-RotateRight[zs]

FindRoot[y[x] /. (Subscript[J, 0]), {x,11.79}]

zs=x /. Table[FindRoot[y[x] /. (Subscript[J, 0]), {x,λ}], {λ, 2.8, 50, 3.14}]

Table[zs[[j+1]]-zs[[j]], {j, 1,15}]

TagProperties["BesselZeros"] = {PageWidth -> 8};
CellExport["BesselZeros"]

Bessel

GraphicsGrid[Partition[Table[
Plot[{BesselJ[α, x], BesselY[α, x]}, {x, 0, 1}, AxesLabel -> Automatic, PlotPoints -> 100,
PlotLabel -> StringReplace["y'' + (1/x)y' + (1-((α^2)/(x^2)))y == 0", "α"->ToString[α]]],
{α, 0., 1.5, 0.5}
],2]]

CellExport["Bessel"]

Oscillatory RSP

Solve[r(r-1)+(13/2)==0, r]

Sol=NDSolve[
y''[x]-3y'[x]+((13/(2(x^2)))+Cos[x])y[x]==0&& y[1]==1 && y'[1]==0,
y[x], {x,ϵ=(10^(-9)),1}
];
Plot[Evaluate[y[x] /. Sol], {x,ϵ,1}, PlotPoints -> 1000]

CellExport["OscillatoryRSP"]

Plot[Evaluate[Table[
y[x] /.
DSolve[y''[x]-y[x]==0
&& y[0]==1 && y'[0]==c,
y[x], x],
{c, {1,0,-0.9, -1,-2}}
]], {x,0,2}, AspectRatio->2]

TagProperties["PushoutForce"] = {Split -> True};
CellExport["PushoutForce"]

Change of the Independent Variable

a=50; b=40;
ψ=NDSolve[
y''[x]-(2/x)y'[x]+y[x]==0
&& y[1]==1 && y'[1]==0,
y[x], {x,1,a}
];
Plot[Evaluate[y[x] /. ψ],
{x,1,a}, PlotRange ->{-b, b}]

ψ=NDSolve[
y''[z]+(1/(((3z))^(4/3)))y[z]==0
&& y[1/3]==1 && y'[1/3]==0,
y[z], {z,1,(a^3)/3}
];
Plot[Evaluate[y[z] /. ψ],
{z,1,(a^3)/3}, PlotRange ->{-b, b}]

CellExport /@ {"Indep1", "Indep2"}

Airy

Ai1=NDSolve[y''[x]+x y[x]==0 && y[0]==1 && y'[0]==0, y[x], {x,-3,10}];
Ai2=NDSolve[y''[x]+x y[x]==0 && y[0]==0 && y'[0]==1, y[x], {x, -3,10}];
Ai=Join[Ai1, Ai2]

Plot[Evaluate[y[x] /. Ai], {x, -3,10}]

CellExport["Airy"]

Euler

Rasterize[Plot3D[
If[γ<1/4,x^(((1-(Sqrt[1-4γ]))/2)), (Sqrt[x])Cos[Log[x](Sqrt[4γ-1])]],
{γ,0,4}, {x,0,1000},
PlotPoints -> 100, AxesLabel -> Automatic, LabelStyle -> Medium
], ImageSize ->500]

TagProperties["Euler"] = {ExportFormat -> ".jpg", ExportOptions -> {ImageSize -> 800}};
CellExport["Euler"]

Rasterize[DensityPlot[
If[γ<1/4,x^(((1-(Sqrt[1-4γ]))/2)),
(Sqrt[x])Cos[Log[x](Sqrt[4γ-1])]],
{γ,0,4}, {x,0,1000},
PlotPoints -> 100,  LabelStyle -> Medium
], ImageSize ->360]

TagProperties["EulerDensity"] = {ExportFormat -> ".jpg", ExportOptions -> {ImageSize -> 800}};
CellExport["EulerDensity"]

UltraFine

eq = (x^2)y''[x]+γ y[x] /. y -> (Y[(E^(#))]&) /.
x -> Log[z];
eq= Expand[(eq/(Coefficient[eq, Y''[z]]))]

{p,q} = Coefficient[eq, #]& /@
{Y'[z], Y[z]};
Q=q-(1/4)(p^2)-(1/2)(∂_z)p

TagProperties["UltraFine"] = {ExportFormat -> ".png"};
CellExport["UltraFine"]

Bessel3D

Rasterize[Plot3D[
{BesselJ[α, x], BesselY[α, x]},
{x,0,20}, {α,0,1}, 
PlotPoints -> 100, AxesLabel -> Automatic, LabelStyle -> Medium,
PlotStyle->{Pink,LightBlue}
], ImageSize ->750]

TagProperties["Bessel3D"] = {ExportFormat -> ".jpg", ExportOptions -> {ImageSize -> 1200}};
CellExport["Bessel3D"]

Export All

False&&  (
tags=Cases[
NotebookGet[EvaluationNotebook[]],
(CellTags->tag_) :> tag,
Infinity
] // Union;
(# -> CellExport[#])& /@ tags
)