Форум программистов, компьютерный форум, киберфорум
Наши страницы
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
kyojin
0 / 0 / 0
Регистрация: 10.12.2017
Сообщений: 6
1

Программа на нахождение треугольника по координатам точек с наименьшим периметром

10.12.2017, 09:20. Просмотров 812. Ответов 5
Метки нет (Все метки)

Задание такое: вводится количество точек с клавиатуры, их координаты, и нужно найти остроугольный треугольник, вершинами которого являются 3 точки из введённых, при этом периметр его должен быть наименьшим, и треугольник должен полностью находиться во второй четверти.
Написал программу, но она работает неправильно. Уже сколько раз пытался что-то исправить, постоянно что-то не так.

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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
var
  xy: array [1..2,1..100] of real;
  l: array [1..100,1..100] of real;
  n,i1,k1,j1,h: integer;
  l1,l2,l3,s,pr: real;
function p(l1,l2,l3: real): real;
begin
  p:=l1+l2+l3;
end;
function dl(x1: real; y1: real; x2: real; y2: real): real;
begin
  dl:=sqrt(sqr(x2-x1)+sqr(y2-y1))
end;
function cs(i: integer; j: integer; k: integer; d1: real; d2: real): real;
begin
  var x1,x2,y1,y2: real;
  x1:=xy[1,i]-xy[1,j];
  y1:=xy[2,i]-xy[2,j];
  x2:=xy[1,j]-xy[1,k];
  y2:=xy[2,j]-xy[2,k];
  cs:=(x1*x2+y1*y2)/(d1*d2);
end;
begin
  pr:=10000;
  write('Введите количество точек: ');
  read(n);
  for var j:=1 to n do begin
    write('Введите координаты ',j,'-й точки: ');
    read(xy[1,j]);
    read(xy[2,j]);
  end;
  for var i:=1 to n do begin
    for var j:=1 to n do
      if (i<>j) and (xy[1,i]<0) and (xy[2,i]>0) and (xy[1,j]<0) and (xy[2,j]>0) then l[i,j]:=dl(xy[1,i],xy[2,i],xy[1,j],xy[2,j]);
  end;
  for var i:=1 to n do begin
    for var j:=1 to n do begin
      for var k:=1 to n do begin
        if (i<>j) and (i<>k) and (j<>k) and ((l[i,j]=l[i,k]) or (l[i,k]=l[j,k])) then begin
          if ((xy[1,i]<>xy[1,j]) or (xy[1,i]<>xy[1,k]) or (xy[1,k]<>xy[1,j])) and ((xy[2,i]<>xy[2,j]) or (xy[2,i]<>xy[2,k]) or (xy[2,k]<>xy[2,j])) then begin
            if (cs(i,j,k,l[i,j],l[j,k])>0) or (cs(i,k,j,l[i,k],l[k,j])>0) or (cs(k,i,j,l[k,i],l[i,j])>0) then begin
              if p(l[i,j],l[i,k],l[j,k])<pr then begin
                l1:=l[i,j];
                l2:=l[i,k];
                l3:=l[j,k];
                i1:=i;
                j1:=j;
                k1:=k;
                pr:=p(l1,l2,l3);
                s:=sqrt((pr/2)*((pr/2)-l1)*((pr/2)-l2)*((pr/2)-l3));
                h:=1;
              end;
            end;
          end;
        end;
      end;
    end;
  end;
  if h=1 then begin
    writeln('Координаты вершин: ');
    writeln('A=(',xy[1,i1],' ,',xy[2,i1],')');
    writeln('B=(',xy[1,j1],' ,',xy[2,j1],')');
    writeln('C=(',xy[1,k1],' ,',xy[2,k1],')');
    writeln('Длины сторон: ');
    writeln('a=',l1);
    writeln('b=',l2);
    writeln('c=',l3);
    writeln('Периметр: ');
    writeln('P=',pr);
    writeln('Площадь: ');
    writeln('S=',s);
  end
  else writeln('Нет треугольников, подходящих под условие');
end.
Протокол работы программыВведите количество точек: 7
Введите координаты 1-й точки: -2
4
Введите координаты 2-й точки: -2
2
Введите координаты 3-й точки: -4
2
Введите координаты 4-й точки: -5
0
Введите координаты 5-й точки: -5
4
Введите координаты 6-й точки: -5
7
Введите координаты 7-й точки: -8
4
Координаты вершин:
A=(-2 ,4)
B=(-2 ,2)
C=(-5 ,0)
Длины сторон:
a=2
b=0
c=0
Периметр:
P=2
Пдощадь:
S=не число
0
Лучшие ответы (1)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
10.12.2017, 09:20
Ответы с готовыми решениями:

найти площадь треугольника по координатам точек
Даны координаты трех точек, не лежищих на одной прямой. нафти площадь...

Определить по координатам трёх точек вид треугольника
Всем привет! Помогите пожалуйста сделать программу, определяющую по координатам...

Определить по координатам трёх точек точку пересечения медиан треугольника
Написать программу, определяющую по координатам трёх точек точку пересечения...

Из заданного множества точек на плоскости выбрать две различные точки так, чтобы количества точек различались наименьшим образом
Из заданного множества точек на плоскости выбрать две различные точки так,...

по координатам вершин треугольника
Пусть даны координаты трех точек на плоскости. Если они могут быть быть...

5
Puporev
Модератор
54717 / 42123 / 29086
Регистрация: 18.05.2008
Сообщений: 99,430
10.12.2017, 12:03 2
Лучший ответ Сообщение было отмечено kyojin как решение

Решение

Я бы по другому написал.
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
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
type point=record
           x,y:real;
           end;
function ostr(a,b,c:point):boolean;
var p1,p2,p3:real;
begin
p1:=(b.x-a.x)*(c.x-a.x)+(b.y-a.y)*(c.y-a.y); //a
p2:=(a.x-b.x)*(c.x-b.x)+(a.y-b.y)*(c.y-b.y);//b
p3:=(a.x-c.x)*(b.x-c.x)+(a.y-c.y)*(b.y-c.y);//c
ostr:=p1*p2*p3>0;
end;
function ch2(a:point):boolean;
begin
ch2:=(a.x<0)and(a.y>0);
end;
function per(a,b,c:point):real;
begin
per:=sqrt(sqr(a.x-b.x)+sqr(a.y-b.y))+
     sqrt(sqr(b.x-c.x)+sqr(b.y-c.y))+
     sqrt(sqr(c.x-a.x)+sqr(c.y-a.y));
end;
 
var a:array[1..50] of point;
    n,t,imn,jmn,kmn:integer;
    mn:real;
begin
randomize;
repeat
write('Введите количество точек от 3 до 100 n=');
readln(n);
until n in [3..50];
for var i:=1 to n do
 begin
  a[i].x:=-10+20*random;
  a[i].y:=-10+20*random;
 end;
 writeln('Полученные точки');
 for var i:=1 to n  do
  begin
   write(i:2,'(',a[i].x:5:2,';',a[i].y:5:2,') ');
   if i mod 5=0 then writeln;
  end;
 writeln;
t:=0;
for var i:=1 to n-2 do
if ch2(a[i])then
for var j:=i+1 to n-1 do
if ch2(a[j])then 
for var k:=j+1 to n do
if ch2(a[k])then
 begin
  inc(t);
  if t=1 then 
   begin
    mn:=per(a[i],a[j],a[k]);
    imn:=i;
    jmn:=j;
    kmn:=k;
   end
  else if per(a[i],a[j],a[k])<mn then
   begin
    mn:=per(a[i],a[j],a[k]);
    imn:=i;
    jmn:=j;
    kmn:=k;
   end;
  end; 
 if t=0 then write('Треугольников соответствующих условиям нет')  
 else 
  begin
   writeln('Остроугольный треугольник, расположенный строго во II четверти');
   writeln('и имеющий минимальный периметр образован точками');
   write(imn:2,'(',a[imn].x:5:2,';',a[imn].y:5:2,') ');
   write(jmn:2,'(',a[jmn].x:5:2,';',a[jmn].y:5:2,') ');
   writeln(kmn:2,'(',a[kmn].x:5:2,';',a[kmn].y:5:2,') ');
   write('Периметр=',mn:0:2);
  end;
 end.
2
kyojin
0 / 0 / 0
Регистрация: 10.12.2017
Сообщений: 6
16.12.2017, 08:55  [ТС] 3
Цитата Сообщение от Puporev Посмотреть сообщение
Pascal
7
8
9
p1:=(b.x-a.x)*(c.x-a.x)+(b.y-a.y)*(c.y-a.y); //a
p2:=(a.x-b.x)*(c.x-b.x)+(a.y-b.y)*(c.y-b.y);//b
p3:=(a.x-c.x)*(b.x-c.x)+(a.y-c.y)*(b.y-c.y);//c
Спасибо, вроде бы всё понял. Только не пойму, что это за формулы?
0
Puporev
Модератор
54717 / 42123 / 29086
Регистрация: 18.05.2008
Сообщений: 99,430
16.12.2017, 08:59 4
Это векторные произведения. Если их произведение=0 треугольник прямоугольный, >0 остроугольный, <0 тупоугольный
1
WARASHiLO
0 / 0 / 0
Регистрация: 23.12.2015
Сообщений: 21
17.12.2017, 05:06 5
Спасибо что помогли))))
0
kyojin
0 / 0 / 0
Регистрация: 10.12.2017
Сообщений: 6
19.12.2017, 04:53  [ТС] 6
Спасибо огромное.
0
19.12.2017, 04:53
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
19.12.2017, 04:53

Нахождение суммы у строки и столбца с наименьшим знач
В данном двумерном массиве определить сумму элементов строки и сумму элементов...

вычисление площади треугольника по координатам его концов
Напишите функцию вычисляющую площадь треугольника по координатам трех его...

По координатам вершин треугольника вычислить его периметр
Здраствуйте...напишите пожалуйста прогу для задачки: По координатам вершин...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru