本章で解説する微分方程式の数値的解法を用いた
「Excel / OpenOffice で学ぶフーリエ変換入門」では マクロをソース閲覧可能な形で用いています。 |
Option Explicit Sub Main() Dim t As Double, tmax As Double Dim dt As Double Dim x1 As Double, x2 As Double ' Euler 法用の変数 Dim count As Long, cellindex As Long t = 0 : tmax = 30 : dt = 0.01 count = 0 : cellindex = 0 x1 = 0 : x2 = 0 ' Euler 法用変数の初期化 ThisComponent.addActionLock() While t < tmax If count Mod 10 = 0 Then ' 10 回に 1 回だけ描画 ThisComponent.Sheets(0).getCellByPosition(0, cellindex).Value = t ThisComponent.Sheets(0).getCellByPosition(1, cellindex).Value = x1 ThisComponent.Sheets(0).getCellByPosition(2, cellindex).Value = 0.5 * t * Sin(2 * t) cellindex = cellindex + 1 End If Euler x1, x2, t, dt count = count + 1 t = t + dt Wend ThisComponent.removeActionLock() End Sub Sub Euler(x1 As Double, x2 As Double, t As Double, dt As Double) Dim f1 As Double, f2 As Double f1 = x2 f2 = -4 * x1 + 2 * Cos(2 * t) x1 = x1 + dt * f1 x2 = x2 + dt * f2 End Sub |
f2(x1, x2, t) = -4 x1 + 2 cos(2t) という式を実現するため、 前ページの シート のみの手法では -4*B2+2*cos(2*A2) と記述したのに対し、今回の VBA では、 -4*x1+2*cos(2*t) と記述できる。 |
Option Explicit Sub Main() Dim t As Double, tmax As Double Dim dt As Double Dim x1 As Double, x2 As Double ' Euler 法用の変数 Dim y1 As Double, y2 As Double ' Runge-Kutta 法用の変数 Dim count As Long, cellindex As Long t = 0 : tmax = 30 : dt = 0.01 count = 0 : cellindex = 0 x1 = 0 : x2 = 0 ' Euler 法用変数の初期化 y1 = 0 : y2 = 0 ' Runge-Kutta 法用変数の初期化 ThisComponent.addActionLock() While t < tmax If count Mod 10 = 0 Then ' 10 回に 1 回だけ描画 ThisComponent.Sheets(0).getCellByPosition(0, cellindex).Value = t ThisComponent.Sheets(0).getCellByPosition(1, cellindex).Value = x1 ThisComponent.Sheets(0).getCellByPosition(2, cellindex).Value = 0.5 * t * Sin(2 * t) ThisComponent.Sheets(0).getCellByPosition(3, cellindex).Value = y1 cellindex = cellindex + 1 End If Euler x1, x2, t, dt RK_4 y1, y2, t, dt count = count + 1 t = t + dt Wend ThisComponent.removeActionLock() End Sub Sub Euler(x1 As Double, x2 As Double, t As Double, dt As Double) Dim f1 As Double, f2 As Double f1 = x2 f2 = -4 * x1 + 2 * Cos(2 * t) x1 = x1 + dt * f1 x2 = x2 + dt * f2 End Sub Sub RK_4(x1 As Double, x2 As Double, t As Double, dt As Double) Dim k11 As Double, k12 As Double Dim k21 As Double, k22 As Double Dim k31 As Double, k32 As Double Dim k41 As Double, k42 As Double k11 = dt * func1(x1, x2, t) k12 = dt * func2(x1, x2, t) k21 = dt * func1(x1 + k11 / 2, x2 + k12 / 2, t + dt / 2) k22 = dt * func2(x1 + k11 / 2, x2 + k12 / 2, t + dt / 2) k31 = dt * func1(x1 + k21 / 2, x2 + k22 / 2, t + dt / 2) k32 = dt * func2(x1 + k21 / 2, x2 + k22 / 2, t + dt / 2) k41 = dt * func1(x1 + k31, x2 + k32, t + dt) k42 = dt * func2(x1 + k31, x2 + k32, t + dt) x1 = x1 + (k11 / 6 + k21 / 3 + k31 / 3 + k41 / 6) x2 = x2 + (k12 / 6 + k22 / 3 + k32 / 3 + k42 / 6) End Sub Function func1(x1 As Double, x2 As Double, t As Double) func1 = x2 End Function Function func2(x1 As Double, x2 As Double, t As Double) func2 = -4 * x1 + 2 * Cos(2 * t) End Function |