Fold Catastrophe

Author

Eric W. Weisstein
November 8, 2005

This notebook downloaded from http://mathworld.wolfram.com/notebooks/DifferentialGeometry/FoldCatastrophe.nb.

For more information, see Eric's MathWorld entry http://mathworld.wolfram.com/FoldCatastrophe.html.

©2005 Wolfram Research, Inc. except for portions noted otherwise

Additional Authors

Original graphic by
Dr. W. Sanns
University of Applied Sciences
Darmstadt, Germany
September 23, 2005

Graphic

F[x_,u_]:=x^3+u x

D1F[x_, u_] := Evaluate[D[F[x, u],x]]

D2F[x_, u_] := Evaluate[D[D1F[x, u],x]]

foldSurface=
  Plot3D[F[x,u],{x,-3,2.6},{u,-2.9,1.5},AspectRatio->2,Boxed->False,PlotPoints->50,
    ViewPoint->{-0.6,-2,0.2},Mesh->False,PlotRange->{{-3,2.6},{-2.9,1.5},{-5,10}},HiddenSurface->True,ClipFill->None]

SingularPoints=Solve[D1F[x,u]==0,{u}]

Flatten[%]

s=u/.%

F[x,s]

SP=ParametricPlot3D[{x,s,F[x,s],
{Thickness[0.008],RGBColor[1, 0, 0]}},{x,-1, 1}]

Projektion=ParametricPlot3D[{x,s,-5,
{Thickness[0.008],RGBColor[0, 0, 1]}},{x,-1,1}]

SPsichtbar=With[{epsilon=0.07},ParametricPlot3D[{x,s,F[x,s]+epsilon,
{Thickness[0.009],RGBColor[1, 0, 0]}},{x,-1,1}
]]

Projektionnachu=ParametricPlot3D[{0,s,-5,
{Thickness[0.01],RGBColor[0, 1,0]}},{x,-1,1}];

Katastbeginn=Graphics3D[{RGBColor[1,0,0],PointSize[0.03],Point[{0,0,-5}]}]

Sattel=Graphics3D[{RGBColor[1,1,0],PointSize[0.02],Point[{0,0,0.2}]}]

<<Graphics`PlotField3D`

vliste = 
{
	{{-1,0,-5} ,{1,0,0}}, 
	{{0,0,-5} ,{0,0.2,0}} 
	
	}

akreuz=ListPlotVectorField3D[vliste,VectorHeads->False,ScaleFactor->3,Axes->False]

g=Show[{foldSurface,SPsichtbar,Projektion,Projektionnachu,Katastbeginn,akreuz, Sattel} ,Boxed->True,ImageSize->200]