Sub DD()

'This program is used to calculate distance based topological change
'Author: Jing "Eric" Du
'April 14, 2014

    Dim Num As Integer, Num_of_input As Integer, Num_of_output As Integer, p As Integer, q As Integer, i As Integer, j As Integer, k As Long
    Dim INPUTp As Variant
    Dim INPUTn As Variant
    Dim INPUTdiff As Variant
    Dim OUTPUTp As Variant
    Dim OUTPUTn As Variant
    Dim OUTPUTdiff As Variant
    Dim MATRIXi As Variant
    Dim MATRIXo As Variant
    Dim RESULTi As Double
        Dim RESULTi1 As Variant
    Dim RESULTo As Double
        Dim RESULTo1 As Variant
    Dim RESULTicum As Double
    Dim RESULTocum As Double
    Dim RESULTiavg As Double
    Dim RESULToavg As Double
    Dim RESULT As Double
    Dim FINALR As Double
    
    Dim MATRIXRange As Range
    
    
' Input parameters

    Num_of_input = InputBox("Please enter number of input variables", "Number of Input")
    Num_of_output = InputBox("Please enter number of output variables", "Number of Output")
    Num = InputBox("Please enter number of Data Points", "Number of Data points")
   
' Initialize what need to be initialized
    RESULT = 0
    RESULTicum = 0
    RESULTocum = 0
    k = 0
    
' Calculate covirance

    Set MATRIXRange = Range(Cells(2, 1), Cells(Num + 1, Num_of_input + Num_of_output))
    
        
    For i = 1 To Num_of_input
        For j = 1 To Num_of_input
            Cells(i, 10 + j).Value = Application.WorksheetFunction.Covar(MATRIXRange.Columns(i), MATRIXRange.Columns(j))
        Next j
    Next i

    Dim Inputmatrix As Range
    Set Inputmatrix = Range(Cells(1, 11), Cells(Num_of_input, 10 + Num_of_input))

    MATRIXi = Application.WorksheetFunction.MInverse(Inputmatrix)


    For i = 1 To Num_of_output
        For j = 1 To Num_of_output
            Cells(Num_of_input + i, 10 + j).Value = Application.WorksheetFunction.Covar(MATRIXRange.Columns(i + Num_of_input), MATRIXRange.Columns(j + Num_of_input))
        Next j
    Next i
    
    Dim Outputmatrix As Range
    Set Outputmatrix = Range(Cells(Num_of_input + 1, 11), Cells(Num_of_input + Num_of_output, 10 + Num_of_output))

    MATRIXo = Application.WorksheetFunction.MInverse(Outputmatrix)
    
' ReDim the arrays
    ReDim INPUTp(1 To Num_of_input) As Double
    ReDim INPUTn(1 To Num_of_input) As Double
    ReDim INPUTdiff(1 To Num_of_input) As Double
    ReDim OUTPUTp(1 To Num_of_output) As Double
    ReDim OUTPUTn(1 To Num_of_output) As Double
    ReDim OUTPUTdiff(1 To Num_of_output) As Double


' Main loop

    For i = 2 To Num + 1
        For j = i + 1 To Num
        
' Load input and output arrays
            For p = 1 To Num_of_input
                INPUTp(p) = Cells(i, p)
                INPUTn(p) = Cells(j, p)
            Next
            
            For q = 1 To Num_of_output
                OUTPUTp(q) = Cells(i, q + Num_of_input)
                OUTPUTn(q) = Cells(j, q + Num_of_input)
            Next
            
' Calculate RESULT
            For p = 1 To Num_of_input
                INPUTdiff(p) = INPUTn(p) - INPUTp(p)
            Next
            RESULTi1 = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MMult(INPUTdiff, MATRIXi), Application.WorksheetFunction.Transpose(INPUTdiff))
            RESULTi = RESULTi1(1) ^ (1 / 2)
            RESULTicum = RESULTicum + RESULTi
        
            For q = 1 To Num_of_output
                OUTPUTdiff(q) = OUTPUTn(q) - OUTPUTp(q)
            Next
            RESULTo1 = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MMult(OUTPUTdiff, MATRIXo), Application.WorksheetFunction.Transpose(OUTPUTdiff))
            RESULTo = RESULTo1(1) ^ (1 / 2)
            RESULTocum = RESULTocum + RESULTo

            RESULT = RESULT + (RESULTo - RESULTi) ^ 2
            
        
' k++
            k = k + 1
        Next j
    Next i

        
' Calculate final result

        FINALR = RESULT ^ (1 / 2) / k
        RESULTiavg = RESULTicum / k
        RESULToavg = RESULTocum / k

        Cells(1, "AA") = "Number of Data points"
        Cells(1, "AB").Value = Num
        Cells(2, "AA") = "Number of Simulations"
        Cells(2, "AB").Value = k
        Cells(3, "AA") = "Average distance before model"
        Cells(3, "AB").Value = RESULTiavg
        Cells(4, "AA") = "Average distance after model"
        Cells(4, "AB").Value = RESULToavg
        Cells(5, "AA") = "Td"
        Cells(5, "AB").Value = FINALR
        
        MsgBox "Number of Data points:   " & Num & vbNewLine & "Number of Simulations:   " & k & vbNewLine & "Average distance before model:   " & RESULTiavg & vbNewLine & "Average distance after model:   " & RESULToavg & vbNewLine & "Td:   " & FINALR, , "CId Result by Eric Du"
        
        
        
        
End Sub