Нуно сделать прогу, которая по двух отрезках находила их пересечение. Искала, но ни одна программа не работает
Автор: Tan 15.04.2007 2:57
в смысле ты задаёшь координаты двух отрезков и тебе надо найти точку их пересечения ?
Автор: Reflex 15.04.2007 3:21
да
Автор: Tan 15.04.2007 3:24
У тебя есть 2 точки отрезка, следовательно ты можешь составить уравнение линии которой принадлежит отрезок, находишь уравнения для 2х линий, приравниваешь уравнения и находишь точку их пересечения, после этого проверяешь принадлежит ли эта точка обоим отрезкам на их интервале.
Автор: Reflex 15.04.2007 3:37
такой код очень муторный и долгий нет ли более простогометода?
Не работает 1 0 2 0 1 0 3 0 и я так поняла, что она не показывает мн-во пересечений(координаты точки или отрезка) помогите, очень нужно
Автор: Perfez 17.04.2007 12:34
Цитата
что она не показывает мн-во пересечений(координаты точки или отрезка)
Разве две прямые линии могут пересекаться в двух разных точках?
Автор: Lapp 17.04.2007 13:49
Отведай мою стряпню..
type tPoint=record x,y:real end; tLine=record P1,P2:tPoint end;
procedure InterSection(L1,L2:tLine;var P:tPoint); var k1,k2:real; begin with L1 do k1:= (P2.y-P1.y)/(P2.x-P1.x); with L2 do k2:= (P2.y-P1.y)/(P2.x-P1.x); P.x:= (L1.P1.y - L2.P1.y + L2.P1.x*k2 - L1.P1.x*k1) / (k2-k1); with L1 do P.y:= P1.y + (P.x-P1.x)*k1; end;
var L1,L2:tLine; P:tPoint;
begin with L1 do begin P1.x:=-2; P1.y:=-2; P2.x:=+2; P2.y:= 0; end; with L2 do begin P1.x:= 0; P1.y:= 1; P2.x:=+2; P2.y:=-2; end; InterSection(L1,L2,P); with P do WriteLn('X=',x:7:3,' Y=',y:7:3); ReadLn end.
Добавлено через 3 мин. Эта процедура выдаст ошибку, если отрезок расположен вдоль у. Но этот случай гораздо проще, и его можно рассмотреть отдельно.
Автор: volvo 17.04.2007 14:10
Цитата
Эта процедура выдаст ошибку, если отрезок расположен вдоль у.
Не только... Эта процедура выдаст ошибку ВСЕГДА, когда отрезки только касаются друг друга, но не пересекаются:
with L1 do begin P1.x:= 1; P1.y:= 2; P2.x:= 5; P2.y:=10; end; with L2 do begin P1.x:= 1; P1.y:= 0; P2.x:= 5; P2.y:= 8; end;
результат: (k1 = k2), divizion by zero
Автор: Lapp 17.04.2007 14:32
Цитата(volvo @ 17.04.2007 11:10)
Эта процедура выдаст ошибку ВСЕГДА, когда отрезки только касаются друг друга, но не пересекаются: ... результат: (k1 = k2), divizion by zero
Не совсем понял, при чем здесь касание... k1=k2 означает параллельность прямых, что естественно, тоже особый случай. В любом случае - volvo, спасибо за исправление.
2 reflex: Да, нужно проверять также на параллельность, то есть равенство k1 и k2.
Автор: Reflex 17.04.2007 22:41
Код
type point = record x, y: real; end; procedure min(var point11,point12:point); var tmp : point; begin if (point11.x<point12.x) or (point11.y<point12.y) then exit; tmp:=point11; point11:=point12; point12:=tmp; end; function inside(p1,p2,p3:point):boolean; begin inside:=false; if p1.y=p2.y then begin if (p1.x<=p3.x) and (p2.x<=p1.x) then inside:=true; end else if (p1.y<=p3.y) and (p2.y<=p1.y) then inside:=true; end;
function conect(point11, point12, point21, point22: point;var pretpoint: point): boolean; var d, d1, d2, t1, t2: real; p1,p2:point; var f : boolean; comp : real; const epsilon = 10E-4; begin conect := false; f:=false; d := (point12.y - point11.y)*(point21.x - point22.x) - (point21.y - point22.y)*(point12.x - point11.x); if abs(d) < epsilon then begin comp:=abs(abs((point12.x-point11.x)*(point21.x-point11.x) +(point12.y-point11.y)*(point21.y-point11.y)) -sqrt(sqr(point12.x-point11.x)+sqr(point11.y-point12.y)) *sqrt(sqr(point21.x-point11.x)+sqr(point11.y-point21.y))); { writeln(comp:0:6);} if comp<epsilon then begin if point11.y=point12.y then begin if (point11.x<=point21.x) and (point12.x>=point21.x) then begin if (point11.x<=point22.x) and (point12.x>=point22.x) then begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point22.x; p2.y:=point22.y; f:=true; conect:=true; end else begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end; end else if (point11.x<=point22.x) and (point12.x>=point22.x) then begin p1.x:=point22.x; p1.y:=point22.y; p2.x:=point11.x; p2.y:=point11.y; f:=true; conect:=true; end else begin p1.x:=point11.x; p1.y:=point11.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end;
end else if (point11.y<=point21.y) and (point12.y>=point21.y) then begin if (point11.y<=point22.y) and (point12.y>=point22.y) then begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point22.x; p2.y:=point22.y; f:=true; conect:=true; end else begin p1.x:=point21.x; p1.y:=point21.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end; end else if (point11.y<=point22.y) and (point12.y>=point22.y) then begin p1.x:=point22.x; p1.y:=point22.y; p2.x:=point11.x; p2.y:=point11.y; f:=true; conect:=true; end else begin p1.x:=point11.x; p1.y:=point11.y; p2.x:=point12.x; p2.y:=point12.y; f:=true; conect:=true; end end; if f then if (p1.x<>p2.x) or (p1.y<>p2.y) then begin write(p1.x:0:6,' ',p1.y:0:6,' ',p2.x:0:6,' ',p2.y:0:6) end else begin write(p1.x:0:6,' ',p1.y:0:6); end else begin if (point11.x=point21.x) and (point11.y=point21.y) then begin writeln(point11.x:0:6,' ',point11.y:0:6); conect:=true; exit; end else if (point11.x=point22.x) and (point11.y=point22.y) then begin writeln(point11.x:0:6,' ',point11.y:0:6); conect:=true; exit; end else if (point12.x=point21.x) and (point12.y=point21.y) then begin writeln(point12.x:0:6,' ',point12.y:0:6); conect:=true; exit; end else if (point12.x=point22.x) and (point12.y=point22.y) then begin writeln(point12.x:0:6,' ',point12.y:0:6); conect:=true; exit; end; end;
exit; end; d1 := (point12.y-point11.y)*(point21.x-point11.x)-(point21.y-point11.y)*(point12.x-point11.x); d2 := (point21.y-point11.y)*(point21.x-point22.x)-(point21.y-point22.y)*(point21.x-point11.x); t1:=d1/d; t2:=d2/d; if not ((t1<=1)and(t1>=0)and(t2>=0)and(t2<=1)) then begin exit; end; write(point11.x+(point12.x-point11.x)*t2:0:6,' ',point11.y+(point12.y-point11.y)*t2:0:6); { pretpoint.x := point11.x+(point12.x-point11.x)*t2; pretpoint.y := point11.y+(point12.y-point11.y)*t2;} conect := true end; var res,p1,p2,p3,p4: point; begin read(p1.x,p1.y,p2.x,p2.y,p3.x,p3.y,p4.x,p4.y); min(p1,p2); min(p3,p4); if conect(p1, p2, p3, p4, res) then else writeln('Empty'); end.
помогите найти ошибку.
Автор: Lapp 18.04.2007 7:09
Цитата(Reflex @ 17.04.2007 19:41)
помогите найти ошибку.
Легко. Твоя ошибка уже в том, что ты не указала, в чем она состоит. А желающим помочь самим догадываться, что должна делать программа, что она вводит в начальных данных (даже нет приглашений на ввод!!), где и как проявляется ошибка... Во всем тексте ни одного комментария!
М
Неполное указание своей проблемы считаю неуважением к собеседникам, которые должны тратить свое время на ненужные исследования. Устное предупреждение! Lapp