Решаем задачи Абрамян на Паскале. Array137

Array137. Дано множество $$A$$ из $$N$$ точек ($$N \gt 2$$, точки заданы своими координатами $$x$$, $$y$$). Найти наибольший периметр треугольника, вершины которого принадлежат различным точкам множества $$A$$, и сами эти точки (точки выводятся в том же порядке, в котором они перечислены при задании множества $$A$$).

Решение:

program Array137;
var
 A: array [1..10,1..2] of real;
 P,Pmax:real;
 N,i,i2,i3,Point1,Point2,Point3: integer;

begin
 Write('N: ');
 Readln(N);

 Writeln('A: ');
 for i:=1 to N do
  begin
   write(i,'.x :');
   readln(a[i,1]);
   write(i,'.y :');
   readln(a[i,2]);
  end;

 Pmax:=0;

 for i:=1 to N do
  for i2:=i+1 to N do
   for i3:=i2+1 to N do
    begin
     P:=0;
     P:=P+sqrt(sqr(A[i,1]-A[i2,1])+sqr(A[i,2]-A[i2,2]));
     P:=P+sqrt(sqr(A[i2,1]-A[i3,1])+sqr(A[i2,2]-A[i3,2]));
     P:=P+sqrt(sqr(A[i,1]-A[i3,1])+sqr(A[i,2]-A[i3,2]));
     if Pmax<P then
      begin
       Pmax:=P;
       Point1:=i;
       Point2:=i2;
       Point3:=i3;
      end;

    end;

  Writeln ('Pmax:',Pmax,' (',A[Point1,1],':',A[Point1,2],')(',A[Point2,1],':',A[Point2,2],')(',A[Point3,1],':',A[Point3,2],')');
end.

program Array137;

var

A: array [1..10,1..2] of real;

P,Pmax:real;

N,i,i2,i3,Point1,Point2,Point3: integer;

begin

Write('N: ');

Readln(N);

Writeln('A: ');

for i:=1 to N do

begin

write(i,'.x :');

readln(a[i,1]);

write(i,'.y :');

readln(a[i,2]);

end;

Pmax:=0;

for i:=1 to N do

for i2:=i+1 to N do

for i3:=i2+1 to N do

begin

P:=0;

P:=P+sqrt(sqr(A[i,1]-A[i2,1])+sqr(A[i,2]-A[i2,2]));

P:=P+sqrt(sqr(A[i2,1]-A[i3,1])+sqr(A[i2,2]-A[i3,2]));

P:=P+sqrt(sqr(A[i,1]-A[i3,1])+sqr(A[i,2]-A[i3,2]));

if Pmax<P then

begin

Pmax:=P;

Point1:=i;

Point2:=i2;

Point3:=i3;

end;

Writeln ('Pmax:',Pmax,' (',A[Point1,1],':',A[Point1,2],')(',A[Point2,1],':',A[Point2,2],')(',A[Point3,1],':',A[Point3,2],')');

end.

Задачи из раздела Array можно посмотреть здесь.

Комментарии 2

Bronislav

24.08.2018 в 18:39

Лишние итерации у вас в строках 22 и 23. Или нет?

for i:=1 to N-2 do for i2:=i+1 to N-1 do

1
2

for i:=1 to N-2 do
for i2:=i+1 to N-1 do

Ответить

Ну понятно, лишних итераций не будет, потому что при i>=N-1 или i2>=N циклы не выполнятся. Мой вариант с записями:

program Array137;//pabc.net

type
  dot = record
    x, y: real;
  end;

function FLen(a, b: dot) := Sqrt(Sqr(a.x - b.x) + Sqr(a.y - b.y)).Round(2);

begin
  var n := 5;
  var a := new dot[n];
  
  for var i := 0 to n - 1 do
  begin
    a[i].x := Random(-10.0, 10.0).Round();
    a[i].y := Random(-10.0, 10.0).Round();
  end;
//  a.Println;
  
  var PMax := 0.0;
  var p, q, r: integer;
  
  for var i := 0 to n - 3 do
    for var j := i + 1 to n - 2 do
      for var k := j + 1 to n - 1 do
      begin
        var Perim := 0.0;
        Perim := FLen(a[i], a[j]) + 
                 FLen(a[j], a[k]) + 
                 FLen(a[k], a[i]);
//        Println(Perim);
        if PMax < Perim then
        begin
          PMax := Perim;
          p := i;
          q := j;
          r := k;
        end;
      end;
  
  Print('PMax =', PMax, a[p], a[q], a[r]);
end.

program Array137;//pabc.net

type

dot = record

x, y: real;

end;

function FLen(a, b: dot) := Sqrt(Sqr(a.x - b.x) + Sqr(a.y - b.y)).Round(2);

begin

var n := 5;

var a := new dot[n];

for var i := 0 to n - 1 do

begin

a[i].x := Random(-10.0, 10.0).Round();

a[i].y := Random(-10.0, 10.0).Round();

end;

// a.Println;

var PMax := 0.0;

var p, q, r: integer;

for var i := 0 to n - 3 do

for var j := i + 1 to n - 2 do

for var k := j + 1 to n - 1 do

begin

var Perim := 0.0;

Perim := FLen(a[i], a[j]) +

FLen(a[j], a[k]) +

FLen(a[k], a[i]);

// Println(Perim);

if PMax < Perim then

begin

PMax := Perim;

p := i;

q := j;

r := k;

end;

Print('PMax =', PMax, a[p], a[q], a[r]);

end.

Ответить

Решаем задачи Абрамян на Паскале. Array137

Комментарии:

Комментарии 2

Добавить комментарий Отменить ответ