modstatistics.vb

visual basic课程设计案例精编

Module modStatistics
    Dim DeviationArray() As Integer '存放偏差的数组
    Dim i As Integer '循环变量
    Public InOrder() As Object

    Public Function Mean() As Object

        'Get the mean of the values
        Mean = SumX() / SS()

    End Function

    Public Function Mode() As Object
        Dim Count() As Integer
        Dim Found As Boolean
        Dim j As Integer
        Dim ModeString As String
        Dim MultipleModes() As Object
        Dim Num() As Double
        Dim Temp As String
        Dim UpperIndex As Integer
        Dim UpperValue As Integer

        'Set the basic dimensions and variables
        ReDim Count(0)
        ReDim Num(0)
        Num(0) = MainArray(0)
        Count(0) = 1

        'Analyse the data to load the numbers and their
        'amount of occurences into arrays
        For i = 1 To UBound(MainArray)
            Found = False
            For j = 0 To UBound(Num)
                If MainArray(i) = Num(j) Then
                    Count(j) = Count(j) + 1
                    Found = True
                    Exit For
                End If
            Next j
            If Found = False Then
                ReDim Preserve Num(UBound(Num) + 1)
                ReDim Preserve Count(UBound(Count) + 1)
                Num(UBound(Num)) = MainArray(i)
                Count(UBound(Count)) = 1
            End If
        Next i

        'Find the most common number
        UpperValue = Count(0)
        For i = 1 To UBound(Count)
            If Count(i) > UpperValue Then
                UpperIndex = i
                UpperValue = Count(i)
            End If
        Next i

        'Check to see if there is only one
        'occurence of each number.  If so, no mode
        'exists
        If Count(UpperIndex) = 1 Then
            Mode = "N/A"
        Else
            ReDim MultipleModes(0)
            For i = 0 To UBound(Count)
                If Count(i) = UpperValue Then
                    ReDim Preserve MultipleModes(UBound(MultipleModes) + 1)
                    MultipleModes(UBound(MultipleModes)) = Num(i)
                End If
            Next i
            If UBound(MultipleModes) > 1 Then
                ModeString = ""
                For i = 1 To UBound(MultipleModes)
                    If i = UBound(MultipleModes) Then
                        ModeString = ModeString & CStr(MultipleModes(i))
                    Else
                        ModeString = ModeString & CStr(MultipleModes(i)) & ", "
                    End If
                Next i
                Mode = ModeString
            Else
                Mode = Num(UpperIndex)
            End If
        End If

    End Function

    Public Function SumX() As Object

        'Get the sum of each of the values
        Value = 0
        For i = 0 To UBound(MainArray)
            Value = Value + MainArray(i)
        Next i
        SumX = Value

    End Function

    Public Function SumX2() As Object

        'Get the sum of each of the values squared
        Value = 0
        For i = 0 To UBound(MainArray)
            Value = Value + (MainArray(i) ^ 2)
        Next i
        SumX2 = Value

    End Function

    Public Function SS() As Object
        'Get sample size
        SS = UBound(MainArray) + 1

    End Function

    Public Function Range() As Object
        'Get range
        Range = maxX() - minX()
    End Function

    Public Function Variance() As Object
        Dim Temp As String
        'Get variance
        Temp = Deviations()
        Value = 0
        For i = 0 To UBound(DeviationArray)
            Value = Value + (DeviationArray(i) ^ 2)
        Next i
        Variance = Value / SS()
    End Function

    Public Function SD() As Object
        'Get standard deviation
        SD = System.Math.Sqrt(Variance)
    End Function

    Public Function SE() As Object
        'Get standard error
        SE = SD() / System.Math.Sqrt(SS)
    End Function

    Public Function minX() As Object
        Dim LowerValue As Double
        'Prevent error if only one value
        If UBound(MainArray) = 0 Then
            minX = MainArray(0)
            Exit Function
        End If
        'Find lowest value
        LowerValue = MainArray(0)
        For i = 1 To UBound(MainArray)
            If MainArray(i) < LowerValue Then
                LowerValue = MainArray(i)
            End If
        Next i
        minX = LowerValue
    End Function



    Public Function Median() As Object
        Dim j As Integer
        Dim LowerIndex As Integer
        Dim LowerValue As Double
        Dim TempArray() As Object
        Dim TempArray2() As Object
        Dim UpperBound As Integer

        'Set basic dimensions and variables
        ReDim InOrder(0)
        ReDim TempArray(UBound(MainArray))
        ReDim TempArray2(UBound(MainArray))
        For i = 0 To UBound(MainArray)

            TempArray(i) = MainArray(i)
        Next i

        'Three steps to sorting the array
        For j = 0 To UBound(MainArray)

            'Find the lowest value in the array
            LowerIndex = 0
            LowerValue = TempArray(0)
            If UBound(TempArray) <> 0 Then
                For i = 1 To UBound(TempArray)
                    If TempArray(i) < LowerValue Then
                        LowerIndex = i
                        LowerValue = TempArray(i)
                    End If
                Next i
            End If
            'Add the lowest value into a new array
            ReDim Preserve InOrder(UBound(InOrder) + 1)
            InOrder(UBound(InOrder)) = LowerValue
            If UBound(TempArray) = 0 Then
                Exit For
            End If

            'Delete the value from the old array
            For i = 0 To UBound(TempArray)
                If i < LowerIndex Then
                    TempArray2(i) = TempArray(i)
                ElseIf i > LowerIndex Then
                    TempArray2(i - 1) = TempArray(i)
                End If
            Next i
            ReDim TempArray(UBound(TempArray2) - 1)
            For i = 0 To (UBound(TempArray2) - 1)
                TempArray(i) = TempArray2(i)
            Next i
            ReDim TempArray2(UBound(TempArray2) - 1)
        Next j

        UpperBound = UBound(InOrder)

        'Even number of values
        If (UpperBound / 2) = CInt(UpperBound / 2) Then
            Median = InOrder(UpperBound / 2) + ((InOrder((UpperBound + 2) / 2) - InOrder(UpperBound / 2)) / 2)

            'Odd number of values
        Else
            Median = InOrder((UpperBound + 1) / 2)
        End If

    End Function



    Public Function maxX() As Object
        Dim UpperValue As Double
        If UBound(MainArray) = 0 Then '防止在只有一个数的情况下发生错误
            maxX = MainArray(0)
            Exit Function
        End If
        UpperValue = MainArray(0)
        For i = 1 To UBound(MainArray)
            If MainArray(i) > UpperValue Then
                UpperValue = MainArray(i)  '寻找最大的数
            End If
        Next i
        maxX = UpperValue
    End Function


    Public Function Deviations() As Object
        Dim DevString As String
        Dim j As Integer
        Dim MeanVar As Double
        MeanVar = Mean()
        ReDim DeviationArray(UBound(MainArray))
        For j = 0 To UBound(DeviationArray)
            DeviationArray(j) = MainArray(j) - Mean()
            '将偏差存储在数组中
        Next j
        DevString = ""
        For i = 0 To UBound(DeviationArray)
            If i = UBound(DeviationArray) Then
                DevString = DevString & CStr(DeviationArray(i))
            Else
                DevString = DevString & CStr(DeviationArray(i)) & ", "
            End If
        Next i
        Deviations = DevString
        '在文本框中显示的偏差
    End Function
End Module