home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / PROGRAMM.PAK / BOOKPICT.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  4.3 KB  |  146 lines
  1.  
  2. Needs["Graphics`ParametricPlot3D`"]
  3. Needs["Graphics`Shapes`"]
  4. Needs["Graphics`Polyhedra`"]
  5. Needs["Graphics`ArgColors`"]
  6.  
  7. Needs["Graphics`ComplexMap`"]
  8. Needs["ProgrammingExamples`RungeKutta`"]
  9. Needs["ProgrammingExamples`RandomWalk`"]
  10.  
  11. (* Moebius transform *)
  12.  
  13. chapter1 := PolarMap[ (2#-I)/(#-1)&, {0, 5, 0.2}, {0, 2Pi, Pi/15} ]
  14.  
  15. (* Minimal surface *)
  16.  
  17. chapter2 :=
  18.     ParametricPlot3D[{r*Cos[phi] - (r^2*Cos[2*phi])/2,
  19.         -(r*Sin[phi]) - (r^2*Sin[2*phi])/2, (4*r^(3/2)*Cos[(3*phi)/2])/3},
  20.         {r, 0.0001, 1, 0.9999/8}, {phi, 0, 4Pi, Pi/12}]
  21.  
  22. (* rotationally symmetric parametric surface *)
  23.  
  24. chapter3 :=
  25.     ParametricPlot3D[
  26.     {r Cos[Cos[r]] Cos[psi], r Cos[Cos[r]] Sin[psi], r Sin[Cos[r]]},
  27.     {r, 0.001, 9Pi/2 + 0.001, Pi/16}, {psi, 0, 3Pi/2, Pi/16}]
  28.  
  29. (* Fractal tile *)
  30.  
  31. om7 = N[-1+Sqrt[-3]]/2; l7=om7-2
  32. r7 = {0, 1,-1,om7,-om7,om7+1,-om7-1}
  33. g7[x_] := Flatten[Outer[Plus, r7 , l7 x]]
  34.  
  35. chapter4 := 
  36.     Module[{points, graph4},
  37.         points = Point[{Re[#],Im[#]}]& /@ Nest[g7, {0.}, 5];
  38.         graph4 = Graphics[Prepend[points, PointSize[0.003]]];
  39.         Show[ graph4, AspectRatio -> 1, Axes -> None ]
  40.     ]
  41.  
  42. (* Sphere with random holes *)
  43.  
  44. chapter5 := Show[ Graphics3D[Select[Sphere[], Random[]>0.5&]] ]
  45.  
  46. (* Saddle surface *)
  47.  
  48. chapter6 := CylindricalPlot3D[r^2 Cos[2 phi],
  49.         {r, 0, 1/2, 1/16}, {phi, 0, 2Pi, 2Pi/24}]
  50.  
  51. (* Van-der-Pol equation *)
  52.  
  53. chapter7 :=
  54.     Module[{vdp, eps = 1.5, x, xdot},
  55.         vdp = RungeKutta[{xdot, eps (1 - x^2) xdot - x}, {x, xdot},
  56.                          {2, 0}, {4Pi, 0.05}];
  57.         ListPlot[vdp, PlotJoined -> True, AspectRatio -> Automatic]
  58.     ]
  59.  
  60.  
  61. (* Fourier approximations of saw-tooth *)
  62.  
  63. l5 = Table[ Sum[Sin[i x]/i, {i, n}], {n, 5} ];
  64.  
  65. chapter9 := Plot[ Evaluate[l5], {x, -0.3, 2Pi+0.3} ]
  66.  
  67. (* spiral with varying radius *)
  68.  
  69. chapter10 :=
  70.     ParametricPlot3D[{r (1 + phi/2) Cos[phi], r (1 + phi/2) Sin[phi], -phi/2},
  71.         {r, 0.1, 1.1, 0.125}, {phi, 0, 11Pi/2, Pi/12}]
  72.  
  73. (* diagonally shaded surface *)
  74.  
  75. chapter11 :=
  76.     SphericalPlot3D[ {Sin[theta],
  77.         FaceForm[GrayLevel[0.05 + 0.9 Sin[2theta + phi]^2],
  78.                  GrayLevel[0.05 + 0.9 Sin[2theta - phi]^2]]},
  79.         {theta, 0, Pi, Pi/36}, {phi, 0, 3Pi/2, Pi/18},
  80.         Lighting->False ]
  81.  
  82. (* Random walk *)
  83.  
  84. appendixA := RandomWalk[5000]
  85.  
  86. (* Minimal Surface II *)
  87.  
  88. appendixB :=  ParametricPlot3D[
  89.     {(r^2*Cos[2*phi])/2 - Log[r], -phi - (r^2*Sin[2*phi])/2, 2*r*Cos[phi]},
  90.         {r, 0.0004, 2.0004, 2.0/12}, {phi, -2Pi, 3Pi, 4Pi/90},
  91.         ViewPoint->{-2.1, -1.1, 1.2}, PlotRange->All ]
  92.  
  93. (* Great icosahedron *)
  94.  
  95. appendixC := Show[ Polyhedron[GreatIcosahedron] ]
  96.  
  97. (* book cover: exponentially shrinking torus *)
  98.  
  99. torus[ R_, r_, psi_, phi_, h_ ] :=
  100.     { (R + r Cos[psi]) Cos[phi],
  101.       (R + r Cos[psi]) Sin[phi],
  102.       r Sin[psi],
  103.       FaceForm[ ColorCircle[h], ColorCircle[h, 0.6] ]
  104.     }
  105.  
  106. Segment[ {phi0_, phi1_, dphi_}, {psi0_, psi1_, dpsi_} ] :=
  107.     ParametricPlot3D[
  108.         Evaluate[torus[1.2, Exp[-phi/(3Pi)], psi + phi/8, phi, psi-3Pi/4]],
  109.         {phi, phi0, phi1, dphi}, {psi, psi0, psi1, dpsi},
  110.         DisplayFunction->Identity ]
  111.  
  112. cover :=
  113.      Module[{glist, dphi = 2Pi/36, dpsi = 2Pi/32},
  114.         glist = {Segment[{-Pi/4,    0, dphi}, {Pi/2, 2Pi, dpsi}],
  115.                  Segment[{  0,  3Pi/2, dphi}, {0, 2Pi, dpsi}],
  116.                  Segment[{3Pi/2,  2Pi, dphi}, {1Pi/4, 7Pi/4, dpsi}],
  117.                  Segment[{2Pi,  7Pi/2, dphi}, {0, 2Pi, 2dpsi}],
  118.                  Segment[{7Pi/2,  4Pi, dphi}, {0, 6Pi/4, 2dpsi}],
  119.                  Segment[{4Pi, 11Pi/2, dphi}, {0, 2Pi, 4dpsi}],
  120.                  Segment[{11Pi/2, 6Pi, dphi}, {-Pi/4, 5Pi/4, 4dpsi}],
  121.                  Segment[{6Pi, 17Pi/2, dphi/2}, {0, 2Pi, 4dpsi}]};
  122.         Show[ glist,
  123.             Boxed -> False, Lighting -> False, PlotRange -> All,
  124.             DisplayFunction -> $DisplayFunction ]
  125.     ]
  126.  
  127. (* cover of first edition: Maeder's shell *)
  128.  
  129. t0 = 0.001; t1 = N[ Pi - t0 ]
  130. dt = (t1 - t0)/36; dp = N[ Pi/20 ]
  131.  
  132. part[t0_, phi0_, phi1_] := Block[{theta, phi},
  133.     SphericalPlot3D[{Sin[theta] (2+Cos[phi/2]),
  134.                      FaceForm[ColorCircle[phi/2, 1], ColorCircle[phi/2, 0.7]]},
  135.                     {theta, t0, t1, dt}, {phi, phi0, phi1, dp},
  136.                     DisplayFunction -> Identity]
  137.     ]
  138.  
  139. cover1 :=
  140.     Module[{glist},
  141.         glist = {part[t0, 0, 3Pi/2],     part[Pi/2, 3Pi/2, 4Pi/2],
  142.                  part[t0, 4Pi/2, 7Pi/2], part[Pi/2, 7Pi/2, 8Pi/2]};
  143.         Show[ glist, Boxed -> False, Lighting -> False,
  144.               DisplayFunction -> $DisplayFunction ]
  145.     ]
  146.