Program spomedzi zadaných bodov určí 3 tak aby v rovine utvorili trojuholník s čo najväčším obsahom

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategórie: Zadání z Pascalu

Program: Bodtroj.pas
Soubor exe: Bodtroj.exe
Soubor ubuntu: Bodtroj

Program spomedzi zadaných bodov určí 3 tak aby v rovine utvorili trojuholník s čo najväčším obsahom.
{ BODTROJ.PAS               Copyright (c) TrSek alias Zdeno Sekerak }
{ Vytvorte program, ktory spomedzi danych bodov v rovine najde tri  }
{ urcujuce trojuholnik s najvacsim obsahom.                         }
{                                                                   }
{ Datum:23.05.2004                             http://www.trsek.com }
 
program trojuholnik_v_rovine;
const MAX=100;
var  bod:array[1..2,1..MAX] of real;    { vsetky body  }
    sbod:array[1..3] of integer;        { najdene body }
   obsah:real;
    poc:integer;
    i:integer;
    b1,b2,b3:integer;
    a,b,c:real;
    pom: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;
 
 
{ pomocou dlzok stran vypocitame obsah }
{ pouzijeme Heronov vzorec }
function VypObsah(a,b,c:real):real;
var s:real;
begin
  s:=(a+b+c)/2;
  VypObsah:=sqrt(s*(s-a)*(s-b)*(s-c));
end;
 
 
begin
  WriteLn('Spomedzi zadanych bodov v rovine zistim trojuholnik');
  WriteLn('ktory ma najvacsi obsah.');
  WriteLn;
  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]:=1; bod[2,1]:=1;
  bod[1,2]:=1; bod[2,2]:=4;
  bod[1,3]:=3; bod[2,3]:=2;
  bod[1,4]:=3; bod[2,4]:=4;
  bod[1,5]:=5; bod[2,5]:=1;
  bod[1,6]:=5; bod[2,6]:=2;
  bod[1,7]:=5; bod[2,7]:=4;
 
  obsah:=0;
  { urobime vsetky kombinacie }
  for b1:=1 to poc do
   for b2:=1 to poc do
    for b3:=1 to poc do
      { rozne body }
      if((b1<>b2) and (b1<>b3) and (b2<>b3))then
       begin
       a:=Dlzka(b1,b2);
       b:=Dlzka(b2,b3);
       c:=Dlzka(b3,b1);
       pom:=VypObsah(a,b,c);
 
       if(obsah < pom)then
         begin
           sbod[1]:=b1;
           sbod[2]:=b2;
           sbod[3]:=b3;
           obsah:=pom;
         end;
       end;
 
  { konecne }
  if(obsah=0)then
    WriteLn('Nenasiel som ziaden trojuholnik')
  else
  begin
    WriteLn('Maximalny obsah trojuholnika je=',obsah: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, ']');
  end;
 
  ReadLn;
end.