Sub DC()

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


    Dim Centroid As Double
    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 INPUTc As Variant
    Dim OUTPUTc As Variant
    Dim INPUTt As Variant
    Dim INPUTdiff As Variant
    Dim OUTPUTt 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
    Centroid = 0
    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
        If Application.WorksheetFunction.Covar(MATRIXRange.Columns(i), MATRIXRange.Columns(j)) = 0 Then
            Cells(i, 10 + j).Value = 0.0001
            Else
            Cells(i, 10 + j).Value = Application.WorksheetFunction.Covar(MATRIXRange.Columns(i), MATRIXRange.Columns(j))
            End If
        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
            If Application.WorksheetFunction.Covar(MATRIXRange.Columns(i + Num_of_input), MATRIXRange.Columns(j + Num_of_input)) = 0 Then
            Cells(Num_of_input + i, 10 + j).Value = 0.0001
            Else
            Cells(Num_of_input + i, 10 + j).Value = Application.WorksheetFunction.Covar(MATRIXRange.Columns(i + Num_of_input), MATRIXRange.Columns(j + Num_of_input))
            End If
        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 INPUTt(1 To Num_of_input) As Double
    ReDim INPUTc(1 To Num_of_input) As Double
    ReDim INPUTdiff(1 To Num_of_input) As Double
    ReDim OUTPUTt(1 To Num_of_output) As Double
    ReDim OUTPUTc(1 To Num_of_output) As Double
    ReDim OUTPUTdiff(1 To Num_of_output) As Double

' Define centroid array

    For p = 1 To Num_of_input
        For i = 2 To Num + 1
            Centroid = Centroid + Cells(i, p)
        Next i
            INPUTc(p) = Centroid / Num
            Centroid = 0
    Next p
    
    
    For q = 1 To Num_of_output
        For i = 2 To Num + 1
            Centroid = Centroid + Cells(i, q + Num_of_input)
        Next i
            OUTPUTc(q) = Centroid / Num
            Centroid = 0
    Next q
  
    
' Loop
    For i = 2 To Num + 1

' Load input and output arrays
            For p = 1 To Num_of_input
                INPUTt(p) = Cells(i, p)
                INPUTdiff(p) = INPUTt(p) - INPUTc(p)
            Next p
            
            For q = 1 To Num_of_output
                OUTPUTt(q) = Cells(i, q + Num_of_input)
                OUTPUTdiff(q) = OUTPUTt(q) - OUTPUTc(q)
            Next q
            
' Calculate RESULT
            
            RESULTi1 = Application.WorksheetFunction.MMult(Application.WorksheetFunction.MMult(INPUTdiff, MATRIXi), Application.WorksheetFunction.Transpose(INPUTdiff))
            RESULTi = RESULTi1(1) ^ (1 / 2)
            RESULTicum = RESULTicum + RESULTi
        
            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 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") = "Tdc"
        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 & "Tdc:   " & FINALR, , "CId Result by Eric Du"
        
        
        
        
End Sub