Hi,

I'm trying to write a custom function to calculate gini coefficients.
I've been able to use this function when inputted manually:

(Where X is a range)
=SUM(ABS(X-TRANSPOSE(X)))/(2*AVERAGE(X)*((COUNT(X))*(COUNT(X))))

....entered as an array function.

What I am interested in creating is a custom function in Visual Basic.
So far, I've gotten this far:

Function GiniCalculator(Range)

GiniCalculator = WorksheetFunction.Sum(Math.Abs(Range -
WorksheetFunction.Transpose(Range))) / (2 *
WorksheetFunction.Average(Range) * ((WorksheetFunction.Count(Range)) *
(WorksheetFunction.Count(Range))))

End Function

But when I use this function, I just arrive at the #VALUE! error
message. I'm not sure why, but it might has something to do with the
fact the above function is an array function. Does anybody have any
thoughts on how to write a custom function for gini coefficients so it
is not necessary to manually input the array address each time?

wrote...
I'm trying to write a custom function to calculate gini coefficients.
I've been able to use this function when inputted manually:

(Where X is a range)
=SUM(ABS(X-TRANSPOSE(X)))/(2*AVERAGE(X)*((COUNT(X))*(COUNT(X))))

...entered as an array function.

You could shorten this formula by using the fact that
COUNT(X-TRANSPOSE(X)) equals COUNT(X)^2, so

=AVERAGE(ABS(X-TRANSPOSE(X)))/AVERAGE(X)/2

What I am interested in creating is a custom function in Visual Basic.
So far, I've gotten this far:

Function GiniCalculator(Range)
GiniCalculator = WorksheetFunction.Sum(Math.Abs(Range -
WorksheetFunction.Transpose(Range))) / (2 *
WorksheetFunction.Average(Range) * ((WorksheetFunction.Count(Range)) *
(WorksheetFunction.Count(Range))))
End Function

But when I use this function, I just arrive at the #VALUE! error
message. I'm not sure why, but it might has something to do with the
fact the above function is an array function. Does anybody have any
thoughts on how to write a custom function for gini coefficients so it
is not necessary to manually input the array address each time?

Yes, it has everything to do with this needing to be evaluated as an
array formula. The good news is that the Evaluate function
automatically detects when it should evaluate its argument as an array
formula. The following udf works.


Function gini(r As Range) As Double
Dim ra As String, n As Double, d As Double
ra = r.Address(1, 1, xlA1, 1)
n = Evaluate("AVERAGE(ABS(" & ra & "-TRANSPOSE(" & ra & ")))")
d = Evaluate("2*AVERAGE(" & ra & ")")
gini = n / d
End Function


However, this is the type of calculation that would be good to
generalize so it could handle arrays or lists of arguments. Not so
difficult to do that as long as you have another function to convert
arbitrary argument lists into 1D arrays.


Function gini(ParamArray a() As Variant) As Double
Dim n As Double, d As Double
Dim v As Variant, i As Long, j As Long, k As Long

v = ravel(a)
k = UBound(v)

For i = 1 To k
d = d + v(i)
For j = i + 1 To k 'eliminates need to divide by 2
n = n + Abs(v(i) - v(j))
Next j
Next i

gini = n / d / k
End Function


Function ravel(ParamArray a() As Variant) As Variant
Dim w As Variant, x As Variant, y As Variant, z As Variant
Dim k As Long, n As Long
Dim rv() As Variant

For Each w In a

If TypeOf w Is Range Then
k = w.Cells.Count
ReDim Preserve rv(1 To n + k)
For Each x In w.Areas
For Each y In x.Value
n = n + 1
rv(n) = y
Next y
Next x

ElseIf IsArray(w) Then
For Each x In w
If IsArray(x) Then
y = ravel(x) 'RECURSE!
k = UBound(y) 'y is 1-based 1D, so done
ReDim Preserve rv(1 To n + k)
For Each z In y
n = n + 1
rv(n) = z
Next z
Else
n = n + 1
If n = UBound(rv) Then ReDim Preserve rv(1 To 2 *
n)
rv(n) = x
End If
Next x

Else
n = n + 1
If n = UBound(rv) Then ReDim Preserve rv(1 To 2 * n)
rv(n) = w

End If

Next w

If n < UBound(rv) Then ReDim Preserve rv(1 To n)
ravel = rv
End Function

Harlan,

Your code is very helpful. Thanks!

I have noticed one thing though. In order for the calculation to be
accurate, there cannot be any missing data in the array. At first I
thought that maybe the functions are treating the missing values as
zeros, but they are not. The effect of the missing values on the gini
coefficient is less than zero. Is there something that can be added to
function to have it ignore missing values?

John

wrote...
....
I have noticed one thing though. In order for the calculation to be
accurate, there cannot be any missing data in the array. At first I
thought that maybe the functions are treating the missing values as
zeros, but they are not. The effect of the missing values on the gini
coefficient is less than zero. Is there something that can be added to
function to have it ignore missing values?

Your original formula, paraphrased as

=SUM(ABS(x-TRANSPOSE(x)))/(2*AVERAGE(x)*COUNT(x)^2)

would also have given overstated results if there were any blank values
in x because any & all blank values in the x-TRANSPOSE(x) term would be
replaced with numeric zeros. For example, if x were only {1;<blank;1},
your original formula would return 0.5 rather than 0. Given this, I had
assumed you'd never have blank values.

However, if some values in x may not be numeric, then use the array
formula

=AVERAGE(IF(ISNUMBER(x)*ISNUMBER(TRANSPOSE(x)),
ABS(x-TRANSPOSE(x))))/AVERAGE(x)/2

or modify the gini udf as follows.

Function gini(ParamArray a() As Variant) As Double
Dim n As Double, d As Double, c As Double
Dim v As Variant, i As Long, j As Long, k As Long

v = ravel(a)
k = UBound(v)

For i = 1 To k
If Not IsEmpty(v(i)) And IsNumeric(v(i)) And VarType(v(i)) <
vbString Then
d = d + v(i)
c = c + 1
For j = i + 1 To k
If Not IsEmpty(v(j)) And IsNumeric(v(j)) And VarType(v(j)) <
vbString Then
n = n + Abs(v(i) - v(j))
End If
Next j
End If
Next i

gini = n / d / c
End Function