Search code examples
excelvbatrigonometryfrequencyphase

Continuous sine wave despite the abrupt changes in frequency


I have a working VBA code that generates a sine wave given the constant amplitude and RPM. The problem is that the RPM changes abruptly n times within the whole dataset, whereas in between it is constant. This abrupt change interrupts the continuity of my sine wave.

Does anyone have an idea how to make my sine wave continuous despite the abrupt changes in RPM? I.e., the frequency of the sine wave should change while the amplitude remains constant. Thank you in advance!

Sub CalcStroke()

Dim i, Stroke As Long
Dim Pi As Double
Dim Time, RPM, Wave As Variant

Pi = WorksheetFunction.Pi()

Time = Range(Cells(3, 9), Cells(3, 9).End(xlDown))
RPM = Range(Cells(3, 10), Cells(3, 10).End(xlDown))
Stroke = Cells(3, 7)

Wave = Cells(3, 5).Resize(UBound(Time, 1), 1)

For i = LBound(Time) To UBound(Time)

    Wave(i, 1) = 0.5 * Stroke * Sin(2 * Pi * RPM(i, 1) / 60 * Time(i, 1))

Next i

Cells(3, 5).Resize(UBound(Time, 1), 1) = Wave

End Sub

The discontinued sine wave

Based on some online research, I tried to adopt a technique called phase continuity, but unsuccessfuly. The code results in an extremly frequent change in frequency of the sine wave.

Sub PhaseContinuity()

    Dim i, Stroke As Long
    Dim Pi, PreviousPhase, CurrentPhase, PhaseAdjustment As Double
    Dim Time, RPM, Wave As Variant

    Pi = WorksheetFunction.Pi()

    Time = Range(Cells(3, 9), Cells(3, 9).End(xlDown))
    RPM = Range(Cells(3, 10), Cells(3, 10).End(xlDown))
    Stroke = Cells(3, 7)

    Wave = Cells(3, 5).Resize(UBound(Time, 1), 1)

    'Initialize the phases
    PreviousPhase = 0
    CurrentPhase = 0

    For i = LBound(Time) To UBound(Time)
        'Calculate the phase adjustment based on RPM change
        CurrentPhase = (2 * Pi * RPM(i, 1) / 60 * Time(i, 1)) + PreviousPhase
        Dim PhaseAdjustment As Double
        If i > LBound(Time) Then
            ' Ensure phase continuity by adjusting for phase jumps
            PhaseAdjustment = CurrentPhase - PreviousPhase
            If PhaseAdjustment > Pi Then
                PhaseAdjustment = PhaseAdjustment - 2 * Pi
            ElseIf PhaseAdjustment < -Pi Then
                PhaseAdjustment = PhaseAdjustment + 2 * Pi
            End If
        End If
        'Update the phase for the next iteration
        PreviousPhase = CurrentPhase + PhaseAdjustment

        'Calculate the new sine wave value using adjusted phase
        Wave(i, 1) = 0.5 * Stroke * Sin(CurrentPhase + PhaseAdjustment)
    Next i

    Cells(3, 5).Resize(UBound(Time, 1), 1) = Wave

End Sub

Solution

  • I found a solution to my problem by getting rid of the differences (jumps) in the phase function (orange line). The jump appears when the RPM changes. Once the phase becomes a continuous (piecewise linear) function, the displacement will be continuous too. Here's the working VBA code for the continuous phase and displacement:

    Sub Phase_Cosine()
    
    Dim threshold, diff(), diffs(), Pi, Stroke As Double
    Dim Time, RPM, Phase, Cosine As Variant
    Dim i, k, lastRow, idx() As Long
    
    Pi = WorksheetFunction.Pi()
    
    threshold = 1
    
    Time = Range(Cells(3, 9), Cells(3, 9).End(xlDown)).Value
    RPM = Range(Cells(3, 10), Cells(3, 10).End(xlDown)).Value
    Stroke = Cells(3, 7)
    
    lastRow = UBound(Time)
    
    ReDim Phase(1 To lastRow, 1 To 1), Cosine(1 To lastRow, 1 To 1)
    For i = 1 To lastRow
        Phase(i, 1) = 2 * Pi * RPM(i, 1) / 60 * Time(i, 1)
        Cosine(i, 1) = 0.5 * Stroke * Cos(Phase(i, 1))
    Next i
    
    ReDim diff(2 To lastRow)
    For i = 3 To lastRow
        diff(i) = Phase(i, 1) - Phase(i - 1, 1)
    Next i
    
    k = 1
    For i = 3 To lastRow
        If Abs(diff(i)) > threshold Then
            ReDim Preserve diffs(k)
            ReDim Preserve idx(k)
            diffs(k) = diff(i)
            idx(k) = i
            k = k + 1
        End If
    Next i
    
    For k = 1 To UBound(idx)
        For i = idx(k) To lastRow
            Phase(i, 1) = Phase(i, 1) - diffs(k)
        Next i
    Next k
    
    For i = 1 To lastRow
        Cosine(i, 1) = 0.5 * Stroke * Cos(Phase(i, 1))
    Next i
    
    Range("E3:E" & lastRow + 2).Value = Phase
    Range("F3:F" & lastRow + 2).Value = Cosine
    
    End Sub
    

    Discontinuous Continuous