singlepost

Паскаль: Задача про пересечение двух окружностей << На главную или назад  

Задача про пересечение двух окружностей.
Даются координаты центров окружностей и радиусы.
Найти все точки пересечение заданных окружностей и их количество. Если точек пересечения бесконечно много, вывести Infinity.
Можно на Паскале и C. Пожалуйста!)

+Похожая задача, только про отрезки:
Даны координаты точек начала и конца двух отрезков. Отрезки могут быть вырожденными (т.е. может быть дана просто точка). Найти их точки пересечения:
1) Если отрезки имеют одну точку пересечения, то вывести
1
координаты точки пересечения
2) если отрезки не пересекаются, вывести Empty
3) Если пересечением отрезков является часть отрезка, то вывести координаты точек начала и конца отрезка, являющегося пересечением.

Программа про отрезки:
var a,b,c,d,e,f,dt,ds,det,t,s,k1,k2,m1,m2: real;
x1,y1,x2,y2,x3,y3,x4,y4,z: integer; h:array[1..4] of integer; q1,q2,q4,q3:real;
procedure kol;
var i,j:byte;
begin
h[1]:=x1; h[2]:=x2; h[3]:=x3; h[4]:=x4;
for i:=3 downto 1 do begin
for j:=1 to i do begin
if h[j]>h[j+1] then begin
z:=h[j]; h[j]:=h[j+1]; h[j+1]:=z; end; end; end;
q1:=h[2]; q2:=h[3];
h[1]:=y1; h[2]:=y2; h[3]:=y3; h[4]:=y4;
for i:=3 downto 1 do begin
for j:=1 to i do begin
if h[j]>h[j+1] then begin
z:=h[j]; h[j]:=h[j+1]; h[j+1]:=z; end; end; end;
q3:=h[2]; q4:=h[3];
write(q1:0:6); write(' ',q3:0:6); write(' ',q2:0:6); write(' ',q4:0:6);
end;
function dot(x:byte):byte;
begin
if x=1 then begin
if (x1=x2) and (y1=y2) then dot:=1 else dot:=0;end else begin
if (x3=x4) and (y3=y4) then dot:=1 else dot:=0; end;
end;
procedure outp(param: shortint; xp, yp: real);
begin
if param=-1 then write('Empty') else
if param=0 then kol else
if param=1 then write(xp:0:6,' ',yp:0:6);
end;

procedure solve;
begin
if (dot(1)=0) and (dot(2)=0) then begin
a:=x2-x1;
b:=x3-x4;
c:=x3-x1;
d:=y2-y1;
e:=y3-y4;
f:=y3-y1;
if y2-y1=0 then k1:=1 else k1:=(x2-x1)/(y2-y1);
if y4-y3=0 then k2:=1 else k2:=(x4-x3)/(y4-y3);
m1:=y1-k1*x1;
m2:=y3-k2*x3;
det:=a*e-b*d;
if det=0 then begin
if trunc(100000*m1)=trunc(100000*m2) then outp(0,0,0) else outp(-1,0,0); end else begin
dt:=c*e-f*b;
ds:=a*f-c*d;
t:=dt/det;
s:=ds/det;
if (0<=s) and (s<=1) and(0<=t) and (t<=1) then outp(1, (x1*(1-t)+x2*t), (y1*(1-t)+y2*t)) else outp(-1,0,0); end; end else
if (dot(1)=1) and (dot(2)=0) then begin
ifx3>x4 then begin z:=x3; x3:=x4; x4:=z; end;
ify3>y4 then begin z:=y3; y3:=y4; y4:=z; end;
if (x1>x3) and (y1>y3)and (x1<x4) and (y1<y4) then outp(1,x1,y1) else outp(-1,0,0); end else
if (dot(1)=0) and (dot(2)=1) then begin
ifx1>x2 then begin z:=x1; x1:=x2; x2:=z; end;
ify1>y2 then begin z:=y1; y1:=y2; y2:=z; end;
if (x3>x1) and (y3>y1)and (x3<x2) and (y3<y2) then outp(1,x3,y3) else outp(-1,0,0); end else
if (dot(1)=1) and (dot(2)=1) then begin
if (x1=x3) and (y1=y3) then outp(1,x1,y1) else outp(-1,0,0); end;
end;
begin
assign(input, 'input.txt'); reset(input);
assign(output, 'output.txt'); rewrite(output);
readln(x1, y1, x2, y2, x3, y3, x4, y4);
close(input);
solve;
close(output);
END.
не всегда работает((

Ответы недоступны

Клуб программистов работает уже ой-ой-ой сколько, а если поточнее, то с 2007 года.