IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Находится ли один треугольник в другом
сообщение
Сообщение #1


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

О найденных ошибках сообщайте сюда: Собираем Ошибки!

uses crt;

const
eps = 0.00001;

type

tfloat = extended;

tpoint = record
x, y: tfloat;
end;

tline = record
p1, p2: tpoint;
k, b : tfloat;
end;

ttriangle = record
top: array [1..3] of tpoint;
end;

{
функция вернет true, если координаты точе p1 и p2 совпадают
}
function points_equal(const p1, p2: tpoint): boolean;
begin
points_equal := (abs(p1.x - p2.x) < eps) and (abs(p1.y - p2.y) < eps)
end;

{
получаем уравнение вида y = k*x+b для прямой по двум точкам,
случаи если прямая параллельна одной из осей, в программе рассматриваются отдельно
}
procedure get_line_equation(var line: tline; const point1, point2: tpoint);
begin
with line do begin

p1.x := point1.x; p1.y := point1.y;
p2.x := point2.x; p2.y := point2.y;

if not((p1.x = p2.x) or (p1.y = p2.y)) then begin
k := (p2.y - p1.y) / (p2.x - p1.x);
b := -p1.x * ((p2.y - p1.y) / (p2.x - p1.x)) + p1.y;
end else begin
k := 0;
b := 0;
end;

end;
end;

{
значение функции заданной прямой line в точке x
}
function get_equation_value(const line: tline; const x: tfloat): tfloat;
begin
get_equation_value := line.k * x + line.b;
end;

{
функция вернет true, если значение value находится между значений A и B
}
function value_between(const value: tfloat; const a, b: tfloat): boolean;
begin
value_between :=
((value >= a) and (value <= b)) or ((value >= b) and (value <= a));
end;

{
функция вернет true, если точка point принадлежит прямой line (не отрезку)
}
function in_line(const point: tpoint; const line: tline): boolean;
begin
with line do begin
if (p1.x = p2.x) then in_line := point.x = p1.x
else if (p1.y = p2.y) then in_line := point.y = p1.y
else in_line := abs(point.y - get_equation_value(line, point.x)) < eps;
end;
end;

{
функция вернет true, если точка point принадлежит отрезку прямой line
крайние точки отрезка line1.p1 и line2.p2
}
function in_piece_line(const point: tpoint; const line: tline): boolean;
var
belongs: boolean;

begin
belongs := in_line(point, line);

if belongs then with line do begin
if abs(p1.x - p2.x) < eps then belongs := belongs and value_between(point.y, p1.y, p2.y)
else belongs := value_between(point.x, p1.x, p2.x)
end;

in_piece_line := belongs;
end;

{
если у прямых line1 и line2 есть точка пересечения, то функция вернет true и cross_point будет
содержать ее координаты
}
function get_crossing_point(const line1, line2: tline;
var cross_point: tpoint): boolean;
begin
if ((abs(line1.p1.x - line1.p2.x) < eps) and (abs(line2.p1.x - line2.p2.x) < eps))
or((abs(line1.p1.y - line1.p2.y) < eps) and (abs(line2.p1.y - line2.p2.y) < eps))
then get_crossing_point := false
else begin

get_crossing_point := true;

if (line1.p1.x = line1.p2.x) then begin

if (line2.p1.y = line2.p2.y) then begin

cross_point.x := line1.p1.x;
cross_point.y := line2.p1.y;

end else begin

cross_point.x := line1.p1.x;
cross_point.y := get_equation_value(line2, cross_point.x);

end;

end else if (line1.p1.y = line1.p2.y) then begin

if (line2.p1.x = line2.p2.x) then begin

cross_point.x := line2.p1.x;
cross_point.y := line1.p1.y;

end else begin

cross_point.y := line1.p1.y;
cross_point.x := (cross_point.y - line2.b) / line2.k;

end;

//
end else if (line2.p1.x = line2.p2.x) then begin

if (line1.p1.y = line1.p2.y) then begin

cross_point.x := line2.p1.x;
cross_point.y := line1.p1.y;

end else begin

cross_point.x := line2.p1.x;
cross_point.y := get_equation_value(line1, cross_point.x);

end;

end else if (line2.p1.y = line2.p2.y) then begin

if (line1.p1.x = line1.p2.x) then begin

cross_point.x := line1.p1.x;
cross_point.y := line2.p1.y;

end else begin

cross_point.y := line2.p1.y;
cross_point.x := (cross_point.y - line1.b) / line1.k;

end;
end else begin

cross_point.x := (line2.b - line1.b) / (line1.k - line2.k);
cross_point.y := get_equation_value(line1, cross_point.x);

end;

end;
end;

{
функция вернет true, если точка point находится в треугольнике triangle
}
function point_in_triangle(const point: tpoint;
const triangle: ttriangle): boolean;
var
test_line, check_side: tline;
cross_point: tpoint;

i, j: integer;
_include: boolean;
begin
i := 1;
_include := false;

while (i <= 2) and not(_include) do begin
j := i + 1;

while (j <= 3) and not(_include) do begin

get_line_equation(test_line, triangle.top[i], triangle.top[j]);

_include := in_piece_line(point, test_line);

inc(j);
end;

inc(i);
end;

if not(_include) then begin
_include := true;

i := 1;
while (i <= 3) and _include do begin

get_line_equation(test_line, triangle.top[i], point);

case i of
1: get_line_equation(check_side, triangle.top[2], triangle.top[3]);
2: get_line_equation(check_side, triangle.top[1], triangle.top[3]);
3: get_line_equation(check_side, triangle.top[1], triangle.top[2]);
end;

_include := get_crossing_point(test_line, check_side, cross_point)
and (in_piece_line(cross_point, check_side));

inc(i);
end;
end;

point_in_triangle := _include;
end;

{
функция вернет true, если треугольник t_1 находится в треугольнике t_2
}
function triangle_in_triangle(const t_1, t_2: ttriangle): boolean;
var
i: byte;
begin
i := 1;
while (i <= 3) and point_in_triangle(t_1.top[i], t_2) do inc(i);
triangle_in_triangle := (i > 3);
end;


var
cross_point: tpoint;
t: array [1..2] of ttriangle;

i, j: byte;

begin
clrscr;

for i := 1 to 2 do
with t[i] do begin
writeln('Enter coords of ', i, ' triangle: ');
writeln;
for j := 1 to 3 do begin
write('top(', j, ').x = '); readln(top[j].x);
write('top(', j, ').y = '); readln(top[j].y);
writeln;
end;
end;

if triangle_in_triangle(t[1], t[2]) then writeln('1 in 2')
else if (triangle_in_triangle(t[2], t[1])) then writeln('2 in 1')
else writeln('none');

readln;
end.



--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Находится ли один треугольник в другом

{
функция вернет true, если точка point принадлежит отрезку прямой line,
координаты крайних точек отрезка соотверствую координатам точек,
по которым была построена прямая line: line.p1 и line.p2
}
function in_piece_line(const point: tpoint; const line: tline): boolean;
var
belongs: boolean;

begin
belongs := in_line(point, line);

if belongs then with line do begin
if abs(p1.x - p2.x) < eps then belongs := belongs and value_between(point.y, p1.y, p2.y)
else belongs := belongs and
value_between(point.x, p1.x, p2.x)
end;
end;

Функция ничего не возвращает, обрати внимание - нет идентификатора, определяющего имя функции... Аккуратнее с этим...
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.10.2020 6:35
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name