求根アルゴリズム (3)

前回の続き。
https://wetch.hatenablog.com/entry/2019/10/19/120124

やりたいことがまだ残ってる。

1. 任意に1変数関数を与えて切り替えられるようにしたい。ただしは定数パラメータベクトル。
2. 二分法の部分を割線法に切り替えられるようにしたい。割線法 - Wikipedia
3. mainプロシージャからこれらの切り替えを行わせるようにする。反復法を行うFunction部分には変更を入れなくてもいいようにしたい。

2番をやろう。
その前に準備として、y_leftとかy_rightとか書いてた部分を配列にする。もう右とか左とかの意味ではなくなるので、ちょっと注意しながら書き変える。

Function 反復法(f As IMathFunc, parameters())
  Dim y(1)
  y(0) = f.初期値Left
  y(1) = f.初期値Right

  For i = 0 To 10000
    y_mid = (y(0) + y(1)) / 2

    If f.Substitute(y(0)) * f.Substitute(y_mid) > 0 Then
      y(0) = y(1)
    End If
    y(1) = y_mid

    '収束判定
    If Abs(f.Substitute(y(1))) < 10 ^ -6 Then Exit For
  Next i

  反復法 = y(1)
End Function

そしたら二分法の1回分を切り出す。

Function 反復法(f As IMathFunc, parameters())
  Dim y(1)
  y(0) = f.初期値Left
  y(1) = f.初期値Right

  For i = 0 To 10000
    y = 二分法(y, f)

    '収束判定
    If Abs(f.Substitute(y(1))) < 10 ^ -6 Then Exit For
  Next i

  反復法 = y(1)
End Function

Function 二分法(y(), f As IMathFunc)
  y_mid = (y(0) + y(1)) / 2

  If f.Substitute(y(0)) * f.Substitute(y_mid) > 0 Then
    y(0) = y(1)
  End If
  y(1) = y_mid

  二分法 = y
End Function

では二分法の部分を切り替えられるように、このアルゴリズムを表す抽象クラスIIterationMethodを作る。

Function 一回分(y(), f As IMathFunc) As Double()
End Function

二分法は具体クラスBinaryMethodになる。

Implements IIterationMethod

Function IIterationMethod_一回分(y(), f As IMathFunc) As Double()
  y_mid = (y(0) + y(1)) / 2

  If f.Substitute(y(0)) * f.Substitute(y_mid) > 0 Then
    y(0) = y(1)
  End If
  y(1) = y_mid

  IIterationMethod_ = y
End Function

ついでに別の実装として割線法も作っておこう。クラス名はSecantMethodとする。

Implements IIterationMethod

Function IIterationMethod_一回分(y(), f As IMathFunc) As Double()
  Dim fy(1) 'fにyを代入したもの
  fy(0) = f(y(0))
  fy(1) = f(y(1))

  s = (y(0) * fy(1) - y(1) * fy(0)) / (fy(1) - fy(0))

  y(1) = s
  y(0) = y(1)

  IIterationMethod_一回分 = y
End Function

ゼロ除算に対するエラー処理とか考えの足りない点も多いが、とりあえずこんな感じか。
最後に完成品をまとめる。

続く