Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Object Pascal: кроссплатформенные технологии > программирование на paskal

Автор: Irisha 6.10.2004, 15:27

Пусть даны вещественные числа x1,x2,x3,y1,y2,y3.Принадлежит ли начало координат треугольнику с вершинами (x1,y1),(x2,y2),(x3,y3)?

Добавлено @ 15:30
решите задачу...

Автор: Guest 6.10.2004, 15:33

Irisha
Эдак вас всех......брррррррр.
Математику учить надо, а не программирование
Векторы в школе проходили?

Автор: Garabar 6.10.2004, 17:43

Ну например так, хоть эт внатуре и не программирование суть
Первое,
Для того что бы начало координат преналжело треугольнику необхадимо что бы одна или несколколько из его сторон пересекали ось обцисс и ординат хотябы один раз, соответсвенно для этого те надо проверять выполняица это условие или нет.
Второе,
Для проверки этого условия те нужно проверить x1*x2>0 еесли истинно то между этими вершинами обцисс не пересекает, для ординат анологично y1*y2>0.
третье,
Ну и потом перебираешь все варианты (их три кстати) до тех пор пока не либо они не конаться либо не выполница кождое из условий хотябы по одному разу....

Автор: Akina 6.10.2004, 17:53

Garabar
Господи, зачем так сложно.

Если начало координат лежит внутри треугольника, то начало координат и одна вершина лежат по одну сторону от прямой, определяемой остальными вершинами. Проверяется это элементарно - если в пределах от -пи до +пи синусы углов 120 и 123 имеют одинаковый знак для любого порядка нумерования точек, то внутри. По координатам посчитать синус - дело плевое...

Автор: Garabar 6.10.2004, 17:59

Цитата

Господи, зачем так сложно.

Интересно рассчет синусов тратит больше системных ресурсов чем произведение....))))

Автор: Pakshin A. S. 6.10.2004, 20:21

1) не paskal, a Pascal
2)

Код


if ((X1 * X2 <0) or (x2 * x3 < 0) or (X1 * x3 < 0)) and ((Y1*Y2 < 0) or (Y2 * Y3 < 0) or (Y3 * Y1 < 0))
 then
  writeln('Да')
 else
  writeln('Нет');

Может и ошибаюсь, но вроде так...

Автор: Pakshin A. S. 7.10.2004, 09:20

ОШИБАЮСЬ!!!
Лохонулся я вчера: после трех пар математичесого анализа и одной пары линейной алгебры мозги не хотели работать
Вот примерчик:

Код


var
 x,y:real;
 x1,y1,x2,y2,x3,y3:real;
begin
 readln(x1,y1,x2,y2,x3,y3);
 x:=0;
 y:=0;
 if ((y < (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y < (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y >(y3 - y2)*(x - x2)/(x3-x2)+y2)) or
   ((y < (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y < (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y >(y1 - y3)*(x - x3)/(x1-x3)+y3)) or
   ((y < (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y < (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y >(y2 - y1)*(x - x1)/(x2-x1)+y1)) or
   ((y > (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y < (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y >(y3 - y2)*(x - x2)/(x3-x2)+y2)) or
   ((y > (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y < (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y >(y1 - y3)*(x - x3)/(x1-x3)+y3)) or
   ((y > (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y < (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y >(y2 - y1)*(x - x1)/(x2-x1)+y1)) or
   ((y < (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y > (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y >(y3 - y2)*(x - x2)/(x3-x2)+y2)) or
   ((y < (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y > (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y >(y1 - y3)*(x - x3)/(x1-x3)+y3)) or
   ((y < (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y > (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y >(y2 - y1)*(x - x1)/(x2-x1)+y1)) or
   ((y > (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y > (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y <(y3 - y2)*(x - x2)/(x3-x2)+y2)) or
   ((y > (y2 - y1)*(x - x1)/(x2-x1)+y1) and (y > (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y <(y1 - y3)*(x - x3)/(x1-x3)+y3)) or
   ((y > (y3 - y2)*(x - x2)/(x3-x2)+y2) and (y > (y1 - y3)*(x - x3)/(x1-x3)+y3) and (y <(y2 - y1)*(x - x1)/(x2-x1)+y1))
   then
    writeln('Да')
   else
    writeln('Нет');
 readln;
end.

Автор: Pakshin A. S. 7.10.2004, 11:21

Доработанный вариант:

Код


if
 ((y < (y1 - y2)*(x - x2)/(x1 - x2) + y2) and (y < (y3 - y1)*(x - x1)/(x3 - x1) + y1) and (y > (y2 - y3)*(x - x3)/(x2 - x3) + y3) and
  (x > (y - y2)*(x1 - x2)/(y1 - y2) + x2) and (x < (y - y1)*(x3 - x1)/(y3 - y1) + x1) and (x > (y - y3)*(x2 - x3)/(y2 - y3) + x3)) or

 ((y < (y2 - y3)*(x - x3)/(x2 - x3) + y3) and (y < (y1 - y2)*(x - x2)/(x1 - x2) + y2) and (y > (y3 - y1)*(x - x1)/(x3 - x1) + y1) and
  (x > (y - y3)*(x2 - x3)/(y2 - y3) + x3) and (x < (y - y2)*(x1 - x2)/(y1 - y2) + x2) and (x > (y - y1)*(x3 - x1)/(y3 - y1) + x1)) or

 ((y < (y3 - y1)*(x - x1)/(x3 - x1) + y1) and (y < (y2 - y3)*(x - x3)/(x2 - x3) + y3) and (y > (y1 - y2)*(x - x2)/(x1 - x2) + y2) and
  (x > (y - y1)*(x3 - x1)/(y3 - y1) + x1) and (x < (y - y3)*(x2 - x3)/(y2 - y3) + x3) and (x > (y - y2)*(x1 - x2)/(y1 - y2) + x2)) or

 ((y < (y1 - y2)*(x - x2)/(x1 - x2) + y2) and (y > (y3 - y1)*(x - x1)/(x3 - x1) + y1) and (y > (y2 - y3)*(x - x3)/(x2 - x3) + y3) and
  (x > (y - y2)*(x1 - x2)/(y1 - y2) + x2) and (x < (y - y1)*(x3 - x1)/(y3 - y1) + x1) and (x > (y - y3)*(x2 - x3)/(y2 - y3) + x3)) or

 ((y < (y2 - y3)*(x - x3)/(x2 - x3) + y3) and (y > (y1 - y2)*(x - x2)/(x1 - x2) + y2) and (y > (y3 - y1)*(x - x1)/(x3 - x1) + y1) and
  (x > (y - y3)*(x2 - x3)/(y2 - y3) + x3) and (x < (y - y2)*(x1 - x2)/(y1 - y2) + x2) and (x > (y - y1)*(x3 - x1)/(y3 - y1) + x1)) or

 ((y < (y3 - y1)*(x - x1)/(x3 - x1) + y1) and (y > (y2 - y3)*(x - x3)/(x2 - x3) + y3) and (y > (y1 - y2)*(x - x2)/(x1 - x2) + y2) and
  (x > (y - y1)*(x3 - x1)/(y3 - y1) + x1) and (x < (y - y3)*(x2 - x3)/(y2 - y3) + x3) and (x > (y - y2)*(x1 - x2)/(y1 - y2) + x2)) or

 ((y < (y1 - y2)*(x - x2)/(x1 - x2) + y2) and (y < (y3 - y1)*(x - x1)/(x3 - x1) + y1) and (y > (y2 - y3)*(x - x3)/(x2 - x3) + y3) and
  (x > (y - y2)*(x1 - x2)/(y1 - y2) + x2) and (x < (y - y1)*(x3 - x1)/(y3 - y1) + x1) and (x < (y - y3)*(x2 - x3)/(y2 - y3) + x3)) or

 ((y < (y2 - y3)*(x - x3)/(x2 - x3) + y3) and (y < (y1 - y2)*(x - x2)/(x1 - x2) + y2) and (y > (y3 - y1)*(x - x1)/(x3 - x1) + y1) and
  (x > (y - y3)*(x2 - x3)/(y2 - y3) + x3) and (x < (y - y2)*(x1 - x2)/(y1 - y2) + x2) and (x < (y - y1)*(x3 - x1)/(y3 - y1) + x1)) or

 ((y < (y3 - y1)*(x - x1)/(x3 - x1) + y1) and (y < (y2 - y3)*(x - x3)/(x2 - x3) + y3) and (y > (y1 - y2)*(x - x2)/(x1 - x2) + y2) and
  (x > (y - y1)*(x3 - x1)/(y3 - y1) + x1) and (x < (y - y3)*(x2 - x3)/(y2 - y3) + x3) and (x < (y - y2)*(x1 - x2)/(y1 - y2) + x2))
{Можно ещё покрутить треугольник в плоскости, но нет времени...}
  then
   writeln('Yes')
  else
   writeln('No');

Автор: Akina 7.10.2004, 12:39

Pakshin A. S.
сплошные деления на нуль при совпадении x или y у двух точек...

Garabar

Цитата

рассчет синусов тратит больше системных ресурсов чем произведение

во-первых, сисинус считается исключительно вычитаниями и делениями. Во-вторых, достаточно получить его знак.

Автор: Garabar 7.10.2004, 13:00

Akina

Код

во-первых, сисинус считается исключительно вычитаниями и делениями. Во-вторых, достаточно получить его знак.

Хе) ну что бы получить его знак его нужно пасчитать....
А во вторых что бы пасчитать синус нужно я думаю больше раза поделить(или умножить))))

Автор: p0s0l 7.10.2004, 13:10

Pakshin A. S., как этим пользоваться ? У меня все время "Да"... + Иногда вылетает Floating Point - ошибка...

Вот мой вариант:
Если начало координат принадлежит треугольнику (внутри треугольника, или на сторонах), то треугольник должен пересекать обе оси Ox и Oy с двух сторон (на положительной и отрицательной частях)...

Код

function ChkTreug (x1, y1, x2, y2, x3, y3 : real) : boolean;
var Ints : array [0..3] of boolean;
  procedure Intersect (x1, y1, x2, y2 : real);
  begin
    if (x2*x1 < 0) then Ints[0 + Byte((y1 - x1/(x2-x1)*(y2-y1)) > 0)] := True;
    if (y2*y1 < 0) then Ints[2 + Byte((x1 - y1/(y2-y1)*(x2-x1)) > 0)] := True;
  end;

begin
  FillChar (Ints, SizeOf(Ints), 0);
  Intersect (x1, y1, x2, y2);
  Intersect (x2, y2, x3, y3);
  Intersect (x3, y3, x1, y1);
  Result := Ints[0] and Ints[1] and Ints[2] and Ints[3];
end;

Автор: Pakshin A. S. 7.10.2004, 17:46

Я пытаюсь рассмотреть позицию точки по отношению к прямым через уравнение прямой, проходящей через две точки
y-y1=(y2-y1)(x-x1)/(x2-x1)...

Да видимо мысль не туда пошла...

Автор: ДЫМ 8.10.2004, 01:54

В RXLibrary есть функция (сечас не помню точно как называется), вот она
возвращает True, если точка лежит внутри многоугольника.

Автор: EKoshelev 8.10.2004, 08:08

ДЫМ , Да? А я помнится сам её корябал... Заманался, честно говоря.

Автор: maxim1000 8.10.2004, 11:22

Цитата

Если начало координат лежит внутри треугольника, то начало координат и одна вершина лежат по одну сторону от прямой, определяемой остальными вершинами. Проверяется это элементарно - если в пределах от -пи до +пи синусы углов 120 и 123 имеют одинаковый знак для любого порядка нумерования точек, то внутри. По координатам посчитать синус - дело плевое...

небольшое уточнение: необходимо проверять не для одной из вершин, а для всех (хотя, может, я неправильно прочитал, и именно это и имелось в виду)

небольшая модификация:
1. точка лежит внутри треугольника тогда и только тогда, когда при обходе его она всегда лежит с одной стороны (это верно вообще для всех выпуклых полигонов)
2. для того, чтобы определить, с какой стороны лежит точка от прямой, достаточно определить знак угла (если считать его между -180 и +180) между направляющим вектором прямой и вектором от одной из точек прямой к исследуемой точке
3. для определения знака угла в интервале (-180, +180) достаточно определить знак синуса
4. как было справедливо замечено для подсчета синуса между двумя векторами на плоскости достаточно нескольких арифметических операций: просто добавляем к каждому вектору третью нулевую координату z и считаем их векторное произведение

и так алгоритм такой:

Код

result:=(ABxAO,BCxBO,CAxCO имеют одинаковый знак);

под обозначением ABxAO понимается следующее:
a=B1-A1
b=B2-A2
c=O1-A1
d=O2-A2
ABxAO=a*d-b*c

Автор: maxim1000 8.10.2004, 11:33

Код

function EqualSigns(x,y,z:real):boolean;
begin
  result:=false;
  if(x>0)and(y>0)and(z>0)then
    result:=true;
  if(x<0)and(y<0)and(z<0)then
    result:=true;
end;
function VectorMultiply(x1,y1,x2,y2:real):real;
begin
  result:=x1*y2-y1*x2;
end;
function IsOriginInsideTriangle(a1,a2,b1,b2,c1,c2:real):boolean;
var
  x,y,z:real;
begin
  x:=VectorMultiply(b1-a1,b2-a2,0-a1,0-a2);
  y:=VectorMultiply(c1-b1,c2-b2,0-b1,0-b2);
  z:=VectorMultiply(a1-c1,a2-c2,0-c1,0-c2);
  result:=EqualSigns(x,y,z);
end;

честно говоря, не проверял (нету у меня на машине Delphi)