Dze je subor www.TrSek.com/zadania/rovstvor.pas

{ ROVSTVOR.PAS              Copyright (c) TrSek alias Zdeno Sekerak }
{ Vytvorte program, ktory z danej mnoziny bodov v rovine vyberie    }
{ styri urcujuce stvoruholnik s najvacsim obvodom.                  }
{ Pozor, nie kazda permutacia styroch bodov v rovine urcuje         }
{ stvoruholnik.                                                     }
{                                                                   }
{ Datum:23.05.2004                             http://www.trsek.com }

program stvorec_v_rovine;
const MAX=100;
var  bod:array[1..2,1..MAX] of real;    { vsetky body  }
    sbod:array[1..4] of integer;        { najdene body }
   obvod:real;
    poc:integer;
    i:integer;
    b1,b2,b3,b4:integer;
    d1,d2,d3,d4:real;

{ pomocou pytagorovej vety vypocitame dlzku strany }
function Dlzka(b1,b2:integer):real;
var a,b:real;
begin
  a:=bod[1,b1]-bod[1,b2];
  b:=bod[2,b1]-bod[2,b2];
  Dlzka:=sqrt(a*a+b*b);
end;

{ ak body vyhovuju pytagorovej vete tak su v pravom uhle }
function PravyUhol(b1,b2,b3:integer):boolean;
var a,b,c:real;
    c2:real;
begin
  a:=Dlzka(b1,b2);
  b:=Dlzka(b2,b3);
  c:=Dlzka(b3,b1);

  { aka ma byt dlzka ak je pravy uhol }
  c2:=sqrt(a*a+b*b);

  if(c=c2)then
    PravyUhol:=true
  else
    PravyUhol:=false;
end;

begin
  WriteLn('Z bodov v rovine vyberie 4 tak aby urcovali najvacsi stvorec.');
  Write('Zadaj pocet bodov v rovine (max=',MAX,'):');
  ReadLn(poc);

  WriteLn('Zadaj suradnice bodov');
  { zadavanie jednotlivych bodov }
  for i:=1 to poc do
  begin
    Write('Bod ',i,'-x='); ReadLn(bod[1,i]);
    Write('Bod ',i,'-y='); ReadLn(bod[2,i]);
  end;

  { priklad pre testovanie }
  {
  poc:=7;
  bod[1,1]:=3; bod[2,1]:=2;
  bod[1,2]:=3; bod[2,2]:=4;
  bod[1,3]:=5; bod[2,3]:=1;
  bod[1,4]:=5; bod[2,4]:=2;
  bod[1,5]:=5; bod[2,5]:=4;
  bod[1,6]:=1; bod[2,6]:=1;
  bod[1,7]:=1; bod[2,7]:=4;
  }

  obvod:=0;
  { urobime vsetky kombinacie }
  for b1:=1 to poc do
   for b2:=1 to poc do
    for b3:=1 to poc do
     for b4:=1 to poc do
      { rozne body }
      if((b1<>b2) and (b1<>b3) and (b1<>b4) and
         (b2<>b3) and (b2<>b4) and (b3<>b4))then
       begin
       d1:=Dlzka(b1,b2);
       d2:=Dlzka(b2,b3);
       d3:=Dlzka(b3,b4);
       d4:=Dlzka(b4,b1);

       { podmienky ze je to stvorec }
       { musi mat protilahle strany rovnake a mat prave uhly - stacia 3 }
       if((d1=d3) and (d2=d4) and
          PravyUhol(b1,b2,b3) and
          PravyUhol(b2,b3,b4) and
          PravyUhol(b3,b4,b1))then
       begin
         if( obvod < (d1+d2+d3+d4))then
         begin
           sbod[1]:=b1;
           sbod[2]:=b2;
           sbod[3]:=b3;
           sbod[4]:=b4;
           obvod:=d1+d2+d3+d4;
         end;
       end;
     end;

  { konecne }
  if(obvod=0)then
    WriteLn('Nenasiel som ziaden stvorec')
  else
  begin
    WriteLn('Maximalny obvod stvorca je=',obvod:0:3,' a maju ho tieto body.');
    WriteLn('[',bod[1,sbod[1]]:0:3, ',',bod[2,sbod[1]]:0:3, ']');
    WriteLn('[',bod[1,sbod[2]]:0:3, ',',bod[2,sbod[2]]:0:3, ']');
    WriteLn('[',bod[1,sbod[3]]:0:3, ',',bod[2,sbod[3]]:0:3, ']');
    WriteLn('[',bod[1,sbod[4]]:0:3, ',',bod[2,sbod[4]]:0:3, ']');
  end;
  ReadLn;
end.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com