📄 非线性逐步回归f2.frm
字号:
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 6360
TabIndex = 9
Top = 1080
Width = 1455
End
Begin VB.Label lbl005F
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 6360
TabIndex = 8
Top = 720
Width = 1455
End
Begin VB.Label lblFA
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 6360
TabIndex = 7
Top = 360
Width = 1455
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "显著性水平为0.01的F临界值："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 2640
TabIndex = 6
Top = 1080
Width = 3735
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "显著性水平为0.05的F临界值："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 2640
TabIndex = 5
Top = 720
Width = 3735
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "最终回归方程F检验值："
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 2640
TabIndex = 4
Top = 360
Width = 3735
End
End
Attribute VB_Name = "frmCalculate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'非线性逐步回归
Option Explicit
Private Sub Form_Load()
Label1.Visible = False: Label2.Visible = False: Label3.Visible = False
Label4.Visible = False: Label9.Visible = False
lblFA.Visible = False: lbl005F.Visible = False: lbl001F.Visible = False
lblB(0).Visible = False: lblV(0).Visible = False: lblT(0).Visible = False
lblType(0).Visible = False: lblR(0).Visible = False
lblt005.Visible = False: lblt001.Visible = False: Label7.Visible = False
cmdContinue.Visible = False
End Sub
'计算
Private Sub cmdCalculate_Click()
Dim F As Double, F1 As Double, F2 As Double
Dim sngF As Single, sngH As Single
Dim F005 As Double, F001 As Double
Dim sngF005 As Single, sngF001 As Single
Dim t005 As Double, t001 As Double
Dim sngt005 As Single, sngt001 As Single
Dim UA As Integer, Ue As Integer
Dim I As Integer, J As Integer
For I = 1 To n
For J = 1 To m + 1
If xy(I, J) <= 0 Then
MsgBox "变量不能为0或负数，先转换数据后再作！"
End
End If
xy1(I, J) = xy(I, J) '保存变换前的原始数据
xyChange xy(I, J), xyType(J) '对变量进行变换
Next J
Next I
If txtF1.Text = "" Or txtF2.Text = "" Then
MsgBox "必须给定引入F和剔出F！"
Exit Sub
End If
F1 = Val(txtF1.Text): F2 = Val(txtF2.Text)
If F1 < F2 Then
MsgBox "F1不能小于F2！"
Exit Sub
End If
If F1 = 0 And F2 = 0 Then MsgBox "F1 = F2 = 0 引入全部变量。不进行t检验"
Label1.Visible = True: Label2.Visible = True: Label3.Visible = True
Label4.Visible = True: Label9.Visible = True
lblFA.Visible = True: lbl005F.Visible = True: lbl001F.Visible = True
lblB(0).Visible = True: lblV(0).Visible = True: lblT(0).Visible = True
lblType(0).Visible = True: lblR(0).Visible = True
lblt005.Visible = True: lblt001.Visible = True: Label7.Visible = True
Strd xy, F1, F2, F, L, b, t '建立回归方程并求F值和t值
sngF = F
lblFA.Caption = Str(sngF)
UA = L: Ue = n - L - 1
PF_DIST UA, Ue, 0.05, F005 '计算显著性为0.05的F临界值
PF_DIST UA, Ue, 0.01, F001 '计算显著性为0.01的F临界值
sngF005 = F005: sngF001 = F001
lbl005F.Caption = Str(sngF005): lbl001F.Caption = Str(sngF001)
If F <= F005 Then lblDA = "总的来看，自变量对因变量的影响不显著"
If F > F005 And F <= F001 Then lblDA = "总的来看，自变量对因变量的影响显著"
If F > F001 Then lblDA = "总的来看，自变量对因变量的影响特别显著"
If m > 20 Then MsgBox "只显示前20个自变量的情况"
PT_DIST Ue, 0.05 / 2, t005 '计算显著性为0.05的t临界值
PT_DIST Ue, 0.01 / 2, t001 '计算显著性为0.01的t临界值
sngt005 = t005: sngt001 = t001
lblB(0).Caption = "b" & " 0"
lblV(0).Caption = Str(b(0))
sngH = lblB(0).Height
'使用标签显示检验结果
For I = 1 To m
Load lblB(I): Load lblV(I): Load lblT(I)
Load lblType(I): Load lblR(I)
lblB(I).Move lblB(0).Left, lblB(0).Top + I * sngH
lblB(I).Caption = "b" & Str(I)
lblB(I).Visible = True
lblV(I).Move lblV(0).Left, lblV(0).Top + I * sngH
lblV(I).Caption = Str(b(I))
lblV(I).Visible = True
lblT(I).Move lblT(0).Left, lblT(0).Top + I * sngH
lblT(I).Caption = Str(t(I))
lblT(I).Visible = True
lblR(I).Move lblR(0).Left, lblR(0).Top + I * sngH
lblR(I).Visible = True
lblType(I).Move lblType(0).Left, lblType(0).Top + I * sngH
lblType(I).Visible = True
If t(I) <= t005 Then lblR(I) = "不显著"
If t(I) > t005 And t(I) <= t001 Then lblR(I) = "显著"
If t(I) > t001 Then lblR(I) = "特别显著"
If F1 = 0 Or F2 = 0 Then
lblT(I).Caption = "*****": lblR(I).Caption = "*****"
End If
Next I
Load lblR(m + 1): Load lblType(m + 1)
lblR(m + 1).Move lblR(0).Left, lblR(0).Top + (m + 1) * sngH
lblR(m + 1).Caption = "Y变换为"
lblR(m + 1).Visible = True
lblType(m + 1).Move lblType(0).Left, lblType(0).Top + (m + 1) * sngH
lblType(m + 1).Visible = True
'在变换类型标签内显示变换类型
I = 0
100:
I = I + 1
Select Case xyType(I) '公有xyType(I)保存变量类型编码
Case 1
lblType(I) = "X"
If I = m + 1 Then lblType(I) = "Y"
Case 2
lblType(I) = "X^2"
If I = m + 1 Then lblType(I) = "Y^2"
Case 3
lblType(I) = "X^3"
If I = m + 1 Then lblType(I) = "Y^3"
Case 4
lblType(I) = "1/X"
If I = m + 1 Then lblType(I) = "1/Y"
Case 5
lblType(I) = "1/X^2"
If I = m + 1 Then lblType(I) = "1/Y^2"
Case 6
lblType(I) = "Sqr(X)"
If I = m + 1 Then lblType(I) = "Sqr(Y)"
Case 7
lblType(I) = "1/Sqr(X)"
If I = m + 1 Then lblType(I) = "1/Sqr(Y)"
Case 8
lblType(I) = "Sqr(X^2-1)"
If I = m + 1 Then lblType(I) = "Sqr(Y^2-1)"
Case 9
lblType(I) = "Log(X)"
If I = m + 1 Then lblType(I) = "Log(Y)"
Case 10
lblType(I) = "Exp(X)"
If I = m + 1 Then lblType(I) = "Exp(Y)"
Case 11
lblType(I) = "Exp(-X)"
If I = m + 1 Then lblType(I) = "Exp(-Y)"
Case 12
lblType(I) = "Sin(X)"
If I = m + 1 Then lblType(I) = "Sin(X)"
Case 13
lblType(I) = "Cos(X)"
If I = m + 1 Then lblType(I) = "Cos(Y)"
Case 14
lblType(I) = "Sin(2*X)"
If I = m + 1 Then lblType(I) = "Sin(2*Y)"
Case 15
lblType(I) = "Cos(2*X)"
If I = m + 1 Then lblType(I) = "Cos(2*Y)"
End Select
If I < m + 1 Then GoTo 100
lblt005.Caption = "t(0.05)=" & Str(sngt005)
lblt001.Caption = "t(0.01)=" & Str(sngt001)
If F1 = 0 Or F2 = 0 Then
lblt005.Caption = "*****": lblt001.Caption = "*****"
End If
cmdContinue.Visible = True
'恢复xy数组为原始数据
For I = 1 To n
For J = 1 To m + 1
xy(I, J) = xy1(I, J)
Next J
Next I
End Sub
'继续
Private Sub cmdContinue_Click()
Unload Me
frmContinue.Visible = True
End Sub
'退出
Private Sub cmdExit_Click()
Unload Me
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -