复相关分析f2.frm

<VB数理统计实用算法>书中的算法源程序

      Left            =   1320
      TabIndex        =   8
      Top             =   1800
      Width           =   5295
   End
   Begin VB.Label lbl001F 
      Alignment       =   2  'Center
      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            =   4800
      TabIndex        =   7
      Top             =   1320
      Width           =   1455
   End
   Begin VB.Label lbl005F 
      Alignment       =   2  'Center
      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            =   4800
      TabIndex        =   6
      Top             =   960
      Width           =   1455
   End
   Begin VB.Label lblFA 
      Alignment       =   2  'Center
      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            =   4800
      TabIndex        =   5
      Top             =   600
      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            =   1080
      TabIndex        =   4
      Top             =   1320
      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            =   1080
      TabIndex        =   3
      Top             =   960
      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            =   1080
      TabIndex        =   2
      Top             =   600
      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: Label5.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
    lblR(0).Visible = False: lblRR.Visible = False: Label6.Visible = False
    lbl005.Visible = False: lbl001.Visible = False
End Sub

'计算
Private Sub cmdCalculate_Click()
    Dim F As Double, RR As Double
    Dim sngF As Single, sngRR 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, sngt As Single
    Dim sngt005 As Single, sngt001 As Single, sngRy As Single
    Dim UA As Integer, Ue As Integer, I As Integer
    Label1.Visible = True: Label2.Visible = True: Label3.Visible = True
    Label4.Visible = True: Label5.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
    lblR(0).Visible = True: lblRR.Visible = True: Label6.Visible = True
    lbl005.Visible = True: lbl001.Visible = True
'求复相关系数和偏相关系数
'x(1 To n, 1 To m)：自变量。n是观测次数，m是自变量的个数
'xx(1 To n)：当前自变量
'y(1 To n)：因变量
'yy(1 To n)：当前因变量
'a(1 To m, 1 To m)：法方程的系数矩阵
'b(0 To m)：回归系数
'RR：复相关系数
'Ry(1 To m)：偏相关系数
'Rx(1 To m,1 To m)：自变量之间的简单相关系数
'F：F检验值
't(1 To m)：偏相关系数的t检验值
    YMulti x, xx, y, yy, a, b, RR, Ry, Rx, F, t
    sngRR = RR: sngF = F
    lblRR.Caption = sngRR: lblFA.Caption = Str(sngF)
    UA = m: Ue = n - m - 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 = "总的来看，变量之间的复相关关系特别显著"
    PT_DIST Ue, 0.05 / 2, t005      '计算显著性为0.05的t临界值（双尾）
    PT_DIST Ue, 0.01 / 2, t001      '计算显著性为0.01的t临界值（双尾）
    sngt005 = t005: sngt001 = t001
    lbl005.Caption = "t0.05 =" & Str(sngt005)
    lbl001.Caption = "t0.01 =" & Str(sngt001)
    sngH = lblB(0).Height
'使用标签显示检验结果
    For I = 1 To m
        Load lblB(I): Load lblV(I): Load lblT(I): Load lblR(I)
        lblB(I).Move lblB(0).Left, lblB(0).Top + I * sngH
        lblB(I).Caption = "Ry" & Str(I)         '偏相关系数名称
        lblB(I).Visible = True
        sngRy = Ry(I)
        lblV(I).Move lblV(0).Left, lblV(0).Top + I * sngH
        lblV(I).Caption = Str(sngRy)            '偏相关系数值
        lblV(I).Visible = True
        sngt = t(I)
        lblT(I).Move lblT(0).Left, lblT(0).Top + I * sngH
        lblT(I).Caption = Str(sngt)             '偏相关系数检验值
        lblT(I).Visible = True
        lblR(I).Move lblR(0).Left, lblR(0).Top + I * sngH
        lblR(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) = "特别显著"
    Next I
End Sub

'退出
Private Sub cmdExit_Click()
    Unload Me
    End
End Sub