Модераторы: volvo877, Snowy, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Задача: принадлежит ли точка треугольнику? 
:(
    Опции темы
mr.Anderson
Дата 7.11.2006, 16:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


iOS Lead Developer
****


Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: нет
Всего: 128
Так. Суть задачи. Юзер задает координаты ( x, y ) трех точек, которые являются вершинами треугольника. Затем юзверь задает еще одну точку, чтобы узнать, лежит эта точка внутри треугольника или нет. Цель программы - сказать об этом.

Мой алгоритм работы:

1. Принимаем координаты четырех точек (координаты целого типа).
2. Вычисляем значение трех сторон главного треугольника по формуле MM = Sqrt( Sqr( x2 - x1 ) + Sqr( y2 - y1 ) ) (формула для вычисления расстояния между двумя точками).
3. Вычисляем периметр треугольника и площадь (площадь по формуле Герона: S = Sqrt( p * ( p - a ) * ( p - b ) * ( p - c ) ), где p - полупериметр).
4. Затем смысл - если точка лежит внутри нашего треугольника, то сумма площадей трех треугольников, на которые точка может разбить главный треугольник, будет равна только что вычисленной площади. Если она не равна, то точка не лежит в треугольнике.
Код

Program Point;
Uses CRT;
Var a,b,c, per, S, S1, S2, S3: Real;
    a1,a2,b1,b2,c1,c2, x,y: Integer;

function Line( x1, x2, y1, y2: Real ): Real;
begin

 Line := Sqrt( Sqr( x2 - x1 ) + Sqr( y2 - y1 ) );

end;

function Geron: Real;
var
 p: Real;
begin

 p := per / 2;

 Geron := Sqrt( p * ( p - a ) * ( p - b ) * ( p - c ) );

end;

Begin

 ClrScr;

 Write( 'Enter coords of first vehicle of triangle: ' );
  ReadLn( a1, a2 );
 Write( 'Enter coords of second vehicle: ' );
  ReadLn( b1, b2 );
 Write( 'Enter coords of third vehicle: ' );
  ReadLn( c1, c2 );
 Write( 'Enter coords of your point: ' );
  ReadLn( x, y );

 { Main Triangle }

 a := Line( a1, a2, b1, b2 );
 b := Line( b1, b2, c1, c2 );
 c := Line( a1, a2, c1, c2 );

 per := a + b + c;
 S := Geron;

 { Triangle 1 }

 a := Line( a1, a2, x, y );
 b := Line( b1, b2, x, y );
 c := Line( a1, a2, b1, b2 );
 per := a + b + c;
 S1 := Geron;

 { Triangle 2 }

 a := Line( b1, b2, x, y );
 b := Line( c1, c2, x, y );
 c := Line( b1, b2, c1, c2 );
 per := a + b + c;
 S2 := Geron;

 { Triangle 3 }

 a := Line( a1, a2, x, y );
 b := Line( c1, c2, x, y );
 c := Line( a1, a2, c1, c2 );
 per := a + b + c;
 S3 := Geron;

 S1 := S1 + S2 + S3;

 If( S = S1 ) Then
  Write( 'Point is IN of the triangle.' )
 Else
  Write( 'Point is OUT of the triangle.' );

 Repeat
 Until KeyPressed;

End.

Есть контрольные значения, по которым можно проверить работу программы.
Если вершины заданы как ( 0; 0 ), ( 3; 0 ), ( 0; 4 ), а точка как ( 1; 1 ), то точка должна лежать внутри треугольника.
Если вершины те же самые, а точка задана как ( 2; 0 ), то точка тоже лежит внутри треугольника.
Если вершины те же самые, но точка с координатами ( 6; 6 ), то точка лежит ВНЕ треугольника.

Из всех трех условий выполняется в моей программе только первое. Где ошибка?

Это сообщение отредактировал(а) sim7 - 7.11.2006, 16:26


--------------------
user posted image

user posted image
PM MAIL ICQ Skype   Вверх
MBo
Дата 7.11.2006, 17:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 234
Регистрация: 10.6.2002

Репутация: нет
Всего: 18
можно проще. Даны точки A,B,C и P
Раскладываем вектор AP по векторам AB и AC, например, так:
http://www.college.ru/mathematics/courses/...dels/basis.html

AP = l*AB+m*AC
если l>=0, m>=0 и l+m<=1 то точка внутри


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


Это сообщение отредактировал(а) MBo - 7.11.2006, 17:11
PM MAIL   Вверх
mr.Anderson
Дата 7.11.2006, 17:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


iOS Lead Developer
****


Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: нет
Всего: 128
Слегка поправили, но все еще не работает:
Код

Program Point;
Uses CRT;
Var a,b,c, per, S, S1, S2, S3: Real;
    a1,a2,b1,b2,c1,c2, x,y: Integer;

function Line( x1, x2, y1, y2: Real ): Real;
begin

 Line := Sqrt( Sqr( x2 - x1 ) + Sqr( y2 - y1 ) );

end;

function Geron: Real;
var
 p: Real;
begin

 p := per / 2;

 Geron := Sqrt( p * ( p - a ) * ( p - b ) * ( p - c ) );

end;

Begin

 ClrScr;

 Write( 'Enter coords of first vehicle of triangle: ' );
  ReadLn( a1, a2 );
 Write( 'Enter coords of second vehicle: ' );
  ReadLn( b1, b2 );
 Write( 'Enter coords of third vehicle: ' );
  ReadLn( c1, c2 );
 Write( 'Enter coords of your point: ' );
  ReadLn( x, y );

 { Main Triangle }

 a := Line( a1, a2, b1, b2 );
 b := Line( b1, b2, c1, c2 );
 c := Line( a1, a2, c1, c2 );

 per := a + b + c;
 S := Geron;

 { Triangle 1 }

 a := Line( a1, a2, x, y );
 b := Line( b1, b2, x, y );
 c := Line( a1, a2, b1, b2 );
 per := a + b + c;
 S1 := Geron;

 { Triangle 2 }

 a := Line( b1, b2, x, y );
 b := Line( c1, c2, x, y );
 c := Line( b1, b2, c1, c2 );
 per := a + b + c;
 S2 := Geron;

 { Triangle 3 }

 a := Line( a1, a2, x, y );
 b := Line( c1, c2, x, y );
 c := Line( a1, a2, c1, c2 );
 per := a + b + c;
 S3 := Geron;

 S1 := S1 + S2 + S3;
 WriteLn( S:0:4, ' vs. ', S1:0:4 );

 If( S = S1 ) Then
  Write( 'Point is IN of the triangle.' )
 Else
  Write( 'Point is OUT of the triangle.' );

 Repeat
 Until KeyPressed;

End.



--------------------
user posted image

user posted image
PM MAIL ICQ Skype   Вверх
Alexeis
Дата 7.11.2006, 17:14 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: нет
Всего: 459
Код

Program Point;


Var
    a,b,c, per, S, S1, S2, S3: Real;
    a1,a2,b1,b2,c1,c2, x,y: Integer;

function Line( x1, y1, x2, y2: Real ): Real;
begin
 Line := Sqrt( Sqr( x2 - x1 ) + Sqr( y2 - y1 ) );
end;

function Geron: Real;
var
 p: Real;
begin
 p := per / 2;
 Geron := Sqrt( p * ( p - a ) * ( p - b ) * ( p - c ) );
end;

Begin
 Write( 'Enter coords of first vehicle of triangle: ' );
  ReadLn( a1, a2 );
 Write( 'Enter coords of second vehicle: ' );
  ReadLn( b1, b2 );
 Write( 'Enter coords of third vehicle: ' );
  ReadLn( c1, c2 );
 Write( 'Enter coords of your point: ' );
  ReadLn( x, y );
 { Main Triangle }
 a := Line( a1, a2, b1, b2 );
 b := Line( b1, b2, c1, c2 );
 c := Line( a1, a2, c1, c2 );
 per := a + b + c;
 S := Geron;
 { Triangle 1 }
 a := Line( a1, a2, x, y );
 b := Line( b1, b2, x, y );
 c := Line( a1, a2, b1, b2 );
 per := a + b + c;
 S1 := Geron;
 { Triangle 2 }
 a := Line( b1, b2, x, y );
 b := Line( c1, c2, x, y );
 c := Line( b1, b2, c1, c2 );
 per := a + b + c;
 S2 := Geron;
 { Triangle 3 }
 a := Line( a1, a2, x, y );
 b := Line( c1, c2, x, y );
 c := Line( a1, a2, c1, c2 );
 per := a + b + c;
 S3 := Geron;
 S1 := S1 + S2 + S3;
 If( abs(S - S1) < 0.0001 ) Then
  Write( 'Point is IN of the triangle.' )
 Else
  Write( 'Point is OUT of the triangle.' );
readln;

End.



--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
mr.Anderson
Дата 7.11.2006, 17:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


iOS Lead Developer
****


Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: нет
Всего: 128
alexeis1, спасибо! Путем долгих изысканий. Все работает.


--------------------
user posted image

user posted image
PM MAIL ICQ Skype   Вверх
Zero
Дата 7.11.2006, 17:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24
А как насчёт варианта расчёта площади без линий (в одну строчку):
Код

var
  ax,ay,bx,by,cx,cy,dx,dy:integer;

function S(ax,ay,bx,by,cx,cy:integer):real;
begin
  S := abs(bx*cy-cx*by-ax*cy+cx*ay+ax*by-bx*ay);
end;

Begin
  read(ax,ay,bx,by,cx,cy,dx,dy);

  if S(ax,ay,bx,by,dx,dy)+S(bx,by,cx,cy,dx,dy)+S(ax,ay,cx,cy,dx,dy) = S(ax,ay,bx,by,cx,cy) then
    write('yes')
  else
    write('no');
End.
PM MAIL ICQ   Вверх
mr.Anderson
Дата 7.11.2006, 18:11 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


iOS Lead Developer
****


Профиль
Группа: Участник Клуба
Сообщений: 3374
Регистрация: 20.12.2004
Где: далеко

Репутация: нет
Всего: 128
Что-то не понял, Zero. Саму формулу не понял. Как она читается словами?


--------------------
user posted image

user posted image
PM MAIL ICQ Skype   Вверх
MBo
Дата 7.11.2006, 18:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 234
Регистрация: 10.6.2002

Репутация: нет
Всего: 18
Попроще маленько smile 
Код

function PtInTriangle(ax, ay, bx, by, cx, cy, px, py: Integer): Boolean;
var
  xb, yb, xc, yc, xp, yp, d: Integer;
  bb, cc, oned: Double;
begin
  Result := False;
  xb := bx - ax;
  yb := by - ay;
  xc := cx - ax;
  yc := cy - ay;
  xp := px - ax;
  yp := py - ay;
  d := xb * yc - yb * xc;
  if d <> 0 then begin
    oned := 1 / d;
    bb := (xp * yc - xc * yp) * oned;
    cc := (xb * yp - xp * yb) * oned;
    Result := (bb >= 0) and (cc >= 0) and (bb + cc <= 1);
  end;
end;
PM MAIL   Вверх
Zero
Дата 7.11.2006, 18:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24
sim7, словами она не читается... Это:
Код

S := abs(bx*cy-cx*by-ax*cy+cx*ay+ax*by-bx*ay);
 Просто формула подсчёта площади....
Я её преобразовал, обычными математическими выражениями на листке. Сканера у меня нет (расчёты выложить не смогу), да и сложного в ней тоже ни чё нет, просто я её перевёл, из формулы площади для ABC, в фор-лу для координат, каждой точки. (Из определителя матрицы площади короче)

Добавлено @ 18:29 
Цитата(MBo @  7.11.2006,  19:26 Найти цитируемый пост)
Попроще маленько

Для понимания, или описания на языке + потом расчёта её в структуре памяти... smile 

Это сообщение отредактировал(а) Zero - 7.11.2006, 18:31
PM MAIL ICQ   Вверх
MBo
Дата 8.11.2006, 06:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 234
Регистрация: 10.6.2002

Репутация: нет
Всего: 18
Zero, 
>Для понимания, или описания на языке + потом расчёта её в структуре памяти... 

Не уловил смысла фразы smile 
PM MAIL   Вверх
Zero
Дата 8.11.2006, 14:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24
Ну всмысле проще относительно какого варианта, моего или ещё чиё нибудь...
(и за счёт чего эта упрощённость осуществляется?)
PM MAIL ICQ   Вверх
sofware
Дата 1.12.2006, 00:04 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 20
Регистрация: 30.11.2006

Репутация: нет
Всего: 1
А вот мой код:

Код

type point=record
       x:real;
       y:real;
     end;
var tr:array[1..3]of point;
    t:point;
    i:1..3;
function dis(p,q:point):real;
begin
dis:=sqrt(sqr(p.x-q.x)+sqr(p.y-q.y));
end;
function Grn(a,b,c:point):real;
var da,db,dc,p:real;
 begin
  da:=dis(c,b);db:=dis(a,c);dc:=dis(a,b);
  p:=(da+db+dc)/2;
  grn:=sqrt(p*(p-da)*(p-db)*(p-dc));
 end;

begin
 for i:=1 to 3 do
 readln(tr[i].x,tr[i].y);
 readln(t.x,t.y);
 if grn(tr[1],tr[2],tr[3])*1.000001<
    grn(t,tr[1],tr[2])+grn(t,tr[1],tr[3])+grn(t,tr[2],tr[3]) then
    write('no') else write('Yes')
end.


Это сообщение отредактировал(а) volvo877 - 1.12.2006, 11:51
PM MAIL   Вверх
Alexeis
Дата 1.12.2006, 00:13 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: нет
Всего: 459
sofware, не забывайте выделять код.


--------------------
Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi"
THandle
Rrader
volvo877

Запрещается!

1. Обсуждать и делится взломанными компонентами или программным обеспечением

2. Публиковать ссылки на варез

3. Оффтопить

  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, THandle, Rrader, volvo877.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Object Pascal: кроссплатформенные технологии | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0705 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.