Discrete Convolutions VBA

[bookworm121]

I'm trying to convolve two discrete distributions in excel using VBA. (Discrete Convolutions)


The distributions are presented as follows:


[table="width: 350"]
[tr]
[td]A[/td]
[td]B[/td]
[/tr]
[tr]
[td]Number[/td]
[td]Probability[/td]
[/tr]
[tr]
[td]0[/td]
[td]0.2[/td]
[/tr]
[tr]
[td]1[/td]
[td]0.3[/td]
[/tr]
[tr]
[td]2[/td]
[td]0.5[/td]
[/tr]
[tr]
[td][/td]
[td][/td]
[/tr]
[tr]
[td]Number[/td]
[td]Probability[/td]
[/tr]
[tr]
[td]0[/td]
[td]0.1[/td]
[/tr]
[tr]
[td]1[/td]
[td]0.2[/td]
[/tr]
[tr]
[td]2[/td]
[td]0.3[/td]
[/tr]
[tr]
[td]3[/td]
[td]0.3[/td]
[/tr]
[tr]
[td]4[/td]
[td]0.1[/td]
[/tr]
[/table]






Any ideas?

 

[shg]

There's an article that explains how to do it via formulas at http://www.ijee.ie/articles/Vol20-5/IJEE1512.pdf, or you could use a UDF:

      ---A--- ---B--- -C--
  1   Signal1 Signal2 Conv
  2       0.2     0.1 0.02
  3       0.3     0.2 0.07
  4       0.5     0.3 0.17
  5               0.3 0.25
  6               0.1 0.26
  7                   0.18
  8                   0.05

The formula in A2:A8, which MUST be confirmed with Ctrl+Shift+Enter, is

=Convolve(A2:A4,B2:B6)

Function Convolve(h As Variant, x As Variant) As Variant
    ' UDF wrapper for adConvolve; UDF only
    Dim avOut As Variant
    
    avOut = adConvolve(h, x)
    With Application.Caller
        If .Rows.Count > 1 Then avOut = WorksheetFunction.Transpose(avOut)
    End With
    Convolve = avOut
End Function

Function adConvolve(h As Variant, x As Variant) As Double()
    ' shg 2013
    
    ' Returns a 1D, zero-based array of the convolution of h and x
    Dim avdH        As Variant
    Dim avdX        As Variant
    Dim adC()        As Double
    Dim i           As Long
    Dim m           As Long
    Dim n           As Long
    Dim k           As Long

    avdH = CatVar(h)
    m = UBound(avdH) + 1

    avdX = CatVar(x)
    n = UBound(avdX) + 1

    ReDim adC(0 To n + m - 2)

    On Error Resume Next
    For i = 0 To n + m - 1
        For k = 0 To n + m - 2
            adC(i) = adC(i) + avdH(k) * avdX(i - k)
        Next k
    Next i
    
    adConvolve = adC
End Function
Function CatVar(v As Variant) As Variant
    ' Returns a 1D zero-based array of the values in v, which can be a
    ' column or row vector range, a 1D or 2D array, or a scalar
    Dim vOut()      As Variant
    Dim rArea       As Range
    Dim cell        As Range
    Dim nOut        As Long
    Dim i           As Long

    If IsArray(v) Then
        If TypeOf v Is Range Then
            ReDim vOut(0 To v.Cells.Count - 1)
            For Each rArea In v.Areas
                For Each cell In rArea.Cells
                    vOut(nOut) = cell.Value
                    nOut = nOut + 1
                Next cell
            Next rArea
            CatVar = vOut
        ElseIf NumDim(v) = 1 Then
            ReDim vOut(0 To UBound(v) - LBound(v))
            For i = LBound(v, 1) To UBound(v, 1)
                vOut(nOut) = v(i)
                nOut = nOut + 1
            Next
            CatVar = vOut
        Else
            ReDim vOut(0 To UBound(v) - LBound(v))
            For i = LBound(v, 1) To UBound(v, 1)
                vOut(nOut) = v(i, 1)
                nOut = nOut + 1
            Next
            CatVar = vOut
        End If
    Else
        CatVar = Array(v)
    End If
End Function

Function NumDim(av As Variant) As Long
    Dim i           As Long
    If TypeOf av Is Range Then
        If av.Cells.Count = 1 Then NumDim = 0 Else NumDim = 2
    ElseIf IsArray(av) Then
        On Error GoTo Done
        For NumDim = 0 To 6000
            i = LBound(av, NumDim + 1)
        Next NumDim
Done:
        Err.Clear
    End If
End Function

 

[controleng]

Mr. Excel,

Have you ever created a *De*convolution VBA to perform the inverse operation of your Convolution VBA? In the example case above, it would take the sequence (0.02, 0.07, 0.17, 0.25, 0.26, 0.18, 0.05) and divide it by the sequence (0.1, 0.2, 0.3, 0.3, 0.1) to get the sequence (0.2, 0.3, 0.5)