Нахождение диагоналей выпуклого многоугольника

@STL1te · Регистрация: 08.12.2009

Студворк — интернет-сервис помощи студентам

Произвольный выпуклый многоугольник задан координатами своих вершин на плоскости. Найдите самую длинную диагональ данного многоугольника.

вот что набросал я:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
const n_max=10;
 
type TArrC=array [1..n_max] of integer; //массив координат
     TArrDl=array [1..n_max] of integer; //массив длин диагоналей
 
procedure Input (var x,y:TArrC; var n:integer);
var i:integer;
begin
  write('Введите кол-во вершин многоугольника: ');
  readln(n);
 
  while n>n_max do
    begin
      writeln('Ошибка! Повторите ввод!');
      readln(n);
    end;
 
  for i:=1 to n do
    begin
      writeln('Введите координаты ',i,'-й вершины(x,y)');
      readln(x[i],y[i]);
      writeln;
    end;
end;
 
procedure SegLen (const x,y:TArrC; var r:TArrDl; const n:integer);
var i:integer;
begin
  for i:=1 to n do
    r[i]:=trunc(sqrt(sqr(x[i+1]-x[i])+sqr(y[i+1]-y[i]))); //расстояние между точками
end;
 
var
    x,y:TArrC;
    d:TArrDl;
    i,n:integer;
 
begin
  Input(x,y,n);
  SegLen(x,y,d,n);
 
  for i:=1 to n do
    write(x[i],',',y[i],' ');
  writeln;
  for i:=1 to n do
    write(d[i],' ');
  readln;
end.

сложности возникли с тем какие расстояния искать т.к диагональ нельзя провести к соседней точке.

Добавлено через 15 часов 38 минут

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
const n_max=10;
 
type TArrC=array [1..n_max] of integer;
 
procedure Input (var x,y:TArrC; var n:integer);
var i:integer;
begin
  write('Введите кол-во вершин многоугольника: ');
  readln(n);
 
  while n>n_max do
    begin
      writeln('Ошибка! Повторите ввод!');
      readln(n);
    end;
 
  for i:=1 to n do
    begin
      writeln('Введите координаты ',i,'-й вершины(x,y)');
      readln(x[i],y[i]);
      writeln;
    end;
end;
 
var
    x,y:TArrC;
    i,j,n:integer;
    d_max,d:real;
 
begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
 
  Input(x,y,n);
 
  d_max:=0;
  for i:=1 to n-2 do
    begin
        for j:=1 to n do
        begin
            if ((j-i)>=2) and ((j-i)<(n-1)) then
            begin
                d:=sqrt(sqr(x[j]-x[i])+sqr(y[j]-y[i]));
                if d>d_max then d_max:=d;
            end;
        end;
    end;
 
  writeln('Самая длинная диагональ: ',d_max:2:1);
  readln;
end.

@Puporev · 09.06.2010, 08:32

Вот так я написал это.

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
const n_max=10;
 
type TArrC=array [1..n_max] of integer;
 
procedure Input (var x,y:TArrC; var n:integer);
var i:integer;
begin
  repeat
  write('Vvedite kolichestvo vershin ot 4 do ',n_max,' n=');
  readln(n);
  if not(n in [4..n_max])then writeln('Oshibka! Povtorite vvod');
  until n in [4..n_max];
  for i:=1 to n do
    begin
      writeln('Vvedite koordinaty(x,y) vershiny ',i);
      readln(x[i],y[i]);
      writeln;
    end;
end;
 
var
    x,y:TArrC;
    i,j,n,imx,jmx:integer;
    d_max,d:real;
 
begin
  {SetConsoleCP(1251);
  SetConsoleOutputCP(1251); }
 
  Input(x,y,n);
  d_max:=0;imx:=1;jmx:=3;
  for j:=3 to n-1 do  //смотрим первую вершину, от 3 до предпоследней
   begin
     d:=sqrt(sqr(x[j]-x[1])+sqr(y[j]-y[1]));
     if d>d_max then
       begin
        d_max:=d;
        jmx:=j;
       end;
   end;
  for i:=2 to n-2 do //остальные вершины от i+2 до последней
  for j:=i+2 to n do
   begin
    d:=sqrt(sqr(x[j]-x[i])+sqr(y[j]-y[i]));
    if d>d_max then
      begin
       d_max:=d;
       imx:=i;
       jmx:=j;
      end;
   end;
  writeln('Samaya dlinnaya diagonal ',imx,' - ',jmx,' = ',d_max:2:1);
  readln;
end.

Кстати у меня вопрос такой. Почему у меня не работает
{SetConsoleCP(1251);
SetConsoleOutputCP(1251); }
Делфи 7. Чего-то не хватает?

@Mad_Dog · 09.06.2010, 09:37

Сообщение от Puporev

Кстати у меня вопрос такой. Почему у меня не работает
{SetConsoleCP(1251);
SetConsoleOutputCP(1251); }
Делфи 7. Чего-то не хватает?

Там хорошо бы еще подключить модуль Windows...
uses
SysUtils, Windows;

@Puporev · 09.06.2010, 09:50

Сообщение от Mad_Dog

Там хорошо бы еще подключить модуль Windows...

Да, хорошо. Признает эти процедуры, но как печатало русские символы крякозябрами, так и печатае....

@Mad_Dog · 09.06.2010, 10:01

Косявые это функции, тогда вот так мона сделать, через функцию перекодировки PR

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
 
const n_max=10;
 
type TArrC=array [1..n_max] of integer;
 
function PR(Const a : string) : string;
begin
  SetLength(result, length(a));
  CharToOem(PChar(a), Pchar(result));
end;
 
 
procedure Input (var x,y:TArrC; var n:integer);
var i:integer;
begin
  repeat
  write(PR('Введите количество вершин от 4 до '),n_max,' n=');
  readln(n);
  if not(n in [4..n_max])then writeln('Oshibka! Povtorite vvod');
  until n in [4..n_max];
  for i:=1 to n do
    begin
      writeln(PR('Введите координату (x,y) вершины '),i);
      readln(x[i],y[i]);
      writeln;
    end;
end;
 
var
    x,y:TArrC;
    i,j,n,imx,jmx:integer;
    d_max,d:real;
 
begin
  Input(x,y,n);
  d_max:=0;imx:=1;jmx:=3;
  for j:=3 to n-1 do  //смотрим первую вершину, от 3 до предпоследней
   begin
     d:=sqrt(sqr(x[j]-x[1])+sqr(y[j]-y[1]));
     if d>d_max then
       begin
        d_max:=d;
        jmx:=j;
       end;
   end;
  for i:=2 to n-2 do //остальные вершины от i+2 до последней
  for j:=i+2 to n do
   begin
    d:=sqrt(sqr(x[j]-x[i])+sqr(y[j]-y[i]));
    if d>d_max then
      begin
       d_max:=d;
       imx:=i;
       jmx:=j;
      end;
   end;
  writeln(PR('Самая длинная диагональ '),imx,' - ',jmx,' = ',d_max:2:1);
  readln;
end.

@Splitter · 09.06.2010, 10:29

Сообщение от STL1te

сложности возникли с тем какие расстояния искать т.к диагональ нельзя провести к соседней точке.

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

@Puporev · 09.06.2010, 10:55

Сообщение от Splitter

упростим программу, с точки зрения производительности еще не известно что лучше..

Нет, ну пока не напишешь код, никто и в тему не смотрит, лень, стоит что-то написать, критики тут как тут, флудерское племя...

@Splitter · 09.06.2010, 11:34

Сообщение от Puporev

Нет, ну пока не напишешь код, никто и в тему не смотрит, лень, стоит что-то написать, критики тут как тут, флудерское племя...

я довольно часто код пишу, так что критика не засчитывается. А здесь просто в голоау пришло рационализаторское предложение

@STL1te · 09.06.2010, 12:52 **[ТС]**

Splitter, тоже подумал о том что в выпуклом многоугольнике никогда сторона не будет длиннее самой длинной диагонали, но потом пришло в голову это))

Puporev, когда запускаете приложение, жмёте пкм на окне - выбираете свойства и там в настройках шрифта выбираете lucida console))

@Puporev · 09.06.2010, 13:01

выбираете lucida console))

Выбрал, без разницы. А вот предложение от Mad_Dog, rulez.....

@STL1te · 10.06.2010, 11:49 **[ТС]**

Puporev, хм очень странно.. у меня всё как надо работало.. и в универе на всех машинах на всех ОС всё работает..

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Программа принимает математическое выражение в виде строки и выдаёт его производную в виде строки и вычисляет значение производной при заданном х Логарифм записывается как: (x-2)log(x^2+2) -. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .

Нахождение диагоналей выпуклого многоугольника

Решение

Решение

@STL1te 7 / 6 / 5 Регистрация: 08.12.2009 Сообщений: 105
	09.06.2010, 12:52 [ТС]
	Splitter, тоже подумал о том что в выпуклом многоугольнике никогда сторона не будет длиннее самой длинной диагонали, но потом пришло в голову это)) Puporev, когда запускаете приложение, жмёте пкм на окне - выбираете свойства и там в настройках шрифта выбираете lucida console)) 1

@STL1te 7 / 6 / 5 Регистрация: 08.12.2009 Сообщений: 105
	10.06.2010, 11:49 [ТС]
	Puporev, хм очень странно.. у меня всё как надо работало.. и в универе на всех машинах на всех ОС всё работает.. 0