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

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。

对于给定的示例， 输入：

输出：

我希望这有帮助！