Continuous sine wave despite the abrupt changes in frequency

87 Views Asked by At

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
1

There are 1 best solutions below

0
Fevzi On BEST ANSWER

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