Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
 
Posts: n/a
Default Creating a Custom Excel Function to Calculate Gini Coefficients

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?

  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Harlan Grove
 
Posts: n/a
Default Creating a Custom Excel Function to Calculate Gini Coefficients

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

  #3   Report Post  
Posted to microsoft.public.excel.worksheet.functions
 
Posts: n/a
Default Creating a Custom Excel Function to Calculate Gini Coefficients

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

  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Harlan Grove
 
Posts: n/a
Default Creating a Custom Excel Function to Calculate Gini Coefficients

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

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
IS THERE AN INTERPOLATION FUNCTION IN EXCEL 2003 Cooper Excel Worksheet Functions 2 December 23rd 05 05:51 AM
Excel 2003 Slow Function Argument Window [email protected] Excel Discussion (Misc queries) 2 June 28th 05 06:53 PM
Excel option to store trendline's coefficients in cells for use Miguel Saldana Charts and Charting in Excel 9 June 20th 05 08:45 PM
Creating custom colours in Excel 2002 Fletch Excel Discussion (Misc queries) 2 March 1st 05 06:55 PM
HOW CAN I GET OFFICE 2003 EXCEL BASIC TO NEST FUNCTIONS LIKE EXCE. Robert AS Excel Worksheet Functions 4 December 2nd 04 11:49 AM


All times are GMT +1. The time now is 08:34 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"