Change background image
Chuyên Tin - Lê Khiết

Go downThông điệp [Trang 1 trong tổng số 1 trang]

© FMvi.vn

on Sun Sep 02, 2012 7:28 pm
Gunny->Rock
avatar
avatar

người mới

Cho N điểm M1,M2,...Mn trên mặp phẳng tọa độ Oxy.Các điểm có tọa độ nguyên và không có 3 điểm nào thẳng hàng.Hãy viết chương trình xác định một đa giác không tự cắt có các đỉnh là các điểm trong N điểm đã cho và chứa tất cả các điểm còn lại đồng thời có chu vi nhỏ nhất.Tính diện tích đa giác này.
Input-Dòng 1:Ghi N<=100
-N dòng tiếp theo,dòng thứ i ghi tọa độ điểm Mi.
Output-ghi 3 số k,c,s.
(k:số đỉnh;C:chu vi;S:dt);
k dòng tiếp theo ghi tọa đọ p[i] của đa giác.
Code:

const fi='bt.inp';fo='bt.out';
type diem=record x,y:integer;end;
    dt=record a,b,c:integer;end;
    Dg=array[0..100]of diem;
var M,P:dg;
    n,dem:integer;
    dd:array[0..100]of boolean;
    f:text;
procedure doc;
var i:integer;
begin
        assign(f,fi);reset(f);
        readln(f,n);
        for i:=1 to n do readln(f,M[i].x,M[i].y);
        close(f);
end;
procedure sx;
var tg:diem;i,j:integer;
begin
        for i:=1 to n-1 do
        for j:=i+1 to n do
        if M[i].y<M[j].y then
        begin
                tg:=M[i];
                M[i]:=M[j];
                M[j]:=tg;
        end;
end;
procedure khoitao;
begin
        assign(f,fo);rewrite(f);
        fillchar(dd,sizeof(dd),false);
end;
procedure xddt(A,B:diem;var T:dt);
begin
        t.a:=A.y-B.y;
        T.b:=B.x-A.x;
        T.c:=A.x*B.y-A.y*B.x;
end;
function gt(A:diem;T:dt):integer;
begin
        gt:=T.a*A.x+T.b*A.y+T.c;
end;
function khacphia(A,B:diem;t:dt):boolean;
begin
        khacphia:=(GT(A,T)*GT(B,T)<0);
end;

function timdinh:integer;
var T:dt;h,k:integer;kt:boolean;i,j:diem;
begin
        timdinh:=0;
        j:=p[dem-1];i:=p[dem];
        for k:=1 to n do
        if not dd[k] then
          begin
              XDDT(i,M[k],T);
              kt:=true;
              for h:=1 to n do
              if h<>k then
              if khacphia(j,M[h],T) then
              begin
                kt:=false;
                break;
              end;
          if kt then begin timdinh:=k;exit;end;
          end;
end;
procedure xuli;
var  i,h,k:integer;T:dt;kt:boolean;
begin
        p[1]:=M[1];
        dd[1]:=true;
        for i:=2 to n do
        begin
                kt:=true;
                xddt(P[1],M[i],T);
                k:=i+1;
                if k=n+1 then k:=1;
                for h:=2 to n do
                if khacphia(M[h],M[k],T) then
                begin
                kt:=false;
                break;
                end;
        if kt then begin P[2]:=M[i];dd[i]:=true;break;end;
        end;
        dem:=2;
        repeat
                k:=timdinh;
                if k<>0 then
                begin
                    inc(dem);
                    p[dem]:=M[k];
                    dd[k]:=true;
                end;
        until k=0;
end;
function kc(A,B:diem):real;
begin
        kc:=sqrt(sqr(A.x-B.x)+sqr(A.y-B.y));
end;
function cvi:real;
var s:real;i:integer;
begin
      p[dem+1]:=p[1];
      s:=0;
      for i:=1 to n do s:=s+kc(p[i],p[i+1]);
      cvi:=s;
end;
function dtich:real;
var s:real;i:integer;
begin
        p[0]:=p[n];
        p[n+1]:=p[1];
        for i:=1 to n do s:=s+(p[i-1].x-p[i+1].x)*p[i].y;
        dtich:=abs(s)/2;
end;
procedure ghi;
var i:integer;
begin
        writeln(f,dem);
        writeln(f,cvi:5:2);
        writeln(f,dtich:5:2);
        for i:=1 to dem do writeln(f,p[i].x,' ',p[i].y);
end;
BEGIN
        doc;
        sx;
        khoitao;
        xuli;
        ghi;
        close(f);
END.
Link : [You must be registered and logged in to see this link.]

Thích

Báo xấu [0]

Gửi một bình luận lên tường nhà Gunny->Rock
Trả lời nhanh

Về Đầu TrangThông điệp [Trang 1 trong tổng số 1 trang]

  © FMvi.vn

|_-Diễn Đàn Tin Học - Lê Khiết-_|

« Xem bài trước | Xem bài kế tiếp »

Bài viết liên quan

    Quyền hạn của bạn:

    Bạn không có quyền trả lời bài viết