, , Visual Basic 6.0
.txt , . . 7.
.7
Visual Basic.
, . , .
:
'
Dim A()
Dim B()
Dim v()
Dim i As Integer
Dim N As Integer
Dim N1 As Integer
' X Y
Dim x(30) As Single
Dim y(30) As Single
'
Dim SngX As Single
bytI As Integer
yy As Single
' SngX - , y
'
Dim SumX, SumY As Single
Dim Sumx2, SumXY As Single
Dim Sumx3 As Single
Dim Sumx4 As Single
Dim SumX2y As Single
Dim SumLnY As Single
Dim SumXLnY As Single
Dim Xsr As Single
Dim Ysr As Single
Dim SumX_Xsr As Single
Dim SumY_Ysr As Single
Dim Pr_Sum_sr As Single
Dim X_Xsr_2 As Single
Dim Y_Ysr_2 As Single
Dim Sum_ost_lin As Single
Dim Sum_ost_kvad As Single
Dim Sum_ost_exp As Single
Dim koeff_kor As Single
Dim koeff_det_lin As Single
Dim koeff_det_kvad As Single
Dim koeff_det_exp As Single
'
Dim masXY() As String
Dim inCounter As Integer
Dim inFoundPos As Integer
Dim num As Byte
Const PROBEL = " "
Sub Draw()
'
'
Picture1.Scale (x(0) - 1, y(N) + 20)-(x(N) + 1, y(0) - 20)
For SngX = x(0) - 1 To x(N) + 1 Step 0.005
yy = v(1) + v(2) * SngX ' y
Picture1.PSet (SngX, yy), vbWhite '
Next SngX '
' X
Picture1.Line (x(0) - 1, 0)-(x(N) + 1, 0)
For bytI = x(0) - 1 To x(N) + 1
Picture1.PSet (bytI, 0) ' X
Picture1.Print bytI '
Next bytI
' Y
Picture1.Line (0, y(N) + 20)-(0, y(0) - 20)
For bytI = y(0) - 20 To y(N) + 20 Step 20
Picture1.PSet (0, bytI) ' Y
Picture1.Print bytI '
Next bytI
'
For i = 1 To N
Picture1.Circle (x(i), y(i)), 0.05, vbBlue
Next i
End Sub
Private Sub Gauss(A(), v(), N As Integer, Epsilon)
'
Dim Result As Boolean
Dim R(10, 10) As Double
Dim k As Long
Dim u As Long
Dim m As Long
Dim j As Long
Dim i As Long
Dim t As Double
For i = 1 To N
For j = 1 To N + 1
R(i, j) = A(i, j)
Next
|
|
|
Next
u = 0
Result = True
Do
u = u + 1
k = u
Do While Abs(R(k, u)) <= Epsilon And k < N
k = k + 1
Loop
If k <> N Or Abs(R(N, u)) > Epsilon Then
If k <> u Then
m = u
Do
t = R(u, m)
R(u, m) = R(k, m)
R(k, m) = t
m = m + 1
Loop Until Not m <= N + 1
End If
j = N + 1
Do
R(u, j) = R(u, j) / R(u, u)
j = j - 1
Loop Until Not j >= u
m = N + 1
If k + 1 <= N Then
i = k + 1
Do
j = u + 1
Do
R(i, j) = R(i, j) - R(i, u) * R(u, j)
j = j + 1
Loop Until Not j <= m
i = i + 1
Loop Until Not i <= N
End If
Else
Result = False
End If
Loop Until Not (u <> N And Result)
If Result Then
i = N
Do
v(i) = R(i, m)
If i <> 1 Then
k = i - 1
Do
R(k, m) = R(k, m) - R(k, i) * v(i)
k = k - 1
Loop Until Not k >= 1
End If
i = i - 1
Loop Until Not i >= 1
End If
End Sub
Private Sub Command1_Click()
'
num = FreeFile
Open "ID1.txt" For Input As #num
While Not EOF(num)
i = i + 1
ReDim Preserve masXY(i)
Line Input #num, masXY(i)
Wend
Close num
' X Y ListBox
N = i
For i = 1 To N Step 1
inCounter = 1
inFoundPos = InStr(inCounter, masXY(i), PROBEL)
While inFoundPos <> 0
x(i) = Val(Mid$(masXY(i), inCounter, inFoundPos - inCounter))
inCounter = inFoundPos + 1
inFoundPos = InStr(inCounter, masXY(i), PROBEL)
Wend
If inCounter < Len(masXY(i)) Then
y(i) = Val(Mid$(masXY(i), inCounter))
End If
List1.AddItem x(i)
List2.AddItem y(i)
Next i
'
For i = 1 To N Step 1
SumX = SumX + x(i)
SumY = SumY + y(i)
Sumx2 = Sumx2 + x(i) ^ 2
SumXY = SumXY + x(i) * y(i)
Sumx3 = Sumx3 + x(i) ^ 3
Sumx4 = Sumx4 + x(i) ^ 4
SumX2y = SumX2y + x(i) ^ 2 * y(i)
SumLnY = SumLnY + Log(y(i))
SumXLnY = SumXLnY + x(i) * Log(y(i))
Next i
Xsr = SumX / N
Ysr = SumY / N
For i = 1 To N Step 1
SumX_Xsr = SumX_Xsr + (x(i) - Xsr)
SumY_Ysr = Sumy_Xsr + (y(i) - Ysr)
Pr_Sum_sr = Pr_Sum_sr + SumX_Xsr * SumY_Ysr
X_Xsr_2 = X_Xsr_2 + (x(i) - Xsr) ^ 2
Y_Ysr_2 = Y_Ysr_2 + (y(i) - Ysr) ^ 2
Next i
'
N1 = 2
ReDim A(1 To N, 1 To N + 1)
ReDim B(1 To N)
ReDim v(1 To N)
A(1, 1) = N
A(1, 2) = SumX
A(2, 1) = SumX
A(2, 2) = Sumx2
A(1, 3) = SumY
A(2, 3) = SumXY
Gauss A(), v(), N1, 0.01
Text1.Text = "y = " & Round(v(1), 4) & " + " & Round(v(2), 4) & "x"
For i = 1 To N
Sum_ost_lin = Sum_ost_lin + (v(1) + v(2) * x(i) - y(i)) ^ 2
Next i
koeff_kor = Round(Pr_Sum_sr / Sqr(X_Xsr_2 * Y_Ysr_2), 4)
Text4.Text = koeff_kor
koeff_det_lin = Round(1 - Sum_ost_lin / Y_Ysr_2, 4)
Text5.Text = koeff_det_lin
Draw
'
For SngX = x(0) - 1 To x(N) + 1 Step 0.005
yy = v(1) + v(2) * SngX ' y
Picture1.PSet (SngX, yy), vbRed '
Next SngX '
'
N1 = 3
ReDim A(1 To N, 1 To N + 1)
ReDim B(1 To N)
ReDim B(1 To N)
ReDim v(1 To N)
A(1, 1) = N
A(1, 2) = SumX
A(1, 3) = Sumx2
A(2, 1) = SumX
|
|
|
A(2, 2) = Sumx2
A(2, 3) = Sumx3
A(3, 1) = Sumx2
A(3, 2) = Sumx3
A(3, 3) = Sumx4
A(1, 4) = SumY
A(2, 4) = SumXY
A(3, 4) = SumX2y
Gauss A(), v(), N1, 0.01
Text2.Text = "y = " & Round(v(1), 4) & " + " & Round(v(2), 4) & "x" & " + " & Round(v(3), 4) & "x^2"
For i = 1 To N
Sum_ost_kvad = Sum_ost_kvad + (v(1) + v(2) * x(i) + v(3) * x(i) ^ 2 - y(i)) ^ 2
Next i
koeff_det_kvad = Round(1 - Sum_ost_kvad / Y_Ysr_2, 4)
Text6.Text = koeff_det_kvad
Draw
'
For SngX = x(0) - 1 To x(N) + 1 Step 0.005
yy = v(1) + v(2) * SngX + v(3) * SngX ^ 2 ' y
Picture1.PSet (SngX, yy), vbGreen '
Next SngX '
'
N1 = 2
ReDim A(1 To N, 1 To N + 1)
ReDim B(1 To N)
ReDim B(1 To N)
ReDim v(1 To N)
A(1, 1) = N
A(1, 2) = SumX
A(2, 1) = SumX
A(2, 2) = Sumx2
A(1, 3) = SumLnY
A(2, 3) = SumXLnY
Gauss A(), v(), N1, 0.01
Text3.Text = "y = " & Exp(Round(v(1), 4)) & " * " & "exp(" & Round(v(2), 4) & "x)"
For i = 1 To N
Sum_ost_exp = Sum_ost_exp + (Exp(v(1)) * Exp(v(2) * x(i)) - y(i)) ^ 2
Next i
koeff_det_exp = Round(1 - Sum_ost_exp / Y_Ysr_2, 4)
Text7.Text = koeff_det_exp
Draw
'
For SngX = x(0) - 1 To x(N) + 1 Step 0.005
yy = Exp(v(1)) * Exp(v(2) * SngX) ' y
Picture1.PSet (SngX, yy), vbMagenta '
Next SngX '
End Sub
Private Sub Form_Load()
Frame1.Caption = " "
Frame2.Caption = " "
Frame3.Caption = " "
Frame4.Caption = " "
Frame5.Caption = " "
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
List1.AddItem " X "
List2.AddItem " Y "
Label1.Caption = " "
Label1.Font.Size = 16
Label1.Alignment = 2
Label2.Caption = " Visual Basic 6.0"
Label2.Font.Size = 12
Label2.Alignment = 2
Label3.Caption = " -11 .."
Label3.Font.Size = 12
Label3.Alignment = 2
Label4.Caption = " "
Label5.Caption = " "
Label6.Caption = " "
Label7.Caption = " "
Command1.Caption = ""
End Sub
ܻ , . 8.
. 8
. Microsoft Excel Visual Basic 6.0.
, , . . , .
, Microsoft Excel Visual Basic 6.0, , . , Visual Basic 6.0 Microsoft Excel , .
|
|
|
1. .. , .. . . .: - , 1963.
2. : / . . .. . .: , 1997.
3. : / . . .. . .: , 1997.
4. . , .. Excel 5.0. . .: . ̔, 1996.
