 Access

Access domain aggregate functions for geometric, harmonic, and quadratic means Ease of Use

Easy

Version tested with

2003

Submitted by:

Description:

Access has a domain aggregate function DAvg to calculate the arithmetic mean for some set of numbers. The UDFs described in this article may be used to provide similar domain aggregate support for other means, such as the geometric, harmonic, and quadratic means.

Discussion:

In some circumstances, means other than the usual arithmetic means are called for. For example, when faced with a series of annual rates of return, to compute the "average" rate for the whole period, you should use the geometric mean and not the arithmetic mean. A harmonic mean should be used whenever you need to get an "average" for a series of ratios. For example, when computing the overall resistance of a series of parallel electrical resistors, the result is the harmonic mean (which will always be less than the arithmetic mean). Lastly, a quadratic mean (or root mean square) should be used for periodic data (i.e., over time, a graph describes a sine curve), or when both positive and negative data are included, and what you seek is an "average distance from zero" for the various data points.

Code:

```			Option Compare Database
Option Explicit

Function DGeomMean(FieldName As String, SourceObject As String, Optional Criteria As String = "")

' This function requires a reference to Microsoft DAO
'
' Function to provide geometric mean "domain aggregate" functionality in Access
' Geometric mean = (a1 * a2 * a3 * ... aN) ^ (1 / n)
'
' It is strongly recommended that users wrap field and table/query names in all three arguments
' in square brackets; this is a requirement if the field/table/query names have spaces or punctuation
'
' If no records match the criteria supplied, then the function returns Null (similar to other
' domain aggregates except for DCount). Also, if any single element is less
' than zero, function returns Null

Dim rs As DAO.Recordset
Dim Product As Double
Dim Counter As Long
Dim SQL As String

' Open recordset
SQL = "SELECT " & FieldName & " FROM " & SourceObject & IIf(Criteria = "", "", " WHERE " & Criteria)
Set rs = CurrentDb.OpenRecordset(SQL)

Product = 1

' Loop through recordset, building the product of the elements in the aggregation and incrementing
' the count of elements
Do Until rs.EOF
Product = Product * rs(0)
Counter = Counter + 1
rs.MoveNext
Loop

rs.Close
Set rs = Nothing

' If the count of elements is >0 then compute; else return Null
If Counter > 0 And Product >= 0 Then DGeomMean = Product ^ (1 / Counter) Else DGeomMean = Null

End Function

Function DPowerMean(FieldName As String, SourceObject As String, Power As Double, _
Optional Criteria As String = "")

' This function requires a reference to Microsoft DAO
'
' Function to provide generalized power mean "domain aggregate" functionality in Access
' For derivation of power mean: http://en.wikipedia.org/wiki/Generalized_mean
'
' Power means include:
' arithmetic mean (Power = 1) -- of course, just use DAvg for this one!
' harmonic mean (Power = -1)
' quadratic mean (Power = 2)
'
' It is strongly recommended that users wrap field and table/query names in all three arguments
' in square brackets; this is a requirement if the field/table/query names have spaces or punctuation
'
' If no records match the criteria supplied, then the function returns Null (similar to other
' domain aggregates except for DCount). In addition, if the user supplies zero for the Power
' argument, or if Power is negative and any element in the aggregation is zero, then the function also
' returns Null (as any of those conditions will introduce a division by zero)
'
' You cannot use this function for the geometric mean, as the geometric mean is the limit of the generalized
' mean as Power approaches zero

Dim rs As DAO.Recordset
Dim RunningSum As Double
Dim Counter As Long
Dim SQL As String

' Initialize function return vaue to Null
DPowerMean = Null

SQL = "SELECT " & FieldName & " FROM " & SourceObject & IIf(Criteria = "", "", " WHERE " & Criteria)
Set rs = CurrentDb.OpenRecordset(SQL)

' From this point on, any errors are going to be division by zero errors as noted in the comments above
On Error Goto Cleanup

' Loop through recordset, building the running sum of the elements in the aggregation raised to the appropriate
' exponent and incrementing the count of elements
Do Until rs.EOF
RunningSum = RunningSum + rs(0) ^ Power
Counter = Counter + 1
rs.MoveNext
Loop

' If count >0 then compute the result; otherwise let the Null stand
If Counter > 0 Then DPowerMean = (RunningSum / Counter) ^ (1 / Power)

On Error Goto 0

Cleanup:
rs.Close
Set rs = Nothing

End Function

```

How to use:

1. From Access, hit Alt+F11 to get to the VB Editor
2. Insert a new regular module into the VB Project (NOT a class module!)
3. Paste the code above into your project
4. Use the functions DGeomMean and DPowerMean in your queries, reports, forms, or VBA code as desired

Test the code:

1. Download the attached archive, and extract the Access file contained in it
2. Open that Access file (Special Domain Aggregates.mdb)
3. Run the queries qryGeometricMean, qryHarmonicMean, and qryQuadraticMean for demonstrations of how to use the functions

Sample File:

Approved by mdmackillop

This entry has been viewed 84 times.

Copyright @2004 - 2020 VBA Express