Home

<<Graphics`Animation` <<Statistics`NormalDistribution`

The Beauty of Applied Mathematics
The program code here is Mathematica

Sierpinsky Triangle

Sierpinsky Triangle

RowBox[{, RowBox[{F1[{x_, y_}] := {1/2x, 1/2y}, , F2[{x_, y_}] := {(x + 1)/2, ... ;, RowBox[{RowBox[{{x0, y0}, =, RowBox[{{, RowBox[{1., ,, 0.}], }}]}], ;}], , T = {} ;}]}]

For[j = 1, j<5000, {dummy = Random[Integer, {1, 3}], If[dummy == 1, {xn, yn ... , RowBox[{PointSize, [, 0.005, ]}]}], ,, PlotRange {{0, 1}, {0, .9}}}], ]}], ;}]

[Graphics:HTMLFiles/dynamics_6.gif]

Koch Curve

g1[{x_, y_}] := {1/3x, 1/3y} g2[{x_, y_}] := {x/6 - (y3^(1/2))/6 + 1/3, (x3^(1 ... /2, -(x3^(1/2))/6 + y/6 + 3^(1/2)/6} g4[{x_, y_}] := {1/3x + 2/3, 1/3y} Koch := {}

For[j = 1, j<5000, {dummy = Random[Integer, {1, 4}], If[dummy == 1, ... , y0} = {xn , yn}, Koch = Prepend[Koch, {xn, yn}] <br />} ; j ++]     

RowBox[{, RowBox[{RowBox[{ListPlot, [, RowBox[{Koch, ,, AspectRatio->Automatic, ,, RowBox[{PlotStyle, , RowBox[{PointSize, [, 0.002, ]}]}]}], ]}], ;}]}]

[Graphics:HTMLFiles/dynamics_11.gif]

Menger Sponge

Menger[0, {i_, j_, k_}] := {Cuboid[{i, j, k}]} ; Menger[n_, {i_, j_, k_}] := Module[{s = {}}, ... {w, 3}] ; s] ; M = Show[Graphics3D[Menger[3, {0, 0, 0}]], Boxed->False, Axes->False]

[Graphics:HTMLFiles/dynamics_14.gif]

Null^3

SpinShow[M]

[Graphics:HTMLFiles/dynamics_41.gif]

Bifurcation Diagram

Bifurcation Diagram

fa[x_] := a * x * (1 - x) Clear[a] ; RowBox[{RowBox[{ListPlot, [, <br />,    &n ... , 1}], ]}], ,, , RowBox[{PlotStyle, ->, RowBox[{PointSize, [, 0.002, ]}]}]}], ]}], ;}]

[Graphics:HTMLFiles/dynamics_45.gif]

fa[x_] := a * x * (1 - x) Clear[a] ; RowBox[{RowBox[{ListPlot, [, <br />,    &n ... , 1}], ]}], ,, , RowBox[{PlotStyle, ->, RowBox[{PointSize, [, 0.002, ]}]}]}], ]}], ;}]

[Graphics:HTMLFiles/dynamics_47.gif]

Lorentz Attractor

Lorentz = NDSolve[{x '[t] == 10 (y[t] - x[t]), y '[t] == -x[t] z[t] + 28x[t] - y[t], < ... * y[t] - 8z[t]/3, x[0] == z[0] == 0, y[0] == .3}, {x, y, z}, {t, 0, 75}, MaxSteps15000] ;

L = ParametricPlot3D[Evaluate[{x[t], y[t], z[t]}/. Lorentz], {t, 0, 75}, PlotPoints->5000, BoxedFalse, AxesFalse, AspectRatioAutomatic] ;

[Graphics:HTMLFiles/dynamics_51.gif]

SpinShow[L, Frames40, SpinRange {0 Degree, 360 Degree}, SpinOrigin {0, .3, 0}]

[Graphics:HTMLFiles/dynamics_93.gif]

Henon Attractor

RowBox[{a, :=, 1.4}] b := .3 m := 50000 F[{x_, y_}] := {1 - a x^2 + b y, x}

H := {} RowBox[{RowBox[{{x0, y0}, =, RowBox[{{, RowBox[{0., ,, 0.}], }}]}], ;}] For[i = 1, i&l ... } = F[{x0, y0}], H = Join[H, {{x1, y1}}],  {x0, y0} = {x1, y1}, } ; i ++]

ListPlot[H, PlotStyle-> {PointSize[.001], RGBColor[1, 0, 0]}, AspectRatio->Automatic] ;

[Graphics:HTMLFiles/dynamics_98.gif]

Brownian Motion

RowBox[{, RowBox[{RowBox[{x1, :=, 0.}], , T = Table[{i, x1 = R ... {0, 0}] ;, , ListPlot[T, PlotStyle-> {PointSize[.00001]}, PlotJoinedTrue] ;}]}]

[Graphics:HTMLFiles/dynamics_101.gif]

RowBox[{x1, :=, 0.}] RowBox[{x2, :=, 0.}] T = Table[{x1 = Random[NormalDistribution[x1 ... = Prepend[T, {0, 0}] ; ListPlot[T, PlotStyle-> {PointSize[.00001]}, PlotJoinedTrue] ;

[Graphics:HTMLFiles/dynamics_103.gif]

H := {{0, 0, 0}} x1 := 0 x2 := 0 x3 := 0 SeedRandom[] ; For[i = 1, i<10000, {ndist1 ... ndom[ndist2], x3 = Random[ndist3], H = Prepend[H, {x1, x2, x3}] } ; i ++]

A = Show[Graphics3D[Point/@H], BoxedFalse] ;

[Graphics:HTMLFiles/dynamics_106.gif]

SpinShow[A]

[Graphics:HTMLFiles/dynamics_132.gif]


Home

Created by Mathematica  (August 16, 2007)

This HTML document was created by converting a Mathematica notebook using Export.