Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Here is my problem,
I have rain gage data at varying time intervals with a cumulative precip. amount at that time interval making a 2-d array. For example 10:00 1 10:08 1.5 10:16 2 10:33 2.5 From this array I want to create another 2-d array at fixed time intervals in this case it could be 15 min. The 2nd column of array two would be created from the first array using linear interpolation or some other rule the result would be 10:00 1 10:15 ? 10:30 ? stepping forward in time to fill the second array. any ideas? |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Brett,
If I understand you correctly, the code below should work. If you need a different method than linear to get the projected final quantity, you'll need to change that part. I have tested much, so ther may be some error(s), but this should get you started. NickHK P.S. Not sure if this should be called "NormaliseArray", but you know what I mean. Private Sub CommandButton1_Click() Dim RetVal As Variant Dim OutputArray As Variant Dim Data(1 To 4, 1 To 2) As Variant 'Sample data Data(1, 1) = "10:00" Data(1, 2) = 1 Data(2, 1) = "10:08" Data(2, 2) = 1.5 Data(3, 1) = "10:16" Data(3, 2) = 2 Data(4, 1) = "10:33" Data(4, 2) = 2.5 RetVal = NormaliseArray(Data, CDate("10:00"), 15, OutputArray) If IsNumeric(RetVal) = True Then MsgBox "Normalised to " & RetVal & " elements" Else MsgBox "Error : " & RetVal End If End Sub Private Function NormaliseArray(ByVal InputData As Variant, _ StartTime As Date, _ IntervalMinutes As Long, _ ByRef OutData As Variant, _ Optional BaseQty As Single = 1) _ As Variant Dim TimeTaken As Double Dim QuantityCollected As Single Dim MinElement As Long Dim MaxElement As Long Dim NewElementCount As Long Dim CalcQtyInterval As Single Dim Counter As Long Const OneMinute As Single = 1 / 24 / 60 Const ERR_SUBSCRIPTOUTOFRANGE As Long = 9 Const ERR_ARRAYCANNOTRESIZE As Long = 10 'Make sure the input is an array If IsArray(InputData) = False Then NormaliseArray = "Not array input" Exit Function End If MinElement = LBound(InputData, 1) MaxElement = UBound(InputData, 1) On Error Resume Next 'Make sure we have a 2-D array 'This will error if there is no 2nd dimension QuantityCollected = InputData(MaxElement, 2) - InputData(MinElement, 2) If Err.Number = ERR_SUBSCRIPTOUTOFRANGE Then NormaliseArray = "No 2nd dimension" Exit Function End If On Error GoTo 0 'The time taken for the original data TimeTaken = CDate(InputData(MaxElement, 1)) - CDate(InputData(MinElement, 1)) 'The number of elements required to cover the data, with the new time interval NewElementCount = RoundUp(TimeTaken / (IntervalMinutes * OneMinute)) On Error Resume Next 'Resize the the OutputData variable, including the Start element ReDim OutData(0 To NewElementCount, 1 To 2) If Err.Number = ERR_ARRAYCANNOTRESIZE Then NormaliseArray = "Cannot resize output array" Exit Function End If On Error GoTo 0 'Calculate the projected new total quantity QuantityCollected = QuantityCollected * (NewElementCount * IntervalMinutes * OneMinute) / TimeTaken CalcQtyInterval = QuantityCollected / (NewElementCount) For Counter = 0 To NewElementCount OutData(Counter, 1) = DateAdd("n", IntervalMinutes * (Counter), StartTime) OutData(Counter, 2) = BaseQty + CalcQtyInterval * (Counter) Debug.Print OutData(Counter, 1), OutData(Counter, 2) Next NormaliseArray = NewElementCount + 1 End Function Private Function RoundUp(sngInBound) As Long RoundUp = CLng(sngInBound + 0.5) End Function "Brett" wrote in message ups.com... Here is my problem, I have rain gage data at varying time intervals with a cumulative precip. amount at that time interval making a 2-d array. For example 10:00 1 10:08 1.5 10:16 2 10:33 2.5 From this array I want to create another 2-d array at fixed time intervals in this case it could be 15 min. The 2nd column of array two would be created from the first array using linear interpolation or some other rule the result would be 10:00 1 10:15 ? 10:30 ? stepping forward in time to fill the second array. any ideas? |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
That should read "I have NOT tested much...
NickHK "NickHK" wrote in message ... Brett, If I understand you correctly, the code below should work. If you need a different method than linear to get the projected final quantity, you'll need to change that part. I have tested much, so ther may be some error(s), but this should get you started. NickHK P.S. Not sure if this should be called "NormaliseArray", but you know what I mean. Private Sub CommandButton1_Click() Dim RetVal As Variant Dim OutputArray As Variant Dim Data(1 To 4, 1 To 2) As Variant 'Sample data Data(1, 1) = "10:00" Data(1, 2) = 1 Data(2, 1) = "10:08" Data(2, 2) = 1.5 Data(3, 1) = "10:16" Data(3, 2) = 2 Data(4, 1) = "10:33" Data(4, 2) = 2.5 ------------------- CUT ---------- |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Nick, I am not sure if I follow the code, I am fairly new to this. The code will have to read in measured data from a worksheet (random time, cumulative precip. amount) in sequential time. Thus creating a 2-d array. I have gotten this far. See attached code, the next step is to create the fixed interval array using the start time , end time, and time interval. At this point the array is only 1d, the next step is too loop through the new time interval array and compare values to the measured array. Perhaps using linear interpolation to calculate the cumulative precip. and the given time interval. These corresponding values would be saved in a 2-d array perhaps named Interval_precip. or something. Another alternative to using linear interpolation would be to simply take the measured precip. amount at the nearest value less than the interval time. Like this T_meas P_meas T_int P_int(this value is calculated from meas) 1 0 0 0 8 1 15 1 16 2 30 4 22 3 45 5 29 4 60 6 36 5 etc... 53 6 etc.... The code I have thus far is attached, I really appreciate your help! Thanks Brett Sub get_15_min_data() ' This program was written to convert varying interval tipping bucket rain gage data into fixed 15 min interval data 'Declare all variables Dim count_m As Integer Dim calc_i As Integer Dim start_time As Double Dim end_time As Double Dim Measured_array() Dim Interval_array() Dim interval_row As Integer Dim time_meas As Double Dim Cum_meas As Double Dim time_int As Double Dim cum_int As Double Dim row As Integer Dim i As Integer Application.ScreenUpdating = False Dim interval As Double interval = Cells(3, 3).Value 'First loop counts the number of measured times and cumulative precip. for the measured_array count_m = 0 row = 5 Do Until Cells(row, 1).Value = "" row = row + 1 count_m = count_m + 1 Loop ReDim Measured_array(1 To (count_m + 4), 1 To 2) 'Fill the measured_array with values from worksheet For i = 1 To (count_m) For j = 1 To 2 Measured_array(i, j) = Cells(i + 4, j).Value Next j Next i 'test to see if the proper array was created Range("L:m").Value = Measured_array 'now we need to create an array with the fixed interval times and cumulative precip. that is calculated start_time = Cells(1, 3).Value end_time = Cells(2, 3).Value interval_row = (end_time - start_time) / interval ReDim Interval_array(1 To interval_row, 1 To 2) ' For now the code will not include a linear interpolation it will check if the interval time is less than_ ' the measured time, if so the the interval_time precip is = to the measured time precip, if the interval time is 'greater than than measured time 'i= measured precip row 'j=measured precip column 'Ti= interval precip. time 'Pi= interval precip. rainfall cumulative inches i = 1 j = 1 For i = 1 To count_m For time_int = start_time To end_time Step interval If Time_int < Measured_array(i, 1).Value Then cum_int= For pi = 1 To 2 End Sub |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Brett,
Did you try the code I posted ? It <should take the original array (time, qty) and adjust to the minimum number of specified intervals (15 minutes was the example) required to cover the sampling period. Each qty value is adjusted by simple linear relationship. So the last qty figure will (probably) be a projection. But one thing strike me is that the is no reason why there should any linear relationship between Time and rainfall. Surely at Time "t", Precipitation is "p". There is no reason to suppose what it would have been at t +/- 1 minute. I'm sure you know you're doing, so then a linear relationship is easiset. I'm no maths expert, but maybe a "least squares" solution would be better. When you say "array", do you mean an array in memeory, or an excel range of data ? It does matter too much, but it is easier to know where the data resides. NickHK "Brett" groups.com... Nick, I am not sure if I follow the code, I am fairly new to this. The code will have to read in measured data from a worksheet (random time, cumulative precip. amount) in sequential time. Thus creating a 2-d array. I have gotten this far. See attached code, the next step is to create the fixed interval array using the start time , end time, and time interval. At this point the array is only 1d, the next step is too loop through the new time interval array and compare values to the measured array. Perhaps using linear interpolation to calculate the cumulative precip. and the given time interval. These corresponding values would be saved in a 2-d array perhaps named Interval_precip. or something. Another alternative to using linear interpolation would be to simply take the measured precip. amount at the nearest value less than the interval time. Like this T_meas P_meas T_int P_int(this value is calculated from meas) 1 0 0 0 8 1 15 1 16 2 30 4 22 3 45 5 29 4 60 6 36 5 etc... 53 6 etc.... The code I have thus far is attached, I really appreciate your help! Thanks Brett Sub get_15_min_data() ' This program was written to convert varying interval tipping bucket rain gage data into fixed 15 min interval data 'Declare all variables Dim count_m As Integer Dim calc_i As Integer Dim start_time As Double Dim end_time As Double Dim Measured_array() Dim Interval_array() Dim interval_row As Integer Dim time_meas As Double Dim Cum_meas As Double Dim time_int As Double Dim cum_int As Double Dim row As Integer Dim i As Integer Application.ScreenUpdating = False Dim interval As Double interval = Cells(3, 3).Value 'First loop counts the number of measured times and cumulative precip. for the measured_array count_m = 0 row = 5 Do Until Cells(row, 1).Value = "" row = row + 1 count_m = count_m + 1 Loop ReDim Measured_array(1 To (count_m + 4), 1 To 2) 'Fill the measured_array with values from worksheet For i = 1 To (count_m) For j = 1 To 2 Measured_array(i, j) = Cells(i + 4, j).Value Next j Next i 'test to see if the proper array was created Range("L:m").Value = Measured_array 'now we need to create an array with the fixed interval times and cumulative precip. that is calculated start_time = Cells(1, 3).Value end_time = Cells(2, 3).Value interval_row = (end_time - start_time) / interval ReDim Interval_array(1 To interval_row, 1 To 2) ' For now the code will not include a linear interpolation it will check if the interval time is less than_ ' the measured time, if so the the interval_time precip is = to the measured time precip, if the interval time is 'greater than than measured time 'i= measured precip row 'j=measured precip column 'Ti= interval precip. time 'Pi= interval precip. rainfall cumulative inches i = 1 j = 1 For i = 1 To count_m For time_int = start_time To end_time Step interval If Time_int < Measured_array(i, 1).Value Then cum_int= For pi = 1 To 2 End Sub |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Nick
I did try the code posted, and it didn't give any output, should I load the existing array of measured data and then try to run the function on it, not sure how to do this? The reason I would like to interpolate points at the 15 minute intervals is due to the fact that at say 8 minutes the cumulative rainfall is perhaps 3 and at 28 minutes the cumulative rainfall is 3.5 and I am trying to get an estimate between these two points for the 15 minute interval. So the linear relationship is not among the whole dataset, only between two points of measured time. Does that make any sense? Thanks again for your interest. Brett NickHK wrote: Brett, Did you try the code I posted ? It <should take the original array (time, qty) and adjust to the minimum number of specified intervals (15 minutes was the example) required to cover the sampling period. Each qty value is adjusted by simple linear relationship. So the last qty figure will (probably) be a projection. But one thing strike me is that the is no reason why there should any linear relationship between Time and rainfall. Surely at Time "t", Precipitation is "p". There is no reason to suppose what it would have been at t +/- 1 minute. I'm sure you know you're doing, so then a linear relationship is easiset. I'm no maths expert, but maybe a "least squares" solution would be better. When you say "array", do you mean an array in memeory, or an excel range of data ? It does matter too much, but it is easier to know where the data resides. NickHK "Brett" groups.com... Nick, I am not sure if I follow the code, I am fairly new to this. The code will have to read in measured data from a worksheet (random time, cumulative precip. amount) in sequential time. Thus creating a 2-d array. I have gotten this far. See attached code, the next step is to create the fixed interval array using the start time , end time, and time interval. At this point the array is only 1d, the next step is too loop through the new time interval array and compare values to the measured array. Perhaps using linear interpolation to calculate the cumulative precip. and the given time interval. These corresponding values would be saved in a 2-d array perhaps named Interval_precip. or something. Another alternative to using linear interpolation would be to simply take the measured precip. amount at the nearest value less than the interval time. Like this T_meas P_meas T_int P_int(this value is calculated from meas) 1 0 0 0 8 1 15 1 16 2 30 4 22 3 45 5 29 4 60 6 36 5 etc... 53 6 etc.... The code I have thus far is attached, I really appreciate your help! Thanks Brett Sub get_15_min_data() ' This program was written to convert varying interval tipping bucket rain gage data into fixed 15 min interval data 'Declare all variables Dim count_m As Integer Dim calc_i As Integer Dim start_time As Double Dim end_time As Double Dim Measured_array() Dim Interval_array() Dim interval_row As Integer Dim time_meas As Double Dim Cum_meas As Double Dim time_int As Double Dim cum_int As Double Dim row As Integer Dim i As Integer Application.ScreenUpdating = False Dim interval As Double interval = Cells(3, 3).Value 'First loop counts the number of measured times and cumulative precip. for the measured_array count_m = 0 row = 5 Do Until Cells(row, 1).Value = "" row = row + 1 count_m = count_m + 1 Loop ReDim Measured_array(1 To (count_m + 4), 1 To 2) 'Fill the measured_array with values from worksheet For i = 1 To (count_m) For j = 1 To 2 Measured_array(i, j) = Cells(i + 4, j).Value Next j Next i 'test to see if the proper array was created Range("L:m").Value = Measured_array 'now we need to create an array with the fixed interval times and cumulative precip. that is calculated start_time = Cells(1, 3).Value end_time = Cells(2, 3).Value interval_row = (end_time - start_time) / interval ReDim Interval_array(1 To interval_row, 1 To 2) ' For now the code will not include a linear interpolation it will check if the interval time is less than_ ' the measured time, if so the the interval_time precip is = to the measured time precip, if the interval time is 'greater than than measured time 'i= measured precip row 'j=measured precip column 'Ti= interval precip. time 'Pi= interval precip. rainfall cumulative inches i = 1 j = 1 For i = 1 To count_m For time_int = start_time To end_time Step interval If Time_int < Measured_array(i, 1).Value Then cum_int= For pi = 1 To 2 End Sub |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Brett,
OK, try this. I've made more interactive, so hopefully you should just need to paste the code and run it. Again, not tested much, so see what it does with some of your data. If you make a chart of the before and after data, you can see if the results are desirable. NickHK < Code Option Explicit Private Type Point X As Single Y As Single End Type Private WorkingData As Range Private Sub CommandButton1_Click() Dim RetVal As Variant Dim OutputArray As Variant Dim StartRange As Range Dim EndRange As Range Dim IntervalMinutes As Long Set StartRange = Application.InputBox("Select the start of the data.", , , , , , , 8) Set EndRange = Application.InputBox("Select the end of the data.", , , , , , , 8) IntervalMinutes = Application.InputBox("Enter the adjusted time interval in minutes.", , 15, , , , , 1) RetVal = NormaliseArray(Range(StartRange.Address, EndRange.Address), IntervalMinutes, OutputArray) If IsNumeric(RetVal) = True Then MsgBox "Normalised to " & RetVal & " elements" Set StartRange = Application.InputBox("Select the start of the output data.", , , , , , , 8) StartRange.Resize(RetVal, 2) = OutputArray Else MsgBox "Error : " & RetVal End If End Sub Private Function NormaliseArray(ByVal InputData As Range, _ IntervalMinutes As Long, _ ByRef OutData As Variant, _ Optional BaseQty As Single = 1) _ As Variant Dim TimeTaken As Double Dim QuantityCollected As Single Dim NewElementCount As Long Dim Counter As Long Dim SPoint As Point Dim EPoint As Point Dim LastProcessedDataRow As Long Const OneMinute As Single = 1 / 24 / 60 Const ERR_ARRAYCANNOTRESIZE As Long = 10 'Make sure there is more than 1 row of data If InputData.Rows.Count < 2 Then NormaliseArray = "Not enough data" Exit Function End If 'Create a local copy Set WorkingData = InputData 'The time taken for the original data TimeTaken = CDate(WorkingData(WorkingData.Rows.Count).Value) - CDate(WorkingData(1).Value) 'The number of elements required to cover the data, with the new time interval NewElementCount = RoundUp(TimeTaken / (IntervalMinutes * OneMinute)) On Error Resume Next 'Resize the the OutputData variable, including the Start element ReDim OutData(0 To NewElementCount, 1 To 2) If Err.Number = ERR_ARRAYCANNOTRESIZE Then NormaliseArray = "Cannot resize output array" Exit Function End If On Error GoTo 0 LastProcessedDataRow = 1 'Set the value of element(0) to the same as the element(0) of WorkingData OutData(0, 1) = WorkingData(LastProcessedDataRow, 1) OutData(0, 2) = WorkingData(LastProcessedDataRow, 2) For Counter = 1 To NewElementCount 'See if we have reached the end of the sample data If LastProcessedDataRow < WorkingData.Rows.Count Then 'Still elements, so update SPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value SPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value LastProcessedDataRow = GetNextDataRow(LastProcessedDataRow, IntervalMinutes * OneMinute) EPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value EPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value Else 'Last element used, so keep previous 2 points 'And project new value End If 'Set the new time OutData(Counter, 1) = DateAdd("n", IntervalMinutes, OutData(Counter - 1, 1)) 'Calculate the new Y value from the X value and 2 points using Y=mX+C OutData(Counter, 2) = InterpolateY(SPoint, EPoint, CSng(OutData(Counter, 1))) Debug.Print OutData(Counter, 1), OutData(Counter, 2) Next NormaliseArray = NewElementCount + 1 End Function Private Function RoundUp(sngInBound) As Long RoundUp = CLng(sngInBound + 0.5) End Function 'Function based on Y=mX+C and 2 know points Private Function InterpolateY(StartPoint As Point, EndPoint As Point, KnownValueX As Single) As Single Dim Gradient As Single Dim Intercept As Single Gradient = (EndPoint.Y - StartPoint.Y) / (EndPoint.X - StartPoint.X) Intercept = EndPoint.Y - Gradient * EndPoint.X InterpolateY = Gradient * KnownValueX + Intercept End Function 'Find the next sample data element that is = the previous element+the interval 'Or we reach the end of the sample data Private Function GetNextDataRow(StartingFrom As Long, MinimumInterval As Single) As Long Dim Counter As Long Counter = 0 With WorkingData.Cells(StartingFrom, 1) Debug.Print .Offset(Counter, 0).Value Do Until .Offset(Counter, 0).Value = .Value + MinimumInterval Or StartingFrom + Counter = WorkingData.Rows.Count Counter = Counter + 1 Loop End With GetNextDataRow = StartingFrom + Counter End Function </ Code "Brett" wrote in message oups.com... Nick I did try the code posted, and it didn't give any output, should I load the existing array of measured data and then try to run the function on it, not sure how to do this? The reason I would like to interpolate points at the 15 minute intervals is due to the fact that at say 8 minutes the cumulative rainfall is perhaps 3 and at 28 minutes the cumulative rainfall is 3.5 and I am trying to get an estimate between these two points for the 15 minute interval. So the linear relationship is not among the whole dataset, only between two points of measured time. Does that make any sense? Thanks again for your interest. Brett -------------- CUT ---------------------------- |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Nick
I ran the code and it works, however the algorithm for calculating the cumulative rainfall amount at the fixed time interval does not work. The values that are calculated don't fit the measured data results. The interpolation should calculate the fixed interval cumulative rainfall amount between the measured times before and after the fixed time interval. For example if the TM PM Ti Pi 10:00 1 10:00 1 10:08 2 10:15 2.6 10:20 3 etc. if the cumulative measured precip. does not change between measured times the fixed interval cumulative should not change as well. Thanks again for all your help. Brett NickHK wrote: Brett, OK, try this. I've made more interactive, so hopefully you should just need to paste the code and run it. Again, not tested much, so see what it does with some of your data. If you make a chart of the before and after data, you can see if the results are desirable. NickHK < Code Option Explicit Private Type Point X As Single Y As Single End Type Private WorkingData As Range Private Sub CommandButton1_Click() Dim RetVal As Variant Dim OutputArray As Variant Dim StartRange As Range Dim EndRange As Range Dim IntervalMinutes As Long Set StartRange = Application.InputBox("Select the start of the data.", , , , , , , 8) Set EndRange = Application.InputBox("Select the end of the data.", , , , , , , 8) IntervalMinutes = Application.InputBox("Enter the adjusted time interval in minutes.", , 15, , , , , 1) RetVal = NormaliseArray(Range(StartRange.Address, EndRange.Address), IntervalMinutes, OutputArray) If IsNumeric(RetVal) = True Then MsgBox "Normalised to " & RetVal & " elements" Set StartRange = Application.InputBox("Select the start of the output data.", , , , , , , 8) StartRange.Resize(RetVal, 2) = OutputArray Else MsgBox "Error : " & RetVal End If End Sub Private Function NormaliseArray(ByVal InputData As Range, _ IntervalMinutes As Long, _ ByRef OutData As Variant, _ Optional BaseQty As Single = 1) _ As Variant Dim TimeTaken As Double Dim QuantityCollected As Single Dim NewElementCount As Long Dim Counter As Long Dim SPoint As Point Dim EPoint As Point Dim LastProcessedDataRow As Long Const OneMinute As Single = 1 / 24 / 60 Const ERR_ARRAYCANNOTRESIZE As Long = 10 'Make sure there is more than 1 row of data If InputData.Rows.Count < 2 Then NormaliseArray = "Not enough data" Exit Function End If 'Create a local copy Set WorkingData = InputData 'The time taken for the original data TimeTaken = CDate(WorkingData(WorkingData.Rows.Count).Value) - CDate(WorkingData(1).Value) 'The number of elements required to cover the data, with the new time interval NewElementCount = RoundUp(TimeTaken / (IntervalMinutes * OneMinute)) On Error Resume Next 'Resize the the OutputData variable, including the Start element ReDim OutData(0 To NewElementCount, 1 To 2) If Err.Number = ERR_ARRAYCANNOTRESIZE Then NormaliseArray = "Cannot resize output array" Exit Function End If On Error GoTo 0 LastProcessedDataRow = 1 'Set the value of element(0) to the same as the element(0) of WorkingData OutData(0, 1) = WorkingData(LastProcessedDataRow, 1) OutData(0, 2) = WorkingData(LastProcessedDataRow, 2) For Counter = 1 To NewElementCount 'See if we have reached the end of the sample data If LastProcessedDataRow < WorkingData.Rows.Count Then 'Still elements, so update SPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value SPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value LastProcessedDataRow = GetNextDataRow(LastProcessedDataRow, IntervalMinutes * OneMinute) EPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value EPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value Else 'Last element used, so keep previous 2 points 'And project new value End If 'Set the new time OutData(Counter, 1) = DateAdd("n", IntervalMinutes, OutData(Counter - 1, 1)) 'Calculate the new Y value from the X value and 2 points using Y=mX+C OutData(Counter, 2) = InterpolateY(SPoint, EPoint, CSng(OutData(Counter, 1))) Debug.Print OutData(Counter, 1), OutData(Counter, 2) Next NormaliseArray = NewElementCount + 1 End Function Private Function RoundUp(sngInBound) As Long RoundUp = CLng(sngInBound + 0.5) End Function 'Function based on Y=mX+C and 2 know points Private Function InterpolateY(StartPoint As Point, EndPoint As Point, KnownValueX As Single) As Single Dim Gradient As Single Dim Intercept As Single Gradient = (EndPoint.Y - StartPoint.Y) / (EndPoint.X - StartPoint.X) Intercept = EndPoint.Y - Gradient * EndPoint.X InterpolateY = Gradient * KnownValueX + Intercept End Function 'Find the next sample data element that is = the previous element+the interval 'Or we reach the end of the sample data Private Function GetNextDataRow(StartingFrom As Long, MinimumInterval As Single) As Long Dim Counter As Long Counter = 0 With WorkingData.Cells(StartingFrom, 1) Debug.Print .Offset(Counter, 0).Value Do Until .Offset(Counter, 0).Value = .Value + MinimumInterval Or StartingFrom + Counter = WorkingData.Rows.Count Counter = Counter + 1 Loop End With GetNextDataRow = StartingFrom + Counter End Function </ Code "Brett" wrote in message oups.com... Nick I did try the code posted, and it didn't give any output, should I load the existing array of measured data and then try to run the function on it, not sure how to do this? The reason I would like to interpolate points at the 15 minute intervals is due to the fact that at say 8 minutes the cumulative rainfall is perhaps 3 and at 28 minutes the cumulative rainfall is 3.5 and I am trying to get an estimate between these two points for the 15 minute interval. So the linear relationship is not among the whole dataset, only between two points of measured time. Does that make any sense? Thanks again for your interest. Brett -------------- CUT ---------------------------- |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Using known arrays to calculate an array of new values
Brett,
That's one reason why I made the Interpolation a function, so you can change the calculation to match your requirements easily. Just adjust that calculation and/or the before/after values passed to it to achieve desired method. NickHK "Brett" wrote in message oups.com... Nick I ran the code and it works, however the algorithm for calculating the cumulative rainfall amount at the fixed time interval does not work. The values that are calculated don't fit the measured data results. The interpolation should calculate the fixed interval cumulative rainfall amount between the measured times before and after the fixed time interval. For example if the TM PM Ti Pi 10:00 1 10:00 1 10:08 2 10:15 2.6 10:20 3 etc. if the cumulative measured precip. does not change between measured times the fixed interval cumulative should not change as well. Thanks again for all your help. Brett NickHK wrote: Brett, OK, try this. I've made more interactive, so hopefully you should just need to paste the code and run it. Again, not tested much, so see what it does with some of your data. If you make a chart of the before and after data, you can see if the results are desirable. NickHK < Code Option Explicit Private Type Point X As Single Y As Single End Type Private WorkingData As Range Private Sub CommandButton1_Click() Dim RetVal As Variant Dim OutputArray As Variant Dim StartRange As Range Dim EndRange As Range Dim IntervalMinutes As Long Set StartRange = Application.InputBox("Select the start of the data.", , , , , , , 8) Set EndRange = Application.InputBox("Select the end of the data.", , , , , , , 8) IntervalMinutes = Application.InputBox("Enter the adjusted time interval in minutes.", , 15, , , , , 1) RetVal = NormaliseArray(Range(StartRange.Address, EndRange.Address), IntervalMinutes, OutputArray) If IsNumeric(RetVal) = True Then MsgBox "Normalised to " & RetVal & " elements" Set StartRange = Application.InputBox("Select the start of the output data.", , , , , , , 8) StartRange.Resize(RetVal, 2) = OutputArray Else MsgBox "Error : " & RetVal End If End Sub Private Function NormaliseArray(ByVal InputData As Range, _ IntervalMinutes As Long, _ ByRef OutData As Variant, _ Optional BaseQty As Single = 1) _ As Variant Dim TimeTaken As Double Dim QuantityCollected As Single Dim NewElementCount As Long Dim Counter As Long Dim SPoint As Point Dim EPoint As Point Dim LastProcessedDataRow As Long Const OneMinute As Single = 1 / 24 / 60 Const ERR_ARRAYCANNOTRESIZE As Long = 10 'Make sure there is more than 1 row of data If InputData.Rows.Count < 2 Then NormaliseArray = "Not enough data" Exit Function End If 'Create a local copy Set WorkingData = InputData 'The time taken for the original data TimeTaken = CDate(WorkingData(WorkingData.Rows.Count).Value) - CDate(WorkingData(1).Value) 'The number of elements required to cover the data, with the new time interval NewElementCount = RoundUp(TimeTaken / (IntervalMinutes * OneMinute)) On Error Resume Next 'Resize the the OutputData variable, including the Start element ReDim OutData(0 To NewElementCount, 1 To 2) If Err.Number = ERR_ARRAYCANNOTRESIZE Then NormaliseArray = "Cannot resize output array" Exit Function End If On Error GoTo 0 LastProcessedDataRow = 1 'Set the value of element(0) to the same as the element(0) of WorkingData OutData(0, 1) = WorkingData(LastProcessedDataRow, 1) OutData(0, 2) = WorkingData(LastProcessedDataRow, 2) For Counter = 1 To NewElementCount 'See if we have reached the end of the sample data If LastProcessedDataRow < WorkingData.Rows.Count Then 'Still elements, so update SPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value SPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value LastProcessedDataRow = GetNextDataRow(LastProcessedDataRow, IntervalMinutes * OneMinute) EPoint.X = WorkingData.Cells(LastProcessedDataRow, 1).Value EPoint.Y = WorkingData.Cells(LastProcessedDataRow, 2).Value Else 'Last element used, so keep previous 2 points 'And project new value End If 'Set the new time OutData(Counter, 1) = DateAdd("n", IntervalMinutes, OutData(Counter - 1, 1)) 'Calculate the new Y value from the X value and 2 points using Y=mX+C OutData(Counter, 2) = InterpolateY(SPoint, EPoint, CSng(OutData(Counter, 1))) Debug.Print OutData(Counter, 1), OutData(Counter, 2) Next NormaliseArray = NewElementCount + 1 End Function Private Function RoundUp(sngInBound) As Long RoundUp = CLng(sngInBound + 0.5) End Function 'Function based on Y=mX+C and 2 know points Private Function InterpolateY(StartPoint As Point, EndPoint As Point, KnownValueX As Single) As Single Dim Gradient As Single Dim Intercept As Single Gradient = (EndPoint.Y - StartPoint.Y) / (EndPoint.X - StartPoint.X) Intercept = EndPoint.Y - Gradient * EndPoint.X InterpolateY = Gradient * KnownValueX + Intercept End Function 'Find the next sample data element that is = the previous element+the interval 'Or we reach the end of the sample data Private Function GetNextDataRow(StartingFrom As Long, MinimumInterval As Single) As Long Dim Counter As Long Counter = 0 With WorkingData.Cells(StartingFrom, 1) Debug.Print .Offset(Counter, 0).Value Do Until .Offset(Counter, 0).Value = .Value + MinimumInterval Or StartingFrom + Counter = WorkingData.Rows.Count Counter = Counter + 1 Loop End With GetNextDataRow = StartingFrom + Counter End Function </ Code "Brett" wrote in message oups.com... Nick I did try the code posted, and it didn't give any output, should I load the existing array of measured data and then try to run the function on it, not sure how to do this? The reason I would like to interpolate points at the 15 minute intervals is due to the fact that at say 8 minutes the cumulative rainfall is perhaps 3 and at 28 minutes the cumulative rainfall is 3.5 and I am trying to get an estimate between these two points for the 15 minute interval. So the linear relationship is not among the whole dataset, only between two points of measured time. Does that make any sense? Thanks again for your interest. Brett -------------- CUT ---------------------------- |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
RENEWED-- Arrays: Counting multiple values within array | Excel Worksheet Functions | |||
Arrays - declaration, adding values to arrays and calculation | Excel Programming | |||
Array of Public Arrays | Excel Programming | |||
Array of Arrays in VBA | Excel Programming | |||
Extracting sub arrays from a 2-D VBA array | Excel Programming |