Задать вопрос
30 марта, 17:23

Нужно переделать эту программу на паскале для нахождения треугольника с самой большой площадью, образованным всеми вариантами точек

uses crt, graphABC;

var

x, y:array[1 ... 100] of integer;

maxR, R, i, j:integer;

begin

randomize;

for i:=1 to 100 do

begin

x[i]:=random (600) + 10;

y[i]:=random (360) + 10;

circle (x[i], y[i],2) ;

end;

maxR:=0;

for i:=1 to 99 do

for j: = i+1 to 100 do

begin

R:=sqr (x[i]-x[j]) + sqr (y[i]-y[j]) ;

if R>maxR then maxR:=R;

end;

readln;

setpencolor (clred) ;

for i:=1 to 99 do

for j:=i+1 to 100 do

begin

R:=sqr (x[i]-x[j]) + sqr (y[i]-y[j]) ;

if R=maxR then line (x[i], y[i], x[j], y[j]) ;

if R=maxR then writeln (x[i],' ', y[i],' ', x[j],' ', y[j]) ;

end;

end.

+5
Ответы (1)
  1. 30 марта, 17:42
    0
    Попробуйте такое:

    uses graphABC;

    var

    x, y: array [1 ... 100] of integer;

    mI, mJ, mK, maxR, R, i, j, k: integer;

    begin

    randomize;

    for i : = 1 to 100 do

    begin

    x[i] : = random (600) + 10;

    y[i] : = random (360) + 10;

    circle (x[i], y[i], 2) ;

    end;

    maxR : = 0;

    for i : = 1 to 100 do

    for j : = 2 to 99 do

    for k : = 3 to 98 do

    begin

    R : = abs ((x[i]-x[k]) * (y[j]-y[k]) - (x[j]-x[k]) * (y[i]-y[k]) div 2) ;

    if R > maxR then

    begin

    maxR : = R;

    if R > mI then mI : = i;

    if R > mJ then mJ : = j;

    if R > mK then mK : = k;

    end;

    end;

    setpencolor (clred) ;

    line (x[mI], y[mI], x[mJ], y[mJ]) ;

    line (x[mJ], y[mJ], x[mK], y[mK]) ;

    line (x[mK], y[mK], x[mI], y[mI]) ;

    end.
Знаете ответ?
Сомневаетесь в ответе?
Найдите правильный ответ на вопрос ✅ «Нужно переделать эту программу на паскале для нахождения треугольника с самой большой площадью, образованным всеми вариантами точек uses ...» по предмету 📘 Информатика, а если вы сомневаетесь в правильности ответов или ответ отсутствует, то попробуйте воспользоваться умным поиском на сайте и найти ответы на похожие вопросы.
Смотреть другие ответы
Похожие вопросы по информатике
Как сделать теперь без массива (паскале) ? var nm:array of integer; j, l:integer; begin nm: = new integer[3] (random (20), random (20), random (20)) ; writeln ('nm[0] = ', nm[0]) ; writeln ('nm[1] = ', nm[1]) ; writeln ('nm[2] = ', nm[2]) ;
Ответы (1)
Сделать так чтобы Writeln был заменен другим словом и повторялься не больше двух раз program choise; var N_M:integer; writeln (' введи номер месяца ') ; readln (N_M) ; case N_M of 1:writeln (' январь ') ; 2:writeln (' февраль ') ;
Ответы (1)
Тем, кто работает с Pascal ABC! Не заливается хобот у слона. В чем проблема? Program elephant_Meri_13; uses graphABC; begin setwindowsize (500,500) ; setpenwidth (8) ; arc (150,300,100,0,180) ; arc (360,250,80,160,360) ; arc (370,240,60,160,360) ;
Ответы (1)
Что не так? (процедура обязательна) procedure random (k:integer) ; var a:array[1 ... 100] of integer; var l:integer; begin for l:=1 to k do begin a[l]:=random (100) ; writeln (a[l]) ; end; end; var v:integer; begin write ('Сколько будет чисел?
Ответы (2)
Запиши программу в Паскале для вычисления площади прямоугольника со сторонами c и m. 1) begin writeln ('Введи длину и ширину прямоугольника c и m') ; readln (c, m) ; s:=c*m; writeln ('s=', s) ; readln; end.
Ответы (1)