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 時間: 2021-7-16 08:27
本帖最後由 laigs218 於 2021-7-16 08:29 編輯
'下面為算法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 時間: 2021-7-16 08:30
'其它的
'求幾何平均數
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
