WScript.Echo 3 + 5 WScript.Echo 3 - 5 WScript.Echo 3 * 5 WScript.Echo 3 ^ 5 WScript.Echo 5 / 3 WScript.Echo 5 \ 3 WScript.Echo 5 Mod 3 WScript.StdOut.Write 3 * 5 & vbNewLine WScript.StdOut.WriteLine 3 * 5 Option Explicit Dim i: i = 3 * 5 WScript.Echo "3 * 5 = " & i Option Explicit Dim i For i = 1 To 9 WScript.StdOut.Write i & ", " Next WScript.StdOut.WriteLine Option Explicit Dim i For i = 1 To 9 If i Mod 3 = 0 Then WScript.StdOut.Write i & ", " End If Next WScript.StdOut.WriteLine Option Explicit Dim sum: sum = 0 Dim i For i = 1 To 99 If i Mod 3 = 0 Then sum = sum + i End If Next WScript.Echo sum Option Explicit ' 初項:a, 公差:a で 上限:lim の数列の総和を返す関数 Private Function sn(a, lim) Dim n: n = lim \ a ' 項数:n = 上限:lim / 公差:a Dim l: l = n * a ' 末項:l = 項数:n * 公差:a sn = (a + l) * n \ 2 ' 総和:sn = (初項:a + 末項:l) * 項数:n / 2 End Function ' 3 の倍数の合計 WScript.Echo sn(3, 999) Option Explicit ' 10000 までの 自然数の和 ' 項目数 n = 10000 Dim n: n = 10000 WScript.Echo n * (n + 1) \ 2 Option Explicit ' 10000 までの 偶数の和 ' 項目数 n = 5000 Dim n: n = 10000 \ 2 WScript.Echo n * (n + 1) Option Explicit ' 10000 までの 奇数の和 ' 項目数 n = 5000 Dim n: n = 10000 \ 2 WScript.Echo n ^ 2 Option Explicit ' 1000 までの 自然数の2乗の和 Dim n: n = 1000 WScript.Echo n * (n + 1) * (2 * n + 1) \ 6 Option Explicit ' 100 までの 自然数の3乗の和 Dim n: n = 100 WScript.Echo (n ^ 2) * ((n + 1) ^ 2) \ 4 Option Explicit ' 初項 2, 公比 3, 項数 10 の等比数列の和 Dim n: n = 10 Dim a: a = 2 Dim r: r = 3 WScript.Echo (a * ((r ^ n) - 1)) \ (r - 1) Option Explicit Dim a: a = 5 '初項 5 Dim d: d = 3 '公差 3 Dim n: n = 10 '項数 10 Dim p: p = 1 '積 Dim m Dim i For i = 1 To n m = a + (d * (i - 1)) WScript.StdOut.Write m & " * " & p & " = " p = p * m WScript.Echo p Next Option Explicit '初項 5, 公差 3, 項数 10 の数列の積を表示する WScript.Echo product(5, 3, 10) Private Function product(m, d, n) If n = 0 Then product = 1 Else product = m * product(m + d, d, n - 1) End If End Function '階乗を求める関数 Private Function Fact(n) If n <= 1 Then Fact = 1 Else Fact = n * Fact(n - 1) End If End Function '10の階乗 WScript.Echo(Fact(10)) WScript.Echo(10 * 9 * 8 * 7 * 6 * 5 * 4 * 3 * 2 * 1) '下降階乗冪 Private Function FallingFact(x, n) If n <= 1 Then FallingFact = x Else FallingFact = x * FallingFact(x - 1, n - 1) End If End Function '10 から 6 までの 総乗 WScript.Echo(FallingFact(10, 5)) WScript.Echo(10 * 9 * 8 * 7 * 6) '上昇階乗冪 Private Function RisingFact(x, n) If n <= 1 Then RisingFact = x Else RisingFact = x * RisingFact(x + 1, n - 1) End If End Function '10 から 14 までの 総乗 WScript.Echo(RisingFact(10, 5)) WScript.Echo(10 * 11 * 12 * 13 * 14) '階乗 Private Function Fact(n) If n <= 1 Then Fact = 1 Else Fact = n * Fact(n - 1) End If End Function '下降階乗冪 Private Function FallingFact(x, n) If n <= 1 Then FallingFact = x Else FallingFact = x * FallingFact(x - 1, n - 1) End If End Function '順列 (異なる 10 個のものから 5 個取ってできる順列の総数) Dim n: n = 10 Dim r: r = 5 WScript.Echo(Fact(n) / Fact(n - r)) WScript.Echo(FallingFact(n, r)) '重複順列 (異なる 10 個のものから重複を許して 5 個取ってできる順列の総数) Dim n: n = 10 Dim r: r = 5 WScript.Echo(n ^ r) '組合せ Private Function Comb(n, r) If (r = 0) Or (r = n) Then Comb = 1 ElseIf r = 1 Then Comb = n Else Comb = Comb(n - 1, r - 1) + Comb(n - 1, r) End If End Function '組合せ (異なる 10 個のものから 5 個取ってできる組合せの総数) Dim n: n = 10 Dim r: r = 5 WScript.Echo(Comb(n, r)) '組合せ Private Function Comb(n, r) If (r = 0) Or (r = n) Then Comb = 1 ElseIf r = 1 Then Comb = n Else Comb = Comb(n - 1, r - 1) + Comb(n - 1, r) End If End Function '重複組合せ (異なる 10 個のものから重複を許して 5 個とる組合せの総数) Dim n: n = 10 Dim r: r = 5 WScript.Echo(Comb(n + r - 1, r)) Option Explicit Const PI = 3.14159265359 Dim degree For degree = 0 To 360 Step 15 If (degree Mod 30 = 0 Or degree Mod 45 = 0) Then Dim radian: radian = degree * PI / 180.0 '自作の正弦関数 Dim d1: d1 = mySin(radian, 1, False, radian, 1.0, radian) '標準の正弦関数 Dim d2: d2 = Sin(radian) '標準関数との差異 WScript.StdOut.Write Right(Space(3) & degree, 3) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1, 10, -1, 0, 0), 13) & " - " WScript.StdOut.Write Right(Space(13) & FormatNumber(d2, 10, -1, 0, 0), 13) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine End If Next '自作の正弦関数 Private Function mySin(ByVal x, ByVal n, ByVal nega, ByVal numerator, ByVal denominator, ByVal y) Dim m: m = 2 * n denominator = denominator * (m + 1) * m numerator = numerator * x * x Dim a: a = numerator / denominator '十分な精度になったら処理を抜ける If (a <= 0.00000000001) Then mySin = y Else If Not nega Then a = -a mySin = y + mySin(x, n + 1, Not nega, numerator, denominator, a) End If End Function Option Explicit Const PI = 3.14159265359 Dim degree For degree = 0 To 360 Step 15 If (degree Mod 30 = 0 Or degree Mod 45 = 0) Then Dim radian: radian = degree * PI / 180.0 '自作の余弦関数 Dim d1: d1 = myCos(radian, 1, False, 1.0, 1.0, 1.0) '標準の余弦関数 Dim d2: d2 = Cos(radian) '標準関数との差異 WScript.StdOut.Write Right(Space(3) & degree, 3) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1, 10, -1, 0, 0), 13) & " - " WScript.StdOut.Write Right(Space(13) & FormatNumber(d2, 10, -1, 0, 0), 13) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine End If Next '自作の余弦関数 Private Function myCos(ByVal x, ByVal n, ByVal nega, ByVal numerator, ByVal denominator, ByVal y) Dim m: m = 2 * n denominator = denominator * m * (m - 1) numerator = numerator * x * x Dim a: a = numerator / denominator '十分な精度になったら処理を抜ける If (a <= 0.00000000001) Then myCos = y Else If Not nega Then a = -a myCos = y + myCos(x, n + 1, Not nega, numerator, denominator, a) End If End Function Option Explicit Const PI = 3.14159265359 Dim i For i = 0 To 180 Step 15 If (i Mod 180 <> 0) Then Dim degree: degree = i - 90 Dim radian: radian = degree * PI / 180.0 Dim x2: x2 = radian * radian '自作の正接関数 Dim d1: d1 = myTan(radian, x2, 15, 0.0) '15:必要な精度が得られる十分大きな奇数 '標準の正接関数 Dim d2: d2 = Tan(radian) '標準関数との差異 WScript.StdOut.Write Right(Space(3) & degree, 3) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1, 10, -1, 0, 0), 13) & " - " WScript.StdOut.Write Right(Space(13) & FormatNumber(d2, 10, -1, 0, 0), 13) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine End If Next '自作の正接関数 Private Function myTan(ByVal x, ByVal x2, ByVal n, ByVal t) t = x2 / (n - t) n = n - 2 If (n <= 1) Then myTan = x / (1 - t) Else myTan = myTan(x, x2, n, t) End If End Function Option Explicit Dim i For i = 0 To 20 Dim x: x = (i - 10) / 4.0 '標準の指数関数 Dim d1: d1 = Exp(x) '自作の指数関数 Dim d2: d2 = myExp(x, 1, 1.0, 1.0, 1.0) '標準関数との差異 WScript.StdOut.Write Right(Space(5) & FormatNumber(x, 2, -1, 0, 0), 5) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1, 10, -1, 0, 0), 13) & " - " WScript.StdOut.Write Right(Space(13) & FormatNumber(d2, 10, -1, 0, 0), 13) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine Next '自作の指数関数 Private Function myExp(ByVal x, ByVal n, ByVal numerator, ByVal denominator, ByVal y) denominator = denominator * n numerator = numerator * x Dim a: a = numerator / denominator '十分な精度になったら処理を抜ける If (Abs(a) <= 0.00000000001) Then myExp = y Else myExp = y + myExp(x, n + 1, numerator, denominator, a) End If End Function Option Explicit Dim i For i = 0 To 20 Dim x: x = (i - 10) / 4.0 '標準の指数関数 Dim d1: d1 = Exp(x) '自作の指数関数 Dim x2: x2 = x * x Dim d2: d2 = myExp(x, x2, 30, 0.0) '30:必要な精度が得られるよう, 6から始めて4ずつ増加させる '標準関数との差異 WScript.StdOut.Write Right(Space(5) & FormatNumber(x, 2, -1, 0, 0), 5) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1, 10, -1, 0, 0), 13) & " - " WScript.StdOut.Write Right(Space(13) & FormatNumber(d2, 10, -1, 0, 0), 13) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine Next '自作の指数関数 Private Function myExp(ByVal x, ByVal x2, ByVal n, ByVal t) t = x2 / (n + t) n = n - 4 If (n < 6) Then myExp = 1 + ((2 * x) / (2 - x + t)) Else myExp = myExp(x, x2, n, t) End If End Function Option Explicit Dim i For i = 1 To 20 Dim x: x = i / 5.0 '標準の対数関数 Dim d1: d1 = Log(x) '自作の対数関数 Dim x2: x2 = (x - 1) / (x + 1) Dim d2: d2 = 2 * myLog(x2, x2, 1.0, x2) '標準関数との差異 WScript.StdOut.Write Right(Space(5) & FormatNumber(x, 2, -1, 0, 0), 5) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1, 10, -1, 0, 0), 13) & " - " WScript.StdOut.Write Right(Space(13) & FormatNumber(d2, 10, -1, 0, 0), 13) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine Next '自作の対数関数 Private Function myLog(ByVal x2, ByVal numerator, ByVal denominator, ByVal y) denominator = denominator + 2 numerator = numerator * x2 * x2 Dim a: a = numerator / denominator '十分な精度になったら処理を抜ける If (Abs(a) <= 0.00000000001) Then myLog = y Else myLog = y + myLog(x2, numerator, denominator, a) End If End Function Option Explicit Dim i For i = 1 To 20 Dim x: x = i / 5.0 '標準の対数関数 Dim d1: d1 = Log(x) '自作の対数関数 Dim d2: d2 = myLog(x - 1, 27, 0.0) '27:必要な精度が得られる十分大きな奇数 '標準関数との差異 WScript.StdOut.Write Right(Space(5) & FormatNumber(x, 2, -1, 0, 0), 5) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1, 10, -1, 0, 0), 13) & " - " WScript.StdOut.Write Right(Space(13) & FormatNumber(d2, 10, -1, 0, 0), 13) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine Next '自作の対数関数 Private Function myLog(ByVal x, ByVal n, ByVal t) Dim n2: n2 = n Dim x2: x2 = x If (n > 3) Then If (n Mod 2 = 0) Then n2 = 2 End If x2 = x * (n \ 2) End If t = x2 / (n2 + t) If (n <= 2) Then myLog = x / (1 + t) Else myLog = myLog(x, n - 1, t) End If End Function Option Explicit Dim i For i = 0 To 20 Dim x: x = i - 10 '自作の双曲線正弦関数 Dim d1: d1 = mySinh(x, 1, x, 1.0, x) '標準の双曲線正弦関数はない Dim d2: d2 = (Exp(x) - Exp(-x)) / 2 '標準関数との差異 WScript.StdOut.Write Right(Space(3) & x, 3) & " : " WScript.StdOut.Write Right(Space(17) & FormatNumber(d1, 10, -1, 0, 0), 17) & " - " WScript.StdOut.Write Right(Space(17) & FormatNumber(d2, 10, -1, 0, 0), 17) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine Next '自作の双曲線正弦関数 Private Function mySinh(ByVal x, ByVal n, ByVal numerator, ByVal denominator, ByVal y) Dim m: m = 2 * n denominator = denominator * (m + 1) * m numerator = numerator * x * x Dim a: a = numerator / denominator '十分な精度になったら処理を抜ける If (Abs(a) <= 0.00000000001) Then mySinh = y Else mySinh = y + mySinh(x, n + 1, numerator, denominator, a) End If End Function Option Explicit Dim i For i = 0 To 20 Dim x: x = i - 10 '自作の双曲線余弦関数 Dim d1: d1 = myCosh(x, 1, 1.0, 1.0, 1.0) '標準の双曲線余弦関数はない Dim d2: d2 = (Exp(x) + Exp(-x)) / 2 '標準関数との差異 WScript.StdOut.Write Right(Space(3) & x, 3) & " : " WScript.StdOut.Write Right(Space(17) & FormatNumber(d1, 10, -1, 0, 0), 17) & " - " WScript.StdOut.Write Right(Space(17) & FormatNumber(d2, 10, -1, 0, 0), 17) & " = " WScript.StdOut.Write Right(Space(13) & FormatNumber(d1 - d2, 10, -1, 0, 0), 13) & vbNewLine Next '自作の双曲線余弦関数 Private Function myCosh(ByVal x, ByVal n, ByVal numerator, ByVal denominator, ByVal y) Dim m: m = 2 * n denominator = denominator * m * (m - 1) numerator = numerator * x * x Dim a: a = numerator / denominator '十分な精度になったら処理を抜ける If (Abs(a) <= 0.00000000001) Then myCosh = y Else myCosh = y + myCosh(x, n + 1, numerator, denominator, a) End If End Function Option Explicit Const PI = 3.14159265359 Const a = 0 Const b = 1 '台形則で積分 Dim n: n = 2 Dim i, j For j = 1 To 10 Dim h: h = (b - a) / n Dim s: s = 0 Dim x: x = a For i = 1 To n - 1 x = x + h s = s + f(x) Next s = h * ((f(a) + f(b)) / 2 + s) n = n * 2 '結果を π と比較 WScript.StdOut.Write Right(Space(2) & j, 2) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(s, 10, -1, 0, 0), 13) & ", " WScript.StdOut.Write Right(Space(13) & FormatNumber(s - PI, 10, -1, 0, 0), 13) & vbNewLine Next Private Function f(x) f = 4 / (1 + x * x) End Function Option Explicit Const PI = 3.14159265359 Const a = 0 Const b = 1 '中点則で積分 Dim n: n = 2 Dim i, j For j = 1 To 10 Dim h: h = (b - a) / n Dim s: s = 0 Dim x: x = a + (h / 2) For i = 1 To n s = s + f(x) x = x + h Next s = h * s n = n * 2 '結果を π と比較 WScript.StdOut.Write Right(Space(2) & j, 2) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(s, 10, -1, 0, 0), 13) & ", " WScript.StdOut.Write Right(Space(13) & FormatNumber(s - PI, 10, -1, 0, 0), 13) & vbNewLine Next Private Function f(x) f = 4 / (1 + x * x) End Function Option Explicit Const PI = 3.14159265359 Const a = 0 Const b = 1 'Simpson則で積分 Dim n: n = 2 Dim i, j For j = 1 To 5 Dim h: h = (b - a) / n Dim s2: s2 = 0 Dim s4: s4 = 0 Dim x: x = a + h For i = 1 To n \ 2 s4 = s4 + f(x) x = x + h s2 = s2 + f(x) x = x + h Next s2 = (s2 - f(b)) * 2 + f(a) + f(b) s4 = s4 * 4 Dim s: s = (s2 + s4) * h / 3 n = n * 2 '結果を π と比較 WScript.StdOut.Write Right(Space(2) & j, 2) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(s, 10, -1, 0, 0), 13) & ", " WScript.StdOut.Write Right(Space(13) & FormatNumber(s - PI, 10, -1, 0, 0), 13) & vbNewLine Next Private Function f(x) f = 4 / (1 + x * x) End Function Option Explicit Const PI = 3.14159265359 Const a = 0 Const b = 1 Dim t(6, 6) '台形則で積分 Dim n: n = 2 Dim i, j For i = 1 To 6 Dim h: h = (b - a) / n Dim s: s = 0 Dim x: x = a For j = 1 To n - 1 x = x + h s = s + f(x) Next '結果を保存 t(i,1) = h * ((f(a) + f(b)) / 2 + s) n = n * 2 Next 'Richardsonの補外法 n = 4 For j = 2 To 6 For i = j To 6 t(i,j) = t(i, j - 1) + (t(i, j - 1) - t(i - 1, j - 1)) / (n - 1) If i = j Then '結果を π と比較 WScript.StdOut.Write Right(Space(2) & j, 2) & " : " WScript.StdOut.Write Right(Space(13) & FormatNumber(t(i,j), 10, -1, 0, 0), 13) & ", " WScript.StdOut.Write Right(Space(13) & FormatNumber(t(i,j) - PI, 10, -1, 0, 0), 13) & vbNewLine End If Next n = n * 4 Next Private Function f(x) f = 4 / (1 + x * x) End Function Option Explicit 'データ点の数 - 1 Private Const N = 6 Dim x(): ReDim x(N) Dim y(): ReDim y(N) '1.5刻みで -4.5〜4.5 まで, 7点だけ値をセット Dim i For i = 0 To N Dim d: d = i * 1.5 - 4.5 x(i) = d y(i) = f(d) Next '0.5刻みで 与えられていない値を補間 For i = 0 To 18 d = i * 0.5 - 4.5 Dim d1: d1 = f(d) Dim d2: d2 = lagrange(d, x, y) '元の関数と比較 WScript.StdOut.Write Right(Space(5) & FormatNumber(d, 2, -1, 0, 0), 5) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d1, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d2, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(d1 - d2, 5, -1, 0, 0), 8) Next '元の関数 Private Function f(ByVal x) f = x - (x ^ 3) / (3 * 2) + (x ^ 5) / (5 * 4 * 3 * 2) End Function 'Lagrange (ラグランジュ) 補間 Private Function lagrange(ByVal d, ByVal x(), ByVal y()) Dim sum: sum = 0 Dim i, j For i = 0 To N Dim prod: prod = y(i) For j = 0 To N If j <> i Then prod = prod * (d - x(j)) / (x(i) - x(j)) End If Next sum = sum + prod Next lagrange = sum End Function Option Explicit 'データ点の数 - 1 Private Const N = 6 Dim x(): ReDim x(N) Dim y(): ReDim y(N) '1.5刻みで -4.5〜4.5 まで, 7点だけ値をセット Dim i For i = 0 To N Dim d: d = i * 1.5 - 4.5 x(i) = d y(i) = f(d) Next '0.5刻みで 与えられていない値を補間 For i = 0 To 18 d = i * 0.5 - 4.5 Dim d1: d1 = f(d) Dim d2: d2 = neville(d, x, y) '元の関数と比較 WScript.StdOut.Write Right(Space(5) & FormatNumber(d, 2, -1, 0, 0), 5) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d1, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d2, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(d1 - d2, 5, -1, 0, 0), 8) Next '元の関数 Private Function f(ByVal x) f = x - (x ^ 3) / (3 * 2) + (x ^ 5) / (5 * 4 * 3 * 2) End Function 'Neville (ネヴィル) 補間 Private Function neville(ByVal d, ByVal x(), ByVal y()) Dim w(): ReDim w(N, N) Dim i For i = 0 To N w(0,i) = y(i) Next Dim j For j = 1 To N For i = 0 To N - j w(j,i) = w(j-1,i+1) + (w(j-1,i+1) - w(j-1,i)) * (d - x(i+j)) / (x(i+j) - x(i)) Next Next neville = w(N,0) End Function Option Explicit 'データ点の数 - 1 Private Const N = 6 Dim x(): ReDim x(N) Dim y(): ReDim y(N) '1.5刻みで -4.5〜4.5 まで, 7点だけ値をセット Dim i For i = 0 To N Dim d1: d1 = i * 1.5 - 4.5 x(i) = d1 y(i) = f(d1) Next '差分商の表を作る Dim d(): ReDim d(N, N) Dim j For j = 0 To N d(0,j) = y(j) Next For i = 1 To N For j = 0 To (N - i) d(i,j) = (d(i-1,j+1) - d(i-1,j)) / (x(j+i) - x(j)) Next Next 'n階差分商 Dim a(): ReDim a(N) For j = 0 To N a(j) = d(j,0) Next '0.5刻みで 与えられていない値を補間 For i = 0 To 18 d1 = i * 0.5 - 4.5 Dim d2: d2 = f(d1) Dim d3: d3 = newton(d1, x, a) '元の関数と比較 WScript.StdOut.Write Right(Space(5) & FormatNumber(d1, 2, -1, 0, 0), 5) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d2, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d3, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(d2 - d3, 5, -1, 0, 0), 8) Next '元の関数 Private Function f(ByVal x) f = x - (x ^ 3) / (3 * 2) + (x ^ 5) / (5 * 4 * 3 * 2) End Function 'Newton (ニュートン) 補間 Private Function newton(ByVal d, ByVal x(), ByVal a()) Dim sum: sum = a(0) Dim i, j For i = 1 To N Dim prod: prod = a(i) For j = 0 To (i - 1) If j <> i Then prod = prod * (d - x(j)) End If Next sum = sum + prod Next newton = sum End Function Option Explicit 'データ点の数 - 1 Private Const N = 6 Private Const Nx2 = 13 Dim x(): ReDim x(N) Dim y(): ReDim y(N) Dim yd(): ReDim yd(N) '1.5刻みで -4.5〜4.5 まで, 7点だけ値をセット Dim i For i = 0 To N Dim d1: d1 = i * 1.5 - 4.5 x(i) = d1 y(i) = f(d1) yd(i) = fd(d1) Next '差分商の表を作る Dim z(): ReDim z(Nx2) Dim d(): ReDim d(Nx2, Nx2) For i = 0 To Nx2 Dim j: j = i \ 2 z(i) = x(j) d(0,i) = y(j) Next For i = 1 To Nx2 For j = 0 To (Nx2 - i) If i = 1 And j mod 2 = 0 Then d(i,j) = yd(j \ 2) Else d(i,j) = (d(i-1,j+1) - d(i-1,j)) / (z(j+i) - z(j)) End If Next Next 'n階差分商 Dim a(): ReDim a(Nx2) For j = 0 To Nx2 a(j) = d(j,0) Next '0.5刻みで 与えられていない値を補間 For i = 0 To 18 d1 = i * 0.5 - 4.5 Dim d2: d2 = f(d1) Dim d3: d3 = hermite(d1, z, a) '元の関数と比較 WScript.StdOut.Write Right(Space(5) & FormatNumber(d1, 2, -1, 0, 0), 5) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d2, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d3, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(d2 - d3, 5, -1, 0, 0), 8) Next '元の関数 Private Function f(ByVal x) f = x - (x ^ 3) / (3 * 2) + (x ^ 5) / (5 * 4 * 3 * 2) End Function '導関数 Private Function fd(ByVal x) fd = 1 - (x ^ 2) / 2 + (x ^ 4) / (4 * 3 * 2) End Function 'Hermite (エルミート) 補間 Private Function hermite(ByVal d, ByVal z(), ByVal a()) Dim sum: sum = a(0) Dim i, j For i = 1 To Nx2 Dim prod: prod = a(i) For j = 0 To (i - 1) If j <> i Then prod = prod * (d - z(j)) End If Next sum = sum + prod Next hermite = sum End Function Option Explicit 'データ点の数 - 1 Private Const N = 6 Dim x(): ReDim x(N) Dim y(): ReDim y(N) '1.5刻みで -4.5〜4.5 まで, 7点だけ値をセット Dim i For i = 0 To N Dim d1: d1 = i * 1.5 - 4.5 x(i) = d1 y(i) = f(d1) Next '3項方程式の係数の表を作る Dim a(): ReDim a(N) Dim b(): ReDim b(N) Dim c(): ReDim c(N) Dim d(): ReDim d(N) For i = 1 To N - 1 a(i) = x(i) - x(i-1) b(i) = 2.0 * (x(i+1) - x(i-1)) c(i) = x(i+1) - x(i) d(i) = 6.0 * ((y(i+1) - y(i)) / (x(i+1) - x(i)) - (y(i) - y(i-1)) / (x(i) - x(i-1))) Next '3項方程式を解く (ト−マス法) Dim g(): ReDim g(N) Dim s(): ReDim s(N) g(1) = b(1) s(1) = d(1) For i = 2 To N - 1 g(i) = b(i) - a(i) * c(i-1) / g(i-1) s(i) = d(i) - a(i) * s(i-1) / g(i-1) Next Dim z(): ReDim z(N) z(0) = 0 z(N) = 0 z(N-1) = s(N-1) / g(N-1) For i = N - 2 To 1 Step -1 z(i) = (s(i) - c(i) * z(i+1)) / g(i) Next '0.5刻みで 与えられていない値を補間 For i = 0 To 18 d1 = i * 0.5 - 4.5 Dim d2: d2 = f(d1) Dim d3: d3 = spline(d1, x, y, z) '元の関数と比較 WScript.StdOut.Write Right(Space(5) & FormatNumber(d1, 2, -1, 0, 0), 5) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d2, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(d3, 5, -1, 0, 0), 8) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(d2 - d3, 5, -1, 0, 0), 8) Next '元の関数 Private Function f(ByVal x) f = x - (x ^ 3) / (3 * 2) + (x ^ 5) / (5 * 4 * 3 * 2) End Function 'Spline (スプライン) 補間 Private Function spline(ByVal d, ByVal x(), ByVal y(), ByVal z()) '補間関数値がどの区間にあるか Dim k: k = -1 Dim i For i = 1 To N If d <= x(i) Then k = i - 1 Exit For End If Next If k < 0 Then k = N Dim d1: d1 = x(k+1) - d Dim d2: d2 = d - x(k) Dim d3: d3 = x(k+1) - x(k) spline = (z(k) * (d1 ^ 3) + z(k+1) * (d2 ^ 3)) / (6.0 * d3) + _ (y(k) / d3 - z(k) * d3 / 6.0) * d1 + _ (y(k+1) / d3 - z(k+1) * d3 / 6.0) * d2 End Function Option Explicit Private Const PI = 3.14159265359 '重力加速度 Private Const g = -9.8 '空気抵抗係数 Private Const k = -0.01 '時間間隔(秒) Private Const h = 0.01 '角度 Private Const degree = 45 Private radian: radian = degree * PI / 180.0 '初速 250 km/h -> 秒速に変換 Private v: v = 250 * 1000 \ 3600 '水平方向の速度 Private vx(): ReDim vx(1) vx(0) = v * Cos(radian) '鉛直方向の速度 Private vy(): ReDim vy(1) vy(0) = v * Sin(radian) '経過秒数 Private t: t = 0.0 '位置 Private x: x = 0.0 Private y: y = 0.0 '空気抵抗による水平方向の減速分 Private Function fx(ByVal vx, ByVal vy) fx = k * Sqr(vx * vx + vy * vy) * vx End Function '重力と空気抵抗による鉛直方向の減速分 Private Function fy(ByVal vx, ByVal vy) fy = g + (k * Sqr(vx * vx + vy * vy) * vy) End Function 'Euler法 Dim i: i = 1 Do While (y >= 0.0) '経過秒数 t = i * h '位置 x = x + h * vx(0) y = y + h * vy(0) WScript.StdOut.Write Right(Space(4) & FormatNumber(t, 2, -1, 0, 0), 4) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(vx(0), 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(vy(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(x, 5, -1, 0, 0), 9) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(y, 5, -1, 0, 0), 8) '速度 vx(1) = vx(0) + h * fx(vx(0), vy(0)) vy(1) = vy(0) + h * fy(vx(0), vy(0)) vx(0) = vx(1) vy(0) = vy(1) i = i + 1 Loop Option Explicit Private Const PI = 3.14159265359 '重力加速度 Private Const g = -9.8 '空気抵抗係数 Private Const k = -0.01 '時間間隔(秒) Private Const h = 0.01 '角度 Private Const degree = 45 Private radian: radian = degree * PI / 180.0 '初速 250 km/h -> 秒速に変換 Private v: v = 250 * 1000 \ 3600 '水平方向の速度 Private vx(): ReDim vx(2) vx(0) = v * Cos(radian) '鉛直方向の速度 Private vy(): ReDim vy(2) vy(0) = v * Sin(radian) '経過秒数 Private t: t = 0.0 '位置 Private x(): ReDim x(2) x(0) = 0.0 Private y(): ReDim y(2) y(0) = 0.0 '空気抵抗による水平方向の減速分 Private Function fx(ByVal vx, ByVal vy) fx = k * Sqr(vx * vx + vy * vy) * vx End Function '重力と空気抵抗による鉛直方向の減速分 Private Function fy(ByVal vx, ByVal vy) fy = g + (k * Sqr(vx * vx + vy * vy) * vy) End Function 'Heun法 Dim i: i = 1 Do While (y(0) >= 0.0) '経過秒数 t = i * h '位置・速度 x(1) = x(0) + h * vx(0) y(1) = y(0) + h * vy(0) vx(1) = vx(0) + h * fx(vx(0), vy(0)) vy(1) = vy(0) + h * fy(vx(0), vy(0)) x(2) = x(0) + h * ( vx(0) + vx(1) ) / 2 y(2) = y(0) + h * ( vy(0) + vy(1) ) / 2 vx(2) = vx(0) + h * (fx(vx(0), vy(0)) + fx(vx(1), vy(1))) / 2 vy(2) = vy(0) + h * (fy(vx(0), vy(0)) + fy(vx(1), vy(1))) / 2 x(0) = x(2) y(0) = y(2) vx(0) = vx(2) vy(0) = vy(2) WScript.StdOut.Write Right(Space(4) & FormatNumber(t, 2, -1, 0, 0), 4) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(vx(0), 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(vy(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(x(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(y(0), 5, -1, 0, 0), 8) i = i + 1 Loop Option Explicit Private Const PI = 3.14159265359 '重力加速度 Private Const g = -9.8 '空気抵抗係数 Private Const k = -0.01 '時間間隔(秒) Private Const h = 0.01 '角度 Private Const degree = 45 Private radian: radian = degree * PI / 180.0 '初速 250 km/h -> 秒速に変換 Private v: v = 250 * 1000 \ 3600 '水平方向の速度 Private vx(): ReDim vx(1) vx(0) = v * Cos(radian) '鉛直方向の速度 Private vy(): ReDim vy(1) vy(0) = v * Sin(radian) '経過秒数 Private t: t = 0.0 '位置 Private x(): ReDim x(1) x(0) = 0.0 Private y(): ReDim y(1) y(0) = 0.0 '空気抵抗による水平方向の減速分 Private Function fx(ByVal vx, ByVal vy) fx = k * Sqr(vx * vx + vy * vy) * vx End Function '重力と空気抵抗による鉛直方向の減速分 Private Function fy(ByVal vx, ByVal vy) fy = g + (k * Sqr(vx * vx + vy * vy) * vy) End Function '中点法 Dim i: i = 1 Do While (y(0) >= 0.0) '経過秒数 t = i * h '位置・速度 vx(1) = h * fx(vx(0), vy(0)) vy(1) = h * fy(vx(0), vy(0)) Dim wx: wx = vx(0) + vx(1) / 2.0 Dim wy: wy = vy(0) + vy(1) / 2.0 vx(0) = vx(0) + h * fx(wx, wy) vy(0) = vy(0) + h * fy(wx, wy) x(0) = x(0) + h * wx y(0) = y(0) + h * wy WScript.StdOut.Write Right(Space(4) & FormatNumber(t, 2, -1, 0, 0), 4) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(vx(0), 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(vy(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(x(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.WriteLine Right(Space(8) & FormatNumber(y(0), 5, -1, 0, 0), 8) i = i + 1 Loop Option Explicit Private Const PI = 3.14159265359 '重力加速度 Private Const g = -9.8 '空気抵抗係数 Private Const k = -0.01 '時間間隔(秒) Private Const h = 0.01 '角度 Private Const degree = 45 Private radian: radian = degree * PI / 180.0 '初速 250 km/h -> 秒速に変換 Private v: v = 250 * 1000 \ 3600 '水平方向の速度 Private vx(): ReDim vx(5) vx(0) = v * Cos(radian) '鉛直方向の速度 Private vy(): ReDim vy(5) vy(0) = v * Sin(radian) '経過秒数 Private t: t = 0.0 '位置 Private x(): ReDim x(5) x(0) = 0.0 Private y(): ReDim y(5) y(0) = 0.0 '空気抵抗による水平方向の減速分 Private Function fx(ByVal vx, ByVal vy) fx = k * Sqr(vx * vx + vy * vy) * vx End Function '重力と空気抵抗による鉛直方向の減速分 Private Function fy(ByVal vx, ByVal vy) fy = g + (k * Sqr(vx * vx + vy * vy) * vy) End Function 'Runge-Kutta法 Dim i: i = 1 Do While (y(0) >= 0.0) '経過秒数 t = i * h '位置・速度 x(1) = h * vx(0) y(1) = h * vy(0) vx(1) = h * fx(vx(0), vy(0)) vy(1) = h * fy(vx(0), vy(0)) Dim wx: wx = vx(0) + vx(1) / 2.0 Dim wy: wy = vy(0) + vy(1) / 2.0 x(2) = h * wx y(2) = h * wy vx(2) = h * fx(wx, wy) vy(2) = h * fy(wx, wy) wx = vx(0) + vx(2) / 2 wy = vy(0) + vy(2) / 2 x(3) = h * wx y(3) = h * wy vx(3) = h * fx(wx, wy) vy(3) = h * fy(wx, wy) wx = vx(0) + vx(3) wy = vy(0) + vy(3) x(4) = h * wx y(4) = h * wy vx(4) = h * fx(wx, wy) vy(4) = h * fy(wx, wy) x(0) = x(0) + ( x(1) + x(2) * 2 + x(3) * 2 + x(4)) / 6 y(0) = y(0) + ( y(1) + y(2) * 2 + y(3) * 2 + y(4)) / 6 vx(0) = vx(0) + (vx(1) + vx(2) * 2 + vx(3) * 2 + vx(4)) / 6 vy(0) = vy(0) + (vy(1) + vy(2) * 2 + vy(3) * 2 + vy(4)) / 6 WScript.StdOut.Write Right(Space(4) & FormatNumber(t, 2, -1, 0, 0), 4) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(vx(0), 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(vy(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(x(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.WriteLine Right(Space(9) & FormatNumber(y(0), 5, -1, 0, 0), 9) i = i + 1 Loop Option Explicit Private Const PI = 3.14159265359 '重力加速度 Private Const g = -9.8 '空気抵抗係数 Private Const k = -0.01 '時間間隔(秒) Private Const h = 0.01 '角度 Private Const degree = 45 Private radian: radian = degree * PI / 180.0 '初速 250 km/h -> 秒速に変換 Private v: v = 250 * 1000 \ 3600 '水平方向の速度 Private vx(): ReDim vx(5) vx(0) = v * Cos(radian) '鉛直方向の速度 Private vy(): ReDim vy(5) vy(0) = v * Sin(radian) '経過秒数 Private t: t = 0.0 '位置 Private x(): ReDim x(5) x(0) = 0.0 Private y(): ReDim y(5) y(0) = 0.0 '空気抵抗による水平方向の減速分 Private Function fx(ByVal vx, ByVal vy) fx = k * Sqr(vx * vx + vy * vy) * vx End Function '重力と空気抵抗による鉛直方向の減速分 Private Function fy(ByVal vx, ByVal vy) fy = g + (k * Sqr(vx * vx + vy * vy) * vy) End Function 'Runge-Kutta-Gill法 Dim i: i = 1 Do While (y(0) >= 0.0) '経過秒数 t = i * h '位置・速度 x(1) = h * vx(0) y(1) = h * vy(0) vx(1) = h * fx(vx(0), vy(0)) vy(1) = h * fy(vx(0), vy(0)) Dim wx: wx = vx(0) + vx(1) / 2.0 Dim wy: wy = vy(0) + vy(1) / 2.0 x(2) = h * wx y(2) = h * wy vx(2) = h * fx(wx, wy) vy(2) = h * fy(wx, wy) wx = vx(0) + vx(1) * ((Sqr(2.0) - 1) / 2) + vx(2) * (1 - 1 / Sqr(2.0)) wy = vy(0) + vy(1) * ((Sqr(2.0) - 1) / 2) + vy(2) * (1 - 1 / Sqr(2.0)) x(3) = h * wx y(3) = h * wy vx(3) = h * fx(wx, wy) vy(3) = h * fy(wx, wy) wx = vx(0) - vx(2) / Sqr(2.0) + vx(3) * (1 + 1 / Sqr(2.0)) wy = vy(0) - vy(2) / Sqr(2.0) + vy(3) * (1 + 1 / Sqr(2.0)) x(4) = h * wx y(4) = h * wy vx(4) = h * fx(wx, wy) vy(4) = h * fy(wx, wy) x(0) = x(0) + ( x(1) + x(2) * (2 - Sqr(2.0)) + x(3) * (2 + Sqr(2.0)) + x(4)) / 6 y(0) = y(0) + ( y(1) + y(2) * (2 - Sqr(2.0)) + y(3) * (2 + Sqr(2.0)) + y(4)) / 6 vx(0) = vx(0) + (vx(1) + vx(2) * (2 - Sqr(2.0)) + vx(3) * (2 + Sqr(2.0)) + vx(4)) / 6 vy(0) = vy(0) + (vy(1) + vy(2) * (2 - Sqr(2.0)) + vy(3) * (2 + Sqr(2.0)) + vy(4)) / 6 WScript.StdOut.Write Right(Space(4) & FormatNumber(t, 2, -1, 0, 0), 4) & vbTab WScript.StdOut.Write Right(Space(8) & FormatNumber(vx(0), 5, -1, 0, 0), 8) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(vy(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.Write Right(Space(9) & FormatNumber(x(0), 5, -1, 0, 0), 9) & vbTab WScript.StdOut.WriteLine Right(Space(9) & FormatNumber(y(0), 5, -1, 0, 0), 9) i = i + 1 Loop Option Explicit Dim a: a = 1.0 Dim b: b = 2.0 WScript.StdOut.Write Right(Space(12) & FormatNumber(bisection(a, b), 10, -1, 0, 0), 12) & vbNewLine Private Function bisection(ByVal a, ByVal b) Dim c Do While(True) '区間 (a, b) の中点 c = (a + b) / 2 c = (a + b) / 2 WScript.StdOut.Write Right(Space(12) & FormatNumber(c, 10, -1, 0, 0), 12) & vbTab WScript.StdOut.Write Right(Space(12) & FormatNumber(c - Sqr(2), 10, -1, 0, 0), 12) & vbNewLine Dim fc: fc = f(c) If Abs(fc) < 0.0000000001 Then Exit Do If fc < 0 Then 'f(c) < 0 であれば, 解は区間 (c, b) の中に存在 a = c Else 'f(c) > 0 であれば, 解は区間 (a, c) の中に存在 b = c End If Loop bisection = c End Function Private Function f(ByVal x) f = x * x - 2.0 End Function Option Explicit Dim a: a = 1.0 Dim b: b = 2.0 WScript.StdOut.Write Right(Space(12) & FormatNumber(falseposition(a, b), 10, -1, 0, 0), 12) & vbNewLine Private Function falseposition(ByVal a, ByVal b) Dim c Do While(True) '点 (a,f(a)) と 点 (b,f(b)) を結ぶ直線と x軸の交点 c = (a * f(b) - b * f(a)) / (f(b) - f(a)) WScript.StdOut.Write Right(Space(12) & FormatNumber(c, 10, -1, 0, 0), 12) & vbTab WScript.StdOut.Write Right(Space(12) & FormatNumber(c - Sqr(2), 10, -1, 0, 0), 12) & vbNewLine Dim fc: fc = f(c) If Abs(fc) < 0.0000000001 Then Exit Do If fc < 0 Then 'f(c) < 0 であれば, 解は区間 (c, b) の中に存在 a = c Else 'f(c) > 0 であれば, 解は区間 (a, c) の中に存在 b = c End If Loop falseposition = c End Function Private Function f(ByVal x) f = x * x - 2.0 End Function Option Explicit Dim x: x = 1.0 WScript.StdOut.Write Right(Space(12) & FormatNumber(iterative(x), 10, -1, 0, 0), 12) & vbNewLine Private Function iterative(ByVal x0) Dim x1 Do While(True) x1 = g(x0) WScript.StdOut.Write Right(Space(12) & FormatNumber(x1, 10, -1, 0, 0), 12) & vbTab WScript.StdOut.Write Right(Space(12) & FormatNumber(x1 - Sqr(2), 10, -1, 0, 0), 12) & vbNewLine If Abs(x1 - x0) < 0.0000000001 Then Exit Do x0 = x1 Loop iterative = x1 End Function Private Function g(ByVal x) g = (x / 2) + (1 / x) End Function Option Explicit Dim x: x = 2.0 WScript.StdOut.Write Right(Space(12) & FormatNumber(newton(x), 10, -1, 0, 0), 12) & vbNewLine Private Function newton(ByVal x0) Dim x1 Do While(True) x1 = x0 - (f0(x0) / f1(x0)) WScript.StdOut.Write Right(Space(12) & FormatNumber(x1, 10, -1, 0, 0), 12) & vbTab WScript.StdOut.Write Right(Space(12) & FormatNumber(x1 - Sqr(2), 10, -1, 0, 0), 12) & vbNewLine If Abs(x1 - x0) < 0.0000000001 Then Exit Do x0 = x1 Loop newton = x1 End Function Private Function f0(ByVal x) f0 = x * x - 2 End Function Private Function f1(ByVal x) f1 = 2 * x End Function Option Explicit Dim x: x = 2.0 WScript.StdOut.Write Right(Space(12) & FormatNumber(bailey(x), 10, -1, 0, 0), 12) & vbNewLine Private Function bailey(ByVal x0) Dim x1 Do While(True) x1 = x0 - (f0(x0) / (f1(x0) - (f0(x0) * f2(x0) / (2 * f1(x0))))) WScript.StdOut.Write Right(Space(12) & FormatNumber(x1, 10, -1, 0, 0), 12) & vbTab WScript.StdOut.Write Right(Space(12) & FormatNumber(x1 - Sqr(2), 10, -1, 0, 0), 12) & vbNewLine If Abs(x1 - x0) < 0.0000000001 Then Exit Do x0 = x1 Loop bailey = x1 End Function Private Function f0(ByVal x) f0 = x * x - 2 End Function Private Function f1(ByVal x) f1 = 2 * x End Function Private Function f2(ByVal x) f2 = 2 End Function Option Explicit Dim x0: x0 = 1.0 Dim x1: x1 = 2.0 WScript.StdOut.Write Right(Space(12) & FormatNumber(secant(x0, x1), 10, -1, 0, 0), 12) & vbNewLine Private Function secant(ByVal x0, ByVal x1) Dim x2 Do While(True) x2 = x1 - f(x1) * (x1 - x0) / (f(x1) - f(x0)) WScript.StdOut.Write Right(Space(12) & FormatNumber(x2, 10, -1, 0, 0), 12) & vbTab WScript.StdOut.Write Right(Space(12) & FormatNumber(x2 - Sqr(2), 10, -1, 0, 0), 12) & vbNewLine If Abs(x2 - x1) < 0.0000000001 Then Exit Do x0 = x1 x1 = x2 Loop secant = x2 End Function Private Function f(ByVal x) f = x * x - 2 End Function Option Explicit 'Private Const MaxGensuu = 10 Dim A(10, 10) 'As Double Dim B(10) 'As Double Dim X(10) 'As Double Dim R(10) 'As Double Dim I 'As Integer Dim J 'As Integer Dim N 'As Integer N = 4 'Range("_N") 'For I = 1 To N ' For J = 1 To N ' A(I, J) = Range("_AI").Offset(I - 1, (J - 1) * 2) A(1, 1) = 9 A(1, 2) = 2 A(1, 3) = 1 A(1, 4) = 1 B(1) = 20 A(2, 1) = 2 A(2, 2) = 8 A(2, 3) = -2 A(2, 4) = 1 B(2) = 16 A(3, 1) = -1 A(3, 2) = -2 A(3, 3) = 7 A(3, 4) = -2 B(3) = 8 A(4, 1) = 1 A(4, 2) = -1 A(4, 3) = -2 A(4, 4) = 6 B(4) = 17 '9 X + 2 Y + 1 Z + 1 U = 20 '2 X + 8 Y + -2 Z + 1 U = 16 '-1 X + -2 Y + 7 Z + -2 U = 8 '1 X + -1 Y + -2 Z + 6 U = 17 ' Next J ' B(I) = Range("_AI").Offset(I - 1, N * 2) 'Next I Call Calculation(N, A, B, X, R) ' ---------------クリア ----------- ' For I = 1 To MaxGensuu ' Range("_S").Offset(I - 1, 0) = "" ' Range("_XI").Offset(I - 1, 0) = "" ' Range("_RI").Offset(I - 1, 0) = "" ' Next I ' ---------------S --------------- ' For I = 1 To N ' Range("_S").Offset(I - 1, 0) = Mid(StringTable, I, 1) ' Next I ' ---------------解--------------- For I = 1 To N 'Range("_XI").Offset(I - 1, 0) = X(I) WScript.Echo X(I) Next ' ---------------誤差--------------- For I = 1 To N 'Range("_RI").Offset(I - 1, 0) = R(I) WScript.Echo R(I) Next 'Sub Calculation(N As Integer, _ ' A() As Double, _ ' B() As Double, _ ' ByRef X() As Double, _ ' ByRef R() As Double) Private Sub Calculation(N, A(), B(), X(), R()) Dim EPS 'As Double Dim LST 'As Long Dim I 'As Integer Dim J 'As Integer Dim L 'As Integer Dim ErrNum 'As Double Dim XX(10) 'As Double EPS = 0.0000001 LST = 1000 For I = 1 To N X(I) = 0 Next For L = 1 To LST '30 ErrNum = 0 For I = 1 To N '35 XX(I) = B(I) For J = 1 To I - 1 XX(I) = XX(I) - A(I, J) * X(J) Next For J = I + 1 To N XX(I) = XX(I) - A(I, J) * X(J) Next XX(I) = XX(I) / A(I, I) ErrNum = ErrNum + Abs(XX(I) - X(I)) Next For I = 1 To N '65 X(I) = XX(I) Next If (ErrNum <= EPS) Then 'GoTo 50 For I = 1 To N R(I) = 0 For J = 1 To N R(I) = R(I) + A(I, J) * X(J) Next R(I) = R(I) - B(I) Next WScript.Echo "反復回数が " & L & " で収束しました。" Exit Sub End If Next WScript.Echo "収束しませんでした。" End Sub |