⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 多项式逐步回归f2.frm

📁 <VB数理统计实用算法>书中的算法源程序
💻 FRM
📖 第 1 页 / 共 2 页
字号:
      Width           =   5415
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "最终回归方程F检验结论"
      BeginProperty Font 
         Name            =   "隶书"
         Size            =   26.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   240
      TabIndex        =   11
      Top             =   1560
      Width           =   7455
   End
   Begin VB.Label lbl001F 
      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        =   10
      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        =   9
      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        =   8
      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            =   3000
      TabIndex        =   7
      Top             =   1080
      Width           =   3375
   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            =   3000
      TabIndex        =   6
      Top             =   720
      Width           =   3375
   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            =   3720
      TabIndex        =   5
      Top             =   360
      Width           =   2655
   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
    lbl005(0).Visible = False: lbl001(0).Visible = False: lblR(0).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
    n = intCol                      '数据点数
    If txtN.Text = "" Then
        MsgBox "必须键入最高幂次!"
        Exit Sub
    End If
    m = Val(txtN.Text)              '最高幂次
    ReDim b(0 To m)                 '保存回归系数数组
    ReDim t(1 To m)                 't检验值数组
    ReDim xMy(1 To n, 1 To m + 1)
    For I = 1 To n
        For J = 1 To m
            xMy(I, J) = XY(1, I) ^ J    '变换自变量为乘幂
        Next J
        xMy(I, m + 1) = XY(2, I)        '保存因变量
    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 "引入F不能小于剔出F!"
        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
    lbl005(0).Visible = True: lbl001(0).Visible = True: lblR(0).Visible = True
    StrdM xMy, 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 lbl005(I): Load lbl001(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
        lbl005(I).Move lbl005(0).Left, lbl005(0).Top + I * sngH
        lbl005(I).Visible = True
        lbl001(I).Move lbl001(0).Left, lbl001(0).Top + I * sngH
        lbl001(I).Visible = True
        lblR(I).Move lblR(0).Left, lblR(0).Top + I * sngH
        lblR(I).Visible = True
        lbl005(I).Caption = sngt005
        lbl001(I).Caption = sngt001
        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 = "*****"
            lbl005(I).Caption = "*****": lbl001(I).Caption = "*****"
        End If
    Next I
    cmdContinue.Visible = True
End Sub

'继续
Private Sub cmdContinue_Click()
    Unload Me
    frmContinue.Visible = True
End Sub

'退出
Private Sub cmdExit_Click()
    Unload Me
    frmFileName.Visible = True
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -