Определить радиус и центр окружности минимального радиуса

[SiliconPower8gb]

Определить радиус и центр окружности минимального радиуса

Определить радиус и центр окружности минимального радиуса, которая проходит хотя бы через три несовпадающие точки данного множества.

 

[кочевник]

Определил. Дальше что?

 

[SiliconPower8gb]

нужно программу во Free Pascal.

 

[Vladimir_S]

Да... хороша задачка! Возни преизрядно. Впрочем, попробую — интересно!
SiliconPower8gb, а сдать нужно, как обычно, позавчера?

 

[Vladimir_S]

Вот. Сотворил:

Const
 N=10; {Number of points}
 L=100; {Dimension of area LxL}
 Eps=0.001; {minimal difference between angular coefficients}

Type
 Crd=Record
      x,y:Word;
     End;

Var
 Pts:Array[1..N] of Crd;
 i,j,k,Xp1,Xp2,Xp3,Yp1,Yp2,Yp3:Word;
 Bu:boolean;
 R,Rmin,Xc,Yc,Xcm,Ycm,A1,B1,C1,A2,B2,C2:Real;

Function Determ(Q11,Q12,Q21,Q22:real):real;
begin
 Determ:=Q11*Q22-Q12*Q21;
end;

Procedure Lines(x1,y1,x2,y2,x3,y3:Word;
                var Al1:real; var Bl1:real; var Cl1:real;
                var Al2:real; var Bl2:real; var Cl2:real);
{Two crossing lines parameters}
Var
 Kl,Xc,Yc:real;
begin
 if x1=x2 then
  begin
   Al1:=1.0;
   Bl1:=0;
   Cl1:=-(x1+x2)/2;
  end
 else
  if y1=y2 then
   begin
    Al1:=0;
    Bl1:=1;
    Cl1:=-(y1+y2)/2;
   end
  else
   begin
    Xc:=(x1+x2)/2;
    Yc:=(y1+y2)/2;
    Kl:=-(x2-x1)/(y2-y1);
    Al1:=Kl;
    Bl1:=-1.0;
    Cl1:=Yc-Kl*Xc;
   end;
 if x2=x3 then
  begin
   Al2:=1.0;
   Bl2:=0;
   Cl2:=-(x2+x3)/2;
  end
 else
  if y2=y3 then
   begin
    Al2:=0;
    Bl2:=1;
    Cl2:=-(y2+y3)/2;
   end
  else
   begin
    Xc:=(x2+x3)/2;
    Yc:=(y2+y3)/2;
    Kl:=-(x3-x2)/(y3-y2);
    Al2:=Kl;
    Bl2:=-1.0;
    Cl2:=Yc-Kl*Xc;
   end;
end;

Procedure CrP(Ac1,Bc1,Cc1,Ac2,Bc2,Cc2:real;
             var Xcp:real; var Ycp:real);
{Crossing point coordinates}
Var D1,D2,D3:real;
begin
 D1:=Determ(Ac1,Bc1,Ac2,Bc2);
 D2:=Determ(Bc1,Cc1,Bc2,Cc2);
 D3:=Determ(Cc1,Ac1,Cc2,Ac2);
 Xcp:=D2/D1;
 Ycp:=D3/D1;
end;

Function Radius(X,Y,XRc,YRc:real):real;
begin
 Radius:=Sqrt(Sqr(X-XRc)+Sqr(Y-YRc));
end;

Begin
 Randomize;
 for i:=1 to N do
  repeat
   Pts[i].x:=Random(L);
   Pts[i].y:=Random(L);
   Bu:=TRUE;
   for j:=1 to i-1 do
    if (Pts[j].x=Pts[i].x) and (Pts[j].y=Pts[i].y) then Bu:=FALSE;
  until Bu;
 Rmin:=1.0E300;
 for i:=1 to N do
  for j:=i+1 to N do
   for k:=j+1 to N do
    begin
     Lines(Pts[i].x,Pts[i].y,Pts[j].x,Pts[j].y,Pts[k].x,Pts[k].y,
           A1,B1,C1,A2,B2,C2);
     if Abs(Determ(A1,B1,A2,B2))>Eps then
      begin
       Crp(A1,B1,C1,A2,B2,C2,Xc,Yc);
       R:=Radius(Pts[i].x,Pts[i].y,Xc,Yc);
       if R<Rmin then
        begin
         Rmin:=R;
         Xcm:=Xc;
         Ycm:=Yc;
         Xp1:=Pts[i].x;
         Yp1:=Pts[i].y;
         Xp2:=Pts[j].x;
         Yp2:=Pts[j].y;
         Xp3:=Pts[k].x;
         Yp3:=Pts[k].y;
        end;
      end;
    end;
 Writeln('Point coordinates:');
 Writeln(' x1 = ',Xp1:2,'    y1 = ',Yp1:2);
 Writeln(' x2 = ',Xp2:2,'    y2 = ',Yp2:2);
 Writeln(' x3 = ',Xp3:2,'    y3 = ',Yp3:2);
 Writeln;
 Writeln('Center coordinates:');
 Writeln('  X = ',Xcm:7:3,'   Y = ',Ycm:7:3);
 Writeln;
 Writeln('Radius:');
 Writeln('  R = ',Rmin:7:3);
 Readln
End.