poj1696 Space Ant 2012-01-11

Posted 2020-06-17

http://poj.org/problem?id=1696

 

__________________________________

类似求凸包。满足一定可以经过所有点。

__________________________________

  1 Program stone;
  2 type coord=record
  3                x,y,num:longint;
  4            end;
  5 var i,j,m,n,ax,le,heap:longint;
  6     a:array[0..500]of coord;
  7     f:array[0..500]of boolean;
  8     stack,b:array[1..500]of longint;
  9  Procedure kp(t,w:longint);
 10  var i,j:longint;
 11      k,mid:coord;
 12   begin
 13     i:=t;j:=w;mid:=a[(i+j)div 2];
 14     repeat
 15       while (a[i].x<mid.x)or((a[i].x=mid.x)and(a[i].y<mid.y)) do inc(i);
 16       while (a[j].x>mid.x)or((a[j].x=mid.x)and(a[j].y>mid.y)) do dec(j);
 17       if i<=j then begin
 18                        k:=a[i];a[i]:=a[j];a[j]:=k;
 19                        inc(i);dec(j);
 20                    end;
 21     until i>j;
 22     if i<w then kp(i,w);
 23     if j>t then kp(t,j);
 24   end;
 25  Procedure Init;
 26  var i,j,k:longint;
 27   begin
 28     readln(n);
 29     a[0].y:=maxint;
 30     for i:=1 to n do
 31       begin
 32          readln(a[i].num,a[i].x,a[i].y);
 33          if a[i].y<a[0].y then a[0].y:=a[i].y;
 34       end;
 35   end;
 36  function cross(o1,o2,o3:longint):longint;
 37   begin
 38     cross:=(a[o2].x-a[o1].x)*(a[o3].y-a[o1].y)-(a[o2].y-a[o1].y)*(a[o3].x-a[o1].x);
 39   end;
 40  Procedure rightgo;     //向右找凸壳
 41  var i,j:longint;
 42   begin
 43      le:=1;stack[1]:=heap;
 44      for i:=0 to n do
 45       if f[i] then
 46         begin
 47             while (le>1)and(cross(stack[le-1],stack[le],i)<0)do begin
 48                                                                   f[stack[le]]:=true;
 49                                                                   dec(le);
 50                                                                 end;
 51             inc(le);stack[le]:=i;
 52             f[i]:=false;
 53         end;
 54      for i:=2 to le do
 55       begin
 56         inc(ax);b[ax]:=stack[i];
 57       end;
 58      heap:=stack[le];
 59   end;
 60  Procedure leftgo;   //向左找凸壳。
 61  var i,j:longint;
 62   begin
 63      le:=1;stack[1]:=heap;
 64      for i:=n downto 0 do
 65       if f[i] then
 66         begin
 67             while (le>1)and(cross(stack[le-1],stack[le],i)<0)do begin
 68                                                                   f[stack[le]]:=true;
 69                                                                   dec(le);
 70                                                                 end;
 71             inc(le);stack[le]:=i;
 72             f[i]:=false;
 73         end;
 74      for i:=2 to le do
 75       begin
 76         inc(ax);b[ax]:=stack[i];
 77       end;
 78      heap:=stack[le];
 79   end;
 80  Procedure main;
 81  var i,j,k:longint;
 82   begin
 83      fillchar(f,sizeof(f),true);
 84      ax:=0;i:=0;
 85      heap:=0;f[0]:=false;
 86      while ax<n do
 87       begin
 88         inc(i);
 89         if i mod 2=0 then leftgo
 90                      else rightgo;
 91       end;
 92   end;
 93 Begin
 94  assign(input,‘input.in‘);reset(input);
 95    readln(m);
 96    for i:=1 to m do
 97     begin
 98       init;
 99       kp(1,n);
100       main;
101       write(ax,‘ ‘);
102       for j:=1 to ax do
103        write(a[b[j]].num,‘ ‘);
104       writeln;
105     end;
106 end.
107 
108