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

📄 两组判别f1.frm

📁 <VB数理统计实用算法>书中的算法源程序
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frmFileName 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "两组判别"
   ClientHeight    =   4080
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   ScaleHeight     =   4080
   ScaleWidth      =   5670
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtFile 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   120
      TabIndex        =   9
      Top             =   3000
      Width           =   5415
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退出"
      Height          =   375
      Left            =   4800
      TabIndex        =   7
      ToolTipText     =   "结束程序运行"
      Top             =   3480
      Width           =   615
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      Height          =   375
      Left            =   4200
      TabIndex        =   6
      ToolTipText     =   "选择好文件并给出行数和列数后单击"
      Top             =   3480
      Width           =   615
   End
   Begin VB.FileListBox File1 
      Appearance      =   0  'Flat
      Height          =   1470
      Left            =   120
      TabIndex        =   2
      Top             =   1080
      Width           =   2655
   End
   Begin VB.DirListBox Dir1 
      Appearance      =   0  'Flat
      Height          =   2190
      Left            =   3000
      TabIndex        =   1
      Top             =   360
      Width           =   2415
   End
   Begin VB.DriveListBox Drive1 
      Appearance      =   0  'Flat
      Height          =   300
      Left            =   120
      TabIndex        =   0
      Top             =   360
      Width           =   2655
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "数据文件全名"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1320
      TabIndex        =   8
      Top             =   2760
      Width           =   3015
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择数据文件"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   5
      Top             =   840
      Width           =   2535
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择目录"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   3000
      TabIndex        =   4
      Top             =   120
      Width           =   2415
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "选择驱动器"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   2655
   End
End
Attribute VB_Name = "frmFileName"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'两组判别文件窗体
Option Explicit
Dim intI As Integer, intJ As Integer, K As Integer, L As Integer
Dim int1 As Integer, int2 As Integer, intNew As Integer
Dim intFileNumber As Integer            '文件号
Dim strData As String                   '临时保存数据

Private Sub Form_Load()
    File1.Pattern = "*.dat"             '只显示数据文件
End Sub

'选择目录
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub

'选择驱动器
Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

'确定数据文件
Private Sub File1_Click()
    txtFile.Text = Dir1.Path & "\" & File1.FileName          '原始数据文件
End Sub

'确定,给出文件名和行数、列数后单击
Private Sub cmdOK_Click()
    strFileName = txtFile.Text          '文件名
    intFileNumber = FreeFile            '取得空闲的文件号码
    Open strFileName For Input As intFileNumber
    Input #intFileNumber, strData       '读列数
    intCol = Val(strData)               '取得列数
    If intCol < 2 Then
        MsgBox "数据的列数不能小于2!", vbOKOnly + vbExclamation, _
        "数据文件错"
        End
    End If
    Input #intFileNumber, strData       '读A组样本数
    int1 = Val(strData)                 'A组样本数
    If intCol >= 3 Then
        For intI = 3 To intCol          '空转,读*****
            Input #intFileNumber, strData
        Next intI
    End If
    Input #intFileNumber, strData       '读数据行数
    intRow = Val(strData)               '取得数据行数
    Input #intFileNumber, strData       '读A组样本数
    int2 = Val(strData)                 'A组样本数
    If intCol >= 3 Then
        For intI = 3 To intCol          '空转,读*****
            Input #intFileNumber, strData
        Next intI
    End If
    Input #intFileNumber, strData       '读总行数
    intRowAll = Val(strData)            '取得总行数
    Input #intFileNumber, strData       '读待定组样本数
    intNew = Val(strData)
    If intCol >= 3 Then
        For intI = 3 To intCol          '空转,读*****
            Input #intFileNumber, strData
        Next intI
    End If
    If int1 + int2 + intNew <> intRow Then
        MsgBox "A组+B组+待定组的行数必须等于给定行数(intRow)!", _
        vbOKOnly + vbExclamation, "数据文件错"
        End
    End If
    N1 = int1: N2 = int2: N3 = intNew
    M = intCol
'重新定义数据数组
    ReDim X1(1 To N1, 1 To M)                           'A组样本数据
    ReDim X2(1 To N2, 1 To M)                           'B组样本数据
    If N3 > 0 Then ReDim X3(1 To N3, 1 To M)            '待定组样本数据
    blnTitle = False: blnRowLabel = False: blnColLabel = False
'优先考虑标题
    If intRowAll > intRow + 3 Then blnTitle = True      '有标题题
'其次考虑行标
    If intRowAll > 2 * intRow + 3 Then
        blnRowLabel = True                              '有行标
        ReDim strRowLabel(1 To intRow)                  '重新定义行标数组
    End If
'最后考虑列标
    If intRowAll > 2 * intRow + 4 Then
        blnColLabel = True                              '有列标
        ReDim strColLabel(1 To intCol)                  '重新定义列标数组
    End If
    If blnTitle Then
        Input #intFileNumber, strData                   '读标题
        strLabelName = strData                          '保存标题
        If intCol >= 2 Then
            For intI = 2 To intCol                      '空转,读*****号
                Input #intFileNumber, strData
            Next intI
        End If
    End If
    If blnRowLabel Then
        For intI = 1 To intRow
            Input #intFileNumber, strData               '读行标题
            If intCol >= 2 Then
                For intJ = 2 To intCol                  '空转,读*****号
                    Input #intFileNumber, strData
                Next intJ
            End If
        Next intI
    End If
    If blnColLabel Then
        For intI = 1 To intCol                          '读列标题
            Input #intFileNumber, strData
        Next intI
    End If
    K = 1: L = 1                                        '读B组和待定组数据所需要的参数
    For intI = 1 To intRow
        For intJ = 1 To intCol
            Input #intFileNumber, strData               '读各组数据
            If intI <= N1 Then X1(intI, intJ) = Val(strData)
            If intI > N1 And intI <= N1 + N2 Then X2(K, intJ) = Val(strData)
            If intI > N1 + N2 Then X3(L, intJ) = Val(strData)
        Next intJ
        If intI > N1 And intI <= N1 + N2 Then K = K + 1 'B组的行加1
        If intI > N1 + N2 Then L = L + 1                '待定组的行加1
    Next intI
    Close
    ReDim Y1(1 To N1), Y2(1 To N2)                      '保存样本判别值
    If N3 > 0 Then ReDim Y3(1 To N3)
    ReDim CP1(1 To M), CP2(1 To M)                      'A、B组样本的各变量平均值
    ReDim XS(1 To M, 1 To M)                            '求判别方程时的系数矩阵
    ReDim DD(1 To M)                                    '求判别方程时的右侧向量
    ReDim CC(1 To M)                                    '求出的判别方程系数
    Unload Me
    frmCalculate.Visible = True                         '显示计算窗体
End Sub

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

⌨️ 快捷键说明

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