1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
| {
Copyright © 2019-2022 Angus Johnson
Freeware released under Boost Software License
https://www.boost.org/LICENSE_1_0.txt
//------------------------------------------------------------------------------
// RamerDouglasPeucker - and support functions
//------------------------------------------------------------------------------ }
type
TPathD = array of TPoint;
TArrayOfInteger = array of integer;
function PerpendicularDistSqrd(const pt, l1, line2: TPoint): double;
var
a,b,c,d: double;
begin
a := pt.X - l1.X;
b := pt.Y - l1.Y;
c := line2.X - l1.X;
d := line2.Y - l1.Y;
if (c = 0) and (d = 0) then
result := 0 else
result := Sqr(a * d - c * b) / (c * c + d * d);
end;
procedure RDP(const path: TPathD; startIdx, endIdx: integer;
epsilonSqrd: double; var flags: TArrayOfInteger);
var
i, idx: integer;
d, maxD: double;
begin
idx := 0;
maxD := 0;
for i := startIdx +1 to endIdx -1 do
begin
//PerpendicularDistSqrd - avoids expensive Sqrt()
d := PerpendicularDistSqrd(path[i], path[startIdx], path[endIdx]);
if d <= maxD then Continue;
maxD := d;
idx := i;
end;
if maxD < epsilonSqrd then Exit;
flags[idx] := 1;
if idx > startIdx + 1 then RDP(path, startIdx, idx, epsilonSqrd, flags);
if endIdx > idx + 1 then RDP(path, idx, endIdx, epsilonSqrd, flags);
end;
//------------------------------------------------------------------------------
function RamerDouglasPeucker(const path: TPathD;
epsilon: double): TPathD;
var
i,j, len: integer;
buffer: TArrayOfInteger;
begin
len := length(path);
if len < 5 then
begin
result := Copy(path, 0, len);
Exit;
end;
SetLength(buffer, len); //buffer is zero initialized
buffer[0] := 1;
buffer[len -1] := 1;
RDP(path, 0, len -1, Sqr(epsilon), buffer);
j := 0;
SetLength(Result, len);
for i := 0 to len -1 do
if buffer[i] = 1 then
begin
Result[j] := path[i];
inc(j);
end;
SetLength(Result, j);
end; |
