?? 一元曲線逆合.frm
字號:
For i = 1 To VSFlexGrid1.Rows - 1
xa(i) = Val(VSFlexGrid1.TextMatrix(i, 1))
ya(i) = Val(VSFlexGrid1.TextMatrix(i, 2))
Next i
yc = Val(Text2.Text)
y1 = 0
y2 = 0
cx = 0
cy = 0
xy = 0
xx = 0
yy = 0
sx = 100000000
sy = 100000000
mx = -100000000
my = -100000000
For i = 1 To m
x = xa(i)
y = ya(i)
y1 = y1 + y
y2 = y2 + y * y
If x > mx Then mx = x
If x < sx Then sx = x
If y > my Then my = y
If y < sy Then sy = y
If md > 0 Then Call yian
cx = cx + x
cy = cy + y
xy = xy + x * y
xx = xx + x * x
yy = yy + y * y
Next i
xx = xx - cx * cx / m
yy = yy - cy * cy / m
xy = xy - cx * cy / m
y2 = y2 - y1 * y1 / m
d = xy / xx
c = (cy - d * cx) / m
b = d
a = c
u = d * xy
q = yy - u
r = Sqr(u / yy)
e = Sqr(q / (m - 2))
F = u / q * (m - 2)
v = Sqr(y2 / (m - 1))
Call xian
List1.Clear
List1.AddItem "回歸系數 B=" + Str(Int(b * 10000 + 0.5) / 10000)
List1.AddItem "常數項 A=" + Str(Int(a * 10000 + 0.5) / 10000)
List1.AddItem "相關系數 R=" + Str(Int(r * 10000 + 0.5) / 10000)
List1.AddItem "復相關系數F=" + Str(Int(F * 10000 + 0.5) / 10000)
List1.AddItem ""
List1.AddItem "序號 數據Xi Yi 擬合值(Y) 差值Y-(Y)"
For i = 1 To m
x = xa(i)
y = ya(i)
Call xian
List1.AddItem Str(i) + " " + Str(x) + " " + Str(y) + " " + Str(Int(z * 1000 + 0.5) / 1000) + " " + Str(Int((y - z) * 1000 + 0.5) / 1000)
Next i
List1.AddItem ""
Text3.Visible = True
Text3.SetFocus
Command3.Enabled = True
Exit Sub
handlerror:
xianshi = MsgBox("請檢查輸入的數據后再計算。", vbInformation, "問題提示")
End Sub
Private Sub Command2_Click()
'關閉
On Error GoTo handlerror
If List1.ListCount > 1 And rjsfzc = 88 Then
frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 《一元曲線擬合計算結果》:"
frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 實驗數據數目=" + Text1.Text
If md > 5 Then frmMain.Text1 = frmMain.Text1 & vbCrLf & " 常數Yc=" + Text2.Text
frmMain.Text1 = frmMain.Text1 & vbCrLf & " 曲線公式=" + Str(dm) + "號"
For i = 0 To List1.ListCount - 1
frmMain.Text1 = frmMain.Text1 & vbCrLf & " " + List1.List(i)
Next i
frmMain.Text1 = frmMain.Text1 & vbCrLf & " --------------------------------------"
End If
Unload Me
Exit Sub
handlerror:
End Sub
Private Sub Command3_Click()
'推測結果
x = Val(Text3.Text)
Call xian
List1.AddItem " X=" + Str(x) + " " + "y=" + Str(Int(z * 1000 + 0.5) / 1000)
Text3.Text = ""
Text3.SetFocus
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc鍵退出,VbEscape可以用27代替
On Error GoTo handlerror
If KeyAscii = 27 Then
Unload Me
End If
Exit Sub
handlerror:
End Sub
Private Sub Form_Load()
'啟動
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text3.Visible = False
Command3.Enabled = False
List1.Clear
VSFlexGrid1.TextMatrix(0, 0) = "序號"
VSFlexGrid1.TextMatrix(0, 1) = "數據Xi"
VSFlexGrid1.TextMatrix(0, 2) = "數據Yi"
VSFlexGrid1.ColAlignment(0) = flexAlignCenterCenter
VSFlexGrid1.ColAlignment(1) = flexAlignCenterCenter
VSFlexGrid1.ColAlignment(2) = flexAlignCenterCenter
VSFlexGrid1.ColWidth(0) = 500
VSFlexGrid1.ColWidth(1) = 1000
VSFlexGrid1.ColWidth(2) = 1000
Label2.Visible = False
Text2.Visible = False
End Sub
Private Sub Option1_Click()
'不顯示常數
md = 0
Label2.Visible = False
Text2.Visible = False
Text2.Text = ""
End Sub
Private Sub Option2_Click()
'不顯示常數
md = 1
Label2.Visible = False
Text2.Visible = False
Text2.Text = ""
End Sub
Private Sub Option3_Click()
'不顯示常數
md = 2
Label2.Visible = False
Text2.Visible = False
Text2.Text = ""
End Sub
Private Sub Option4_Click()
'不顯示常數
md = 3
Label2.Visible = False
Text2.Visible = False
Text2.Text = ""
End Sub
Private Sub Option5_Click()
'不顯示常數
md = 4
Label2.Visible = False
Text2.Visible = False
Text2.Text = ""
End Sub
Private Sub Option6_Click()
'不顯示常數
md = 5
Label2.Visible = False
Text2.Visible = False
Text2.Text = ""
End Sub
Private Sub Option7_Click()
'顯示常數
md = 6
Label2.Visible = True
Text2.Visible = True
Text2.Text = ""
End Sub
Private Sub Option8_Click()
'顯示常數
md = 7
Label2.Visible = True
Text2.Visible = True
Text2.Text = ""
End Sub
Private Sub Text1_Change()
'實驗數目
If Val(Text1.Text) >= 1 Then
VSFlexGrid1.Rows = Val(Text1.Text) + 1
For i = 1 To VSFlexGrid1.Rows - 1
VSFlexGrid1.TextMatrix(i, 0) = i
Next i
End If
End Sub
Public Sub yian()
'因變量線形化分程序
Select Case md
Case Is = 1
y = Log(y)
x = Log(x)
Case Is = 2
y = Log(y)
Case Is = 3
y = Log(x)
x = 1 / x
Case Is = 4
x = Log(x)
Case Is = 5
y = 1 / y
x = 1 / x
Case Is = 6
y = Log(yc / y - 1)
Case Is = 7
y = Log(1 - y / yc)
End Select
End Sub
Public Sub xian()
'求擬合值分程序
Select Case md
Case Is = 0
z = a + b * x
Case Is = 1
a = Exp(c)
z = a * x ^ b
Case Is = 2
a = Exp(c)
z = a * Exp(b * x)
Case Is = 3
a = Exp(c)
z = a * Exp(b / x)
Case Is = 4
z = a + b * Log(x)
Case Is = 5
z = x / (a * x + b)
Case Is = 6
z = yc / (1 + Exp(a + b * x))
Case Is = 7
a = -c / d
b = -d
z = yc * (1 - Exp(-b * (x - a)))
End Select
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -