描述统计m2.bas

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

Attribute VB_Name = "modMethod"
'描述统计的计算方法
Option Explicit
'数组排序的希尔方法
'按升序
'Y()：被排序的数组
Public Sub Sort_Shell(Y() As Double)
    Dim Temp As Double, Gap As Integer
    Dim I As Integer, K As Integer, Exchage As Boolean
    K = UBound(Y)                           '获取下标的上界
    Gap = CInt((K + 1) / 2)                 '间距的初值
    Do
        Do
            Exchage = False
            For I = 1 To K - Gap
                If Y(I) > Y(I + Gap) Then
                    Temp = Y(I)
                    Y(I) = Y(I + Gap)
                    Y(I + Gap) = Temp
                    Exchage = True
                End If
            Next I
        Loop While Exchage
        Gap = Gap / 2                       '间距缩小一半
    Loop While Gap >= 1
End Sub

'求描述统计数
'X(1 To M*N)：原始统计数据
'M：统计数据的行数
'N：统计数据的列数
'R(1 To 10)：描述统计结果
Public Sub Character(X() As Double, R() As Double)
    Dim I As Integer, J As Integer, N As Integer
    Dim Max As Double, Min As Double
    Dim J3 As Integer, K3 As Integer
    N = UBound(X)
'求极大值和极小值
    Max = X(1): Min = X(1)
    For I = 1 To N
            If X(I) > Max Then Max = X(I)
            If X(I) < Min Then Min = X(I)
    Next I
'如果极差为0说明数列中所有的数据都相等
    If Max - Min = 0 Then
        R(1) = X(1): R(2) = X(1): R(3) = 99999999: R(4) = X(1)
        R(5) = 0: R(6) = 0: R(7) = 0: R(8) = 0
        R(9) = 99999999: R(10) = 99999999
        Exit Sub
    End If
'求算术平均值
    R(1) = 0
    For I = 1 To N
        R(1) = R(1) + X(I)
    Next I
    R(1) = R(1) / N
'求中值
    Sort_Shell X                    '用希尔方法排序
    If (N \ 2) * 2 = N Then         '数据个数为偶数
        R(2) = (X(N \ 2) + X(N \ 2 + 1)) / 2
    Else                            '数据个数为奇数
        R(2) = X(N \ 2 + 1)
    End If
'求众数
'数列已经按生序排好了，这时可以按简单方法求众数
    R(3) = 99999999                     '在不存在等数时众数无意义
    J3 = 1
    K3 = 1
    I = 1: J = I + 1
    Do Until I >= N
        While X(I) = X(J)
            J3 = J3 + 1                 '增加一个相等的数
            J = J + 1                   '将对下一个数比较
            If J3 > K3 Then R(3) = X(I) '把当前最多的等数临时作为众数
        Wend
        If J3 > K3 Then K3 = J3         '在K3中保存最多的等数的个数
        J3 = 1
        I = J
        J = I + 1
    Loop
'求几何平均数
    For I = 1 To N
        If X(I) <= 0 Then
            R(4) = 99999999
            GoTo 100
        End If
    Next I
    R(4) = 0
    For I = 1 To N
        R(4) = R(4) + Log(X(I))
    Next I
    R(4) = Exp(R(4) / N)
100:
'求范围
    R(5) = Max - Min
'求平均差
    R(6) = 0
    For I = 1 To N
        R(6) = R(6) + Abs(X(I) - R(1))
    Next I
    R(6) = R(6) / N
'求方差
    R(7) = 0
    For I = 1 To N
        R(7) = R(7) + (X(I) - R(1)) ^ 2
    Next I
    R(7) = R(7) / (N - 1)
'求标准差
    R(8) = Sqr(R(7))
'求偏度系数
    R(9) = 0
    For I = 1 To N
        R(9) = R(9) + ((X(I) - R(1)) / R(8)) ^ 3
    Next I
    R(9) = R(9) * Sqr(1 / (6 * N))
'求峰度系数
    R(10) = 0
    For I = 1 To N
        R(10) = R(10) + ((X(I) - R(1)) / R(8)) ^ 4
    Next I
    R(10) = Sqr(N / 24) * (R(10) / N - 3)
End Sub