Cod sursa(job #912084)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 12 martie 2013 06:25:25
Problema Infasuratoare convexa Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.66 kb
program adas;
type vect=array[1..50000]of real;
var n,i,j,k,semn,p,contor,imin:word;
    aux,min,x1,x2,x3,x4,y1,y2,y3,y4,xq,xp,yp,yq,ymin,xo,yo:real;
    x,y,v:vect;
    f,g:text;
function ec(x1,y1,x2,y2,x,y:real):real;
begin
ec:=(x-x1)*(y2-y1)-(y-y1)*(x2-x1);
end;
procedure afisare(x,y:real);
begin
writeln(g,x:14:12,' ',y:14:12);
end;
function sinus(xp,yp,xq,yq:real):real;
begin
sinus:=(yq-yp)/sqrt(sqr(xq-xp)+sqr(yq-yp));
end;
function cosinus(xp,yp,xq,yq:real):real;
begin
cosinus:=(xq-xp)/sqrt(sqr(xq-xp)+sqr(yq-yp));
end;
begin
assign(f,'infasuratoare.in');reset(f);
assign(g,'infasuratoare.out');rewrite(g);
readln(f,n);
ymin:=1000000000;imin:=-1;
for i:=1 to n do begin
                 readln(f,x[i],y[i]);
                 if y[i]<ymin then begin ymin:=y[i];imin:=i;end
                   else if y[i]=y[imin] then
                         if x[i]<x[imin] then begin ymin:=y[i];imin:=i;end;
                 end;
xo:=x[imin];yo:=y[imin];
for i:=1 to n do begin
                 x[i]:=x[i]-xo;
                 y[i]:=y[i]-yo;
              //   writeln(g,x[i]:4:2,' ',y[i]:4:2);
                 end;
dreapta:=-1000000000;stanga:=1000000000; sus:=-1;
for i:=1 to  n do begin
                  if x[i]>dreapta then begin dreapta:=x[i];
                  end;






for i:=1 to n do writeln(g,x[i]:4:2,' ',y[i]:4:2);

//for i:=1 to n do
// if i<>imin then v[i]:=sinus(0,0,x[i],y[i]);
x1:=0;y1:=0;  x2:=12;y2:=4;
//writeln(g,xq:4:2,' ',yq:4:2);
xq:=x2*cosinus(x1,y1,x2,y2)+y2*sinus(x1,y1,x2,y2);
yq:=-x2*sinus(x1,y1,x2,y2)+y2*cosinus(x1,y1,x2,y2);
writeln(g,xq:6:4,' ',yq:6:4);
//writeln(g,sqrt(80):6:4);


close(f);close(g);
end.