API tools faq
paste
Janilabo

Clustering

Janilabo
Sep 24th, 2013
53
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 11.10 KB | None | 0 0
raw download clone embed print report
  1. {==============================================================================]
  2.  Splits TPA with dist. Alternative to SplitTPA.
  3. [==============================================================================}
  4. function ClusterTPA(TPA: TPointArray; dist: Extended): T2DPointArray;
  5. type
  6.   TPointScan = record
  7.     skipRow: Boolean;
  8.     count: Integer;
  9.   end;
  10. var
  11.   h, i, l, c, s, x, y, o, r, d, m: Integer;
  12.   p: array of array of TPointScan;
  13.   q: TPointArray;
  14.   a, b, t: TBox;
  15.   e: Extended;
  16.   z: TPoint;
  17.   v: Boolean;
  18. begin
  19.   SetLength(Result, 0);
  20.   h := High(TPA);
  21.   if (h > -1) then
  22.     if (h > 0) then
  23.     begin
  24.       b.X1 := TPA[0].X;
  25.       b.Y1 := TPA[0].Y;
  26.       b.X2 := TPA[0].X;
  27.       b.Y2 := TPA[0].Y;
  28.       r := 0;
  29.       for i := 1 to h do
  30.       begin
  31.         if (TPA[i].X < b.X1) then
  32.           b.X1 := TPA[i].X
  33.         else
  34.           if (TPA[i].X > b.X2) then
  35.             b.X2 := TPA[i].X;
  36.         if (TPA[i].Y < b.Y1) then
  37.           b.Y1 := TPA[i].Y
  38.         else
  39.           if (TPA[i].Y > b.Y2) then
  40.             b.Y2 := TPA[i].Y;
  41.       end;
  42.       SetLength(p, ((b.X2 - b.X1) + 1));
  43.       for i := 0 to (b.X2 - b.X1) do
  44.       begin
  45.         SetLength(p[i], ((b.Y2 - b.Y1) + 1));
  46.         for c := 0 to (b.Y2 - b.Y1) do
  47.         begin
  48.           p[i][c].count := 0;
  49.           p[i][c].skipRow := False;
  50.         end;
  51.       end;
  52.       if (dist < 0.0) then
  53.         dist := 0.0;
  54.       d := Ceil(dist);
  55.       m := Max(((b.X2 - b.X1) + 1), ((b.Y2 - b.Y1) + 1));
  56.       if (d > m) then
  57.         d := m;
  58.       for i := 0 to h do
  59.         Inc(p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count);
  60.       for i := 0 to h do
  61.         if (p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count > 0) then
  62.         begin
  63.           c := Length(Result);
  64.           SetLength(Result, (c + 1));
  65.           SetLength(Result[c], p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count);
  66.           for o := 0 to (p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count - 1) do
  67.             Result[c][o] := TPA[i];
  68.           r := (r + p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count);
  69.           if (r > h) then
  70.             Exit;
  71.           SetLength(q, 1);
  72.           q[0] := TPA[i];
  73.           p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count := 0;
  74.           s := 1;
  75.           while (s > 0) do
  76.           begin
  77.             s := High(q);
  78.             z := q[s];
  79.             a.X1 := (z.X - d);
  80.             a.Y1 := (z.Y - d);
  81.             a.X2 := (z.X + d);
  82.             a.Y2 := (z.Y + d);
  83.             t := a;
  84.             SetLength(q, s);
  85.             if (a.X1 < b.X1) then
  86.               a.X1 := b.X1
  87.             else
  88.               if (a.X1 > b.X2) then
  89.                 a.X1 := b.X2;
  90.             if (a.Y1 < b.Y1) then
  91.               a.Y1 := b.Y1
  92.             else
  93.               if (a.Y1 > b.Y2) then
  94.                 a.Y1 := b.Y2;
  95.             if (a.X2 < b.X1) then
  96.               a.X2 := b.X1
  97.             else
  98.               if (a.X2 > b.X2) then
  99.                 a.X2 := b.X2;
  100.             if (a.Y2 < b.Y1) then
  101.               a.Y2 := b.Y1
  102.             else
  103.               if (a.Y2 > b.Y2) then
  104.                 a.Y2 := b.Y2;
  105.             case ((t.X1 <> a.X1) or (t.X2 <> a.X2)) of
  106.               True:
  107.               for y := a.Y1 to a.Y2 do
  108.                 if not p[(a.X2 - b.X1)][(y - b.Y1)].skipRow then
  109.                 for x := a.X1 to a.X2 do
  110.                   if (p[(x - b.X1)][(y - b.Y1)].count > 0) then
  111.                   begin
  112.                     e := Sqrt(Sqr(z.X - x) + Sqr(z.Y - y));
  113.                     if (e <= dist) then
  114.                     begin
  115.                       l := Length(Result[c]);
  116.                       SetLength(Result[c], (l + p[(x - b.X1)][(y - b.Y1)].count));
  117.                       for o := 0 to (p[(x - b.X1)][(y - b.Y1)].count - 1) do
  118.                       begin
  119.                         Result[c][(l + o)].X := x;
  120.                         Result[c][(l + o)].Y := y;
  121.                       end;
  122.                       r := (r + p[(x - b.X1)][(y - b.Y1)].count);
  123.                       if (r > h) then
  124.                         Exit;
  125.                       p[(x - b.X1)][(y - b.Y1)].count := 0;
  126.                       SetLength(q, (s + 1));
  127.                       q[s] := Result[c][l];
  128.                       Inc(s);
  129.                     end;
  130.                   end;
  131.               False:
  132.               for y := a.Y1 to a.Y2 do
  133.                 if not p[(a.X2 - b.X1)][(y - b.Y1)].skipRow then
  134.                 begin
  135.                   v := True;
  136.                   for x := a.X1 to a.X2 do
  137.                     if (p[(x - b.X1)][(y - b.Y1)].count > 0) then
  138.                     begin
  139.                       e := Sqrt(Sqr(z.X - x) + Sqr(z.Y - y));
  140.                       if (e <= dist) then
  141.                       begin
  142.                         l := Length(Result[c]);
  143.                         SetLength(Result[c], (l + p[(x - b.X1)][(y - b.Y1)].count));
  144.                         for o := 0 to (p[(x - b.X1)][(y - b.Y1)].count - 1) do
  145.                         begin
  146.                           Result[c][(l + o)].X := x;
  147.                           Result[c][(l + o)].Y := y;
  148.                         end;
  149.                         r := (r + p[(x - b.X1)][(y - b.Y1)].count);
  150.                         if (r > h) then
  151.                           Exit;
  152.                         p[(x - b.X1)][(y - b.Y1)].count := 0;
  153.                         SetLength(q, (s + 1));
  154.                         q[s] := Result[c][l];
  155.                         Inc(s);
  156.                       end else
  157.                         v := False;
  158.                     end;
  159.                   if v then
  160.                     p[(a.X2 - b.X1)][(y - b.Y1)].skipRow := True;
  161.                 end;
  162.             end;
  163.           end;
  164.         end;
  165.     end else
  166.     begin
  167.       SetLength(Result, 1);
  168.       SetLength(Result[0], 1);
  169.       Result[0][0] := TPA[0];
  170.     end;
  171. end;
  172.  
  173. {==============================================================================]
  174.  Splits TPA with width, height (alternative for SplitTPAEx).
  175. [==============================================================================}
  176. function ClusterTPAEx(TPA: TPointArray; width, height: Integer): T2DPointArray;
  177. type
  178.   TPointScan = record
  179.     skipRow: Boolean;
  180.     count: Integer;
  181.   end;
  182. var
  183.   h, i, l, c, s, x, y, o, r, dw, dh: Integer;
  184.   p: array of array of TPointScan;
  185.   q: TPointArray;
  186.   a, b, t: TBox;
  187.   z: TPoint;
  188. begin
  189.   SetLength(Result, 0);
  190.   h := High(TPA);
  191.   if (((width > 0) and (height > 0)) and (h > -1)) then
  192.     if (h > 0) then
  193.     begin
  194.       dw := width;
  195.       dh := height;
  196.       b.X1 := TPA[0].X;
  197.       b.Y1 := TPA[0].Y;
  198.       b.X2 := TPA[0].X;
  199.       b.Y2 := TPA[0].Y;
  200.       r := 0;
  201.       for i := 1 to h do
  202.       begin
  203.         if (TPA[i].X < b.X1) then
  204.           b.X1 := TPA[i].X
  205.         else
  206.           if (TPA[i].X > b.X2) then
  207.             b.X2 := TPA[i].X;
  208.         if (TPA[i].Y < b.Y1) then
  209.           b.Y1 := TPA[i].Y
  210.         else
  211.           if (TPA[i].Y > b.Y2) then
  212.             b.Y2 := TPA[i].Y;
  213.       end;
  214.       SetLength(p, ((b.X2 - b.X1) + 1));
  215.       for i := 0 to (b.X2 - b.X1) do
  216.       begin
  217.         SetLength(p[i], ((b.Y2 - b.Y1) + 1));
  218.         for c := 0 to (b.Y2 - b.Y1) do
  219.         begin
  220.           p[i][c].count := 0;
  221.           p[i][c].skipRow := False;
  222.         end;
  223.       end;
  224.       if (dw > ((b.X2 - b.X1) + 1)) then
  225.         dw := ((b.X2 - b.X1) + 1);
  226.       if (dh > ((b.Y2 - b.Y1) + 1)) then
  227.         dh := ((b.Y2 - b.Y1) + 1);
  228.       for i := 0 to h do
  229.         Inc(p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count);
  230.       for i := 0 to h do
  231.         if (p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count > 0) then
  232.         begin
  233.           c := Length(Result);
  234.           SetLength(Result, (c + 1));
  235.           SetLength(Result[c], p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count);
  236.           for o := 0 to (p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count - 1) do
  237.             Result[c][o] := TPA[i];
  238.           r := (r + p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count);
  239.           if (r > h) then
  240.             Exit;
  241.           SetLength(q, 1);
  242.           q[0] := TPA[i];
  243.           p[(TPA[i].X - b.X1)][(TPA[i].Y - b.Y1)].count := 0;
  244.           s := 1;
  245.           while (s > 0) do
  246.           begin
  247.             s := High(q);
  248.             z := q[s];
  249.             a.X1 := (z.X - dw);
  250.             a.Y1 := (z.Y - dh);
  251.             a.X2 := (z.X + dw);
  252.             a.Y2 := (z.Y + dh);
  253.             t := a;
  254.             SetLength(q, s);
  255.             if (a.X1 < b.X1) then
  256.               a.X1 := b.X1
  257.             else
  258.               if (a.X1 > b.X2) then
  259.                 a.X1 := b.X2;
  260.             if (a.Y1 < b.Y1) then
  261.               a.Y1 := b.Y1
  262.             else
  263.               if (a.Y1 > b.Y2) then
  264.                 a.Y1 := b.Y2;
  265.             if (a.X2 < b.X1) then
  266.               a.X2 := b.X1
  267.             else
  268.               if (a.X2 > b.X2) then
  269.                 a.X2 := b.X2;
  270.             if (a.Y2 < b.Y1) then
  271.               a.Y2 := b.Y1
  272.             else
  273.               if (a.Y2 > b.Y2) then
  274.                 a.Y2 := b.Y2;
  275.             case ((t.X1 <> a.X1) or (t.X2 <> a.X2)) of
  276.               True:
  277.               for y := a.Y1 to a.Y2 do
  278.                 if not p[(a.X2 - b.X1)][(y - b.Y1)].skipRow then
  279.                 for x := a.X1 to a.X2 do
  280.                   if (p[(x - b.X1)][(y - b.Y1)].count > 0) then
  281.                   begin
  282.                     l := Length(Result[c]);
  283.                     SetLength(Result[c], (l + p[(x - b.X1)][(y - b.Y1)].count));
  284.                     for o := 0 to (p[(x - b.X1)][(y - b.Y1)].count - 1) do
  285.                     begin
  286.                       Result[c][(l + o)].X := x;
  287.                       Result[c][(l + o)].Y := y;
  288.                     end;
  289.                     r := (r + p[(x - b.X1)][(y - b.Y1)].count);
  290.                     if (r > h) then
  291.                       Exit;
  292.                     p[(x - b.X1)][(y - b.Y1)].count := 0;
  293.                     SetLength(q, (s + 1));
  294.                     q[s] := Result[c][l];
  295.                     Inc(s);
  296.                   end;
  297.               False:
  298.               for y := a.Y1 to a.Y2 do
  299.                 if not p[(a.X2 - b.X1)][(y - b.Y1)].skipRow then
  300.                 begin
  301.                   for x := a.X1 to a.X2 do
  302.                     if (p[(x - b.X1)][(y - b.Y1)].count > 0) then
  303.                     begin
  304.                       l := Length(Result[c]);
  305.                       SetLength(Result[c], (l + p[(x - b.X1)][(y - b.Y1)].count));
  306.                       for o := 0 to (p[(x - b.X1)][(y - b.Y1)].count - 1) do
  307.                       begin
  308.                         Result[c][(l + o)].X := x;
  309.                         Result[c][(l + o)].Y := y;
  310.                       end;
  311.                       r := (r + p[(x - b.X1)][(y - b.Y1)].count);
  312.                       if (r > h) then
  313.                         Exit;
  314.                       p[(x - b.X1)][(y - b.Y1)].count := 0;
  315.                       SetLength(q, (s + 1));
  316.                       q[s] := Result[c][l];
  317.                       Inc(s);
  318.                     end;
  319.                   p[(a.X2 - b.X1)][(y - b.Y1)].skipRow := True;
  320.                 end;
  321.             end;
  322.           end;
  323.         end;
  324.     end else
  325.     begin
  326.       SetLength(Result, 1);
  327.       SetLength(Result[0], 1);
  328.       Result[0][0] := TPA[0];
  329.     end;
  330. end;
Advertisement
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!