Программа на нахождение треугольника по координатам точек с наименьшим периметром - PascalABC.NET - Ответ 11930394

var
  xy: array [1..2,1..100] of real;
  l: array [1..100,1..100] of real;
  n,i1,k1,j1,h: integer;
  l1,l2,l3,s,pr: real;
function p(l1,l2,l3: real): real;
begin
  p:=l1+l2+l3;
end;
function dl(x1: real; y1: real; x2: real; y2: real): real;
begin
  dl:=sqrt(sqr(x2-x1)+sqr(y2-y1))
end;
function cs(i: integer; j: integer; k: integer; d1: real; d2: real): real;
begin
  var x1,x2,y1,y2: real;
  x1:=xy[1,i]-xy[1,j];
  y1:=xy[2,i]-xy[2,j];
  x2:=xy[1,j]-xy[1,k];
  y2:=xy[2,j]-xy[2,k];
  cs:=(x1*x2+y1*y2)/(d1*d2);
end;
begin
  pr:=10000;
  write('Введите количество точек: ');
  read(n);
  for var j:=1 to n do begin
    write('Введите координаты ',j,'-й точки: ');
    read(xy[1,j]);
    read(xy[2,j]);
  end;
  for var i:=1 to n do begin
    for var j:=1 to n do
      if (i<>j) and (xy[1,i]<0) and (xy[2,i]>0) and (xy[1,j]<0) and (xy[2,j]>0) then l[i,j]:=dl(xy[1,i],xy[2,i],xy[1,j],xy[2,j]);
  end;
  for var i:=1 to n do begin
    for var j:=1 to n do begin
      for var k:=1 to n do begin
        if (i<>j) and (i<>k) and (j<>k) and ((l[i,j]=l[i,k]) or (l[i,k]=l[j,k])) then begin
          if ((xy[1,i]<>xy[1,j]) or (xy[1,i]<>xy[1,k]) or (xy[1,k]<>xy[1,j])) and ((xy[2,i]<>xy[2,j]) or (xy[2,i]<>xy[2,k]) or (xy[2,k]<>xy[2,j])) then begin
            if (cs(i,j,k,l[i,j],l[j,k])>0) or (cs(i,k,j,l[i,k],l[k,j])>0) or (cs(k,i,j,l[k,i],l[i,j])>0) then begin
              if p(l[i,j],l[i,k],l[j,k])<pr then begin
                l1:=l[i,j];
                l2:=l[i,k];
                l3:=l[j,k];
                i1:=i;
                j1:=j;
                k1:=k;
                pr:=p(l1,l2,l3);
                s:=sqrt((pr/2)*((pr/2)-l1)*((pr/2)-l2)*((pr/2)-l3));
                h:=1;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
  if h=1 then begin
    writeln('Координаты вершин: ');
    writeln('A=(',xy[1,i1],' ,',xy[2,i1],')');
    writeln('B=(',xy[1,j1],' ,',xy[2,j1],')');
    writeln('C=(',xy[1,k1],' ,',xy[2,k1],')');
    writeln('Длины сторон: ');
    writeln('a=',l1);
    writeln('b=',l2);
    writeln('c=',l3);
    writeln('Периметр: ');
    writeln('P=',pr);
    writeln('Площадь: ');
    writeln('S=',s);
  end
  else writeln('Нет треугольников, подходящих под условие');
end.