計算数学 2019 / 計算数学特論 2019

Table of Contents

例題及びレポート課題等解答例

logo_footer.png

授業に関する情報

重要: 試験情報

この授業では、期末試験を実施します。どちらの試験においても、授業のプリン トなどの持ち込みは可とします。一方、インターネットの使用については、本サ イト (授業のサイト) 以外の閲覧は禁止です (閲覧した場合、カンニングとみな します)。

期末試験は、*** の授業時間中に実施します。

参考サイト

第 1 章 Excel VBA プログラミングの概要

ex1-1: 最初の例

Sub ex1_1 ()

   Dim i As Long
   Dim x As Double

   i = 21
   x = 3.14

   Cells(1,2) = "整数値" 
   Cells(1,3) = "実数値"
   Cells(2,2) = i 
   Cells(2,3) = x

End Sub

pr1-1: 四則演算

Sub pr1_1 ()

   Dim a As Long
   Dim b As Long

   a = 5
   b = 3

   Cells(4,2) = "加算" 
   Cells(4,3) = "減算"
   Cells(4,4) = "乗算" 
   Cells(4,5) = "除算"
   Cells(4,6) = "商"
   Cells(4,7) = "余り"

   Cells(5,2) = a + b
   Cells(5,3) = a - b
   Cells(5,4) = a * b
   Cells(5,5) = a / b
   Cells(5,6) = a \ b
   Cells(5,7) = a Mod b

End Sub

pr1-2: 繰り返し処理 (For 文)

Sub pr1_2 ()

   Dim a As Long
   Dim i As Long

   Cells(7, 2) = "i"
   Cells(8, 2) = "i*i"

   For i = 1 To 10
      Cells(7, i+2) = i
      Cells(8, i+2) = i*i
   Next i

End Sub

第 2 章 変数と演算

ex2-1: 処理の流れ

Sub ex2_1 ()

   Dim i As Long
   Dim x As Double

   i = 1
   x = 2.5

   Cells(1,2) = i
   Cells(1,3) = x

   i = 10
   x = 5

   Cells(2,2) = i
   Cells(2,3) = x

End Sub

ex2-2: 四則演算

Sub ex2_2 ()

   Dim x As Double
   Dim y As Double

   Cells(4,2) = "x"
   Cells(4,3) = "y"

   x = 1.1

   y = x
   Cells(5,2) = x
   Cells(5,3) = y

   y = x + 2
   Cells(6,2) = x
   Cells(6,3) = y

   y = x - 2
   Cells(7,2) = x
   Cells(7,3) = y

   y = (x - 1) * 2
   Cells(8,2) = x
   Cells(8,3) = y

   y = ((x + 2) * 3)/(3 + x)
   Cells(9,2) = x
   Cells(9,3) = y 

End Sub

ex2-3: 代入演算子 (等号)

Sub ex2_3 ()

   Dim i As Long 

   i = 1
   Cells(11,2) = i

   i = i + 1
   Cells(11,3) = i

   i = i * 5
   Cells(11,4) = i

   i = i - 4
   Cells(11,5) = i

   i = i / 2
   Cells(11,6) = i

End Sub

ex2-4: 平均点の計算

Sub ex2_4 ()

   Cells(13,2) = "点数→"
   Cells(14,2) = "平均点→"

   Dim mean As Double

   mean = 0

   mean = mean + Cells(13,3)
   mean = mean + Cells(13,4)
   mean = mean + Cells(13,5)
   mean = mean + Cells(13,6)
   mean = mean + Cells(13,7)

   mean = mean / 5

   Cells(14,3) = mean

End Sub

pr2-1: 分散の計算

Sub pr2_1 ()

   Cells(13,2) = "点数→"
   Cells(14,2) = "平均点→"
   Cells(15,2) = "分散→"

   Dim mean As Double
   Dim var As Double

   mean = 0
   var = 0

   mean = mean + Cells(13,3)
   mean = mean + Cells(13,4)
   mean = mean + Cells(13,5)
   mean = mean + Cells(13,6)
   mean = mean + Cells(13,7)

   mean = mean / 5

   Cells(14,3) = mean

   var = var + Cells(13,3) ^ 2
   var = var + Cells(13,4) ^ 2
   var = var + Cells(13,5) ^ 2
   var = var + Cells(13,6) ^ 2
   var = var + Cells(13,7) ^ 2

   var = var / 5 - mean ^ 2

   Cells(15,3) = var

End Sub

pr2-2: 値の入れ替え

通常は、以下のように補助変数 (ここでは a) を導入して値の入れ替えを行う:

Sub pr2_2 ()

   Dim x As Double
   Dim y As Double
   Dim t As Double

   Cells(17,3) = "x↓"
   Cells(17,4) = "y↓"
   Cells(18,2) = "元の数値→"
   Cells(19,2) = "入れ替え後の数値→"

   x = Cells(18,3)
   y = Cells(18,4)

   t = x
   x = y
   y = t

   Cells(19,3) = x
   Cells(19,4) = y

End Sub

この練習問題は、補助変数を使わなくても作成できる (ただし、分かりにくいので、 普通はこういうことはしない):

Sub pr2_2_1()

   Dim x As Double
   Dim y As Double

   Cells(17, 3) = "x↓"
   Cells(17, 4) = "y↓"
   Cells(18, 2) = "元の数値→"
   Cells(19, 2) = "入れ替え後の数値→"

   x = Cells(18, 3)
   y = Cells(18, 4)

   x = x - y
   y = x + y
   x = y - x

   Cells(19, 3) = x
   Cells(19, 4) = y

End Sub

第 3 章 条件分岐

ex3-1: 絶対値の計算

ex3-1: 絶対値の計算

Sub ex3_1 ()

   Dim a As Long

   Cells(1,2) = "元の数値"
   a = Cells(2,2)

   If a < 0 Then

      a = -a

   End If

   Cells(1,3) = "絶対値"
   Cells(2,3) = a

End Sub

ex3-2: 最大値の出力

ex3-2: 最大値の出力

Sub ex3_2 ()

   Dim a As Long
   Dim b As Long
   Dim max As Long

   Cells(4,2) = "数値1"
   Cells(4,3) = "数値2"
   a = Cells(5,2)
   b = Cells(5,3)

   If a > b Then

      max = a

   Else

      max = b

   End If

   Cells(4,4) = "最大値"
   Cells(5,4) = max

End Sub

ex3-2-1: ひとつの If 文だけで作成したプログラム (練習問題)

Sub ex3_2_1()

   Dim a As Long
   Dim b As Long
   Dim max As Long

   Cells(4, 2) = "数値1"
   Cells(4, 3) = "数値2"
   a = Cells(5, 2)
   b = Cells(5, 3)

   max = b

   If a > b Then

      max = a

   End If

   Cells(4, 4) = "最大値"
   Cells(5, 4) = max

End Sub

ex3-3: 符号の判定

ex3-3: 符号の判定

Sub ex3_3 ()

   Dim a As Long

   Cells(7,2) = "数値"
   Cells(7,3) = "符号"
   a = Cells(8,2)

   If a > 0 Then

      Cells(8,3) = "プラス"

   ElseIf a < 0 Then

      Cells(8,3) = "マイナス"

   Else

      Cells(8,3) = "ゼロ"

   End If

End Sub

ex3-3-1: ひとつの If 文とひとつの ElseIf 文だけで作成したプログラム (練習問題)

Sub ex3_3_1()

   Dim a As Long

   Cells(7, 2) = "数値"
   Cells(7, 3) = "符号"
   a = Cells(8, 2)

   Cells(8, 3) = "ゼロ"

   If a > 0 Then

      Cells(8, 3) = "プラス"

   ElseIf a < 0 Then

      Cells(8, 3) = "マイナス"

   End If

End Sub

pr3-1: 2 次方程式の解を出力

Sub pr3_1 ()

   Dim a As Double
   Dim b As Double
   Dim c As Double
   Dim D As Double
   Dim x1 As Double
   Dim x2 As Double

   Cells(10,2) = "a↓"
   Cells(10,3) = "b↓"
   Cells(10,4) = "c↓"
   Cells(10,5) = "解 1↓"
   Cells(10,6) = "解 2↓"

   a = Cells(11,2)
   b = Cells(11,3)
   c = Cells(11,4)

   D = b * b - 4 * a * c

   If D >= 0 Then

      x1 = ( -b + Sqr(D) ) / (2 * a)
      x2 = ( -b - Sqr(D) ) / (2 * a)

      Cells(11,5) = x1
      Cells(11,6) = x2

   Else

      Cells(11,5) = "解無し"
      Cells(11,6) = "解無し"

   End If

End Sub

pr3-2: 3 つの変数の最大値を出力

Sub pr3_2 ()

   Dim a As Long
   Dim b As Long
   Dim c As Long
   Dim max As Long

   Cells(13,2) = "a↓"
   Cells(13,3) = "b↓"
   Cells(13,4) = "c↓"
   a = Cells(14,2)
   b = Cells(14,3)
   c = Cells(14,4)

   max = a

   If b > max Then

      max = b

   End If

   If c > max Then

      max = c

   End If 

   Cells(13,5) = "max(a,b,c)↓"
   Cells(14,5) = max

End Sub

pr3-2-1: 中央値

Sub pr3_2_1()

   Dim a As Long
   Dim b As Long
   Dim c As Long
   Dim med As Long

   Cells(13, 2) = "a↓"
   Cells(13, 3) = "b↓"
   Cells(13, 4) = "c↓"
   a = Cells(14, 2)
   b = Cells(14, 3)
   c = Cells(14, 4)

   med = a

   If b > med And c > med Then

      If b > c Then

         med = c

      Else

         med = b

      End If

   ElseIf b < med And c < med Then

      If b > c Then

         med = b

      Else

         med = c

      End If

   End If

   Cells(13, 6) = "med(a,b,c)↓"
   Cells(14, 6) = med

End Sub

pr3-3: 絶対値が大きい方の変数を出力

Sub pr3_3 ()

   Dim a As Long
   Dim b As Long
   Dim max_abs As Long

   Cells(16,2) = "a↓"
   Cells(16,3) = "b↓"
   a = Cells(17,2)
   b = Cells(17,3)

If a * a > b * b Then

      max_abs = a

   Else

      max_abs = b

   End If

   Cells(16,4) = "絶対値が大きいのは↓"
   Cells(17,4) = max_abs

End Sub

pr3-3-1: 奇数か偶数かの判定

\(a\) と \(b\) を整数型の変数とする。VBA で \(a/2\) の値が小数になる場合、小数 点以下は切り捨てまたは切り上げになることを用いる (\(a>0, b>0\) のとき)。

Sub pr3_3_1()

   Dim a As Long
   Dim b As Long

   Cells(18, 2) = "数値↓"
   Cells(18, 3) = "判定↓"
   a = Cells(19, 2)
   b = a / 2

   If b * 2 = a Then

      Cells(19, 3) = "偶数"

   Else

      Cells(19, 3) = "奇数"

   End If

End Sub

第 4 章 繰り返し処理

ex4-1: for 文の簡単な例 (for 文)

Sub ex4_1 ()

   Dim i As Long

   Cells(1, 2) = "i"
   Cells(2, 2) = "i*i"

   For i = 1 To 10

      Cells(1, i+2) = i
      Cells(2, i+2) = i*i

   Next i

End Sub

ex4-2: for 文の簡単な例 (Do 文)

Sub ex4_2 ()

   Dim i As Long

   Cells(4, 2) = "i"
   Cells(5, 2) = "i*i"

   i = 1
   Do 
      Cells(4, i+2) = i
      Cells(5, i+2) = i*i
      i = i+1
   Loop Until i >= 10

End Sub

ex4-3: 和の計算

Sub ex4_3 ()

   Dim i As Long
   Dim sum As Long

   Cells(7, 2) = "i"
   Cells(8, 2) = "和"

   sum = 0
   For i = 1 To 10

      sum = sum + i
      Cells(7, i+2) = i
      Cells(8, i+2) = sum

   Next i

End Sub

ex4-4: 漸化式

Sub ex4_4 ()

   Dim n As Long
   Dim a As Double
   Dim r As Double

   a = 1
   r = 0.9

   Cells(10, 2) = "n"
   Cells(11, 2) = "a_n"

   For n = 1 To 25

      Cells(10, n+2) = n
      Cells(11, n+2) = a
      a = r * a

   Next n

End Sub

ex4-5: 数値積分

Sub ex4_5 ()

   Dim N As Long, i As Long
   Dim sum As Double
   Dim pi As Double
   Dim a As Double, b As Double
   Dim h As Double, x As Double

   N = 100
   sum = 0
   pi = 3.14159265

   a = 0 
   b = pi / 2
   h = (b - a) / N

   Cells(13, 2) = "積分値→"

   x = a
   For i = 0 To N-1

      sum = sum + (Sin(x) + Sin(x+h)) / 2 * h
      x = x + h

   Next i

   Cells(13, 3) = sum

End Sub

pr4-1: 自然対数の底

自然対数の底として用いられる定数 \(e = 2.71828\dots\) (無理数) はネイピア数と も呼ばれる。その値は、次のように極限値により定義される:

\begin{eqnarray*} e = \lim_{n \to \infty} \left( 1 + \frac 1n \right)^n \end{eqnarray*}
Sub pr4_1()

   Dim n As Long

   Cells(15, 2) = "n"
   Cells(16, 2) = "a_n"

   For n = 10 To 100 Step 10

      Cells(15, n / 10 + 2) = n
      Cells(16, n / 10 + 2) = (1 + 1 / n) ^ n

   Next n

End Sub

pr4-2: 階乗の計算

Sub pr4_2 ()

   Dim i As Long
   Dim fact As Long

   Cells(15, 2) = "i"
   Cells(16, 2) = "和"

   fact = 1
   For i = 1 To 10

      fact = fact * i
      Cells(15, i+2) = i
      Cells(16, i+2) = fact

   Next i

End Sub

pr4-2-1: コンビネーションの計算

コンビネーション \({}_nC_r\) は

\begin{equation*} {}_nC_r = \frac {n!}{r! (n-r)!} \end{equation*}

で定義される。このまま計算することもできるが、あらかじめ約分できる所は約分 した方が良い:

\begin{equation*} {}_nC_r = \frac {(n-r+1) \cdot (n-r + 2) \cdots (n-1) \cdot n } {1\cdot 2 \cdot 3 \cdots (r-1) \cdot r} \end{equation*}

この右辺の分母 (dfact) と分子 (nfact) をそれぞれ計算することで、コンビネーショ ンを求めたのが以下のプログラムである:

Sub pr4_2_1()

   Dim i As Long, K As Long
   Dim nfact As Long, dfact As Long

   Cells(20, 2) = "nCi"

   For i = 1 To 10

      dfact = 1
      For K = 1 To i

         dfact = dfact * K

      Next K

      nfact = 1
      For K = 10 - i + 1 To 10

        nfact = nfact * K

      Next K

      Cells(20, i + 2) = nfact / dfact

   Next i

End Sub

pr4-3: 九九の表

Sub pr4_3 ()

   Dim i As Long
   Dim j As Long

   For j = 1 To 9
      For i = 1 To 9

         Cells(j+18, i+2) = i*j

      Next i
   Next j

End Sub

pr4-4: 数値積分

次の積分の値は \(\pi\) になる:

\[ \int_0^{1} \frac{4}{1+x^2} dx \]

これは、\(x = \tan(\theta)\) と置換積分ですぐに確かめられる:

\begin{eqnarray*} \int_0^{1} \frac{4}{1+x^2} dx &=& 4\int_0^{\pi/4} \frac {1}{1 + \tan^2 \theta}\frac {1}{\cos^2 \theta} d\theta\\ &=& 4\int_0^{\pi/4} d\theta = 4 \times \frac {\pi}{4} = \pi \end{eqnarray*}

上の積分値が \(\pi\) になる (もう少し直感的な) 理由は、 \(\{\arctan(x)\}' = \frac{1}{1+x^2}\) であることによる:

\begin{eqnarray*} \int_0^{1} \frac{4}{1+x^2} dx &=& 4\int_0^{1} \arctan' (x) dx\\ &=& 4\left[\arctan (x)\right]_0^{1} = 4 \times \frac {\pi}{4} = \pi \end{eqnarray*}
Sub pr4_4 ()

   Dim N As Long
   Dim sum As Double
   Dim pi As Double
   Dim a As Double
   Dim b As Double
   Dim h As Double

   N = 20
   sum = 0

   a = 0 
   b = 1
   h = (b - a) / N

   Cells(32, 2) = "積分値→"

   x = a
   For i = 0 To N-1

      sum = sum + (4/(1+x*x) + 4/(1+(x+h)*(x+h))) / 2 * h
      x = x + h

   Next i

   Cells(32, 3) = sum

End Sub

pr4-5: 2 変数の漸化式

Sub pr4_5 ()

   Dim n As Long
   Dim a As Double
   Dim b As Double
   Dim r As Double

   a = 1000
   b = 0
   r = 0.01

   Cells(34, 2) = "n"
   Cells(35, 2) = "a_n"
   Cells(36, 2) = "b_n"

   For n = 1 To 25

      Cells(34, n+2) = n
      Cells(35, n+2) = a
      Cells(36, n+2) = b

      b = b + r * (a - b)
      a = a - r * a

   Next n

End Sub

第 5 章 配列

ex5-1: 平均点の計算

Sub ex5_1 ()

   Cells(1,2) = "点数→"
   Cells(2,2) = "平均点→"

   Dim mean As Double
   Dim x(5) As Double

   mean = 0

   x(1) = Cells(1,3)
   x(2) = Cells(1,4)
   x(3) = Cells(1,5)
   x(4) = Cells(1,6)
   x(5) = Cells(1,7)

   mean = x(1) + x(2) + x(3) + x(4) + x(5)
   mean = mean / 5

   Cells(2,3) = mean

End Sub

ex5-2: 平均点の計算 (for 文)

Sub ex5_2 ()

   Cells(1,2) = "点数→"
   Cells(2,2) = "平均点→"

   Dim i As Long
   Dim sum As Double, mean As Double
   Dim x(5) As Double

   x(1) = Cells(1,3)
   x(2) = Cells(1,4)
   x(3) = Cells(1,5)
   x(4) = Cells(1,6)
   x(5) = Cells(1,7)

   sum = 0
   For i = 1 To 5

     sum = sum + x(i)

   Next i

   mean = sum / 5
   Cells(2,3) = mean

End Sub

ex5-3: 最高点と最低点

Sub ex5_3 ()

   Cells(1,2) = "点数→"
   Cells(4,2) = "最高点→"
   Cells(5,2) = "最低点→"

   Dim i As Long
   Dim max As Double, min As Double
   Dim x(5) As Double

   For i = 1 To 5
      x(i) = Cells(1,i+2)
   Next i

   max = x(1)
   min = x(1)

   For i = 1 To 5

     If x(i) > max Then
        max = x(i)
     End If

     If x(i) < min Then
        min = x(i)
     End If

   Next i  

   Cells(4,3) = max
   Cells(5,3) = min

End Sub

ex5-4: 成績順にソート

Sub ex5_4 ()

   Cells(1,2) = "点数→"
   Cells(6,2) = "降順→"

   Dim i As Long, j As Long
   Dim tmp As Double, x(5) As Double

   For i = 1 To 5
      x(i) = Cells(1,i+2)
   Next i

   For i = 1 To 5
     For j = i+1 To 5

       If x(i) < x(j) Then

         tmp  = x(i)
         x(i) = x(j)
         x(j) = tmp

       End If

     Next j

     Cells(6,i+2) = x(i)

   Next i  
End Sub

pr5-1: ベクトルの内積

Sub pr5_1 ()

   Cells(8,2) = "ベクトル x →"
   Cells(9,2) = "ベクトル y →"
   Cells(10,2) = "内積→"

   Dim i As Long, sum As Double
   Dim x(6) As Double, y(6) As Double

   For i = 1 To 6
     x(i) = Cells(8,i+2)
     y(i) = Cells(9,i+2)
   Next i

   sum = 0
   For i = 1 To 6
     sum = sum + x(i) * y(i)
   Next i

   Cells(10,3) = sum

End Sub

pr5-2: 相関係数

Sub pr5_2 ()

   Cells(13,2) = "数学 X →"
   Cells(14,2) = "英語 Y →"
   Cells(15,2) = "平均 (数学)→"
   Cells(15,4) = "分散 (数学)→"
   Cells(16,2) = "平均 (英語)→"
   Cells(16,4) = "分散 (英語)→"
   Cells(17,2) = "相関係数→"

   Dim i As Long
   Dim mx As Double, my As Double
   Dim vx As Double, vy As Double
   Dim vxy As Double, rxy As Double
   Dim x(6) As Double, y(6) As Double

   For i = 1 To 6
     x(i) = Cells(13,i+2)
     y(i) = Cells(14,i+2)
   Next i

   '平均値
   mx = 0
   my = 0
   For i = 1 To 6
     mx = mx + x(i)
     my = my + y(i)
   Next i

   mx = mx / 6
   my = my / 6

   Cells(15,3) = mx
   Cells(16,3) = my

   '分散・共分散
   vx = 0
   vy = 0
   vxy = 0
   For i = 1 To 6
     vx = vx + x(i) * x(i)
     vy = vy + y(i) * y(i)
     vxy = vxy + x(i) * y(i)
   Next i

   vx = vx / 6 - mx * mx
   vy = vy / 6 - my * my
   vxy = vxy / 6 - mx * my

   Cells(15,5) = vx
   Cells(16,5) = vy

   '相関係数

   rxy = vxy / Sqr(vx * vy)   
   Cells(17,3) = rxy

End Sub

第 6 章 整数と最大公約数

ex6-1: 商と余りの計算

Sub ex6_1()

   Cells(1, 2) = "割り算"
   Cells(2, 2) = 27 / 7

   Cells(1, 3) = "商"
   Cells(2, 3) = 27 \ 7

   Cells(1, 4) = "余り"
   Cells(2, 4) = 27 Mod 7

End Sub

ex6-2: 最大公約数とユークリッドの互除法

Sub ex6_2()

    Dim i As Long  
    Dim n1 As Long
    Dim n2 As Long
    Dim nt As Long

    Cells(4, 2) = "数値 1 ↓"
    Cells(4, 3) = "数値 2 ↓"
    n1 = Cells(5, 2)
    n2 = Cells(5, 3)

    If n1 > n2 Then

        nt = n1
        n1 = n2
        n2 = nt

    End If

    i = 1
    Do 

      nt = n1
      n1 = n2 Mod n1
      n2 = nt

      Cells(6, i+1) = nt
      i = i+1

    Loop Until n1 = 0

End Sub

一番最後に出力された数字が最大公約数である。

pr6-1: ツェラーの公式

Sub pr6_1()

    Dim J As Long, K As Long
    Dim m As Long, d As Long
    Dim h As Long

    Cells(8, 2) = "西暦 (上 2 桁) ↓"
    Cells(8, 3) = "西暦 (下 2 桁) ↓"
    Cells(8, 4) = "月 ↓"
    Cells(8, 5) = "日 ↓"
    Cells(8, 6) = "曜日 ↓"
    J = Cells(9, 2)
    K = Cells(9, 3)
    m = Cells(9, 4)
    d = Cells(9, 5)

    h = d + ((m+1) * 26) \ 10 + K + (K \ 4) + (J \ 4) - 2*J
    h = h Mod 7
    Cells(9, 6) = h

End Sub

1 月・ 2 月の場合の \(m, J, K\) の変換を自動化することもできる:

Sub pr6_1_1()

   Dim h As Long, Y As Long 
   Dim J As Long, K As Long
   Dim m As Long, d As Long

   Cells(11, 2) = "西暦 ↓"
   Cells(11, 3) = "月 ↓"
   Cells(11, 4) = "日 ↓"
   Cells(11, 5) = "曜日 ↓"
   Y = Cells(12, 2)
   m = Cells(12, 3)
   d = Cells(12, 4)

   If m < 3 Then

      m = m + 12
      Y = Y - 1

   End If

   J = Y \ 100
   K = Y Mod 100

   h = d + ((m+1) * 26) \ 10 + K + (K \ 4) + (J \ 4) - 2*J
   h = h Mod 7
   Cells(12, 5) = h

End Sub

pr6-2: 最小公倍数

ふたつの正整数 \(n_1\) と \(n_2\) の最大公約数を、 \({\rm gcd}(n_1, n_2)\) とす る。このとき、\(n_1\) と \(n_2\) は、ある正整数 \(p\) と \(q\) を用いて、

\begin{eqnarray*} n_1 &=& p \times {\rm gcd}(n_1, n_2) \\ n_2 &=& q \times {\rm gcd}(n_1, n_2) \end{eqnarray*}

と表せる。ここで、 \(p\) と \(q\) は互いに素になる。したがって、最小公倍数は

\begin{eqnarray*} p q \times {\rm gcd}(n_1, n_2) = \frac {n_1 n_2}{{\rm gcd}(n_1, n_2)} \end{eqnarray*}

で与えられる。実際に計算する際は、この右辺を計算すれば良い。

Sub pr6_2()

    Dim i As Long  
    Dim n1 As Long, n2 As Long
    Dim nt As Long
    Dim gcd As Long, prdct As Long 

    Cells(14, 2) = "数値 1 ↓"
    Cells(14, 3) = "数値 2 ↓"
    Cells(16, 2) = "最小公倍数 →"
    n1 = Cells(15, 2)
    n2 = Cells(15, 3)

    prdct = n1 * n2

    If n1 > n2 Then

        nt = n1
        n1 = n2
        n2 = nt

    End If

    i = 1
    Do 

      nt = n1
      n1 = n2 Mod n1
      n2 = nt

      Cells(6, i+1) = nt
      i = i+1

    Loop Until n1 = 0

    Cells(16, 3) = prdct / nt

End Sub

第 7 章 素数

ex7-1: 素数の判定

Sub ex7_1()

    Dim n As Long
    Dim i As Long
    Dim check As Long

    Cells(1, 2) = "調べたい数値↓"
    Cells(1, 3) = "判定↓"

    n = Cells(2, 2)
    check = 1

    For i = 2 To n - 1
        If n Mod i = 0 Then
            check = 0
            Exit For
        End If
    Next i

    If check = 1 Then
        Cells(2,3) = "素数である"
    Else
        Cells(2,3) = "素数でない"
    End If

End Sub

ex7-2: 素数の判定 (改良版)

Sub ex7_2 ()

    Dim n As Long
    Dim i As Long
    Dim check As Long

    Cells(4, 2) = "調べたい数値↓"
    Cells(4, 3) = "判定↓"

    n = Cells(5, 2)
    check = 1

    For i = 2 To Sqr(n)
        If n Mod i = 0 Then
            check = 0
            Exit For
        End If
    Next i

    If check = 1 Then
        Cells(5,3) = "素数である"
    Else
        Cells(5,3) = "素数でない"
    End If

End Sub

pr7-1: 素数のリスト

Sub pr7_1()

    Dim n As Long, i As Long
    Dim check As Long, num As Long

    num = 1
    Cells (7, 2) = "素数のリスト"

    For n = 2 To 100
       check = 1
       For i = 2 To n - 1
          If n Mod i = 0 Then
             check = 0
             Exit For
          End If
       Next i

       If check = 1 Then
          Cells(7, num+2) = n
          num = num + 1
       End If
    Next n
End Sub

第 8 章 方程式の根

ex8-1: バビロニアの平方根

漸化式

\begin{eqnarray*} x_{n+1} = \frac 12 \left(x_n + \frac a{x_n}\right) \end{eqnarray*}

で、 \(a\) の平方根が求まることの初等的な説明については、

http://www-math.edu.kagoshima-u.ac.jp/~fractaro/C-elementary/for.htm

などを参照 (以下のニュートン法に基づく説明も参照)。

Sub ex8_1 ()

   Dim i As Long
   Dim x As Double, a As Double

   a = 2
   x = 5

   Cells (1,2) = "平方根→"

   For i = 1 To 10

      x = 0.5 * (x + a / x)
      Cells (1, i+2) = x

   Next i

End Sub

ex8-2: 2 分法: 円周率

超越方程式

\begin{eqnarray*} \tan x = 1 \end{eqnarray*}

を解くプログラム。 \(\frac {\pi}4\) の値が求まる。たまにニュースで「コンピュー タを用いて円周率を小数点以下何桁まで計算」という報道があるが、この例も (アルゴリズムは違うが) そうした「円周率の実際の値」を求めるプログラムであ る。

Sub ex8_2 ()

   Dim i As Long, xmid As Double
   Dim xmax As Double, xmin As Double

   xmin = 0
   xmax = 1

   Cells(3, 2) = "xmin→"
   Cells(4, 2) = "xmax→"

   For i=1 To 20

      xmid = (xmax + xmin) / 2

      If  tan(xmid) - 1 > 0  Then 

         xmax = xmid

      Else

         xmin = xmid

      End If

      Cells(3, i+2) = xmin
      Cells(4, i+2) = xmax

   Next i

End Sub

pr8-1: ニュートン法: 立方根

\(a\) の立方根 \(a^{\frac {1}{3}}\) をニュートン法で求める漸化式は

\begin{eqnarray*} x_{n+1} = \frac 13 \left( 2 x_n + \frac a{x_n^2}\right) \end{eqnarray*}

となる。

Sub pr8_1 ()

   Dim i As Long
   Dim x As Double, a As Double

   a = 2
   x = 5

   Cells (12,2) = "立法根→"

   For i = 1 To 10

      x = 1/3 * (2*x + a / (x*x))
      Cells (12, i+2) = x

   Next i

End Sub

pr8-2: 2 分法: 超越方程式

超越方程式

\begin{eqnarray*} x^2e^{-x} = 1 \end{eqnarray*}

の解を 2 分法を用いて求めるプログラム。

Sub pr8_2 ()

   Dim i As Long, xmid As Double
   Dim xmax As Double, xmin As Double

   xmin = -1
   xmax = 0

   Cells(9,  2) = "xmin→"
   Cells(10, 2) = "xmax→"

   For i=1 To 20

      xmid = (xmax + xmin) / 2

      If  xmid*xmid * Exp(-xmid) - 1 < 0  Then 

         xmax = xmid

      Else

         xmin = xmid

      End If

      Cells(9,  i+2) = xmin
      Cells(10, i+2) = xmax

   Next i

End Sub

第 9 章 行列と連立 1 次方程式

行列の足し算

Sub ex9_1 ()

   Dim i As Long, j As Double 
   Dim a(3,3) As Double, b(3,3) As Double 

   Cells (1,1) = "行列A"
   Cells (1,5) = "行列B"
   Cells (1,9) = "行列 AxB"

   For i = 1 To 3
      For j = 1 To 3
         a (i,j) = cells (i+1, j)
         b (i,j) = cells (i+1, j+4)
      Next j
   Next i

   For i = 1 To 3
      For j = 1 To 3
         cells(i+1, j+9) = a(i,j) + b(i,j)
      Next j
   Next i

End Sub

連立 1 次方程式 (第 1 ステップ)

Sub ex9_2 ()

   Dim i As Long, j As Double 
   Dim a(3,3) As Double, b(3) As Double 
   Dim ta As double

   Cells (6,1) = "行列A"
   Cells (6,5) = "ベクトルb"
   Cells (6,7) = "行列 A'"
   Cells (6,11) = "ベクトル b'"

   For i = 1 To 3
      For j = 1 To 3
         a (i,j) = cells (i+6, j)
      Next j
      b (i) = cells (i+6, 5)
   Next i

   For i = 1 To 3
      ta = a(i,1)
      For j = 1 To 3
         a (i,j) = a(i,j) / ta
      Next j
      b (i) = b(i) /ta
   Next i

   For i = 2 To 3
      For j = 1 To 3
         a (i,j) = a(i,j) - a(1,j)
      Next j
      b (i) = b(i) - b(1)
   Next i

   For i = 1 To 3
      For j = 1 To 3
         cells(i+6, j+6) = a(i,j)
      Next j
      cells(i+6, 11) = b(i)
   Next i

End Sub

連立 1 次方程式 (第 2 ステップ)

Sub ex9_3 ()

   Dim i As Long, j As Double, k As double 
   Dim a(3,3) As Double, b(3) As Double 
   Dim ta As double

   Cells (6,1) = "行列A"
   Cells (6,5) = "ベクトルb"
   Cells (6,7) = "行列 A'"
   Cells (6,11) = "ベクトル b'"

   For i = 1 To 3
      For j = 1 To 3
         a (i,j) = cells (i+6, j)
      Next j
      b (i) = cells (i+6, 5)
   Next i

   For k = 1 To 2

      For i = k To 3
         ta = a(i,k)
         For j =  To 3
            a (i,j) = a(i,j) / ta
         Next j
         b (i) = b(i) /ta
      Next i

      For i = k+1 To 3
         For j = k To 3
            a (i,j) = a(i,j) - a(k,j)
         Next j
         b (i) = b(i) - b(k)
      Next i

      For i = 1 To 3
         For j = 1 To 3
            cells(i+6, j+6) = a(i,j)
         Next j
         cells(i+6, 11) = b(i)
      Next i
   Next k

End Sub

第 10 章 確率と統計: 乱数の生成

ex10-1: 実数値を取る乱数

Sub ex10_1 ()

   Dim i As Long
   Dim x As Double

   Cells (1,2) = "実数値乱数→"

   For i = 1 To 10

      x = Rnd
      Cells (1, i+2) = x

   Next i

End Sub

ex10-2: ヒストグラムの作成

Sub ex10_2 ()

   Dim i As Long, n As Long 
   Dim x As Double
   Dim h(20) As Double

   Cells (1,2) = "実数値乱数→"
   Cells (2,2) = "階級値→"
   Cells (3,2) = "ヒストグラム→"

   For i = 1 To 1000

      x = Rnd * 2
      Cells (1, i+2) = x

      n = Int (x * 10)
      h(n) = h(n) + 1

   Next i

   For n = 0 To 19

      ' 階級値
      Cells (2, n+3) = 0.1 * n + 0.05
      ' ヒストグラム
      Cells (3, n+3) = h(n) / 1000 / 0.1

   Next n

End Sub
Sub ex10_2_1 ()

   Dim i As Long, n As Long 
   Dim x As Double, y As Double
   Dim h(20) As Double

   Cells (1,2) = "実数値乱数→"
   Cells (2,2) = "階級値→"
   Cells (3,2) = "ヒストグラム→"

   For i = 1 To 1000

      x = Rnd * 2
      y = Sqr(2 * x) 
      Cells (1, i+2) = y

      n = Int (y * 10)
      h(n) = h(n) + 1

   Next i

   For n = 0 To 19

      ' 階級値
      Cells (2, n+3) = 0.1 * n + 0.05
      ' ヒストグラム
      Cells (3, n+3) = h(n) / 1000 / 0.1

   Next n

End Sub

ex10-3: 確率変数の和

Sub ex10_3 ()

   Dim i As Long, n As Long 
   Dim x As Double, y As Double
   Dim h(40) As Double

   Cells (5,2) = "実数値乱数 (X)→"
   Cells (6,2) = "実数値乱数 (Y)→"
   Cells (7,2) = "階級値→"
   Cells (8,2) = "ヒストグラム→"

   For i = 1 To 1000

      x = Rnd * 2
      Cells (5, i+2) = x
      y = Rnd * 2
      Cells (6, i+2) = y

      n = Int ((x+y) * 10)
      h(n) = h(n) + 1

   Next i

   For n = 0 To 39

      ' 階級値
      Cells (7, n+3) = 0.1 * n + 0.05
      ' ヒストグラム
      Cells (8, n+3) = h(n) / 1000 / 0.1

   Next n

End Sub

ex10-4: 整数値を取る乱数

Sub ex10_4 ()

   Dim i As Long
   Dim x As Long

   Cells (10,2) = "整数値乱数→"

   For i = 1 To 10

      x = Int (Rnd * 6) + 1
      Cells (10, i+2) = x

   Next i

End Sub
Sub ex10_4_1()

   Dim i As Long
   Dim x As Long
   Dim h(6) As Long

   Cells(10, 2) = "整数値乱数→"
   Cells(11, 2) = "頻度 (1 to 6)→"

   For i = 1 To 900

      x = Rnd * 6 + 0.5
      Cells(10, i + 2) = x

      h(x) = h(x) + 1

   Next i

   For i = 1 To 6
      Cells(11, i + 2) = h(i)
   Next i

End Sub

ex10-5: モンテカルロ法 (円の面積)

Sub ex10_5 ()

   Dim i As Long
   Dim m As Long, N As Long 
   Dim x As Double, y As Double

   Cells (13,2) = "面積→"

   m = 0
   N = 10000

   For i = 1 To N

      x = Rnd
      y = Rnd

      If  x * x + y * y < 1 Then

         m = m + 1

      End If 

   Next i

   Cells (13, 3) = 4.0 * m / N

End Sub

pr10-1: モンテカルロ法 (球の体積)

Sub pr10_1 ()

   Dim i As Long, m As Long, N As Long 
   Dim x As Double, y As Double, z As Double

   Cells (15,2) = "面積→"

   m = 0
   N = 10000

   For i = 1 To N

      x = Rnd
      y = Rnd
      z = Rnd

      If  x * x + y * y + z * z < 1 Then

         m = m + 1

      End If 

   Next i

   Cells (15, 3) = 8.0 * m / N

End Sub

pr10-2: 虫の動き

Sub pr10_2 ()

   Dim i As Long
   Dim x As Double, y As Double
   Dim theta As Double, pi As Double

   Cells (17,2) = "x→"
   Cells (18,2) = "y→"

   pi = 4 * Atn(1) 'Atn(1) は Arctan(1)=π/4 

   x = 0
   y = 0

   For i = 1 To 1000

      theta = 2.0 * pi * Rnd
      x = x + cos(theta)
      y = y + sin(theta)

      Cells (17, i+2) = x
      Cells (18, i+2) = y

   Next i

End Sub

第 11 章 確率と統計: 2 項分布と正規分布

ex11-1: 標準正規分布

Sub ex11_1()

   Dim i As Long
   Dim x As Double, y As Double
   Dim pi As Double
   pi = 3.14159265

   cells(1,1) ="x"
   cells(2,1) ="標準正規分布 f(x)"

   For i = -30 To 30
      x = i * 0.1
      y = Exp(-x*x / 2) / Sqr(2*pi)

      Cells(1, i + 32) = x
      Cells(2, i + 32) = y
   Next i

End Sub

練習: 正規分布

Sub ex11_1_1 ()

   Dim i As Long
   Dim x As Double, y As Double
   Dim pi As Double
   Dim m As Double, s As Double
   pi = 3.14159265

   m = 1
   s = 0.5

   cells(3,1) ="正規分布 N(1,0.5)"

   For i = -30 To 30
      x = i * 0.1
      y = Exp(-(x-m)*(x-m) / (2*s*s)) / (Sqr(2*pi)*s)

      Cells(3, i + 32) = y
   Next i

End Sub

ex11-2: 2 項分布 (試行回数 1 回) に従う乱数

Sub ex11_2()

   Dim i As Long, x As Long
   Dim h(2) As Long

   Cells(5, 1) = "表の回数→"
   Cells(6, 1) = "頻度 (0 to 1)→"

   For i = 1 To 1000

      x = Int(Rnd + 0.5)  '1 枚目のコイン
      Cells(5, i + 1) = x
      h(x) = h(x) + 1

   Next i

   For i = 0 To 1 '度数分布を出力

      Cells(6, i + 2) = h(i)

   Next i

End Sub

練習: 2 項分布 (試行回数 2 回) に従う乱数

Sub ex11_2_1 ()

   Dim i As Long, x As Long, y As Long 
   Dim h(2) As Long 

   Cells (8, 1) = "表の回数→"
   Cells (9, 1) = "頻度 (0 to 2)→"

   For i = 1 To 1000

      x = Int (Rnd + 0.5) '1 枚目のコイン 
      y = Int (Rnd + 0.5) '2 枚目のコイン 
      Cells (8, i + 1) = x + y
      h(x+y) = h(x+y) + 1

   Next i

   For i = 0 To 2 '頻度分布を出力

      Cells (9, i+2) = h(i) 

   Next i

End Sub

ex11-3: 2 項分布 (試行回数 10 回) に従う乱数

Sub ex11_3 ()

   Dim i As Long, j As Long
   Dim x As Long, sum As Long 
   Dim h(100) As Long 

   Cells (11, 1) = "表の回数→"
   Cells (12, 1) = "表の回数→"
   Cells (13, 1) = "頻度 →"

   For i = 1 To 1000

      sum = 0
      For j = 1 To 10

         x = Int (Rnd + 0.5) 'j 枚目のコイン 
         sum = sum + x

      Next j

      Cells (11, i+1) = sum
      h(sum) = h(sum) + 1

   Next i

   For i = 0 To 10 '頻度分布を出力

      Cells (12, i+2) = i
      Cells (13, i+2) = h(i) 

   Next i

End Sub

ex11-4: 標本平均と標本分散

Sub ex11_4 ()

   Dim i As Long, x As Long
   Dim h(2) As Long
   Dim sum1 As Long, sum2 As Long
   Dim mean As Double, var As Double
   Dim N As Double

   N = 100

   Cells(5, 1) = "表の回数→"
   Cells(6, 1) = "頻度 (0 to 1)→"
   Cells(6, 4) = "標本平均→"
   Cells(6, 6) = "標本分散→"

   sum1 = 0
   sum2 = 0
   For i = 1 To N

      x = Int(Rnd + 0.5)  'i 枚目のコイン
      Cells(5, i + 1) = x
      h(x) = h(x) + 1

      sum1 = sum1 + x
      sum2 = sum2 + x * x

   Next i

   For i = 0 To 1 '度数分布を出力

      Cells(6, i + 2) = h(i)

   Next i

   mean = sum1 / N
   var = sum2 / N - mean * mean

   Cells(6, 5) = mean
   Cells(6, 7) = var

End Sub

ex11-5: 正規乱数

Sub ex11_5()

   Dim i As Long, x As Double
   Dim N As Double

   N = 1000
   Cells(17, 1) = "正規乱数→"

   For i = 1 To N

      x = WorksheetFunction.NormInv(Rnd, 1, 0.5)
      Cells(17, i + 1) = x

   Next i

End Sub

第 12 章 確率と統計: 推定と検定

第 13 章 確率と統計: 相関係数と回帰

Author: Tomoshige MIYAGUCHI

Created: 2019-12-02 Mon 09:40

Emacs 24.5.1 (Org mode 9.2)

Validate