Visualisierung innerhalb Mathematica 6.0
und ausserhalb mittels LiveGraphics3D

Andreas Kriegl (c) 2007.12.03

Initialisierung

Wir ergaenzen den Suchpfad durch den Pfad des Notebooks.

PrependTo[$Path,NotebookDirectory[]];
SetDirectory[NotebookDirectory[]];
SetOptions[Manipulate,ControlPlacement->Right,SaveDefinitions->True];

Bemerkung: Die externen Links habe ich wie folgt produziert

Hyperlink[Framed["Beispiel-1.html"],"./Beispiel-1.html"]
Hyperlink[Framed["Beispiel-2.html"],"./Beispiel-2.html"]
Hyperlink[Framed["Torus.html"],"./Torus.html"]
Hyperlink[Framed["LiveForm.m"],"./LiveForm.m"]
Hyperlink[Framed["PP3D.m"],"./PP3D.m"]
Hyperlink[Framed["demo-1.m"],"./demo-1.m"]
Hyperlink[Framed["demo-2a.m"],"./demo-2a.m"]
Hyperlink[Framed["demo-2b.m"],"./demo-2b.m"]
Hyperlink[Framed["demo-2c.m"],"./demo-2c.m"]
Hyperlink[Framed["demo-2d.m"],"./demo-2d.m"]
Hyperlink[Framed["torus.m"],"./torus.m"]
Hyperlink[Framed["Beispiel-1.html"],"file://"<>NotebookDirectory[]<>"Beispiel-1.html"]
Hyperlink[Framed["Beispiel-2.html"],"file://"<>NotebookDirectory[]<>"Beispiel-2.html"]
Hyperlink[Framed["Torus.html"],"file://"<>NotebookDirectory[]<>"Torus.html"]
Hyperlink[Framed["Homepage LiveGraphics3D"],"http://www.vis.uni-stuttgart.de/%7Ekraus/LiveGraphics3D/"]

Ein einfaches Beispiel via Graphics3D MouseOver

Definition der Graphik

Zuerst die Definition der Parameterabhaengigen 3D-Graphik

ϵ=0.01;
Clear[G1]
G1[t_,s_]:=Graphics3D[
{
(* die Grundflaeche *)
Polygon[{{0,0,0},{1,0,0},{1,1,0},{0,1,0}}],
(* x- und y-Koordinate *)
Line[{{t,0,ϵ},{t,s,ϵ},{0,s,ϵ}}],
(* die Flaechennormale *)
Thickness[0.005],Line[{{t,s,0},{t,s,1-0.01}}],
PointSize[0.02],Red,Point[{t,s,1}]
},
PlotRange->{{-0.2,1.2},{-0.2,1.1},{-0.2,1.2}}
]

Visualisierung der Graphik

Visualisierung innerhalb Mathematica 6.0

Gezeichnet wird sie nur nach Angabe expliziter Parameterwerte

Show[G1[0.5,0.5]]

Interaktiv kann sie manipuliert werden durch

Manipulate[G1[t,s],{t,0,1},{s,0,1},ControlType->VerticalSlider,ControlPlacement->Left]

Oder besser :

Manipulate[G1[p[[1]],p[[2]]],{{p,{0.5,0.5},"Position"},{0,0},{1,1}}]

Oder mittels Locator:

Manipulate[G1[p[[1]],p[[2]]],{{p,{0.5,0.5},{1,1}},Locator}]

Visualisierung mittels Live Graphics3D in Web-Browser

Nun laden wir das Macro MouseOver fuer's Schreiben des Inputs fuer das LiveGraphics3D Java-Applet.

<<"LiveForm.m"

Wir schreiben die Definition der Graphic in eine Datei MouseOver

WriteLiveForm["demo-1.m",G1[t,s]]

Nun produzieren wir eine html-Datei MouseOver mittels Text-Editor.

Und koennen MouseOver mittels Web-Browser betrachten.

Eine in Hinblick auf Sichtbarkeiten verbesserte Version.

n=10;
Remove[G1]
G1[t_,s_]:=Graphics3D[
{
(* der rechteckige Teil der Grundflaeche bis zum mobilen Basispunkt *)
Polygon[{{0,0,0},{0,s,0},{t,s,0},{t,0,0}}], 
(* der Rest der Grundflaeche ohne Kanten *)
EdgeForm[],
Polygon[{{t,0,0},{1,0,0},{1,1,0},{t,s,0}}],
Polygon[{{0,s,0},{0,1,0},{1,1,0},{t,s,0}}],
(* die Flaechennormel  aus kleinen Stuecken zusammengesetzt *)
Thickness[0.005],
Line[Table[{t,s,i/n},{i,0,n}]],
PointSize[0.02],
Red,
Point[{t,s,1}]
},
PlotRange->{{-0.2,1.2},{-0.2,1.1},{-0.2,1.2}}
]

WriteLiveForm["demo-1.m",G1[t,s]]

Ein einfaches Beispiel via Plot3D MouseOver

Wir beschreiben eine Flaeche als Graph einer Funktion f
sowie ihre Tangentialebenen t

Die parametrisierte Graphik

Zuerst die Funktionen

Remove[f,t]
f[x_,y_]:=1-(x^2+y^2)/4
t[x_,y_,u_,v_]:=f[u,v]+
(x-u)*Derivative[1,0][f][u,v]+(y-v)*Derivative[0,1][f][u,v]

Einige Optionen und Konstante

ϵ=0.03;
z0=-1; z1=2.5;
x0=-1; x1=1;
y0=-1; y1=1;
SetOptions[Plot3D,
PlotStyle->{Directive[Opacity[0.8]]},
BoxRatios->Automatic,
Boxed->False,
Axes->False
];
SetOptions[Graphics3D,
PlotRange->{{x0,x1},{y0,y1},{z0,z1}},
BoxRatios->Automatic,
Boxed->False,
Axes->False
];
(* SetOptions[Manipulate,TrackedSymbols->{u}]; *)

Bemerkung zu Plot3D via LiveGraphics3D

P2a=Plot3D[f[x,y],{x,x0,x1},{y,y0,y1}]

Das Folgende funktioniert nur in Mathematica Version <= 5.2
In Version 5.2: Plot3D, ListPlot3D returns SurfaceGraphics
In Version 6.0: Plot3D and ParametricPlot3D returns Graphics3D[GraphicsComplexe[DATA]

WriteLiveForm["demo-2a.m",P2a]

Wir koennen Normal[ ..] verwenden um GraphicsComplex in normale Graphics3D Primitive umzuwandeln, allerdings entfernt dies auch die Faerbung der Flaechen.

WriteLiveForm["demo-2b.m",Graphics3D[Normal[P2a[[1]]]]]

Die parametrisierte  Graphik

Nun die eigentliche Graphic bestehend aus der beweglichen Ordinate G0,
sowie den Plot3D P der Grundflaeche, der Flaeche, sowie der Tangentialebene
und die Kombination G all dieser.

Remove[G0,P,G]
G0[u_,v_]:={
(* Diee Verbindunsggerade zwischen Parameterpunkt und Beruehrpunkt *)
Red,PointSize[0.02],Point[{u,v,z0-ϵ}],Point[{u,v,z0+ϵ}],Point[{u,v,f[u,v]+ϵ}],Point[{u,v,f[u,v]-ϵ}],
Point[{u,v,f[u,v]}],
Line[{{u,v,z0},{u,v,f[u,v]}}],
Black}
P[u_,v_]:=Plot3D[{-1,f[x,y],t[x,y,u,v]},{x,x0,x1},{y,y0,y1}];
G2[u_,v_]:=Graphics3D[{ G0[u,v] ,P[u,v][[1]] } ]

Show[G2[0.5,0.5]]

Die interaktiven Animationen der Tangentialebene

Die animierte Graphik

Manipulate[G2[u[[1]],u[[2]]],{{u,{0,0},"Fusspunkt"},{x0,x0},{x1,y1}},ContinuousAction->False]

Wir faerben die Flaechen des Plots explizit.

G2[u_,v_]:=Graphics3D[{
G0[u,v],FaceForm[RGBColor[0,1,1],RGBColor[0,0.6,0.6]],P[u,v][[1]]
}]

WriteLiveForm["demo-2c.m",Graphics3D[Normal[G2[u,v][[1]]]]]

Show[G2[0.5,0.5]]

Nun mit PP3D anstelle von Plot3D

MouseOver ist eine vereinfachte modifierte Version von ParametricPlot3D
die nur Graphics3D-Primitive zurueckliefert.

<<"PP3D.m"

Die 3 in P inkludierten ParametricPlot3D von vorher sind nun

P0:=PP3D[{x,y,z0},{x,x0,x1},{y,y0,y1}]
P1:=PP3D[{x,y,f[x,y]},{x,x0,x1},{y,y0,y1}]
P2[u_,v_]:=PP3D[{x,y,t[x,y,u,v]},{x,x0,x1},{y,y0,y1}]

Die Graphik G ist ganz analog

G2[u_,v_]:=Graphics3D[{
G0[u,v],
FaceForm[RGBColor[0,1,1],RGBColor[0,0.6,0.6]],
P0[[1]],P1[[1]],P2[u,v][[1]]
}
]

Show[G2[0.5,0.5]]

Wir schreiben diese wieder zur Verwendung als Input in unser html-Seite MouseOver

WriteLiveForm["demo-2d.m",G2[u,v]]

Innerhalb Mathematica sieht das ganze nun wie folgt aus

Manipulate[G2[u[[1]],u[[2]]],{{u,{0,0},"Position"},{x0,y0},{x1,y1}}]

Ein einfaches Beispiel via ParametricPlot3D / PP3D MouseOver

Wir rollen ein Rechteck auf verschiedende Weisen zu einem Torus ein.

Die parametrisierte Graphik

Das Rechteck in Ruhelage

Clear[h]
h[ϕ_,ψ_]:={ϕ,0,ψ}

Tangentiale und normale Komponente des Einrollens der x-Achse in Richtung y

ϕ ... Der Bogenlaengenparameter
t ... Der Deformationsparameter
ft ... Die tangentiale Komponente
fn ... Die vertikale Komponente

ft[t_,ϕ_]:=Sin[t ϕ]/t
fn[t_,ϕ_]:=2Sin[t ϕ/2]^2/t

Visualisierung des Einrolllens einer Gerade zu einem Kreis

Manipulate[ParametricPlot[{ft[t,ϕ],fn[t,ϕ]},{ϕ,-π,π},PlotRange->{{-π,π},{0,2}},Ticks->False],{t,0.001,1}]

Einrollen der Erzeugendenschar einer Flaeche in Richtung der Flaechennormale

Dabei ist vorausgesetzt, dass die parametrisierte Flaeche h in diesem Parameter linear ist.
Gerollt wird in Richtung der Flaechennormale.

R1[h_,t_,u_,v_]:=
h[0,v]+ft[t,u] Derivative[1,0][h][u,v]+fn[t,u]Cross[Derivative[0,1][h][u,v],Derivative[1,0][h][u,v]]
R2[h_,t_,u_,v_]:=
h[u,0]+ft[t,v] Derivative[0,1][h][u,v]+fn[t,v]Cross[Derivative[1,0][h][u,v],Derivative[0,1][h][u,v]]
R[u_,v_,t_,s_]:=R2[Function[{u1,v1},R1[h,t/2,u1,v1]],s/2,u,v]

Die Schieberegel fuer die beiden Deformations-Parameter als farbige Punkte im Raum

G03[t_,s_]:=Graphics3D[{
PointSize[0.01],
RGBColor[1,0,0],
Line[{{0,0,0},{0,2,0}}],
Point[{0,t,0}],
RGBColor[0,0.8,0],
Line[{{0,0,0},{0,-2,0}}],
Point[{0,s,0}]
}]

Testbilder

ParametricPlot3D[R1[h,1/2,u,v],{u,-π,π},{v,-π,π}]
ParametricPlot3D[R[u,v,0.5,0.5],{u,-π,π},{v,-π,π}]

Ein ParametricPlot3D mit Deformations-Parameter

P[a_]:=ParametricPlot3D[ {Cos[a t]Cos[s],Cos[a t]Sin[s],Sin[a t]},{t,-π/2,π/2},{s,-π,π},Boxed->False,Axes->False,PlotRange->{-1,1}]

Manipulate[ P[a],{a,0,1}]

Es ist ParametricPlot3D in version 5.2 
und auch in version 6.0 nicht direkt mit WriteLiveForm vertraeglich

WriteLiveForm["torus.m",Graphics3D[{P[t],G03[t,s][[1]]},Boxed->False,Lighting->Automatic]]

Die interaktiven Animationen des Torus

Interaktive Animation von ParametricPlot3D

SetOptions[ParametricPlot3D,Boxed->False,Axes->False,Lighting->Automatic,PlotRange->Automatic,PlotStyle->{Directive[Opacity[0.8]]}];

Manipulate[ParametricPlot3D[R[u,v,t,s],{u,-π,π},{v,-π,π}],{t,0.01,2},{s,0.01,2},ContinuousAction->False]

Externe interaktive Animation via LiveGraphics3D

Die deformierbare Flaeche als PP3D

PP[t_,s_]:=PP3D[R[u,v,t,s],{u,-π,π},{v,-π,π},Boxed->False]

WriteLiveForm["torus.m",Graphics3D[{PP[t,-s][[1]],G03[t,s][[1]]},Boxed->False,Lighting->Automatic]]

Interne Animation von PP3D

Manipulate[Append[PP[t,s],PlotRange->All],{t,0.01,2},{s,0.01,2},ContinuousAction->False]