I am trying to calculate Mahalanobis distances in VBA.
I have created my UDF to calculate Covarince matrix but i got a #value error when executing my function.
could you give me some help
Thanks in advance!
Function DMahalanobis(x As Range, y As Range) As Variant
Dim c() As Variant, k As Variant, U As Range, a() As Variant, b() As Variant
Set U = Application.Union(x, y)
Debug.Print U
k = x.Columns.Count
a = x
b = y
ReDim c(1, k)
For i = 1 To k Step 1
c(1, i) = a(1, i) - b(1, i)
Next i
DMahalanobis = Application.MMult(Application.MMult(Application.Transpose(c), Application.MInverse(MVARCOVAR(U))), c)
End Function
This is my VarCovar function that works fine
'Function to calculate Covariance matrix
Function MVARCOVAR(RANGO As Range) As Variant
Dim c() As Variant, i As Long, k As Long, j As Long
k = RANGO.Columns.Count
Debug.Print k
ReDim c(k, k)
For i = 1 To k Step 1
For j = 1 To k Step 1
c(i, j) = Application.Covar(Application.Index(RANGO, , i), Application.Index(RANGO, , j))
Next j
Next i
MVARCOVAR = c
End Function
may due to the singular issue in the line:
DMahalanobis = Application.MMult(Application.MMult(Application.Transpose(c), Application.MInverse(MVARCOVAR(U))), c).
Based on your given input, dimension of U is 2xk, as 2<<k, the covariance matrix of U may contain some missing value, when you take the inverse, it will pop up an error. Maybe you can try to change U to the whole data set, otherwise you cannot capture the distribution information in the data when calculating mahalanobis distance.
Related
For example please open thisIf there is N*N matrix as R(row) is given. So the program will find the minimum value in Rth row and then replace that particular column with 9999. I am getting #value error. How to rectify this?
I think there is some error in defining an array.
Please help me in this.
Function abc(N As Range, R As Integer) As Range
Dim c As Integer, i As Integer, min As Integer, ci As Integer, a As Integer,
j As Integer, y As Integer, z As Integer
a = N.Rows.Count
c = N.Columns.Count
Dim ab(1 To 1000, 1 To 1000) As integer
min = N(R, 1)
ci = 1
For i = 1 To c
If N(R, i) < min Then
min = N(R, i) And ci = i
End If
Next i
For y = 1 To a
For z = 1 To c
If z = ci Then
ab(y, z) = 9999
Else
ab(y, z) = N(y, z)
End If
Next z
Next y
abc = ab
End Function
Does this need to be VBA? Can be done with this formula (using your sample image, put this formula in cell D1 and copy over and down):
=IF(COLUMN(A1)=MATCH(MIN(INDEX($A$1:$B$2,2,0)),INDEX($A$1:$B$2,2,0),0),5432,INDEX($A$1:$B$2,ROW(A1),COLUMN(A1)))
Change both instances of $A$1:$B$2 to be the actual range the formula should be evaulating
Change 5432 to be the number you actually want returned (I got 5432 from your sample image, but your UDF shows 9999)
other than the output issue, your code is not consequent to your question wording
so either you
have to substitute the minimum value in a row with 9999
so your code can be reduced to
Function abc(N As Range, R As Integer) As Variant
Dim a As Long, c As Long, j As Long, min As Long, cj As Long
Dim ab As Variant
ab = N.value
a = UBound(ab, 1)
c = UBound(ab, 2)
min = ab(R, 1)
cj = 1
For j = 1 To c
If ab(R, j) < min Then
min = ab(R, j)
cj = j
End If
Next
ab(R, cj) = 9999
abc = ab
End Function
or you have to change ALL the range cells whose content matches the given row minimum value to this latter
Function abc2(N As Range, R As Integer) As Variant
Dim a As Long, c As Long, i As Long, j As Long, min As Long
Dim ab As Variant
ab = N.value
a = UBound(ab, 1)
c = UBound(ab, 2)
min = ab(R, 1)
For j = 1 To c
If ab(R, j) < min Then min = ab(R, j)
Next
For i = 1 To a
For j = 1 To c
If ab(i, j) = min Then ab(i, j) = 9999
Next
Next
abc2 = ab
End Function
I have created a functon to return matrix correlation of a data set, but I want this matrix to have colors like the one you can do using R o Python
Function MCORRELATION(Rango As Range) As Variant
Dim x As Variant, y As Variant, s As Integer, T As Integer, C() As Variant
ReDim C(Rango.Columns.Count, Rango.Columns.Count)
For i = 1 To Rango.Columns.Count Step 1
For j = 1 To i Step 1
C(i, j) = Application.Correl(Application.Index(Rango, , i),
Application.Index(Rango, , j))
Next j
Next i
MCORRELATION = C
End Function
How can I achieve that using conditional formating with VBA?
I have created a function that gives me the log of the verisimilitude function in VBA ; this function requires to enter 3 parameters: Independent range(x), Dependent range(y) and betas' values (B)
option base 1
Public Function LogVerosimilitud(RangoX As Range, RangoY As Range, B As Range) As Variant
Application.Volatile
Dim n%, m%, i%, j%, k%, X() As Variant, p() As Variant, q() As Variant, g As Double, V() As Variant
Dim acumula As Double, LogVero As Double
If B.Rows.Count > B.Columns.Count Then
Application.Transpose (B)
End If
g = 0
n = RangoX.Rows.Count
m = B.Columns.Count
k = 0
ReDim X(n, m)
ReDim p(n)
ReDim q(n)
ReDim V(n)
For i = 1 To n
For j = 1 To m
If j = 1 Then
X(i, j) = 1
Else
k = k + 1
X(i, j) = RangoX(i, k)
End If
Next j
k = 0
Next i
For i = 1 To n
For j = 1 To m
g = g + X(i, j) * B(1, j)
Next j
p(i) = Exp(g) / (1 + Exp(g))
q(i) = 1 - p(i)
g = 0
Next i
For i = 1 To n
V(i) = RangoY(i) * Application.Ln(p(i)) + (1 - RangoY(i)) * Application.Ln(q(i))
Next i
LogVerosimilitud = Application.Sum(V)
End Function
Sincé I'm not able to use Solver directly in a UDF I want to run my function in an specific cell and then in another cell run an auxiliary function that call a sub in which I'm triying to run Excel's solver
Sub Solver(Target, Rango)
SolverOk SetCell:=Target.Address, MaxMinVal:=1, ValueOf:=0, ByChange:=Rango.Address, _
Engine:=1, EngineDesc:="GRG Nonlinear"
SolverSolve
End Sub
This is my auxiliary function:
Public Function LOGIT(LogVero As Range, B As Range) As Boolean
Debug.Print LogVero.Address
Debug.Print B.Address
Call Solver(LogVero.Address, B.Address)
End Function
But when running LOGIT function I got a #Value error in the cell I'm running LOGIT function
What am I doing wrong?
This how my data look like:
Really new and self taught so would appreciate any help
Have allocated a range from a spreadsheet to an array but it starts the data in row 1 of the array.
Dim arr As Variant
arr = Range("DATA")
Is there any way of starting in row 0?
Thanks in advance
Range operations are slow, the best is to use a temporary array , and then make a copy to another array while changing the start position.
Indeed array -> array = very fast
Dim arr, arr2 As Variant
arr2 = Range("DATA").value2
redim arr(0 to ubound(arr2)-1, 0 to ubound(arr2,2)-1)
for i= 0 to ubound(arr2)-1
for j= 0 to ubound(arr2,2)-1
arr(i,j)= arr2(i+1,j+1)
next
next
Well, if you are going to clean-up range-derived VBA arrays, why not make them 1-dimensional instead of falsely 2-dimensional in the case that you are dealing with a column range or a row range? The following does that as a default and also uses 0-based as a default, but provides ways to override both defaults:
Function RangeToArray(R As Range, Optional b As Long = 0, Optional collapse As Boolean = True) As Variant
'returns a b-based array of the values in R
'if the Range is 1-dimensional and collapse is true, the array returned is 1-dimensional
Dim i As Long, j As Long, m As Long, n As Long, k As Long
Dim vals As Variant, arr As Variant
m = R.Rows.Count
n = R.Columns.Count
If m = 1 And n = 1 Then 'to catch an edge-case
ReDim vals(1 To 1, 1 To 1)
vals(1, 1) = R.Value
Else
vals = R.Value
End If
If collapse And (m = 1 Or n = 1) Then
k = Application.WorksheetFunction.Max(m, n)
ReDim arr(b To b + k - 1)
For i = 1 To k
If m = 1 Then
arr(b + i - 1) = vals(1, i)
Else
arr(b + i - 1) = vals(i, 1)
End If
Next i
Else
ReDim arr(b To b + m - 1, b To b + n - 1)
For i = 1 To m
For j = 1 To n
arr(b + i - 1, b + j - 1) = vals(i, j)
Next j
Next i
End If
RangeToArray = arr
End Function
It would be used like A = RangeToArray(Range("A1:B3"))
I wanted to create function that mimics standard Excel MMULT function for multiplying matrices. My code is:
Function MatrixMultiplication(Matrix1 As Range, Matrix2 As Range)
Dim m1() As Long, m2() As Long, m3() As Long
m1 = Matrix1
m2 = Matrix2
If Matrix1 Is Nothing Or Matrix2 Is Nothing Then GoTo Err1
If UBound(m1, 2) <> UBound(m2, 1) Then GoTo Err2
ReDim m3(UBound(m1, 1), UBound(m2, 2))
For i = LBound(m1) To UBound(m1, 1)
For j = LBound(m2) To UBound(m1, 2)
For k = 1 To UBound(m1, 2)
m3(i, j) = m3(i,j)+ m1(i, k) * m2(k, i)
Next k
Next j
Next i
Dim Matrix3 As Range
Set Matrix3 = Range(ActiveCell.Address, ActiveCell.Offset(UBound(m1, 1) - 1, UBound(m2, 2) - 1))
Matrix3 = m3
Set MatrixMultiplication = Matrix3
Err1:
Selection.Cells(0, 0).Value = CVErr(xlErrNull)
Err2:
Selection.Cells(0, 0).Value = CVErr(xlErrNA)
End Function
Somehow it does not work. It should work as CSE function. Thanks for any help.
Here is a version that works. A somewhat subtle point is that if you pass it arrays which are given in ranges then you need to convert them to regular arrays. Note the two lines near the beginning of the function that do that:
Function MatrixProduct(A As Variant, B As Variant) As Variant
'Assumes that A,B are 1-based variant arrays
'Or ranges containing such things.
'Little error checking is done
Dim m As Long, n As Long, p As Long, i As Long, j As Long, k As Long
Dim C As Variant
If TypeName(A) = "Range" Then A = A.Value
If TypeName(B) = "Range" Then B = B.Value
m = UBound(A, 1)
p = UBound(A, 2)
If UBound(B, 1) <> p Then
MatrixProduct = "Not Defined!"
Exit Function
End If
n = UBound(B, 2)
ReDim C(1 To m, 1 To n)
For i = 1 To m
For j = 1 To n
For k = 1 To p
C(i, j) = C(i, j) + A(i, k) * B(k, j)
Next k
Next j
Next i
MatrixProduct = C
End Function
This can be used directly in the spreadsheet and also be used directly in VBA code. It is almost definitely slower then the built-in MMULT, so I'm not quite sure how useful it is.