Advertisement
Janilabo

fix?

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