module1.bas

来自「本程序提供了输入表达式计算、积分、微分、拟合、插值等多种数值计算」· BAS 代码 · 共 319 行

Attribute VB_Name = "Module1"
Public d1 As Single, d2 As Single, nn As Single
Public x() As Single, y() As Single, h() As Single, biaozi As Integer, xx1() As Single, yy1() As Single
Public Sub nh(h() As Single, m As Single, n As Single, x() As Single, y() As Single)
ReDim a(n, m), b(n, n), c(n, m), d(n), f(n), g(n), af(n), bf(n), w(m)

For i = 0 To n
For j = 0 To m
a(i, j) = x(j) ^ i
Next j
Next i
For i = 0 To n

 b(i, i) = 1
 
Next i
For i = 0 To n
 For j = i + 1 To n
 b(i, j) = 0
 Next j
Next i

For j = 0 To m
c(0, j) = 1
Next j
For i = 0 To m
s = s + x(i)
Next i
af(0) = s / (m + 1)
b(1, 0) = -1 * af(0)
For j = 0 To m
  For i = 0 To 1
  c(1, j) = b(1, i) * a(i, j) + c(1, j)
  Next i
Next j
f(0) = m + 1
If n > 1 Then
For k = 0 To n - 2
  For i = 0 To m
  d(k + 1) = d(k + 1) + x(i) * c(k + 1, i) ^ 2
  f(k + 1) = f(k + 1) + c(k + 1, i) ^ 2
  Next i
 af(k + 1) = d(k + 1) / f(k + 1)
 bf(k) = f(k + 1) / f(k)
 For i = 0 To k + 1
 If i = 0 Then
 t = 0
 Else
 t = b(k + 1, i - 1)
 End If
 If i > k + 2 Then
q = 0
 Else
 q = b(k, i)
 End If
 b(k + 2, i) = t - af(k + 1) * b(k + 1, i) - bf(k) * q

 Next i
 For j = 0 To m
   For i = 0 To k + 2
   c(k + 2, j) = b(k + 2, i) * a(i, j) + c(k + 2, j)
   Next i
 Next j
 
 Next k
 End If
 For i = 0 To m
 f(n) = f(n) + c(n, i) ^ 2
 Next i
 For k = 0 To n
 s = 0
   For i = 0 To m
   s = s + y(i) * c(k, i)
   Next i
   g(k) = s / f(k)
 Next k
 For k = 0 To n
 For i = 0 To n
 h(k) = h(k) + g(i) * b(i, k)
 Next i
 Next k
End Sub

Public Sub gaos(a() As Single, x() As Single, n As Single)
For k = 1 To n - 1
p = k
E = Abs(a(k, k))
For i = k + 1 To n
  If Abs(a(i, k)) > E Then
  E = Abs(a(i, k))
  p = i
  End If
Next i
For j = k To n + 1
 s = a(k, j)
 a(k, j) = a(p, j)
 a(p, j) = s
Next j
If a(k, k) = 0 Then
Form4.Text1 = "无解"
Else
 For i = k + 1 To n
 r = a(i, k) / a(k, k)
 If a(i, k) = 0 Then
 Else
  For j = k + 1 To n + 1
  a(i, j) = a(i, j) - r * a(k, j)
  Next j
  End If
  Next i
  End If
  Next k
  x(n) = a(n, n + 1) / a(n, n)
  For i = n - 1 To 1 Step -1
   s = a(i, n + 1)
   For j = i + 1 To n
   s = s - a(i, j) * x(j)
   Next j
   x(i) = s / a(i, i)
   Next i
   
End Sub

Public Sub sjfj(a() As Single, x() As Single, n As Single)
For k = 1 To n - 1
 p = k
 E = Abs(a(k, k))
  For i = k + 1 To n
  If Abs(a(i, k)) > E Then
  E = Abs(a(i, k))
  p = i
  End If
  Next i
  For j = 0 To n + 1
   s = a(k, j)
   a(k, j) = a(p, j)
   a(p, j) = s
   Next j
  If a(k, k) = 0 Then
    Form4.Text1 = "无解"
  Else
 For i = k + 1 To n
 a(i, k) = a(i, k) / a(k, k)
 Next i
 If k <> 1 Then
For j = k + 1 To n + 1

For i = 1 To k - 1
a(k, j) = a(k, j) - a(k, i) * a(i, j)
Next i

Next j
End If
For i = k + 1 To n
For j = 1 To k
a(i, k + 1) = a(i, k + 1) - a(i, j) * a(j, k + 1)
Next j
Next i
End If
Next k
For i = 1 To n - 1
a(n, n + 1) = a(n, n + 1) - a(n, i) * a(i, n + 1)
Next i
 x(n) = a(n, n + 1) / a(n, n)
  For i = n - 1 To 1 Step -1
   s = a(i, n + 1)
   For j = i + 1 To n
   s = s - a(i, j) * x(j)
   Next j
   x(i) = s / a(i, i)
   Next i

End Sub

Public Sub zhuigan(a() As Single, b() As Single, c() As Single, d() As Single, x1() As Single, r() As Single, y1() As Single, n As Single, m As Single)
r(m) = c(m) / b(m)
y1(m) = d(m) / b(m)
For k = m + 1 To n - 1
 q = b(k) - r(k - 1) * a(k)
 r(k) = c(k) / q
 y1(k) = (d(k) - y1(k - 1) * a(k)) / q
Next k
y1(n) = (d(n) - y1(n - 1) * a(n)) / (b(n) - r(n - 1) * a(n))
x1(n) = y1(n)
For k = n - 1 To m Step -1
x1(k) = y1(k) - r(k) * x1(k + 1)
Next k
End Sub

Public Sub nj(a() As Single, n As Single)
For k = 1 To n
p = k
E = Abs(a(k, k))
For i = k + 1 To n
  If Abs(a(i, k)) > E Then
  E = Abs(a(i, k))
  p = i
  End If
Next i
For j = k To n + n
 s = a(k, j)
 a(k, j) = a(p, j)
 a(p, j) = s
Next j
If a(k, k) = 0 Then
Form4.Text1 = "无解"
Else
 For i = 1 To n
 If i <> k Then
 r = a(i, k) / a(k, k)
 If a(i, k) = 0 Then
 Else
  For j = k + 1 To n + n
  a(i, j) = a(i, j) - r * a(k, j)
  Next j
  End If
  End If
  Next i
  End If
  Next k
  
End Sub

Public Sub ntcz(x() As Single, y() As Single, p As Single, u As Single, n As Single, m As Single)
ReDim a(m, n) As Single
For r = 0 To m
a(r, 0) = y(r)
Next r
For k = 1 To n
For r = k To m
a(r, k) = (a(r, k - 1) - a(r - 1, k - 1)) / (x(r) - x(r - k))
Next r
Next k
For k = 0 To m - 1
If x(k) <= u And u < x(k + 1) Then
i = k
ElseIf u < x(1) Then
i = 0
ElseIf u >= x(m - 1) Then
i = m - 1
End If
Next k
If m - i >= n Then
p = a(i + n, n)
For t = n - 1 To 0 Step -1
p = p * (u - x(i + t)) + a(i + t, t)
Next t
Else
p = a(i, n)
For t = n - 1 To 0 Step -1
p = p * (u - x(i - t)) + a(i, t)
Next t
End If
End Sub

Public Function cm(a As Single, b As Single, x As Single)
cm = a * (x ^ b)

End Function

Public Function duis(a As Single, b As Single, x As Single)
duis = b * Log(x) + a
End Function


Public Function zhis(a As Single, b As Single, x As Single)
zhis = a * Exp(b * x)
End Function

Public Function duoxs(h() As Single, n As Single, x As Single)
For i = 0 To n
duoxs = duoxs + h(i) * x ^ i
Next i
End Function

Public Sub yangt(biao As Single, x() As Single, y() As Single, d1 As Single, d2 As Single, u As Single, p As Single, m As Single)
ReDim r(m) As Single, a(m) As Single, b(m) As Single, h(m) As Single, c(m) As Single, g(m) As Single, x1(m) As Single, y1(m) As Single

For i = 0 To m
b(i) = 2
Next i
For k = 0 To m - 1
h(k) = x(k + 1) - x(k)
Next k
For k = 1 To m - 1
a(k) = h(k) / (h(k) + h(k - 1))
c(k) = 1 - a(k)
g(k) = 3 * (c(k) * (y(k + 1) - y(k)) / h(k) + a(k) * (y(k) - y(k - 1)) / h(k - 1))

Next k
If biao = 1 Then
 g(1) = g(1) - a(1) * d1
 g(m - 1) = g(m - 1) - c(m - 1) * d1
 Call zhuigan(a(), b(), c(), g(), x1(), r(), y1(), m - 1, 1)
 x1(0) = d1
 x1(m) = d2
 ElseIf biao = 2 Then
 c(0) = 1
 a(m) = 1
 g(0) = 3 * (y(1) - y(0)) / h(0) - d1 * h(0) / 2
 g(m) = 3 * (y(m) - y(m - 1)) / h(m - 1) + d2 * h(m - 1) / 2
 Call zhuigan(a(), b(), c(), g(), x1(), r(), y1(), m, 0)
 End If
 For k = 0 To m - 1
If x(k) < u And u <= x(k + 1) Then i = k

Next k
If u < x(1) Then i = 0
If u > x(m - 1) Then i = m - 1

p1 = (h(i) + 2 * (u - x(i))) * ((u - x(i + 1)) ^ 2) * y(i) / (h(i) ^ 3)
p2 = (h(i) - 2 * (u - x(i + 1))) * ((u - x(i)) ^ 2) * y(i + 1) / (h(i) ^ 3)
p3 = (u - x(i)) * ((u - x(i + 1)) ^ 2) * x1(i) / (h(i) ^ 2)
p4 = (u - x(i + 1)) * ((u - x(i)) ^ 2) * x1(i + 1) / (h(i) ^ 2)
p = p1 + p2 + p3 + p4

End Sub