如何删除可以从图形数据线性插值的所有点？

Question

在Excel中给出两列图形数据，如何进行“非插值” - 即压缩到产生相同折线图的最少行数？

一个简单的例子：

x    y
1    4
2    5
3    6
4    3
5    0

会变成：

x    y
1    4
3    6
5    0

...因为这会产生完全相同的线条，但删除了“中间”点。

是否存在可用于产生此类结果的现有宏，加载项，在线工具等 - 如果没有，也许有人可能会发明这样的算法？

编辑：对于实际示例，下图是使用WebPlotDigitizer进行逆向工程的。粉红点标记了点，这些点可能没有完美地转换为浮点值 - 所以理想情况下算法会包含一个小的“误差范围”来解释这一点。

Answer 1

你能试试吗？

Sub RemoveLinearlyDependentPoints()

    Dim rngX As Range, rngY As Range, rngData As Range, rngRemove As Range
    Dim lCount As Long, dSlope1 As Double, dSlope2 As Double
    Dim varX As Variant, varY As Variant
    Const EPSILON = 0.0001

    ' Change ranges as needed
    Set rngX = Range("A1:A5")
    Set rngY = Range("B1:B5")
    Set rngData = Union(rngX, rngY)

    rngData.Sort key1:=rngX, Order1:=xlAscending

    ' Working with arrays instead of ranges is faster,
    ' can make a big different for large datasets
    varX = rngX.Value
    varY = rngY.Value

    With WorksheetFunction
        For lCount = 1 To rngX.Count - 2
            dSlope1 = .Slope(Array(varX(lCount, 1), varX(lCount + 1, 1)), Array(varY(lCount, 1), varY(lCount + 1, 1)))
            dSlope2 = .Slope(Array(varX(lCount + 1, 1), varX(lCount + 2, 1)), Array(varY(lCount + 1, 1), varY(lCount + 2, 1)))
            ' If slopes are the same, point in row lCount+1 can be removed
            If Abs(dSlope1 - dSlope2) < EPSILON Then
                If Not rngRemove Is Nothing Then
                    Set rngRemove = Union(rngRemove, .Index(rngData, lCount + 1, 0))
                Else
                    Set rngRemove = .Index(rngData, lCount + 1, 0)
                End If
            End If
        Next lCount
    End With

    ' Mark the cells red for checking
    rngRemove.Cells.Interior.Color = vbRed
    ' Uncomment the below to delete the cells
    'rngRemove.EntireRow.Delete (xlUp)
End Sub

我们的想法是，如果数据按照x坐标进行排序，我们只需要保留斜率变化的点。因此，只要斜率在两个连续的(A,B)和(B,C)对中没有变化，就可以删除B，因为它与(A,C)位于同一行。我们只需检查斜率，因为数据是按照x进行排序的，因此我们知道x_A <= x_B <= x_C。

对于给定的例子， 的输入

<强>输出：

我希望这有帮助！