This is a Visual basic application

'////////////////////////////////////////////////////////////
'////////// DO NOT DISTRIBUTE WITHOUT PERMISSION
'////////// Wit C. Bushko 8*833 5674
'////////////////////////////////////////////////////////////
Option Explicit
'
Private Const MIN_DISTX = 0.0001
Private Const MIN_DISTY = 0.0001
'
Private Type LineFit
    A As Double
    b As Double
    x1 As Double
    x2 As Double
    q As Double
End Type
'--------------------------------------------------------------------------------
Public Sub CompressData(RawData() As Double, CompData() As Double, _
                ByVal DistX As Double, ByVal DistY As Double)
'------
' CompressData finds a multilinear fit to a series of points.
' Input:
'   RawData(i,j)  - coordinate x (i=0), and coordinate y,(i=1) of the jth point (j=0,1,2,...,n)
'                   of raw data.
'   DistX         - parameter defining the accuracy of x coordinate fit.
'   DistY         - parameter defining the accuracy of y coordinate fit.
' Output:
'   CompData(i,j) - coordinate x (i=0), and coordinate y,(i=1) of jth point (j=0,1,2,...,n)
'                   of compressed data.
'
'------
    Dim n1 As Long
    Dim n2 As Long
    Dim n, Mx As Long
    Dim A As Double
    Dim b As Double
    Dim Seg() As LineFit
    Dim i As Integer
    Dim y1, y2, ymax, ymin As Double
    Dim NorD As Double
'---
    If DistX < MIN_DISTX Then DistX = MIN_DISTX
    If DistY < MIN_DISTY Then DistX = MIN_DISTY
'
    Mx = UBound(RawData, 2)
'
    n = -1
    n1 = 0
    Do
        LinearFit RawData(), n1, n2, DistX, DistY, A, b, NorD
'
        n = n + 1: ReDim Preserve Seg(n)
        Seg(n).A = A
        Seg(n).b = b
        Seg(n).x1 = RawData(0, n1)
        Seg(n).x2 = RawData(0, n2)
        Seg(n).q = NorD
        If n2 = Mx Then Exit Do
        n1 = n2
    Loop
'-------
    ReDim CompData(1, n + 1)
    CompData(0, 0) = Seg(0).x1
    CompData(1, 0) = Seg(0).A * Seg(0).x1 + Seg(0).b
    For i = 1 To n
        CompData(0, i) = Seg(i).x1
        y1 = Seg(i - 1).A * CompData(0, i) + Seg(i - 1).b + Seg(i - 1).q
        y2 = Seg(i).A * CompData(0, i) + Seg(i).b + Seg(i).q
        If y1 < y2 Then ymax = y1 Else ymax = y2
        y1 = Seg(i - 1).A * CompData(0, i) + Seg(i - 1).b - Seg(i - 1).q
        y2 = Seg(i).A * CompData(0, i) + Seg(i).b - Seg(i).q
        If y1 > y2 Then ymin = y1 Else ymin = y2
        CompData(1, i) = (ymin + ymax) / 2#
    Next
    CompData(0, n + 1) = Seg(n).x2
    CompData(1, n + 1) = Seg(n).A * Seg(n).x2 + Seg(n).b
'---
End Sub
'--------------------------------------------------------------------------------
Private Sub LinearFit(y() As Double, nmin As Long, nmax As Long, _
                ByVal DistX As Double, ByVal DistY As Double, _
                A As Double, b As Double, NorD As Double)
'---
    Dim Flg As Boolean
    Dim i, n1, n2, Mx, m, Dn, q As Long
    Dim Sx, Sxx, Sy, Sxy As Double
    Dim MaxD As Double
'---
    Mx = UBound(y, 2)
'
    Sx = y(0, nmin): Sxx = y(0, nmin) * y(0, nmin)
    Sy = y(1, nmin)
    Sxy = y(0, nmin) * y(1, nmin)
'
    nmax = nmin
    Dn = 1
    n1 = nmax + 1
    nmax = nmax + Dn
    n2 = nmax
    q = 1
'-------
    Do
        For i = n1 To n2
            Sx = Sx + q * y(0, i): Sxx = Sxx + q * y(0, i) * y(0, i)
            Sy = Sy + q * y(1, i)
            Sxy = Sxy + q * y(0, i) * y(1, i)
        Next
        m = nmax - nmin + 1
        A = (m * Sxy - Sx * Sy) / (m * Sxx - Sx * Sx)
        b = (Sxx * Sy - Sx * Sxy) / (m * Sxx - Sx * Sx)
'-------
        NorD = Sqr(DistX * DistX * A * A + DistY * DistY)
        MaxD = MaxDistance(y(), nmin, nmax, A, b)
'-------
        If NorD > MaxD Then
            If Flg Then
                If Dn = 1 Then Exit Sub
                Dn = Dn / 2
            Else
                Dn = 2 * Dn
                Do While nmax + Dn > Mx
                    If Dn = 1 Then Exit Sub
                    Dn = Dn / 2
                Loop
            End If
            n1 = nmax + 1
            nmax = nmax + Dn
            n2 = nmax
            q = 1
        Else
            Flg = True
            If Dn > 1 Then Dn = Dn / 2
            n2 = nmax
            nmax = nmax - Dn
            n1 = nmax + 1
            q = -1
        End If
    Loop
'---
End Sub
'--------------------------------------------------------------------------------
Private Function MaxDistance(f() As Double, _
                                n1 As Long, n2 As Long, _
                                A As Double, b As Double) As Double
'---
    Dim i As Integer
    Dim d As Double
'---
    MaxDistance = 0#
    For i = n1 To n2
        d = Abs(A * f(0, i) + b - f(1, i))
        If d > MaxDistance Then MaxDistance = d
    Next
'---
End Function
'--------------------------------------------------------------------------------