[VBA] 二分法(分割を繰り返して解の存在区間を小さくします)

二分法で方程式の近似解を求めます

 方程式 $f(x)=0$ について、適当な初期値 $a,\:b\:(a\lt b)$ を与えます。このとき
 
\[f(a)\lt 0,\quad f(b)\gt 0\]
であるとすると、方程式 $f(x)=0$ の解は $a$ と $b$ の間にあることがわかります。

 Excel VBA 二分法による方程式近似解 by BlogCat

 そこで $a$ と $b$ の中点
 
\[f(c)=\frac{a+b}{2}\]
を求めて $f(c)$ の符号を調べます。このとき、
 
\[f(a)f(c)\lt 0\]
ならば、$b$ と $c$ の間に解があります。そして中点 $c$ をあらためて $b$ とおきます。

 Excel VBA 二分法による方程式近似解② by BlogCat

 再び $a$ と $b$ の中点 $c$ について $f(c)$ の符号を調べて、今度は
 
\[f(a)f(c)\gt 0\]
であったとすると、解は $a$ と $c$ の間にあることになります。このように二分割を繰り返して解が存在する区間を小さくしていくことで、$c$ を真の解に近づけていくことができます。この方法を 二分法 (Bisection method) とよびます。
 

二分法のマクロ

 二分法で $x^2=2$ の解を求めるマクロです。つまり $\sqrt{2}$ の近似値を計算させます。解の含まれる区間 $b-a$ があらかじめ設定した収束判定定数 EPS 以下になったときに計算を打ち切って、そのときの $c$ を近似解とします。

'VBA 二分法でx^2=2の解を求めるプログラム

'関数 f(x) = x^2 - 2
Function MyFunction(x As Double) As Double

  MyFunction = x ^ 2 - 2

End Function

'二分法で x^2 - 2 = 0 の解を求めるサブルーチン
Sub Bisection()

  Dim a As Double, b As Double, c As Double
  Dim f1 As Double, f2 As Double
  Dim eps As Double, k As Integer

  eps = 0.001

  a = InputBox("初期値 a を入力してください")
  b = InputBox("初期値 b を入力してください")

  f1 = MyFunction(a)
  f2 = MyFunction(b)

  If f1 * f2 > 0 Then
    Debug.Print "この区間には解が含まれないか複数存在する可能性があります"
    Debug.Print "区間を入力し直してください"
    Exit Sub
  End If

  Do While Abs(b - a) > eps And k < 100

    k = k + 1
    c = (a + b) / 2

    f1 = MyFunction(a)
    f2 = MyFunction(c)

    If f1 * f2 < 0 Then
      b = c
    Else
      a = c
    End If

  Loop

  Debug.Print c

End Sub

 マクロを実行すると a と b の入力が促されます。たとえば a = 3, b = 0 を入力すると 1.412109... という値が表示されるはずです(真値は 1.4142135... )。eps の値を小さくすれば、より高い精度の近似解を返します。MyFunction の中身を別の関数に書き換えることで、色々な方程式の近似解を計算することができるので、ぜひ試してみてください。 ≫ VBA 数値計算


 

コメントをどうぞ

メールアドレスが公開されることはありません。