如何从graphics数据中删除所有可以线性插入的点?

如果在Excel中给出了两列graphics数据,那么它如何能够“不插入” – 即压缩到产生相同线图的最less行数?

一个简单的例子:

xy 1 4 2 5 3 6 4 3 5 0 

会成为:

 xy 1 4 3 6 5 0 

…因为这将产生完全相同的线条,但“中间”点被删除。

是否有一个现有的macros,加载项,在线工具等可以用来产生这样的结果 – 如果不是,也许有人可以发明这样的algorithm?

编辑:对于一个现实世界的例子,下面的图是使用WebPlotDigitizer反向工程。 粉红色的点标记的点,可能不完全转换为浮点值 – 如此理想的algorithm将包括一个小的“误差余量”来解释这一点。

图形

你能试试吗?

 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坐标sorting,我们只需要保持斜率变化的点。 因此,只要斜率在两个连续对(A,B)(B,C)中不变, B就可以被移除,因为它与(A,C)在同一行。 我们只需要检查斜率就是因为数据是按xsorting的,所以我们知道x_A <= x_B <= x_C

对于给定的例子, input:

在这里输入图像说明

输出:

在这里输入图像说明

我希望这有帮助!