Median Calculation
DaveW
the following fields:
NumberSold - The number of items sold at a price
Price - The price of the item
I can find the median Price, but I need to find the median price of a sold
unit.
Logically I think I need to sort the list by Price, calculate the sum of
NumberSold and divide by 2 (the median datapoint), create a running total of
the NumberSold select the Price for the record at the median datapoint and
return this value.
I can sort, sum and create a running total, but I can't firgure out how to
return the Price of the median datapoint (do I use DLookup in some form?).
Please help!
I know there is some extra programming if the median datapoint is
fractional, but if anyone can help with the first part I am sure I can figure
out the rest.
Thanks!
Tom Wickerath
Try working through this example and see if it helps:
How to Use Code to Derive a Statistical Median
http://support.microsoft.com/kb/210581
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
DaveW
Thanks for the response, I used the code you suggested to calculate the
median of a simple field, but this does not calculate the median for my
specific application.
By way of example, my table is as follows:
Item NumberSold Price
A 1 $10
B 3 $15
C 6 $20
I would like to return the median Price of a sold item, which in this
example would be $20. (10 items sold mid-point is 5, therefore the median of
a sold item is the 5th most (or least) expensive, or $20). The median
example you provided would return a value of $15.
Tom Wickerath
to post back, because I have a pretty full schedule until Sunday afternoon.
Tim Ferguson
news:43788527-13A2-4F4D...@microsoft.com:
> NumberSold - The number of items sold at a price
> Price - The price of the item
>
> I can find the median Price, but I need to find the median price of a
> sold unit.
>
You need to find the total number of sold units, then get the middle one.
Bear in mind that this is air code, untested, etc etc but it's not
exactly complicated...
dim totalSales as long
dim jetSQL as string
dim rst as DAO.Recordset
dim numberSoFar as Long
dim finalAnswer as Double ' or currency if you prefer
totalSales = DSum("NumberSold", "Sales", True)
jetSQL = "select Numbersold, price " & _
"from Sales " & _
"order by Price ASC"
set rst = db.openrecordset(jetSQL, dbOpenSnapshot, dbForwardOnly)
numberSoFar = 0
finalAnswer = 0
Do While finalAnswer = 0
' we should never get to the end of the recordset unless
' it was an empty table to begin with
If rst.EOF then err.raise somethingUseful ' oops!
numberSoFar = numberSoFar + rst("NumberSold")
if numberSoFar * 2 > totalSales +1 then
' if we've gone past, we don't need to worry about interpolating
finalAnswer = rst("Price")
elseif numberSoFar * 2 = totalSales + 1 Then
' okay, it's exactly the middle one out of an odd number
' so we've got the answer
finalAnswer = rst("Price")
elseif numberSoFar * 2 = totalSales Then
' this is the first of the middle pair; we need to
' average this price and the next one
finalAnswer = rst("Price")
rst.MoveNext ' need to check for error here... :-)
finalAnswer = (finalAnswer + rst("Price") / 2)
else
' no joy yet, just get the next record and move on
rst.MoveNext
end if
' return FinalAnswer...
Hope that helps
Tim F
DaveW
Thanks, I guess first of all I must admit that I am a novice, so I cannot
pretend to exactly understand all the code suggested is doing... but
First I got a "Do without Loop" error, which I corrected by adding Loop to
the end of the code (makes sense to me).
But now I get an error "Object Required" on the line beginning "Set rst =..."
I am in too far over my head to figure out what to do next!
Thanks for your continued help! I don't know what I would do without this
resource!
Dave.
Tom Wickerath
I tried out Tim's code this morning, and found that I needed to add:
Dim db as DAO.Database
Set db = CurrentDB()
in addition to the Loop statement that you found. Add these two lines prior
to the line that attempts to set the recordset, ie.:
set rst = db.openrecordset(jetSQL, dbOpenSnapshot, dbForwardOnly)
However, with my test data, the value returned with Tim's code (add either a
debug.print finalAnswer or MsgBox finalAnswer to see the result), was not
correct.
The solution is going to require converting your existing set of data into
one record for each entry, for example:
Price
10
15
15
15
20
20
20
20
20
20
and then apply the KB code method. However, I don't have the time available
right now to work on this, until later on Sunday evening.
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
John Nurick
net> wrote:
>However, with my test data, the value returned with Tim's code (add either a
>debug.print finalAnswer or MsgBox finalAnswer to see the result), was not
>correct.
>
FWIW Tim's code gave the correct answer with my test data, and I can't
see anything wrong with the logic.
--
John Nurick [Microsoft Access MVP]
Please respond in the newgroup and not by email.
Tom Wickerath
With the test data that Dave provided, and a Debug.Print finalAnswer added,
I get the following printed to the immediate window:
0
0
20
Since 20 is the correct answer, we might conclude that all is well. Try
adding a fourth row of data:
Item D, Quantity = 10, Price = 25
I get:
0
0
32.5
indicating that the median price is now $32.50. However, the highest priced
item is $25.00.
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
Matthias Klaey
The (empirical) p-quantile in statistics is defined as
y_p = y(Floor(N*p) + 1)
wher 0 <= p <= 1, N ist the total number of observations, and y(j) is
the j-th obeservation in the ordered sample, and Floor(x) in VBA is
just Int(x).
The median is the p-quantile for p = 0.5
In your example below, this translates to
p = 0.5, N = 1 + 3 + 6 = 10, Floor(10 * 0.5) + 1 = 5 + 1 = 6
So you need th find 6th observation in the ordered sample, written out
here with the repetitions:
ordered sample: 10, 15, 15, 15, 20, 20, 20, 20, 20, 20
rank: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
Thus the median = 20, as you already know.
An algorithm to calculate this would be
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim N As Long
Dim Jp As Long
Dim J As Long
Dim Median As Double
N = DSum("NumberSold", "YourTable")
Jp = Int(N * 0.5) + 1
Set db = CurrentDb
Set rs = db.OpenRecordset("Select NumberSold, Price From YourTable
Order By Price Asc;")
J = 0
Do While Not rs.EOF
J = J + rs!NumberSold
If J >= Jp Then
Median = rs!Price
Exit Do
End If
rs.MoveNext
Loop
Debug.Print Median
HTH
Matthias Kläy
--
www.kcc.ch
Tim Ferguson
news:59BA9425-EC5F-49C3...@microsoft.com:
> 0
> 0
> 20
>
> Since 20 is the correct answer, we might conclude that all is well. Try
> adding a fourth row of data:
>
Thanks for taking the time to test the code for me: I must say that I jst
presented it as a demonstration of the algorithm.
Your example doesn't accord with the initial problem as set. The input
data should be :
Num, Price
2, 0
1, 20
and the median would be zero, since it's the second element of two.
It's not a fair test anyway, because although the OP didn't specify that
price could not be zero, the field is called Price and selling something
for zero isn't a Sale it's a GiveAway. That sounds to me like a
reasonable assumption, and it's also built in because of the test for
finalAnswer>0, which would make the function fail with an input set like
Num, Price
24, 0
If a zero price was allowed then the starting value would have to be
negative. Can we agree that negative prices are not expected?
All the best
Tim F
John Nurick
Thanks for pointing this out. I see where the problem is...
On Fri, 5 Jan 2007 02:47:01 -0800, Tom Wickerath <AOS168b AT comcast DOT
Tom Wickerath
> I see where the problem is...
Do you have the time to fix it before I can get back to it? The reason I
ask is that I have relatives visiting from Germany right now, so I'm not able
to spend too much time working this right now. If not, I will get back to it
when I can.
Tom Wickerath
I'm not sure how you are deciding that price can be zero. This was not
indicated in Dave's sample data.
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
Tom Wickerath
0
0
20
and
0
0
32.5
were printed to the Immediate (debug) window because I had initially stuck
my debug.print statement in prior to the Loop statement, ie:
Else
' no joy yet, just get the next record and move on
rst.MoveNext
End If
Debug.Print finalAnswer
Loop
End Function
If I had moved it *after* the Loop statement, then I would have only had the
following results printed:
20
32.5
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
John Nurick
?Median869("SELECT NumberSold As Qty, Price As Val FROM DavesTable ORDER
BY Price")
Public Function Median869(ByVal SQL As String) As Variant
'SQL must be a Jet SQL SELECT statement query that returns
'fields Qty and Val ordered by Val ASC
'based on code posted by Tim Ferguson
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstSums As DAO.Recordset
Dim MinVal As Long
Dim QtyTotal As Long
Dim QtySoFar As Long
Dim Answer As Double 'or Currency
Set db = CurrentDb()
If Right(SQL, 1) = ";" Then
SQL = Left(SQL, Len(SQL) - 1)
End If
Set rst = db.OpenRecordset(SQL, dbOpenSnapshot, dbForwardOnly)
If rst.EOF Then
MsgBox "Empty recordset", vbExclamation + vbOKOnly
Median869 = Null
Exit Function
End If
Set rstSums = db.OpenRecordset("SELECT MIN(Val), SUM(QTY) FROM (" _
& SQL & ")", dbOpenSnapshot, dbForwardOnly)
MinVal = rst.Fields(0).Value
QtyTotal = rst.Fields(1).Value
Answer = MinVal
rst.Close
Do While Answer = MinVal
' we should never see the end of the recordset
If rst.EOF Then Err.Raise 9999, , "Someone has blundered!"
QtySoFar = QtySoFar + rst.Fields("Qty").Value
If QtySoFar * 2 > QtyTotal + 1 Then
' if we've gone past, we don't need to worry about interpolating
Answer = rst.Fields("Val").Value
ElseIf QtySoFar * 2 = QtyTotal + 1 Then
' okay, it's exactly the middle one out of an odd number
' so we've got the answer
Answer = rst.Fields("Val").Value
ElseIf QtySoFar * 2 = QtyTotal Then
' this is the first of the middle pair; we need to
' average this Val and the next one
Answer = rst.Fields("Val").Value
rst.MoveNext
If rst.EOF Then
'The middle item is in the last record, so the
'median Val is also the maximum Val
'and Answer is already set to the right value
Else
Answer = (Answer + rst.Fields("Val").Value / 2)
End If
Else
' no joy yet, just get the next record and move on
rst.MoveNext
End If
Loop
rst.Close
' return Answer...
Median869 = Answer
End Function
On Fri, 5 Jan 2007 14:57:01 -0800, Tom Wickerath <AOS168b AT comcast DOT
net> wrote:
>> I see where the problem is...
>
>Do you have the time to fix it before I can get back to it? The reason I
>ask is that I have relatives visiting from Germany right now, so I'm not able
>to spend too much time working this right now. If not, I will get back to it
>when I can.
>
>
>Tom Wickerath
>Microsoft Access MVP
>
>http://www.access.qbuilt.com/html/expert_contributors.html
>http://www.access.qbuilt.com/html/search.html
>__________________________________________
--
Matthias Klaey
John Nurick <j.mapSo...@dial.pipex.com> wrote:
>I think this is getting closer. [...]
Close, but not quite there :-)
First,
> MinVal = rst.Fields(0).Value
> QtyTotal = rst.Fields(1).Value
> Answer = MinVal
> rst.Close
should be
MinVal = rstSums.Fields(0).Value
QtyTotal = rstSums.Fields(1).Value
Answer = MinVal
rstSums.Close
Second,
> Answer = (Answer + rst.Fields("Val").Value / 2)
should be
Answer = (Answer + rst.Fields("Val").Value) / 2
Third, if DavesTable consist of just only one row, say
NumberSold Price
1 10
your algorithm goes into an infinite loop.
The median *is* defined in this case, of course it is 10. As an aside,
the "Values" - Price in the example - can be any number, positive, 0,
or negative, as far as the definition of the median is concerned. But
the qunantities (NumberSold) must be strictly positive.
I propose a slightly refined algorithm from my previous post. It
properly guards against Null values in the table and 0 or negative
values in the "Quantity" field, and it also returns the average of the
midpoints for even total quantity. It is to be called like this:
?kMedian("DavesTable", "NumberSold", "Price")
Public Function kMedian(strTable As String, strQty As String, _
strVal As String) As Variant
' Input: strTable: Neme of the table, e.g. "DavesTable"
' strQty : Name of Quantity Field, e.g. "NumberSold"
' strVal : Name of Value Field, e.g. "Price"
' Output: Median, or Null if there are no records for the calculation
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim N As Long
Dim Jp As Long
Dim J As Long
Dim strWhere As String
kMedian = Null
strWhere = "(" & strQty & " > 0) And (Not " & strVal & " Is Null)"
N = Nz(DSum(strQty, strTable, strWhere), 0)
If N > 0 Then
If N Mod 2 = 0 Then
Jp = Int(N * 0.5)
Else
Jp = Int(N * 0.5) + 1
End If
J = 0
Set db = CurrentDb
Set rs = db.OpenRecordset("Select " & strQty & ", " & strVal & _
" From " & strTable & " Where " & strWhere & _
" Order By " & strVal & " Asc;", _
dbOpenForwardOnly)
Do While Not rs.EOF
J = J + rs.Fields(strQty)
If J >= Jp Then
kMedian = rs.Fields(strVal)
If N Mod 2 = 0 Then
rs.MoveNext
If Not rs.EOF Then
kMedian = (kMedian + rs.Fields(strVal)) / 2#
End If
End If
Exit Do
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End If
End Function
Greetings, Matthias Kläy
--
www.kcc.ch
------------
Tom Wickerath
I could not get Matthias' first contribution (1/5/2007) to work properly
after adding additional data to the original set, and comparing the results
with 1.) the median as calculated in Excel and 2.) the 50th percentile
(median) as calculated using Total Access Statistics
http://www.fmsinc.com/products/statistics/index.html
(I have a copy of this software).
Here is my solution, which seems to work. First, create two tables:
tblItemsSold
ID (Autonumber Primary Key)
Item (Text)
NumberSold ()
Price (Currency)
Copy tblItemsSold as tblItemsSoldExcel. You can delete the ID and NumberSold
fields from this table. This table serves as a temporary work table. It would
be best to have such a table in an external linked database to help prevent
DB bloat, but for the present time I have it in the same database. I am using
tblItemsSoldExcel as the source data for the Median function as shown in the
KB article 210581:
How to Use Code to Derive a Statistical Median
http://support.microsoft.com/kb/210581
Here is the code I came up with:
Option Compare Database
Option Explicit
Public Sub Test()
On Error GoTo ProcError
Dim db As DAO.Database
Dim rs1 As DAO.Recordset 'Source data
Dim rs2 As DAO.Recordset 'Re-written data to feed to Median function
Dim intCount As Integer 'Counter
Dim intSold As Integer 'Number of Items Sold for a given item type
Set db = CurrentDb()
' Clear records from ordered table
db.Execute "DELETE * FROM tblItemsSoldExcel", dbFailOnError
Set rs1 = db.OpenRecordset("SELECT Item, NumberSold, Price " & _
"FROM tblItemsSold ORDER BY Price", dbOpenSnapshot)
Set rs2 = db.OpenRecordset("tblItemsSoldExcel", dbOpenDynaset)
If rs1.RecordCount > 0 Then
intSold = rs1("NumberSold")
Do Until rs1.EOF
For intCount = 1 To intSold
With rs2
.AddNew
!Item = rs1("Item")
!Price = rs1("Price")
.Update
End With
Next intCount
rs1.MoveNext
If Not rs1.EOF Then
intSold = rs1("NumberSold")
End If
Loop
MsgBox "The median is: " & _
Format(Median("tblItemsSoldExcel", "Price"), "Currency"), _
vbInformation, "Median Calculation..."
Else
MsgBox "There are no records to calculate a median.", _
vbCritical, "Median Calculation..."
End If
ExitProc:
'Cleanup
On Error Resume Next
rs1.Close: Set rs1 = Nothing
rs2.Close: Set rs2 = Nothing
db.Close: Set db = Nothing
Exit Sub
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure Test..."
Resume ExitProc
End Sub
Function Median(tName As String, fldName As String) As Single
On Error GoTo ProcError
Dim MedianDB As DAO.Database
Dim ssMedian As DAO.Recordset
Dim RCount As Integer
Dim i As Integer
Dim x As Double
Dim y As Double
Dim OffSet As Integer
Set MedianDB = CurrentDb()
Set ssMedian = MedianDB.OpenRecordset("SELECT [" & fldName & _
"] FROM [" & tName & "] WHERE [" & fldName & _
"] IS NOT NULL ORDER BY [" & fldName & "];")
'NOTE: To include nulls when calculating the median value, omit
'WHERE [" & fldName & "] IS NOT NULL from the example.
ssMedian.MoveLast
RCount% = ssMedian.RecordCount
x = RCount Mod 2
If x <> 0 Then
OffSet = ((RCount + 1) / 2) - 2
For i% = 0 To OffSet
ssMedian.MovePrevious
Next i
Median = ssMedian(fldName)
Else
OffSet = (RCount / 2) - 2
For i = 0 To OffSet
ssMedian.MovePrevious
Next i
x = ssMedian(fldName)
ssMedian.MovePrevious
y = ssMedian(fldName)
Median = (x + y) / 2
End If
ExitProc:
'Cleanup
On Error Resume Next
ssMedian.Close: Set ssMedian = Nothing
MedianDB.Close: Set MedianDB = Nothing
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in Median Function..."
Resume ExitProc
End Function
Tom Wickerath
NumberSold should be numeric (Long Integer)
Regarding the idea of an external work database, to help prevent DB bloat,
here is an example that I have available for download:
http://home.comcast.net/~tutorme2/samples/tmpwrkdb.zip
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
Tim Ferguson
news:ljqup25jvrrgijkvg...@4ax.com:
> Third, if DavesTable consist of just only one row, say
>
> NumberSold Price
> 1 10
>
> your algorithm goes into an infinite loop.
>
>
Yes: if I'd really thought about the routine, I'd have put the .MoveNext
outside the If..ElseIf..EndIf, and put Exit Do on each of the other If
blocks.
PS I just spotted that I got the brackets wrong in the averaging
calculation too!
John Nurick
wrote:
>Third, if DavesTable consist of just only one row, say
>
> NumberSold Price
> 1 10
>
>your algorithm goes into an infinite loop.
Actually this only seems to happen when there's just one row and
NumberSold is 1. And there was another error later one. Here's the
latest:
Public Function Median870(ByVal SQL As String) As Variant
'SQL must be a Jet SQL SELECT statement query that returns
'fields Qty and Val ordered by Val ASC
'based on code posted by Tim Ferguson
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstSums As DAO.Recordset
Dim MinVal As Long
Dim QtyTotal As Long
Dim QtySoFar As Long
Dim Answer As Variant ' or currency if you prefer
Set db = CurrentDb()
If Right(SQL, 1) = ";" Then
SQL = Left(SQL, Len(SQL) - 1)
End If
Set rst = db.OpenRecordset(SQL, dbOpenSnapshot, dbForwardOnly)
If rst.EOF Then
MsgBox "Empty recordset", vbExclamation + vbOKOnly
Median870 = Null
Exit Function
End If
Set rstSums = db.OpenRecordset("SELECT MIN(Val), SUM(QTY) FROM (" _
& SQL & ")", dbOpenSnapshot, dbForwardOnly)
MinVal = rstSums.Fields(0).Value
QtyTotal = rstSums.Fields(1).Value
Answer = Null
rstSums.Close
Do While IsNull(Answer)
' we should never see the end of the recordset
If rst.EOF Then Err.Raise 9999, , "Someone has blundered!"
QtySoFar = QtySoFar + rst.Fields("Qty").Value
If QtySoFar * 2 > QtyTotal + 1 Then
' if we've gone past, we don't need to worry about interpolating
Answer = rst.Fields("Val").Value 'wrap in CDbl() or CCur() if
desired
ElseIf QtySoFar * 2 = QtyTotal + 1 Then
' okay, it's exactly the middle one out of an odd number
' so we've got the answer
Answer = rst.Fields("Val").Value
ElseIf QtySoFar * 2 = QtyTotal Then
' this is the first of the middle pair; we need to
' average this Val and the next one
Answer = rst.Fields("Val").Value
rst.MoveNext
If rst.EOF Then
'The middle item is in the last record, so the
'median Val is also the maximum Val
'and Answer is already set to the right value
Else
Answer = (Answer + rst.Fields("Val").Value) / 2
End If
Else
' no joy yet, just get the next record and move on
rst.MoveNext
End If
Loop
rst.Close
' return Answer (use CDbl() or CCur() if desired)
Median870 = Answer
End Function
Tom Wickerath
> Close, but not quite there :-)
Take a look at the following data sets and printed results. I think you are
also close, but not quite there (see Test # 5, below). I used Debug.Print to
print the results of several tests to the Immediate window, which I then
copied and pasted into this post.
First, here is how I am printing the results to the immediate window:
Option Compare Database
Option Explicit
Public Sub TestProcedures()
Debug.Print DataSet
Debug.Print "John Nurick's 2nd Median: ", Median870 _
("SELECT NumberSold As Qty, Price As Val FROM tblItemsSold ORDER BY Price;")
Debug.Print "TimFerguson's Median: ", TimFerguson
Debug.Print "Matthias Klay's 2nd Median: ", kMedian("tblItemsSold",
"NumberSold", "Price")
Debug.Print "Tom Wickerath's Median: ", TomWickerath
Debug.Print "---------------------------------"
Debug.Print
End Sub
Function DataSet()
On Error GoTo ProcError
Dim db As DAO.Database
Dim rs1 As DAO.Recordset 'Source data
Dim intCount As Integer 'Counter
Dim intSold As Integer 'Number of Items Sold for a given item type
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("SELECT Item, NumberSold, Price " & _
"FROM tblItemsSold", dbOpenSnapshot)
If rs1.RecordCount > 0 Then
Debug.Print "Item", "NumberSold", "Price"
Do Until rs1.EOF
Debug.Print rs1("Item"), vbTab, rs1("NumberSold"), vbTab, rs1("Price")
rs1.MoveNext
Loop
Else
MsgBox "There are no records to calculate a median.", _
vbCritical, "Median Calculation..."
End If
ExitProc:
'Cleanup
On Error Resume Next
rs1.Close: Set rs1 = Nothing
db.Close: Set db = Nothing
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in DataSet function..."
Resume ExitProc
End Function
Here are the results I have collected thus far:
Test # 1: Using Dave's data
Item NumberSold Price
A 1 10
B 3 15
C 6 20
John Nurick's 2nd Median: 20
TimFerguson's Median: 20
Matthias Klay's 2nd Median: 20
Tom Wickerath's Median: 20
---------------------------------
Test # 2
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 10 1
John Nurick's 2nd Median: 5.5
TimFerguson's Median: 6
Matthias Klay's 2nd Median: 5.5
Tom Wickerath's Median: 5.5
---------------------------------
Test # 3
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 10 30
John Nurick's 2nd Median: 25
TimFerguson's Median: 35
Matthias Klay's 2nd Median: 25
Tom Wickerath's Median: 25
---------------------------------
Test # 4
Item NumberSold Price
A 1 1.5
B 3 15
C 6 27.65
D 10 32.4
John Nurick's 2nd Median: 30.025
TimFerguson's Median: 43.85
Matthias Klay's 2nd Median: 30.025
Tom Wickerath's Median: 30.03
---------------------------------
Test # 5
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 8 27.65
John Nurick's 2nd Median: 20
TimFerguson's Median: 20
Matthias Klay's 2nd Median: 23.825
Tom Wickerath's Median: 20
---------------------------------
Test # 6
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 8 27.65
E 3 5.5
F 5 7.65
G 2 14.63
H 7 17.62
John Nurick's 2nd Median: 17.62
TimFerguson's Median: 17.62
Matthias Klay's 2nd Median: 17.62
Tom Wickerath's Median: 17.62
---------------------------------
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
"Matthias Klaey" wrote:
> Hi John
>
> John Nurick <j.mapSo...@dial.pipex.com> wrote:
> >I think this is getting closer. [...]
>
> Close, but not quite there :-)
>
<Snip>
Matthias Klaey
Tom Wickerath <AOS168b AT comcast DOT net> wrote:
>Hi Matthias,
>
>> Close, but not quite there :-)
>
>Take a look at the following data sets and printed results. I think you are
>also close, but not quite there
Shame on me :-(. I used to teach, even to *preach*, that one never
should trust a computer calculation unless one has checked it for
correctness by hand... I seem to become old and forgetful.
Anyway, thank you for testing this so thoroughly. The correct results
for your tests are (calculated by hand):
Test 1: 20
Test 2: 5.5
Test 3: 25
Test 4: 30.025
Test 5: 20
Test 6: 17.62
Below is my corrected function. The test in the innermost loop should
be
If (J = Jp) And (N Mod 2 = 0) Then
not just
If (N Mod 2 = 0) Then
I also eliminated another possible pitfall:
Jp = Int(N * 0.5)
could give a wrong result due to floating point imprecision. I replace
this with integer division:
Jp = N \ 2
Greetings, Matthias Kläy
--------------
Public Function kMedian(strTable As String, strQty As String, _
strVal As String) As Variant
' Input: strTable: Neme of the table, e.g. "DavesTable"
' strQty : Name of Quantity Field, e.g. "NumberSold"
' strVal : Name of Value Field, e.g. "Price"
' Output: Median, or Null if there are no records for the calculation
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim N As Long
Dim Jp As Long
Dim J As Long
Dim strWhere As String
kMedian = Null
strWhere = "(" & strQty & " > 0) And (Not " & strVal & " Is Null)"
N = Nz(DSum(strQty, strTable, strWhere), 0)
If N > 0 Then
If N Mod 2 = 0 Then
Jp = N \ 2
Else
Jp = (N \ 2) + 1
End If
J = 0
Set db = CurrentDb
Set rs = db.OpenRecordset("Select " & strQty & ", " & strVal & _
" From " & strTable & " Where " & strWhere & _
" Order By " & strVal & " Asc;", _
dbOpenForwardOnly)
Do While Not rs.EOF
J = J + rs.Fields(strQty)
If J >= Jp Then
kMedian = rs.Fields(strVal)
If (J = Jp) And (N Mod 2 = 0) Then
Tom Wickerath
Your modifications seem to have done the trick with my limited testing. Here
are the results I just obtained:
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 8 27.65
E 3 5.5
F 5 7.65
G 2 14.63
H 7 17.62
John Nurick's 2nd Median: 17.62
Matthias Klaey's 3rd Median: 17.62
Tom Wickerath's Median: 17.62
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 8 27.65
E 3 5.5
F 5 7.65
G 2 14.63
John Nurick's 2nd Median: 17.5
Matthias Klaey's 3rd Median: 17.5
Tom Wickerath's Median: 17.5
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 8 27.65
E 3 5.5
F 5 7.65
John Nurick's 2nd Median: 20
Matthias Klaey's 3rd Median: 20
Tom Wickerath's Median: 20
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 8 27.65
E 3 5.5
John Nurick's 2nd Median: 20
Matthias Klaey's 3rd Median: 20
Tom Wickerath's Median: 20
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 8 27.65
John Nurick's 2nd Median: 20
Matthias Klaey's 3rd Median: 20
Tom Wickerath's Median: 20
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 10 30
John Nurick's 2nd Median: 25
Matthias Klaey's 3rd Median: 25
Tom Wickerath's Median: 25
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 10 1
John Nurick's 2nd Median: 5.5
Matthias Klaey's 3rd Median: 5.5
Tom Wickerath's Median: 5.5
---------------------------------
Item NumberSold Price
A 1 1.5
B 3 15
C 6 20
D 6 1
John Nurick's 2nd Median: 15
Matthias Klaey's 3rd Median: 15
Tom Wickerath's Median: 15
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
John Nurick's 2nd Median: 20
Matthias Klaey's 3rd Median: 20
Tom Wickerath's Median: 20
---------------------------------
Item NumberSold Price
A 1 10
B 3 15
C 6 20
D 15 3.2
E 2 8.61
F 5 9.23
G 12 22.46
H 19 14.97
I 32 7.82
J 4 56.25
K 8 100
John Nurick's 2nd Median: 9.23
Matthias Klaey's 3rd Median: 9.23
Tom Wickerath's Median: 9.23
---------------------------------
So, it looks like the OP (original poster), Dave, now has his choice of
three algorithms to use. I guess one could call that a triple play!
Thank You for sticking with this and seeing it through.
Tom Wickerath
Microsoft Access MVP
http://www.access.qbuilt.com/html/expert_contributors.html
http://www.access.qbuilt.com/html/search.html
__________________________________________
John Nurick
On Sun, 7 Jan 2007 13:07:00 -0800, Tom Wickerath <AOS168b AT comcast DOT
net> wrote:
--
DaveW
I can't thank everyone enough for all of your help. I am positive that
without everyones generous time I would have had to resort back to manually
calculating the median... I can't tell you how many hours this will save me!
Thanks again - problem solved!
Dave.