Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4,391
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4,391
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 415
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4,391
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4
Default 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   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 4,391
Default 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
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
RENEWED-- Arrays: Counting multiple values within array Trilux_nogo Excel Worksheet Functions 5 April 20th 07 01:30 AM
Arrays - declaration, adding values to arrays and calculation Maxi[_2_] Excel Programming 1 August 17th 06 04:13 PM
Array of Public Arrays Hari Prasadh Excel Programming 1 January 21st 05 04:42 PM
Array of Arrays in VBA Peter[_49_] Excel Programming 0 November 9th 04 10:50 PM
Extracting sub arrays from a 2-D VBA array Alan Beban[_2_] Excel Programming 7 August 16th 04 09:50 PM


All times are GMT +1. The time now is 07:27 AM.

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"