Mathematicaを利用した教材作成

\(\[SelectionPlaceholder] 表紙\)

\(bx\  = \ 6\ \ Cos[u]\ \((1\  + \ Sin[u])\); 
by\  = \ 16\ \ Sin[u]; 

    rad\  = \ 4\ \((1\  - \ Cos[u]\ /\ 2)\); 

    X\  = \ If[Pi\  < \ u\  <= \ 2\ Pi, \ bx\  + \ rad\ Cos[v\  + \ Pi], \ 

        \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
        bx\  + \ rad\ Cos[u]\ Cos[v]]; 

    Y\  = \ If[Pi\  < \ u\  <= \ 2\ Pi, \ by, \ 
        by\  + \ rad\ Sin[u]\ Cos[v]]; 
Z\  = \ rad\ Sin[v]; 

    kleinb = ParametricPlot3D[{X, \ Y, \ Z}, \ {u, \ 0, \ 2\ Pi}, 
        \ {v, \ 0, \ 2\ Pi}, \ 
\ \ \ \ \ \ \ \ PlotPoints\  -> \ {48, 12}, 
        \ Axes\  -> \ False, \ Boxed\  -> \ False, \ 

        \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
        ViewPoint -> \ {0.893496, \(-1.73314\), \(-1.9499\)}]; \)

\[SelectionPlaceholder]第1章\(「電卓的機能」\)としての活用

Expand[(x + 1)^3]

Factor[x^3 + y^3 + z^3 - 3 x y z]

FactorInteger[36]

PrimeQ[1999]

Divisors[1998]

Solve[x^2 + 2 x - 15 == 0, x]

Solve[x^2 + 5 x - 3 == 0, x]

Solve[{x + 2 y == 3, 4 x - 8 y == 9}, {x, y}]

\(Needs["Algebra`SymbolicSum`"]; 
Sum[k, {k, 1, n}]\)

Sum[k^2, {k, 1, n}]

DSolve[y'[x] == -x/y[x], y[x], x]

Integrate[x^5, x]

Integrate[Sin[x] + Cos[x], x]

Integrate[x^5, {x, 3, 5}]

Integrate[Sin[5 x]^4, {x, 0, Pi/4}]

\[SelectionPlaceholder]第2章　Mathematicaでグラフィックスを

Plot[Sin[x], {x, -2 Pi, 2 Pi}]

ParametricPlot[{Cos[t], Sin[t]},{t, 0, 2 Pi},
AspectRatio -> Automatic,
Axes -> False,PlotStyle -> {Thickness[0.0002]}]

\(Show[Graphics[Disk[{0, 0}, 2]], Axes -> True, GridLines -> Automatic, 
        
AspectRatio -> Automatic, 

        PlotRange -> {{\(-6\), 6}, {\(-4\), 8}}, AxesLabel -> {X, Y}]\)

\(Module[{A, B, cir}, 
\ A = {Circle[{\(-2\), 0}, 1]}; \ 
        B = {Circle[{2, 0}, 1]}; 
\ 
        c[t_] := Circle[{t, Sqrt[3\ t^2 - 3]}, 1 + Sqrt[4\ t^2 + 4\ t + 1]]; 
        
\ L[t_] := {Dashing[{0.01}], 
            Line[{{2, 0}, {t, Sqrt[3\ t^2 - 3]}, {\(-2\), 0}}]}; 

        Show[Graphics[{A, B, c[\(-1.5\)], L[\(-1.5\)]}, Axes -> True, 
            PlotRange -> {{\(-7\), 7}, {\(-7\), 7}}, 

            GridLines -> Automatic, AspectRatio -> Automatic]]]\)

\(Plot[{Sqrt[3\ x^2 - 3], \(-Sqrt[3\ x^2 - 3]\)}, {x, \(-3\), \(-1\)}, 
        
GridLines -> Automatic, AspectRatio -> Automatic, 

        PlotRange -> {{\(-7\), 7}, {\(-7\), 7}}]\)

Show[%, %%]

\(Module[{A, B, C, L}, 
\ A = {Circle[{\(-2\), 0}, 1]}; 
\ 
        B = {Circle[{2, 0}, 1]}; 
\ 
        c[t_] := Circle[{t, Sqrt[3\ t^2 - 3]}, 1 + Sqrt[4\ t^2 + 4\ t + 1]]; 
        
\ L[t_] := {Dashing[{0.01}], 
            Line[{{2, 0}, {t, Sqrt[3\ t^2 - 3]}, 
{\(-2\), 0}}]}; 

        C = Table[c[t], {t, \(-3\), \(-1\), 0.25}]; 

        L = Table[L[t], {t, \(-3\), \(-1\), 0.25}]; 

        Show[Graphics[{A, B, C, L}, Axes -> True, 

            PlotRange -> {{\(-7\), 7}, {\(-7\), 7}}, 

            GridLines -> Automatic, AspectRatio -> Automatic]]]\)

\(Module[{A, B, cir}, 
\ A = {Circle[{\(-2\), 0}, 1]}; 
\ 
        B = {Circle[{2, 0}, 1]}; 
\ 
        c[t_] := 
          Circle[{t, \(-Sqrt[3\ t^2 - 3]\)}, 
1 + Sqrt[4\ t^2 + 4\ t + 1]]; 
        
\ L[t_] := {Dashing[{0.01}], 
            Line[{{2, 0}, 
{t, \(-Sqrt[3\ t^2 - 3]\)}, 
{\(-2\), 0}}]}; 

        Show[Graphics[{A, B, c[\(-7\)], L[\(-7\)]}, Axes -> True, 
            PlotRange -> {{\(-15\), 15}, {\(-15\), 15}}]]]\)

Plot3D[Sin[x] Sin[y], {x, 0, 2 Pi}, {y, 0, 2 Pi}]

Plot3D[Sin[x] Sin[y], {x, 0, 2 Pi}, {y, 0, 2 Pi}, Mesh -> False]

Plot3D[Sin[x] Sin[y], {x, 0, 2 Pi}, {y, 0, 2 Pi}, 
        BoxRatios -> {1, 1, 1}]

Plot3D[Sin[x] Cos[y], {x, 0, 2 Pi}, {y, 0, 2 Pi}, PlotPoints -> 30]

ParametricPlot3D[{Cos[t] Cos[u], Sin[t] Cos[u], Sin[u]}, {t, 0, 
          Pi}, {u, -Pi/2, Pi/2}, Boxed -> False]

\(Plot[Sqrt[1 - Log[x]^2], {x, 1/E, E}, 
GridLines -> Automatic, 
        AspectRatio -> 1, 
AxesLabel -> {X, Y}, 
        PlotRange -> {{0, 3}, {0, 3}}]\)

Plot[Evaluate[Table[-Log[t]/{t Sqrt[1 - Log[t]^2]} {x - t} + 
                  Sqrt[1 - Log[t]^2],
{t, 0.5, 1, 0.05}]],{x, 0, E},GridLines -> Automatic,AspectRatio -> 1,
AxesLabel -> {X, Y},PlotRange -> {{0, 3}, {0, 3}}]

Show[%, %%]

f[x_] := Sqrt[1 - Log[x]^2];
f'[x]

\(f[x_] := Sqrt[1 - Log[x]^2]; 

      p = E^\((\((1 - Sqrt[5])\)/2)\); 

      g[x_] := \(f'\)[p]\ \((x - p)\) + f[p]; 

      Plot[{f[x], g[x]}, {x, 1/E, E}, 
GridLines -> Automatic, 
        AspectRatio -> 1, 
AxesLabel -> {X, Y}, 
        PlotRange -> {{0, 3}, {0, 3}}]\)

Remove["Global`*"];
Needs["Graphics`SurfaceOfRevolution`"];
\(SurfaceOfRevolution[Sqrt[1 - Log[x]^2], {x, 1/E, E}, 
          
{t, Pi, 2\ Pi}, RevolutionAxis -> {1, 0, 0}, 
          ViewPoint -> {\(-1.334\), \(-2.381\), 2.000}]\)

Integrate[Pi (1 - Log[x]^2), {x, 1/E, E}]

Integrate[Cos[2 x]^2 Sin[x]^3, {x, 0, Pi/4}]

Remove["Global`*"];
Needs["Graphics`Graphics`"]\(PolarPlot[Sin[2\ t], {t, 0, 2\ Pi}, 
GridLines -> Automatic, 
        AspectRatio -> Automatic]\)

\(ParametricPlot[{2\ Sin[t]\ Cos[t]^2, 2\ Sin[t]^2\ Cos[t]}, 
        
{t, 0, Pi/2}, GridLines -> Automatic, AspectRatio -> Automatic]\)

\(SurfaceOfRevolution[{2\ Sin[t]\ Cos[t]^2, 
2\ Sin[t]^2\ Cos[t]}, 
        
{t, 0, Pi/4}, {p, 0, Pi}, RevolutionAxis -> {1, 0, 1}]\)

\[SelectionPlaceholder]第3章　Mathematicaでアニメ−ション

\(g[x_, k_] := x^2/\((4 - x^2)\) - k

      f[k_] := E^k - k - 1

      Do[Plot[{g[x, k], 0, 
f[k]}, {x, \(-1.95\), 1.95}, 
          PlotRange -> {{\(-2\), 2}, {\(-4\), 15}}, 

          PlotStyle -> {Thickness[0.01]}, 
GridLines -> Automatic, 

          AspectRatio -> 1.5], {k, 0, 3, 0.5}]\)

\(Box = {{0, 0}, {0, 1}, {\(-1\), 1}, {\(-1\), 0}, {0, 0}}; 

      Ito = {{\(-1\)/2, 0}, {\(-1\)/2, 1}}; 

      Ro[t_] := {{Cos[t], \(-Sin[t]\)}, {Sin[t], Cos[t]}}; 

      Lev[t_] := 
        Which[N[Tan[t]] < 
            0.5, {{\(-1\), 1/4 - Tan[t]/2}, {0, 1/4 + Tan[t]/2}}, 

          0.5 <= N[Tan[t]] <= 
            1.5, {{\(-2\)/\((1 + 2\ Tan[t])\), 0}, {0, 1/4 + Tan[t]/2}}, 

          1.5 < N[Tan[t]], {{\(-1\)/4 - 1/\((2\ Tan[t])\), 0}, {
              \(-1\)/4 + 1/\((2\ Tan[t])\), 1}}]

      Do[Show[
          Graphics[{Line[Box . Ro[t]], Line[Ito . Ro[t]], 

              Line[Lev[t] . Ro[t]]}], 
AspectRatio -> Automatic, 

          Axes -> True, PlotRange -> {{\(-1\), 1}, {0, 1.5}}], {t, 0, 
          N[Pi/2] - 0.001, N[Pi/24]}]\)

\[SelectionPlaceholder]第4章　Mathematicaでフラクタル数学

\(Clear[spawn]

      spawn[{a_, b_, c_, a_}] := 

        Block[{ab = \((a + b)\)/2, bc = \((b + c)\)/2, ac = \((a + c)\)/2}, 
          
{{a, ab, ac, a}, {b, bc, ab, b}, {c, ac, bc, c}}]; 

      spawn[l_List] := 
Flatten[Map[spawn, l], 1] /; Length[l[\([1]\)]] > 1; 
      
Do[Show[
          Graphics[{Thickness[0.001], 
              Line\ /@

                Nest[spawn, {{0, 0}, 
{1/2, Sqrt[3]/2}, {1, 0}, {0, 0}}, 
                  k]}], 
AspectRatio -> Sqrt[3]/2], {k, 1, 7}]\)

\(A1 = {1, 0, 0}; A2 = {0, 1, 0}; A3 = {0, 0, 1}; 

      norm[v_] := Sqrt[v . v]

      Gaiseki[v_, w_] := {Det[{A1, v, w}], Det[{A2, v, w}], Det[{A3, v, w}]}
          

      new[{x_, y_, z_}] := 
        norm[y - x]\ 
            Gaiseki[y - x, z - x]/
              \((norm[Gaiseki[y - x, 
z - x]]\ Sqrt[6])\) + 
          \((x + y + z)\)/3

      data[{x_, y_, z_}] := {{x, \((x + y)\)/2, \((x + z)\)/2}, {
            \((x + y)\)/2, y, \((z + y)\)/2}, {\((x + z)\)/2, \((z + y)\)/2, 
            z}, 
{\((x + z)\)/2, \((x + y)\)/2, new[{x, y, z}]}, {
            \((x + y)\)/2, \((z + y)\)/2, new[{x, y, z}]}, 
          
{\((z + y)\)/2, \((x + z)\)/2, new[{x, y, z}]}}

      fractalize[{x_, y_, z_}] := Map[Polygon[#]&, data[{x, y, z}]]

      DD[0] = {{{1, 1, \(-1\)}, {\(-1\), 1, 1}, {1, \(-1\), 1}}, {{\(-1\), 
              \(-1\), \(-1\)}, {1, 1, \(-1\)}, {1, \(-1\), 1}}, 
          
{{\(-1\), \(-1\), \(-1\)}, {1, \(-1\), 1}, {\(-1\), 1, 1}}, {{
              \(-1\), \(-1\), \(-1\)}, {\(-1\), 1, 1}, {1, 1, \(-1\)}}}; 

      T0 = Show[Graphics3D[Map[Polygon[#]&, DD[0]]]]\)

\(Do[Snoopy[n_] := Part[DD[0], n], {n, 1, Length[DD[0]]}]; 

      T1 = Show[
          Graphics3D[
            Table[fractalize[v] /. {v -> Snoopy[i]}, 
              
{i, 1, Length[DD[0]]}], 
ViewPoint -> {1.7, 1.3, 1.3}]]\)

\(DD[1] = 
        Flatten[Table[data[v] /. {v -> Snoopy[i]}, {i, 1, Length[DD[0]]}], 
          1]; 
Do[Mic[n_] := Part[DD[1], n], {n, 1, Length[DD[1]]}]; 

      T2 = Show[T1, 
          Graphics3D[
            Table[fractalize[v] /. {v -> Mic[i]}, {i, 1, Length[DD[1]]}], 

            ViewPoint -> {2, 1.3, 1.3}]]\)

\(DD[2] = 
        Flatten[Table[data[v] /. {v -> Mic[i]}, {i, 1, Length[DD[1]]}], 1]; 

      Do[Donald[n_] := Part[DD[2], n], {n, 1, Length[DD[2]]}]; 

      T3 = Show[T1, 
          Graphics3D[
            Table[fractalize[v] /. {v -> Donald[i]}, 
              
{i, 1, Length[DD[2]]}], ViewPoint -> {2, 1.3, 1.3}]]\)

\(DD[3] = 
        Flatten[Table[data[v] /. {v -> Donald[i]}, {i, 1, Length[DD[2]]}], 
          1]; 
Do[Poo[n_] := Part[DD[3], n], {n, 1, Length[DD[3]]}]; 

      T4 = Show[T1, 
          Graphics3D[
            Table[fractalize[v] /. {v -> Poo[i]}, 
{i, 1, Length[DD[3]]}], 
            ViewPoint -> {2, 1.3, 1.3}]]\)

\(Clear[initialize]

      initialize[start_List: {0. , 0. }, dim_Integer: 1000] := 

        \((path = Table[Null, {dim}]; 
X = start // N; U = {1. , 0. }; 
          path[\([1]\)] = X; count = 1)\)

      right[a_] := 

        \(U = {{t1 = Cos[aa = a\ Degree // N], t2 = Sin[aa]}, {\(-t2\), 
                t1}} . U\)

      left[a_] := right[\(-a\)]

      forward[s_] := \(path[\([\(++count\)]\)] = \((X += s\ U)\)\)

      back[s_] := forward[\(-s\)]

      finished := \(path = Take[path, count]\)

      showturtlepath := 
        \((finished; 

          Show[Graphics[Line[path]], PlotRange -> All, 
AspectRatio -> 1]; )
          \)

      Attributes[Tree] = Listable

      Listable

      branch[depth_Integer, length_, angle_, ratio_] := 
        \((
forward[length]; left[angle/2]; 

          If[depth > 0, branch[depth - 1, length\ ratio, angle, ratio], 

            AppendTo[points, X]]; right[angle]; 

          If[depth > 0, branch[depth - 1, length\ ratio, angle, ratio]]; 

          left[angle/2]; back[length]; )\)

      Tree[depth_Integer, length_, angle_, ratio_] := 
        \((initialize[]; 
points = {\ }; left[90]; 

          If[depth > 0, branch[depth, length, angle, ratio]]; finished; 

          Show[Graphics[{Line[path], PointSize[0.02], Point/@points}], 

            PlotRange -> All])\)

      Tree[5, 1, Range[45, 90, 2.5], 0.8]\)

\[SelectionPlaceholder]第5章　Mathematicaで複素数

\(Module[{sy, sy2}, 
sy = Table[1 + y\ I, {y, 0, 2, 0.1}]; 

        sy2 = Map[{Re[#^2], Im[#^2]}&, sy]; 

        Show[Graphics[{Table[Line[sy2], 
{y, \(-3\), 3, 0.5}]}], 

          Axes -> True, AspectRatio -> 1]]\)

\(Module[{sx, sx2, sy, sy2}, 

        sx = Table[x + y\ I, {x, \(-3\), 3, 0.1}]; 

        sy = Table[x + y\ I, {y, \(-3\), 3, 0.1}]; 

        sx2 = Map[{Re[#^2], Im[#^2]}&, sx]; 

        sy2 = Map[{Re[#^2], Im[#^2]}&, sy]; 

        Show[Graphics[{Table[Line[sx2], {y, \(-3\), 3, 0.5}], 

              Table[Line[sy2], {x, \(-3\), 3, 0.5}]}], 
Axes -> True, 
          AspectRatio -> 1]]\)

ComplexMapPlot[z/2 + 1/z, z, 
        RectangularGrid[{{-1, 1}, {-1, 1}}]]

ComplexMapPlot[z/2 + 1/z, z, PolarGrid[{0, 0}, {0.1, 5}]]

\(Do[ComplexMapPlot[z/2 + 1/z, z, {Circle[{0.3, n}, 0.3 + 1]}, 

          PlotRange -> {{\(-2\), 3.5}, {\(-2\), 2}}], {n, \(-0.3\), 0.3, 
          0.05}]\)