Набор треугольников, Выявить пересекающиеся |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Набор треугольников, Выявить пересекающиеся |
Ольга |
Сообщение
#1
|
Гость |
Здравствуйте!
Помогите пожалуйста решить задачу. На плоскости имеется набор треугольников. Выявить все треугольники , пересекающиеся хотя бы с одним треугольником из этого набора. Буду очень благодарна! |
volvo |
Сообщение
#2
|
Гость |
Цитата Выявить все треугольники , пересекающиеся хотя бы с одним треугольником из этого набора. Уточни задание... Откуда берутся те треугольники, КОТОРЫЕ надо проверять на пересечение с заданными... |
Lapp |
Сообщение
#3
|
Уникум Группа: Пользователи Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: 159 |
Я думаю, что речь идет о треугольниках из того же набора. Но даже если это не так - это все равно несущественная чать задачи. Как я понимаю, интересует алгоритм проверки двух треугольников на пересечение (чтобы потом использовать как процедуру). В голову сразу приходит проверить все три стороны одного треугольника со всеми тремя сторонами другого на пересечение (как отрезки). Всего будет 3^2=9 комбинаций. Но, возможно, есть и более короткий алгоритм.. Например, похоже, что не нужно проверять последнюю пару сторон..
-------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
volvo |
Сообщение
#4
|
Гость |
lapp, то, что ДУМАЕШЬ ты, меня в данном контексте мало интересует! Задание либо есть либо его НЕТ. В данном случае - его нет.
У нас не форум телепатов, в конце концов. |
Lapp |
Сообщение
#5
|
Уникум Группа: Пользователи Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: 159 |
lapp, то, что ДУМАЕШЬ ты, меня в данном контексте мало интересует! Задание либо есть либо его НЕТ. В данном случае - его нет. У нас не форум телепатов, в конце концов. Волво, в чем дело? Я предложил конкретное решение задачи. Разве не так? Тут есть масса гораздо менее четко поставленных задач! Люди не на экзамене, и это нужно учитывать. -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
Ольга |
Сообщение
#6
|
Гость |
Вчера бегала в институт, искала преподавателя. Вообщем треугольники все из одного набора.
Lapp правильно подумал. Очень прошу помочь мне с решением данной задачи, пожалуйста! |
Lapp |
Сообщение
#7
|
Уникум Группа: Пользователи Сообщений: 6 823 Пол: Мужской Реальное имя: Лопáрь (Андрей) Репутация: 159 |
Как я уже писал выше, для каждой пары треугольников проверь, пересекаются ли их стороны (попарно, 9 пар, но реально, похоже, достаточно проверить 8). Текст процедуры для проверки перескаемости отрезков здесь.
Пиши и приноси на проверку.. -------------------- я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой |
-Оля- |
Сообщение
#8
|
Гость |
Принесла на проверку! Посмотрите пожалуйста, может будут какие-нибудь замечания.
Код program treug1; uses crt,graph; type point = record x,y:integer; end; ptreug = ^treug; treug = record ver:array[0..2]of point; per:boolean; next:ptreug; end; var mas:ptreug; gdriver,gmode:integer; key:char; select:integer; {процедура очистки памяти} procedure Free(var t:ptreug); begin if t<>nil then begin Free(t^.next); freemem(t,sizeof(treug)); t:=nil; end; end; {проверка на пересечение отрезков} function ver(x1,y1,x2,y2,x3,y3,x4,y4:integer):boolean; var b1,b2,x:real; flag2,flag1:boolean; z,z1,z2:real; begin {проверка на паралельность оси оу 1 прямой} if (x1<>x2)then begin b1:=(-x1*(y2-y1))/(x2-x1)+y1; z1:=(y2-y1)/(x2-x1); end else begin b1:=0; z1:=0; end; {проверка на паралельность оси оу 2 прямой} if (x3<>x4)then begin b2:=(-x3*(y4-y3))/(x4-x3)+y3; z2:=(y4-y3)/(x4-x3); end else begin b2:=0; z2:=0; end; {находим знаменатель} z:=z1-z2; ver:=false; {если отрезки паралельны то выходим} if z=0 then exit; {координата x пересечения 2х прямых} x:=(b2-b1)/(z); flag1:=false; {проверяем координаты х ???} if x1>x2 then begin if (x<=x1)and(x>=x2) then flag1:=true; end else begin if (x>=x1)and(x<=x2) then flag1:=true; end; flag2:=false; if x3>x4 then begin if (x<=x3)and(x>=x4) then flag2:=true; end else begin if (x>=x3)and(x<=x4) then flag2:=true; end; ver:=(flag1 and flag2); end; {процедура поиска и вывода результата} procedure vivod; var i,j,i1,j1:integer; t,t1:ptreug; s:string; f:text; begin cleardevice; {оси координат} outtextxy(100,196,'vvedite ima faila dla zapisi resultata'); gotoxy(60,13); readln(s); cleardevice; line(20,240,620,240); line(620,240,610,250); line(620,240,610,230); line(320,20,320,460); line(320,20,310,30); line(320,20,330,30); t:=mas; {перебор треугольников} while t^.next<>nil do begin t1:=t^.next; while t1<>nil do begin for i:=0 to 1 do for j:=i+1 to 2 do{1 треугольник} for i1:=0 to 1 do for j1:=i1+1 to 2 do{2 треугольник} if ver(t^.ver[i].x,t^.ver[i].y, t^.ver[j].x,t^.ver[j].y, t1^.ver[i1].x,t1^.ver[i1].y, t1^.ver[j1].x,t1^.ver[j1].y) then begin{если пересекаются} {отметим оба} t^.per:=true; t1^.per:=true; end; {след треуг} t1:=t1^.next; end; {след треуг} t:=t^.next; end; assign(f,s); rewrite(f); t:=mas; {вывод всех треугольников} while t<>nil do begin {отметим цветом пересекающиеся} if t^.per then begin setcolor(10); writeln(f,'(',t^.ver[0].x:4, t^.ver[0].y:4,')(', t^.ver[1].x:4, t^.ver[1].y:4,')(', t^.ver[2].x:4, t^.ver[2].y:4,')'); end else setcolor(6); line(t^.ver[0].x+320,240-t^.ver[0].y,t^.ver[1].x+320,240-t^.ver[1].y); line(t^.ver[0].x+320,240-t^.ver[0].y,t^.ver[2].x+320,240-t^.ver[2].y); line(t^.ver[1].x+320,240-t^.ver[1].y,t^.ver[2].x+320,240-t^.ver[2].y); t:=t^.next; end; close(f); setcolor(6); end; {заполнение случайными значениями} procedure mrandom; var i:integer; t:ptreug; n:integer; begin cleardevice; gotoxy(50,13); outtextxy(100,196,'Введите количество треугольников:'); readln(n); getmem(mas,sizeof(treug)); t:=mas; for i:=0 to n-1 do begin t^.ver[0].x:=random(300)-150; t^.ver[0].y:=random(300)-150; t^.ver[1].x:=random(300)-150; t^.ver[1].y:=random(300)-150; t^.ver[2].x:=random(300)-150; t^.ver[2].y:=random(300)-150; t^.per:=false; if i<n-1 then begin getmem(t^.next,sizeof(treug)); t:=t^.next; end; end; t^.next:=nil; vivod; free(mas); readln; end; procedure minput; var i:integer; s,s1:string; t:ptreug; n:integer; begin cleardevice; gotoxy(50,13); outtextxy(100,200,'Введите количество треугольников:'); readln(n); getmem(mas,sizeof(treug)); t:=mas; for i:=0 to n-1 do begin cleardevice; str(i+1,s1); s:='Введите координаты первой точки '+s1+' треугольника:'; outtextxy(100,196,s); gotoxy(60,13); readln(t^.ver[0].x,t^.ver[0].y); cleardevice; s:='Введите координаты второй точки '+s1+' треугольника:'; outtextxy(100,196,s); gotoxy(60,13); readln(t^.ver[1].x,t^.ver[1].y); cleardevice; s:='Введите координаты третьей точки '+s1+' треугольника:'; outtextxy(100,196,s); gotoxy(60,13); readln(t^.ver[2].x,t^.ver[2].y); t^.per:=false; if i<n-1 then begin getmem(t^.next,sizeof(treug)); t:=t^.next; end; end; t^.next:=nil; vivod;{поиск и вывод} free(mas);{освободим память} readln; end; {чтение данных из файла} procedure mfile; var s,s1:string; f:text; i,code:integer; t:ptreug; begin cleardevice; gotoxy(50,13); outtextxy(100,200,'Введите имя файла:'); readln(s); assign(f,s); reset(f); getmem(mas,sizeof(treug)); t:=mas; while not eof(f) do begin readln(f,s); if s[length(s)]<>' ' then s:=s+' '; for i:=0 to 2 do begin s1:=copy(s,1,pos(' ',s)-1); delete(s,1,pos(' ',s)); val(s1,t^.ver[i].x,code); s1:=copy(s,1,pos(' ',s)-1); delete(s,1,pos(' ',s)); val(s1,t^.ver[i].y,code); end; t^.per:=false; if not eof(f) then begin getmem(t^.next,sizeof(treug)); t:=t^.next; end; end; close(f); t^.next:=nil; vivod; free(mas); readln; end; begin mas:=nil; randomize; gmode:=0; gdriver:=detect; initgraph(gdriver,gmode,''); {цвет текста} setcolor(6); textcolor(5); {цвет фона} setbkcolor(0); REPEAT cleardevice; outtextxy(100,200,'Случайные значения'); outtextxy(100,240,'Ввести с клавиатуры'); outtextxy(100,280,'Открыть файл'); outtextxy(100,320,'Выход'); moveto(30,190+select*40); lineto(45,205+select*40); lineto(30,220+select*40); key:=#0; repeat if keypressed then begin key:=readkey; end; until (key=chr(27))or (key=chr(72))or (key=chr(80))or (key=chr(13)); case key of chr(72):begin select:=select-1; if select<0 then select:=3; end; chr(80):begin select:=select+1; if select>3 then select:=0; end; chr(13):begin case select of 0:mrandom; 1:minput; 2:mfile; 3:key:=#27; end; end; end;{case} UNTIL key=#27; closegraph; end. |
Текстовая версия | 23.12.2024 21:27 |