实现功能:求出二维平面内一对散点的凸包(详见Codevs 1298)
很神奇的算法——先将各个点按坐标排序,然后像我们所知的那样一路左转,求出半边的凸包,然后反过来求另一半的凸包
我以前正是因为总抱着想一步到位的想法,所以每次都跪得很惨(HansBug:事实上这次是我这辈子第一次A掉凸包题)
然后别的没了,就是凸包的基本思想
(顺便输出凸包周长C和面积S)
1 type arr=array[0..100005] of longint; 2 var 3 i,j,k,l,m,n,m1,m2:longint; 4 a:array[0..100005,1..2] of longint; 5 b,c,d:arr;ans,are:extended; 6 procedure swap(var x,y:longint); 7 var z:longint; 8 begin 9 z:=x;x:=y;y:=z; 10 end; 11 procedure sort(l,r:longint); 12 var i,j,x,y:longint; 13 begin 14 i:=l;j:=r;x:=a[(l+r) div 2,1];y:=a[(l+r) div 2,2]; 15 repeat 16 while (a[i,1]or ((a[i,1]=x) and (a[i,2] do inc(i); 17 while (a[j,1]>x) or ((a[j,1]=x) and (a[j,2]>y)) do dec(j); 18 if i<=j then 19 begin 20 swap(a[i,1],a[j,1]); 21 swap(a[i,2],a[j,2]); 22 inc(i);dec(j); 23 end; 24 until i>j; 25 if i then sort(i,r); 26 if l then sort(l,j); 27 end; 28 function right(x1,y1,x2,y2:longint):boolean; 29 begin 30 exit((x1*y2)>(x2*y1)); 31 end; 32 function trip(x1,y1,x2,y2,x3,y3:longint):boolean; 33 begin 34 exit(right(x2-x1,y2-y1,x3-x2,y3-y2)); 35 end; 36 function check(x,y,z:longint):boolean; 37 begin 38 exit(trip(a[x,1],a[x,2],a[y,1],a[y,2],a[z,1],a[z,2])); 39 end; 40 procedure doit(var b:arr;var m:longint); 41 begin 42 b[1]:=d[1];b[2]:=d[2];j:=2; 43 for i:=3 to n do 44 begin 45 while (j>1) and not(check(b[j-1],b[j],d[i])) do dec(j); 46 inc(j);b[j]:=d[i]; 47 end; 48 m:=j; 49 end; 50 begin 51 readln(n); 52 for i:=1 to n do readln(a[i,1],a[i,2]); 53 sort(1,n);j:=1; 54 for i:=2 to n do //去重 55 begin 56 if (a[i,1]<>a[j,1]) or (a[i,2]<>a[j,2]) then 57 begin 58 inc(j); 59 a[j,1]:=a[i,1];a[j,2]:=a[i,2]; 60 end; 61 end; 62 n:=j; 63 //求凸包 64 for i:=1 to n do d[i]:=i;doit(b,m1); 65 for i:=1 to n do d[i]:=n+1-i;doit(c,m2); 66 //两个半边整合 67 for i:=1 to m1 do d[i]:=b[i]; 68 for i:=2 to m2 do d[i+m1-1]:=c[i]; 69 //开始计算周长+面积 70 m:=m1+m2-2;ans:=0;are:=0; 71 for i:=1 to m do ans:=ans+sqrt(sqr(a[d[i],1]-a[d[i+1],1])+sqr(a[d[i],2]-a[d[i+1],2])); //周长 72 for i:=1 to m do are:=are+a[d[i],1]*a[d[i+1],2]-a[d[i],2]*a[d[i+1],1]; //面积 73 are:=abs(are)/2; 74 writeln('Convex Hull:'); 75 for i:=1 to m do writeln(a[d[i],1],' ',a[d[i],2]); 76 writeln('C = ',ans:0:1); 77 writeln('S = ',are:0:1); 78 readln; 79 end.