Interpolate missing values

[KariLeigh]

Hi -

This should be relatively simple, but I have been fighting with it way too long.

I have a table with two fields, [Date] and [Value]. [Date] is populated with all dates in one year, and [Value] has roughly one date per month, at randomish intervals.

I'd like to loop through [Value], count the nulls between set of non-nulls and then interpolate linearly. For example, say Jan 1 has a [Value] = 1 and Jan 30 has [Value] = 30, the results would populate Jan 2nd = 2, Jan 26th = 26th, etc.

I've tried all sorts of things in VBA and keep struggling.
Thanks in advance!

 

[Remou]

Do you have a little sample code?

http://lessthandot.com

 

[bubba100]

The word Date is a reserved word. I would suggest that you not use Date as a field name.

 

[MajP]

I found this to be a little challenging

Public Sub interpolateTable()
  Dim rs As DAO.Recordset
  Dim startVal As Double
  Dim endVal As Double
  Dim updateVal As Double
  Dim startPos As Integer
  Dim endPos As Integer
  Dim interval As Double
  Dim criteria As String
  Dim bk As Variant
  
  criteria = "dblVal is not null"
  Set rs = CurrentDb.OpenRecordset("tblDates", dbOpenDynaset)
  If rs.EOF And rs.BOF Then
    Exit Sub
  Else
    rs.MoveFirst
  End If
  
  If Not IsNull(rs.Fields("dblVal")) Then
    startVal = rs.Fields("dblVal")
    rs.FindNext criteria
    endPos = rs.AbsolutePosition
    endVal = rs.Fields("dblVal")
  Else
    rs.FindNext criteria
    startVal = rs.Fields("dblVal") / (rs.AbsolutePosition + 1)
    endVal = rs.Fields("dblVal")
    endPos = rs.AbsolutePosition
    rs.MoveFirst
    rs.Edit
      rs.Fields("dblVal").Value = startVal
    rs.Update
    End
  End If
  'see if the first record has a value if not the
  'start pos
  
  'MsgBox "start" & startPos & "  val " & startVal & " end" & endPos & " val" & endVal
  
  interval = getInterval(startPos, endPos, startVal, endVal)
  'MsgBox interval
  rs.MoveFirst
  If Not IsNull(rs.Fields("dblVal")) Then
   rs.MoveNext
  End If
   updateVal = startVal
   Do While Not rs.EOF
   
    If IsNull(rs.Fields("dblVal")) Then
      updateVal = updateVal + interval
      rs.Edit
      rs.Fields("dblVal") = updateVal
      rs.Update
    Else
       updateVal = rs.Fields("dblVal")
       startPos = rs.AbsolutePosition
       startVal = rs.Fields("dblVal").Value
       bk = rs.Bookmark
      rs.FindNext criteria
      If rs.NoMatch Then
          endPos = rs.RecordCount
          endVal = endPos - startVal
       Else
         endPos = rs.AbsolutePosition
         endVal = rs.Fields("dblVal").Value
       End If
       interval = getInterval(startPos, endPos, startVal, endVal)
       rs.Bookmark = bk
    End If
    rs.MoveNext
  Loop
End Sub

Public Function getInterval(startPos As Integer, endPos As Integer, startVal As Double, endVal As Double)
  If Not Abs(endPos - startPos) < 0.000001 Then
    MsgBox (endPos - startPos)
    getInterval = (endVal - startVal) / ((endPos - startPos))
  End If
End Function

before
dtmDate dblVal
1/1/2009 5
1/2/2009
1/3/2009
1/4/2009
1/5/2009
1/6/2009 10
1/7/2009
1/8/2009
1/9/2009 13
1/10/2009
1/11/2009
1/12/2009
1/13/2009 33

after

dtmDate dblVal
1/1/2009 5
1/2/2009 6
1/3/2009 7
1/4/2009 8
1/5/2009 9
1/6/2009 10
1/7/2009 11
1/8/2009 12
1/9/2009 13
1/10/2009 18
1/11/2009 23
1/12/2009 28
1/13/2009 33

 

[MajP]

although this was a good academic exercise, your example simply looks like you are returning the day value for the date

Jan 1 has a [Value] = 1
Jan 30 has [Value] = 30
the results would populate Jan 2nd = 2, Jan 26th = 26th

Is that just a poor example or do you want to do an actual interpolation?

 

[MichaelRed]

" ... academic exercise ... "

Seems to be right on target.


There are so many things WRONG with the concept, it is difficult to believe it is anything BUT an academic exercise (e.g. H O M E W O R K !!!!!!!!!!!!!)

Intervals require a start and end point.\

Interpolate requires INTERVALS to interpolate over.

Adding artifical data to a 'real' database is -at best- questionable exercise in poor judgement.

Failure to provide more than the barest hint of the datatypes to fill in seem to be even worse.

The paucity of rationale, the overall data structure, the scarcity of (useful) examples all convince me that this is a real 'exercise' for programmiing 101.




MichaelRed

 

[KariLeigh]

Thanks much. This was not homework - I'm a bit too long in the tooth for homework, I fear.

The example was a simplified one - but it clearly got the point across. Thanks again for the help!

 

[TheAceMan1]

How are ya KariLeigh . . .

BTW: Welcome to [blue]Tek-Tips![/blue] Do have a look at one of the links at the bottom of my post. The links will help you [blue]ask better questions[/blue], get [blue]quick responses[/blue], [blue]better answers[/blue], and insite into [blue]etiquette[/blue] here in the forums. Again . . . Welcome to [blue]Tek-Tips![/blue] [blue]Its Worthy Reading![/blue]

See Ya! . . . . . .

Be sure to see thread181-473997 [blue]Worthy Reading![/blue]
Also faq181-2886 [blue]Worthy Reading![/blue]

 

[MichaelRed]

a slightly different approach? Primarily it 'resolves' the ambiguity of the possibly missiing initial and final values in the table

Public Function basInterpolateRs()

    Dim dbs As DAO.Database
    Dim rstDates As DAO.Recordset
    Dim rstSeedVals As DAO.Recordset

    Dim iDate As Date               'Inital Date for a sequence
    Dim eDate As Date               'End date for a sequence
    Dim iVal As Single              'Inital value for a sequence
    Dim eVal As Single              'End Value for a sequence
    Dim sglStep() As Single         'Interval / Step for a sequence
    Dim sglSeedVals() As Single     'Values seeded in the rs
    Dim dtSeedDates() As Date       'Values seeded in the rs
    Dim Idx As Integer

    'For Demo purposes, initalize the year _
     and seed some random dates with random values.  To run for production _
     Comment out the following call to basMakeYrDates
    Call basMakeYrDates

    Set dbs = CurrentDb

    'SQL for qry_valDates.  Of course change the table Name to suit.  The table used _
     here is strictly for Demo purposes.  In any production process the field names _
     also need to be associated with the actual table.  Here, the dtDate field is _
     Date type, while the valDate is a single.
    'strSQL = "SELECT dtDate, valDate " _
            & "FROM tblDateSeq " _
            & "WHERE (((valDate) <> 0)) Or " _
            & "(((dtDate) = DateSerial(Year(Date), 1, 1))) Or " _
            & "(((dtDate) = DateSerial(Year(Date), 12, 31))) " _
            & "ORDER BY dtDate;"

    'This is the ordered list of dates with values.  It FORCES the list to _
     include the first and last elements of the list (new years day to start _
     and New Years Eve to end.  Unless these HAPPEN to have values, they _
     will generally be 0 as the interval is assumed (here at least to be numeric).
    Set rstSeedVals = dbs.OpenRecordset("qry_ValDates", dbOpenDynaset)
    rstSeedVals.MoveLast
    rstSeedVals.MoveFirst
    DoEvents

    'Creates a set of local arrays for the dates which have values associated, _
     and the values asociated with the dates.
    Idx = rstSeedVals.RecordCount
    ReDim sglSeedVals(Idx)
    ReDim dtSeedDates(Idx)
    ReDim sglStep(Idx)

    'Get the seed values and their dates from the query
    Idx = 0
    While rstSeedVals.EOF = False
        sglSeedVals(Idx) = rstSeedVals!valDate
        dtSeedDates(Idx) = rstSeedVals!dtDate
        rstSeedVals.MoveNext
        Idx = Idx + 1
    Wend

    'Calculate step values for the intervals
    Idx = 0
    While Idx < UBound(sglSeedVals)
        iDate = dtSeedDates(Idx)
        eDate = dtSeedDates(Idx + 1)
        iVal = sglSeedVals(Idx)
        eVal = sglSeedVals(Idx + 1)

        sglStep(Idx) = (eVal - iVal) / (DateDiff("d", iDate, eDate))
        Idx = Idx + 1
    Wend

    'Show us the step values (not necessary - except to understand)
    Idx = 0
    While Idx < UBound(sglSeedVals)
        Debug.Print Idx, dtSeedDates(Idx), sglSeedVals(Idx), sglStep(Idx)
        Idx = Idx + 1
    Wend
    
    Set rstDates = dbs.OpenRecordset("tblDateSeq", dbOpenDynaset)

    'Using the local arrays, calculate (interpolate) and insert the missing values
    Idx = 0
    While Idx < UBound(sglSeedVals)

        While rstDates!dtDate < dtSeedDates(Idx + 1)
            iVal = iVal + sglStep(Idx)
            rstDates.Edit
                rstDates!valDate = iVal
            rstDates.Update
            rstDates.MoveNext
        Wend
        Idx = Idx + 1
    Wend

End Function
Public Function basMakeYrDates()

    'Just be able to male a list of the dates in a Calendar Year _
     and randomly fill about a Dozen with value fields with apparently _

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim sglRandVal(12) As Single    'Array of random values to insert, randomly
    Dim dtRandVal(12) As Double     'Array of random Dates for the values

    Dim dtStart As Date
    Dim dtCurr As Date
    Dim dtEnd As Date
    Dim intRange As Integer
    Dim intDays As Integer                      'Days in the Year [365 | 366]
    Dim Idx As Integer
    Dim strCriteria As String
    
    dtCurr = DateSerial(Year(Date), 1, 1)       '1/1/this year
    dtStart = dtCurr
    dtEnd = DateSerial(Year(Date), 12, 31)      '12/31/thisYear
    intDays = DateDiff("d", dtCurr, dtEnd)
    intRange = (dtEnd - dtCurr + 1)

    'Get the random values
    Randomize
    While Idx < UBound(sglRandVal)
        sglRandVal(Idx) = Rnd() * intDays
        dtRandVal(Idx) = CLng(intRange * Rnd())
        Idx = Idx + 1
    Wend

    DoCmd.SetWarnings False
        DoCmd.RunSQL "Delete * From tblDateSeq;"
    DoCmd.SetWarnings False

    Set dbs = CurrentDb
    Set rst = dbs.OpenRecordset("tblDateSeq", dbOpenDynaset)

    With rst
        While dtCurr <= dtEnd
            .AddNew
                !dtDate = dtCurr
            .Update
            dtCurr = DateAdd("d", 1, dtCurr)
        Wend
        DoEvents
    End With

    Idx = 0
    While Idx <= UBound(sglRandVal)
        strCriteria = "[dtDate] = " & Chr(35) & DateAdd("d", dtRandVal(Idx), dtStart) & Chr(35)
        rst.FindFirst strCriteria
        If (rst.NoMatch = False) Then
            rst.Edit
                rst!valDate = sglRandVal(Idx)
            rst.Update
         Else
            Stop
        End If
        Idx = Idx + 1
    Wend

End Function

MichaelRed