[轉貼] 述

laigs218

Option Explicit
Public intRow As Integer            '行數
Public intRowAll As Integer         '總行數
Public intCol As Integer            '列數
Public strFileName As String        '資料檔案
Public strLabelName As String       '標題
Public intM As Integer, intN As Integer
Public V() As Double
Public M As Integer, N As Integer   '數據點的行數和列數

'陣列排序的希爾方法
'按昇冪
'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

laigs218

'下面為算法1
'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

laigs218

'其它的
'求幾何平均數
    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