трехмерное пространство, найти радиус Опции

[bairt]

В трехмерном пространстве задано N шаров. Найти шар минимального радиуса, охватывающий все заданные

[klem4]

lapp, а пост # 15 ты учел ?

[bairt]

lapp, а пост # 15 ты учел ?

тогда можете проверить етот код

uses crt;
type InfoSphere=record
     x,y,z,r:real;
end;
const n=10;
var InfoSp:InfoSphere;
    f:text;
    i:integer;
    Spheri: array[1..n] of InfoSphere;
    Rnew,Xnew,Ynew,Znew:real;

function Lenght(x0,y0,z0,x1,y1,z1:real):real;
begin
     Lenght:=sqrt(sqr(x0-x1)+sqr(y0-y1)+sqr(z0-z1));
end;


procedure SearchMinSpher(x0,y0,z0,r0,x1,y1,z1,r1:real);
var L:real;
begin
   L:=Lenght(x0,y0,z0,x1,y1,z1);
   if (L=0) then
   begin
      Xnew:=x0;
      Ynew:=y0;
      Znew:=z0;
      if (r1>r0) then
      begin
         Rnew:=r1;
      end
      else
      begin
         Rnew:=r0;
      end;
   end
   else
   begin
      if (r1>r0) and ((r1-r0)>=L) then
      begin
            Rnew:=r1;
            Xnew:=x1;
            Ynew:=y1;
            Znew:=z1;
      end;
      if (r0>r1) and ((r0-r1)>=L) then
      begin
            Rnew:=r0;
            Xnew:=x0;
            Ynew:=y0;
            Znew:=z0;
      end;
      Rnew:=(r0+r1+L)/2;
      Xnew:=(Rnew-r0)*(x1-x0)/L+x0;
      Ynew:=(Rnew-r0)*(y1-y0)/L+y0;
      Znew:=(Rnew-r0)*(z1-z0)/L+z0;
     
   end;
end;

begin
   assign(f,'3_input.txt');
   reset(f); {otkrivaem file}
   with InfoSp do
   begin
      for i:=0 to 4*n do
      begin
         read(f,Spheri[i div 4].x);
         read(f,Spheri[i div 4].y);
         read(f,Spheri[i div 4].z);
         read(f,Spheri[i div 4].r);
      end;
      {
      zapolnili massiv iz file
      }
      Rnew:=Spheri[1].r;
      Xnew:=Spheri[1].x;
      Ynew:=Spheri[1].y;
      Znew:=Spheri[1].z;
      for i:=2 to n do
      begin
         SearchMinSpher(Xnew,Ynew,Znew,Rnew,Spheri[i].x,Spheri[i].x,Spheri[i].x,Spheri[i].x);
      end;

   end;
   close(f);
end.

Теги !