$Author: leiser $
$Id: Gegenbeispiel_zum_Satz_von_Schwarz_und_Caveat.nb 1995 2010-02-08 18:23:33Z leiser $
$LastChangedDate: 2010-02-08 19:23:33 +0100 (Mon, 08 Feb 2010) $

Manipulate[
TabView[{Style["Satz von Schwarz (Satz von Clairaut)",titleStyle]->
allElements  (* see initialization for details *)
},Background->RGBColor[1,1,1],ImageSize->{tabWidth,Automatic},Alignment->Center] ,(* End TabView *)

Initialization:> ({
functionList = {
Piecewise[{{0, x==0 && y==0}},(x y^3-y x^3)/(x^2+y^2)],
Piecewise[{{0,(3 x^4+x^2+y^2)==0}},Sin[y x^3]/(3 x^4+x^2+y^2)]},
criticalPointList = {{0,0},{0,0}},
initialFunctionIndex =2,
f[x_,y_]:=functionList[[initialFunctionIndex]],
pointToWatch = criticalPointList[[initialFunctionIndex]],
pointToWatchX =pointToWatch[[1]],
pointToWatchY =pointToWatch[[2]],
xIntervallAroundPointToWatch = 1,
yIntervallAroundPointToWatch = 1,
xBound = 3, (* Defines the displayed intervall of the function itself *)
yBound = 3, (* " *)
h=xIntervallAroundPointToWatch,
animationRate = 0.16,
currentFunctionIndex = Dynamic[
If[
StringMatchQ[ToString[f[x,y]],ToString[functionList[[1]]]],
1,
2]],  (* Very simple for the moment with just two functions)*)
functionChooser=Labeled[PopupMenu[Dynamic[f[x_,y_]],functionList, BaseStyle->{12,FontFamily->"Courier",Plain}],Style["Funktion mit kritischer Stelle: ",textStyle],Top],
slider2D = Labeled[Slider2D[{Dynamic[pointToWatchX],Dynamic[pointToWatchY]},{{-xIntervallAroundPointToWatch,-yIntervallAroundPointToWatch},{xIntervallAroundPointToWatch,yIntervallAroundPointToWatch},{0.5,0.5}}],Style["\nBetrachteter Ableitungspunkt:\n(Auf Bereich klicken zum Verschieben)",textStyle],Top],
pointToWatchLabel = Dynamic[Labeled[Style["("<>ToString[pointToWatchX]<>","<>ToString[pointToWatchY]<>")",textStyle,Red,9],Style["Aktuell: (a,b)=",textStyle,Red,9],Left]],
pointToWatchResetButton = Dynamic[Button[Style["Auf kritischen Punkt (0,0) setzen",10],
{
pointToWatch = criticalPointList[[initialFunctionIndex]];
pointToWatchX =pointToWatch[[1]];
pointToWatchY =pointToWatch[[2]];
},ImageSize->{220,40}]],
(* currently unused: *)
(*
fxy[x_,y_]:=Evaluate[D[fx[x,y],y]],
fyx[x_,y_]:=Evaluate[D[fy[x,y],x]],
fxy[a_,b_,h_]:=(fx[a,b+h] - fx[a,b])/h,
fyx[a_,b_,h_]:=(fy[a+h,b] - fy[a,b])/h,
*)

(* ----------- Plots -------------- *)
plotCutsAnimation  = Dynamic[
Column[{
Animate[
Row[{
(* left part of animation *)
Column[{
Show[
Plot[Evaluate[D[f[x,y],x]]/.x->pointToWatchX,
{y,pointToWatchY-yIntervallAroundPointToWatch,pointToWatchY+yIntervallAroundPointToWatch},
AxesLabel->Automatic,PlotStyle->{Thick,Red},PlotLabel->"Schnitt (Subscript[f, x])(a,y)\n a=const="<>ToString[pointToWatchX],ImageSize->{defaultPlotImageSizeWidth+50,defaultPlotImageSizeHeight+50}, PlotRange->{{pointToWatchY-yIntervallAroundPointToWatch,pointToWatchY+yIntervallAroundPointToWatch},Full},Background->RGBColor[1,1,1]
],
Graphics[{PointSize[0.03],Black,Point[{pointToWatchY,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY}}]}],
Graphics[{PointSize[0.03],Blue,Point[{pointToWatchY+h,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY+h}}]}],
Graphics[{Thickness[0.005],Blue,Line[{
{pointToWatchY+h,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY+h}} - 10^5*({pointToWatchY+h,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY+h}} - {pointToWatchY,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY}}),
{pointToWatchY,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY}} + 
10^5*({pointToWatchY+h,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY+h}} - {pointToWatchY,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY}})
}]}]
]
(*]*),
Style["(Subscript[f, xy])("<>ToString[pointToWatchX]<>","<>ToString[pointToWatchY]<>") ≈ "<>ToString[Round[((Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY+h}) - (Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY}))/h,0.001]],plotLabelStyle,12,Red,Bold],
Style["Mathematica: (Subscript[f, xy])("<>ToString[pointToWatchX]<>","<>ToString[pointToWatchY]<>") = "<>ToString[Round[Evaluate[D[f[x,y],x,y]]/.{x->pointToWatchX,y->pointToWatchY},0.001]],plotLabelStyle,12]
}, Center] (* end column *)
,

(* right part of animation *)
Column[{
Show[
Plot[Evaluate[D[f[x,y],y]]/.y->pointToWatchY,
{x,pointToWatchX-xIntervallAroundPointToWatch,pointToWatchX+xIntervallAroundPointToWatch},
AxesLabel->Automatic,PlotStyle->{Thick,Red},PlotLabel->"Schnitt (Subscript[f, y])(x,b)\n b=const="<>ToString[pointToWatchY],ImageSize->{defaultPlotImageSizeWidth+50,defaultPlotImageSizeHeight+50}, PlotRange->{{pointToWatchX-xIntervallAroundPointToWatch,pointToWatchX+xIntervallAroundPointToWatch},Full},Background->RGBColor[1,1,1]
],
Graphics[{PointSize[0.03],Black,Point[{pointToWatchX,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX,y->pointToWatchY}}]}],
Graphics[{PointSize[0.03],Blue,Point[{pointToWatchX+h,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX+h,y->pointToWatchY}}]}],
Graphics[{Thickness[0.005],Blue, Line[{
{pointToWatchX+h,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX+h,y->pointToWatchY}} -
 10^5 * ({pointToWatchX+h,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX+h,y->pointToWatchY}} - {pointToWatchX,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX,y->pointToWatchY}}),
{pointToWatchX,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX,y->pointToWatchY}} +
 10^5 * ({pointToWatchX+h,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX+h,y->pointToWatchY}} - {pointToWatchX,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX,y->pointToWatchY}})
}]}]
],
Style["(Subscript[f, yx])("<>ToString[pointToWatchX]<>","<>ToString[pointToWatchY]<>") ≈ "<>ToString[Round[((Evaluate[D[f[x,y],y]]/.{x->pointToWatchX+h,y->pointToWatchY}) - (Evaluate[D[f[x,y],y]]/.{x->pointToWatchX,y->pointToWatchY}))/h,0.001]],plotLabelStyle,12,Red,Bold]
,
Style["Mathematica: (Subscript[f, yx])("<>ToString[pointToWatchX]<>","<>ToString[pointToWatchY]<>") = "<>ToString[Round[Evaluate[D[f[x,y],y,x]]/.{x->pointToWatchX,y->pointToWatchY},0.001]],plotLabelStyle,12]

},Center] (* end colum *)
}] (* end row *)

,{{h,pointToWatchX+xIntervallAroundPointToWatch,Dynamic[Style["                         Animation:  h = "<>ToString[TraditionalForm[NumberForm[Round[h,0.001],{4,3}]]], textStyle]]},xIntervallAroundPointToWatch,0.0001}, ControlPlacement->{Bottom},SaveDefinitions->True,AppearanceElements->None, AnimationRunning->False, DisplayAllSteps->True, AnimationRate->Dynamic[animationRate],RefreshRate->5, AnimationRepetitions->1,Paneled->False

], (* end animate *)
Labeled[Slider[Dynamic[animationRate],{0.02,0.2,0.005}],Style["Animationsrate:",textStyle] ,Left]
},Alignment->{Center,Top}]
],(* end plotsCutAnimation *)

plot3Df = Dynamic[
Show[
Plot3D[f[x,y],
{x,-xBound,xBound},
{y,-yBound,yBound},
(*
{x,pointToWatchX-xIntervallAroundPointToWatch,pointToWatchX+xIntervallAroundPointToWatch},{y,pointToWatchY-yIntervallAroundPointToWatch,pointToWatchY+yIntervallAroundPointToWatch},
*)
AxesLabel->Automatic,Mesh->5,PlotLabel->Style["f",Italic],ImageSize->{defaultPlotImageSizeWidth,defaultPlotImageSizeHeight},Background->RGBColor[1,1,1]
],
Graphics3D[{PointSize[0.05],Black,Point[{pointToWatchX,pointToWatchY, f[x,y]/.{x->pointToWatchX,y->pointToWatchY}}]}],
(* The arrow thing is far from being parametrized and automated yet ...: *)Graphics3D[{Red,Thick,Arrowheads[If[currentFunctionIndex == 1,0.1,0.01]],
Arrow[{ 
{pointToWatchX,pointToWatchY,If[currentFunctionIndex == 1,2.2, 0.3] },
{pointToWatchX,pointToWatchY,If[currentFunctionIndex == 1,0.5, 0.1]}
}]
}]
],Background -> RGBColor[1,1,1]
], (* End plot3Df *)

fx[x_,y_]:=Evaluate[D[f[x,y],x]],
plot3Dfx=Dynamic[
Show[
Plot3D[Evaluate[D[f[x,y],x]],
{x,pointToWatchX-xIntervallAroundPointToWatch,pointToWatchX+xIntervallAroundPointToWatch},{y,pointToWatchY-yIntervallAroundPointToWatch,pointToWatchY+yIntervallAroundPointToWatch},
AxesLabel->Automatic,PlotLabel->"\n (Subscript[f, x]) \n rot: Schnitt in y-Richtung",ImageSize->{defaultPlotImageSizeWidth+50,defaultPlotImageSizeHeight+50},Mesh->
{
{ (* mesh in y direction *)
(*
{(2/3)*(pointToWatchX-xIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(1/3)*(pointToWatchX-xIntervallAroundPointToWatch),{Thickness[0.002],Black}},
*)
{pointToWatchX,{Thickness[0.01],Red}}(*,

{(1/3)*(pointToWatchX+xIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(2/3)*(pointToWatchX+xIntervallAroundPointToWatch),{Thickness[0.002],Black}}
*)
},
{ (* mesh in x direction *)
(*
{(2/3)*(pointToWatchY-yIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(1/3)*(pointToWatchY-yIntervallAroundPointToWatch),{Thickness[0.002],Black}},
*)
{pointToWatchY,{Thickness[0.001],LightGray}}(*,
{(1/3)*(pointToWatchY+yIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(2/3)*(pointToWatchY+yIntervallAroundPointToWatch),{Thickness[0.002],Black}}
*)
}
}
],
Graphics3D[{PointSize[0.05],Black,Point[{pointToWatchX,pointToWatchY,Evaluate[D[f[x,y],x]]/.{x->pointToWatchX,y->pointToWatchY}}]}]
]
],

fy[x_,y_]:=Evaluate[D[f[x,y],y]],
plot3Dfy=Dynamic[
Show[
Plot3D[Evaluate[D[f[x,y],y]],
{x,pointToWatchX-xIntervallAroundPointToWatch,pointToWatchX+xIntervallAroundPointToWatch},{y,pointToWatchY-yIntervallAroundPointToWatch,pointToWatchY+yIntervallAroundPointToWatch},
AxesLabel->Automatic,PlotLabel->"\n (Subscript[f, y]) \n rot: Schnitt in x-Richtung",ImageSize->{defaultPlotImageSizeWidth+50,defaultPlotImageSizeHeight+50},Mesh->
{
{ (* mesh in y direction *)
(*
{(2/3)*(pointToWatchX-xIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(1/3)*(pointToWatchX-xIntervallAroundPointToWatch),{Thickness[0.002],Black}},
*)
{pointToWatchX,{Thickness[0.001],LightGray}}(*,

{(1/3)*(pointToWatchX+xIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(2/3)*(pointToWatchX+xIntervallAroundPointToWatch),{Thickness[0.002],Black}}
*)
},
{ (* mesh in x direction *)
(*
{(2/3)*(pointToWatchY-yIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(1/3)*(pointToWatchY-yIntervallAroundPointToWatch),{Thickness[0.002],Black}},
*)
{pointToWatchY,{Thickness[0.01],Red}}(*,

{(1/3)*(pointToWatchY+yIntervallAroundPointToWatch),{Thickness[0.002],Black}},
{(2/3)*(pointToWatchY+yIntervallAroundPointToWatch),{Thickness[0.002],Black}}
*)
}
}
],
Graphics3D[{PointSize[0.05],Black,Point[{pointToWatchX,pointToWatchY,Evaluate[D[f[x,y],y]]/.{x->pointToWatchX,y->pointToWatchY}}]}]
]
];
firstDerivPlots = Row[{plot3Dfx, plot3Dfy}];

(* ---- Explanation Window Content ---- *)
b = TextCell[Row[{"Hallo (Subscript[f, x]) blabla ",Subscript[Style["f",explanationStyle],Style["x",explanationStyle]]}],explanationStyle];
explanationWindowContent=Column[{
TextCell["\nLinke Spalte:",{explanationStyle,Bold}],
TextCell["→ Auswahl der Funktion und Anzeige seines Graphen. \n→ Auswahl des betrachteten Ableitungspunktes.\n",explanationStyle],
TextCell["Rechte Spalte:",explanationStyle,Bold],
TextCell[Row[{"In der oberen Reihe wird der Graph der ersten Ableitung gezeigt: links ",Subscript["f","x"]," und rechts ",Subscript["f","y"],". Darin miteingezeichnet ist der Schnitt in y- bzw. x-Richtung, welcher in der darunterfolgenden Animation die zweiten Ableitungen ",Subscript["f","xy"]," und ",Subscript["f","yx"]," als Grenzprozesse visualisiert. (Die Plots lassen sich manipulieren, z.B. mit dem Mauszeiger bei gedrückter linker Maustaste drehen!)"}],explanationStyle],

TextCell[Row[{"In der unteren Reihe können Sie diese Animation starten (wobei Sie die Animationsrate schneller oder langsamer machen können). Darin sehen Sie wie die beiden partiellen Ableitungen  ",Subscript["f","xy"]," und ",Subscript["f","yx"], " als Grenzwerte von Sekantensteigungen ermittelt werden und dass beide Werte im Allgemeinen zwar gleich sind, nicht aber im kritischen Punkt (a,b) = (0,0) der beiden Beispielsfunktionen. Hier ist nämlich die Voraussetzung des Satzes von Schwarz, dass die zweiten Ableitungen in beide Richtungen stetig sein müssen, nicht erfüllt.\n"}],{explanationStyle}],
TextCell["Zu beachten:",{explanationStyle,Bold}],
TextCell[Row[{"Es werden unter der Animation auch die beiden Ausdrücke für ",Subscript["f","xy"]," und ",Subscript["f","yx"]," angezeigt, wie sie Computer Algebra Systeme (hier z.B. Mathematica) häufig berechnen. Im kritischen Punkt (0,0) sind die beiden zweiten Ableitungen verschieden, wie die Visualisierung zeigt. (Und was mit einer exakten Rechnung anhand der Definition der zweiten partiellen Ableitungen verifiziert werden kann.) Viele CAS ignorieren aber den Umstand, dass in diesen kritischen Punkten der Satz von Schwarz nicht gilt und geben - wie demonstriert - fälschlicherweise gleiche Werte für beide Ableitungen aus!"}],explanationStyle]},{Left,Top}]; 
(* End Explanation Window Content *)

explanationButton = Button[Style["Erklärung",9],CreateDocument[TextCell[Pane[explanationWindowContent]],WindowFrame->"Normal",WindowSize->{650,500},WindowTitle->"Erklärung"],ImageSize->{90,20},Background->RGBColor[0.9,0.9,0.9]]; (* End Button *)
subTitle = Style["Gegenbeispiele und Bemerkung zu Computer Algebra Systemen",textStyle];

(* ---- Overall GUI Layout ---- *)
tabWidth=950;
subTitleRow = Row[{subTitle,"  ",explanationButton},ImageSize->{Full,Automatic}];
leftMain = Column[{
"\n",functionChooser,"\n", plot3Df,slider2D, pointToWatchLabel, pointToWatchResetButton
},Alignment->Center];
rightMain = Column[{
firstDerivPlots,
plotCutsAnimation
},Background->RGBColor[1,1,1],Alignment->Center];

allElements = Column[{
subTitleRow,
Row[{leftMain,rightMain}]
},Center];

(* ---- Style Definitions ---- *)
titleStyle={FontFamily->"Arial",14,Bold,RGBColor[0.35,0.35,0.35],Background->RGBColor[1,1,1,0]};textStyle={FontFamily->"Arial",12,Bold,RGBColor[0.35,0.35,0.35],Background->RGBColor[1,1,1,0]};
explanationStyle={FontFamily->"Arial",12,Plain,RGBColor[0.35,0.35,0.35],Background->RGBColor[1,1,1,0],AutoIndent->False,ParagraphIndent->0,TextJustification->1};
plotLabelStyle={FontFamily->"Times",14,Plain,RGBColor[0.35,0.35,0.35],Background->RGBColor[1,1,1,0]};
defaultPlotImageSizeWidth=250;
defaultPlotImageSizeHeight=250

}) (* End Initialization *)

,SaveDefinitions->True,AppearanceElements->None,Paneled->False,SynchronousUpdating->False
] (* End Manipulate *)

2009, Projekt LEMUREN, Lernen Multimedial, Departement Mathematik, ETH Zürich | Licence: CC-BY-SA

$LastChangedDate: 2010-02-08 19:23:33 +0100 (Mon, 08 Feb 2010) $