 |
 |
 |
Скачать программы Все программы автора
КВАДРАТ
Треугольник задан на плоскости координатами своих вершин: (X1,Y1), (X2,Y2), (X3,Y3).
Найти длину L стороны квадрата минимальной площади, в который можно поместить этот треугольник так, чтобы все вершины треугольника находились внутри квадрата либо на его сторонах.
Задание Составьте программу SQUARE, которая по координатам вершин треугольника находит длину L стороны квадрата минимальной площади, в который можно поместить этот треугольник. L достаточно найти с точностью 10-4.
Входные данные Файл SQUARE.DAT содержит в одной строке действительные числа X1 Y1 X2 Y2 X3 Y3, разделенные пробелами, – координаты вершин треугольника (-10000 £ X1, Y1, X2, Y2, X3, Y3 £ 10000).
Пример входного файла
0.0 0.0 1.1 0.0 0.0 1.1
Выходные данные Файл SQUARE.SOL должен содержать одно число - длину L стороны искомого квадрата.
Пример выходного файла
1.1
{$A-,B-,D-,E+,F-,G-,I+,L-,N+,O-,P-,Q+,R-,S-,T-,V+,X+,Y+}
{$M 16384,0,655360}
program Triangle;
const
delta=1e-6;
var
fr,fw:text;
x1,x2,x3,y1,y2,y3:real;
function min(a,b:real):real;
begin
if a<b then min:=a
else min:=b;
end;
function max(a,b:real):real;
begin
if a>b then max:=a
else max:=b;
end;
procedure find_qxy(a,x1,x2,y1,y2:real; var q,x,y:real);
var _x1,_x2,_y1,_y2:real;
begin
_x1:=x1*cos(a)-y1*sin(a);
_y1:=y1*cos(a)+x1*sin(a);
_x2:=x2*cos(a)-y2*sin(a);
_y2:=y2*cos(a)+x2*sin(a);
x:=max(max(0,_x1),_x2)-min(min(0,_x1),_x2);
y:=max(max(0,_y1),_y2)-min(min(0,_y1),_y2);
q:=max(x,y);
end;
procedure ExpandAngle(var a:real;x,y:real);
begin
if x<0 then a:=a+pi;
end;
procedure MainMake;
var k:integer;
sc_product,_x1,_x2,_x3,_y1,_y2,_y3:real;
a1,a2,minq,la,ha,xa,lq,hq,xq,lx,hx,xx,ly,hy,xy,direction:real;
begin
minq:=1e15;
for k:=1 to 3 do
begin
if k=1 then
begin
_x1:=x2-x1; _x2:=x3-x1;
_y1:=y2-y1; _y2:=y3-y1;
end;
if k=2 then
begin
_x1:=x1-x2; _x2:=x3-x2;
_y1:=y1-y2; _y2:=y3-y2;
end;
if k=3 then
begin
_x1:=x1-x3; _x2:=x2-x3;
_y1:=y1-y3; _y2:=y2-y3;
end;
{calculate scalar product of 2 vectors}
sc_product:=_x1*_x2+_y1*_y2;
if sc_product<0 then continue; {we are going to work with angles<=Pi/2 only}
{arctan has an asymptote on Pi/2, 3*Pi/2}
if abs(_x1)<abs(_y1) then
begin
a1:=arctan(_x1/_y1);
if a1<0 then a1:=-pi/2-a1
else a1:=pi/2-a1;
end
else
a1:=arctan(_y1/_x1);
if abs(_x2)<abs(_y2) then
begin
a2:=arctan(_x2/_y2);
if a2<0 then a2:=-pi/2-a2
else a2:=pi/2-a2;
end
else
a2:=arctan(_y2/_x2);
ExpandAngle(a1,_x1,_y1);
ExpandAngle(a2,_x2,_y2);
if max(a1,a2)-min(a1,a2)>=Pi then
begin
if a1<a2 then a1:=a1+2*Pi
else a2:=a2+2*Pi;
end;
la:=min(a1,a2);
ha:=max(a1,a2);
ha:=-la+Pi/2-(ha-la);
la:=-la;
find_qxy(la,_x1,_x2,_y1,_y2,lq,lx,ly);
find_qxy(ha,_x1,_x2,_y1,_y2,hq,hx,hy);
if hq<minq then minq:=hq;
if lq<minq then minq:=lq;
xq:=lq;
if (lx-ly)<(hx-hy) then direction:=1
else direction:=-1;
if (lx-hx)*(ly-hy)>0 then continue;
if (lx-ly)*(hx-hy)>0 then continue;
while abs(lx-ly)>delta do
begin
xa:=(la+ha)/2;
find_qxy(xa,_x1,_x2,_y1,_y2,xq,xx,xy);
if (xx-xy)*direction<0 then la:=xa
else ha:=xa;
find_qxy(la,_x1,_x2,_y1,_y2,lq,lx,ly);
find_qxy(ha,_x1,_x2,_y1,_y2,hq,hx,hy);
end;
if xq<minq then minq:=xq;
end;
writeln(fw, minq:3:9);
end;
procedure Make;
var qmin,amin,q,a,x,y,xmin,ymin,xmax,ymax,axmin,aymin,axmax,aymax:real;
i:longint;
a1,a2:real;
begin
x1:=x1-x3; y1:=y1-y3;
x2:=x2-x3; y2:=y2-y3;
x3:=0;y3:=0;
MainMake; {:-)}
end;
begin
assign(fr, 'square.dat');
assign(fw, 'square.sol');
reset(fr);
rewrite(fw);
readln(fr,x1,y1,x2,y2,x3,y3);
Make;
close(fr);
close(fw);
end.
|
|
|
