Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel seems to hang while running a UDF
I created the following UDF to perform a robust regression, and run it
against subsets of data in a column by writing formulas of the following type: =INDEX(TheilSenRegression(OFFSET($AZ6,0,0,22,1),OF FSET($AZ6,1,0,22,1)), 1) =INDEX(TheilSenRegression(OFFSET($AZ7,0,0,22,1),OF FSET($AZ7,1,0,22,1)), 1) .... =INDEX(TheilSenRegression(OFFSET($AZ57,0,0,22,1),O FFSET($AZ57,1,0,22,1)), 1) Works like a charm while I have less than about 100 such formulae in the spreadsheet. Any more, and Excel seems to go into an infinite loop, and I have to eventually killl it. I then tried copying and pasting values in 96 of the cells to ensure that it was not getting overloaded (the algorithm is O(N^2) and it may take a while to recompute the spreadsheet if there are large numbers of fomulae). Now there are only 4 cells with formulae in them. But the behaviour does not change - If I copy one of thse formulae to a fifth cell, Excel goes into an infinite loop. I have tried creating a new spreadsheet - same problem. Any thoughts? Sincerely Thomas Philips Public Function TheilSenRegression(x As Range, y As Range) 'This function performs a Theil Sen regression, regressing y on x 'For details, refer to Rand Wilcox - Fundamentals of Modern Statistical Methods or 'P.K. Sen, Estimates of the Regression Coefficient based on Kendall's Tau, JASA,v 63,#324, Dec 1968pp. 1379-1389 Dim xx() As Double, yy() As Double, slopes() As Double Nx = Application.WorksheetFunction.Max(x.Rows.Count, x.Columns.Count) Mx = Application.WorksheetFunction.Min(x.Rows.Count, x.Columns.Count) Ny = Application.WorksheetFunction.Max(y.Rows.Count, y.Columns.Count) My = Application.WorksheetFunction.Min(y.Rows.Count, y.Columns.Count) If Nx < Ny Then MsgBox ("This routine does not work with two ranges of different lengths.") Exit Function ElseIf Nx = 1 Then MsgBox ("Each range must be of length 2 or more.") Exit Function ElseIf Mx 1 Then MsgBox ("This routine handles only univariate regressions. Choose a single row or column for x") Exit Function ElseIf Mx 1 Then MsgBox ("This routine handles only univariate regressions. Choose a single row or column for y") Exit Function ElseIf result < 0 Or result 2 Then MsgBox ("The third parameter (result) must be 0, 1 or 2") Exit Function Else N = Nx nC2 = N * (N - 1) / 2 ReDim xx(1 To N) ReDim yy(1 To N) ReDim slopes(1 To nC2) For i = 1 To N If x.Cells(i).Value = "" Then MsgBox ("X has one or more blank cells") Exit Function Else xx(i) = x.Cells(i).Value End If If y.Cells(i).Value = "" Then MsgBox ("Y has one or more blank cells") Exit Function Else yy(i) = y.Cells(i).Value End If Next End If k = 0 'Compute slopes between points with unequal x values For i = 1 To N - 1 For j = i + 1 To N If xx(i) < xx(j) Then k = k + 1 slopes(k) = (yy(j) - yy(i)) / (xx(j) - xx(i)) End If Next Next ReDim Preserve slopes(1 To k) TheilSenSlope = Application.WorksheetFunction.Median(slopes) TheilSenIntercept = Application.WorksheetFunction.Median(yy) - TheilSenSlope * Application.WorksheetFunction.Median(xx) TheilSenRegression = Array(TheilSenSlope, TheilSenIntercept) End Function |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Excel seems to hang while running a UDF
Sorry, I don't have an answer to your problem, but I think there is an error in your calculation of TheilSenIntercept that I wanted to correct before anyone else copied your code like I did.
I was looking for a Theil-Sen function for excel and found your question. Once I removed all the line breaks added by this web page, it worked for me (I don't have anywhere near 100 formulas), but I found that it gave results that didn't seem right for my data sets. The slope looked good, but the offset didn't always go through the center of the distribution for random datasets, and for curved datasets the result was a line tangential to a curved fit. Based on the wikipedia definition of Theil-Sen, the intercept is the median of (yy(i) - TheilSenSlope * xx(i) for each point), not the median(yy()) - TheilSenSlope * median(x). When I changed the code, the fit looks much better (very similar to native Excel trendline, but better outlier rejection as expected). I replaced the third-to-last line with: ' Original incorrect code ' TheilSenIntercept = Application.WorksheetFunction.Median (yy) - TheilSenSlope * Application.WorksheetFunction.Median(xx) ' New corrected code Dim intercepts() As Double ReDim intercepts(1 To N) For i = 1 To N intercepts(i) = yy(i) - TheilSenSlope * xx(i) Next TheilSenIntercept = Application.WorksheetFunction.Median(intercepts()) On Friday, March 21, 2008 7:09 AM tkpme wrote: I created the following UDF to perform a robust regression, and run it against subsets of data in a column by writing formulas of the following type: =INDEX(TheilSenRegression(OFFSET($AZ6,0,0,22,1),OF FSET($AZ6,1,0,22,1)), 1) =INDEX(TheilSenRegression(OFFSET($AZ7,0,0,22,1),OF FSET($AZ7,1,0,22,1)), 1) ... =INDEX(TheilSenRegression(OFFSET($AZ57,0,0,22,1),O FFSET($AZ57,1,0,22,1)), 1) Works like a charm while I have less than about 100 such formulae in the spreadsheet. Any more, and Excel seems to go into an infinite loop, and I have to eventually killl it. I then tried copying and pasting values in 96 of the cells to ensure that it was not getting overloaded (the algorithm is O(N^2) and it may take a while to recompute the spreadsheet if there are large numbers of fomulae). Now there are only 4 cells with formulae in them. But the behaviour does not change - If I copy one of thse formulae to a fifth cell, Excel goes into an infinite loop. I have tried creating a new spreadsheet - same problem. Any thoughts? Sincerely Thomas Philips Public Function TheilSenRegression(x As Range, y As Range) 'This function performs a Theil Sen regression, regressing y on x 'For details, refer to Rand Wilcox - Fundamentals of Modern Statistical Methods or 'P.K. Sen, Estimates of the Regression Coefficient based on Kendall's Tau, JASA,v 63,#324, Dec 1968pp. 1379-1389 Dim xx() As Double, yy() As Double, slopes() As Double Nx = Application.WorksheetFunction.Max(x.Rows.Count, x.Columns.Count) Mx = Application.WorksheetFunction.Min(x.Rows.Count, x.Columns.Count) Ny = Application.WorksheetFunction.Max(y.Rows.Count, y.Columns.Count) My = Application.WorksheetFunction.Min(y.Rows.Count, y.Columns.Count) If Nx < Ny Then MsgBox ("This routine does not work with two ranges of different lengths.") Exit Function ElseIf Nx = 1 Then MsgBox ("Each range must be of length 2 or more.") Exit Function ElseIf Mx 1 Then MsgBox ("This routine handles only univariate regressions. Choose a single row or column for x") Exit Function ElseIf Mx 1 Then MsgBox ("This routine handles only univariate regressions. Choose a single row or column for y") Exit Function ElseIf result < 0 Or result 2 Then MsgBox ("The third parameter (result) must be 0, 1 or 2") Exit Function Else N = Nx nC2 = N * (N - 1) / 2 ReDim xx(1 To N) ReDim yy(1 To N) ReDim slopes(1 To nC2) For i = 1 To N If x.Cells(i).Value = "" Then MsgBox ("X has one or more blank cells") Exit Function Else xx(i) = x.Cells(i).Value End If If y.Cells(i).Value = "" Then MsgBox ("Y has one or more blank cells") Exit Function Else yy(i) = y.Cells(i).Value End If Next End If k = 0 'Compute slopes between points with unequal x values For i = 1 To N - 1 For j = i + 1 To N If xx(i) < xx(j) Then k = k + 1 slopes(k) = (yy(j) - yy(i)) / (xx(j) - xx(i)) End If Next Next ReDim Preserve slopes(1 To k) TheilSenSlope = Application.WorksheetFunction.Median(slopes) TheilSenIntercept = Application.WorksheetFunction.Median(yy) - TheilSenSlope * Application.WorksheetFunction.Median(xx) TheilSenRegression = Array(TheilSenSlope, TheilSenIntercept) End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Application Hang with Excel | Excel Discussion (Misc queries) | |||
Excel Application hang | Excel Discussion (Misc queries) | |||
Excel Attachments Hang | Excel Discussion (Misc queries) | |||
excel hang | Excel Discussion (Misc queries) | |||
Excel hang when SaveAs | Excel Programming |