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
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
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