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

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

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

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


Гость






Здравствуйте!
Помогите пожалуйста решить задачу.
На плоскости имеется набор треугольников. Выявить все треугольники , пересекающиеся хотя бы с одним треугольником из этого набора.
Буду очень благодарна!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Цитата
Выявить все треугольники , пересекающиеся хотя бы с одним треугольником из этого набора.
Уточни задание... Откуда берутся те треугольники, КОТОРЫЕ надо проверять на пересечение с заданными...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Я думаю, что речь идет о треугольниках из того же набора. Но даже если это не так - это все равно несущественная чать задачи. Как я понимаю, интересует алгоритм проверки двух треугольников на пересечение (чтобы потом использовать как процедуру). В голову сразу приходит проверить все три стороны одного треугольника со всеми тремя сторонами другого на пересечение (как отрезки). Всего будет 3^2=9 комбинаций. Но, возможно, есть и более короткий алгоритм.. Например, похоже, что не нужно проверять последнюю пару сторон..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






lapp, то, что ДУМАЕШЬ ты, меня в данном контексте мало интересует! Задание либо есть либо его НЕТ. В данном случае - его нет.

У нас не форум телепатов, в конце концов.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(volvo @ 26.02.2006 15:54) *

lapp, то, что ДУМАЕШЬ ты, меня в данном контексте мало интересует! Задание либо есть либо его НЕТ. В данном случае - его нет.

У нас не форум телепатов, в конце концов.

Волво, в чем дело? Я предложил конкретное решение задачи. Разве не так? Тут есть масса гораздо менее четко поставленных задач! Люди не на экзамене, и это нужно учитывать.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Вчера бегала в институт, искала преподавателя. Вообщем треугольники все из одного набора.
Lapp правильно подумал. Очень прошу помочь мне с решением данной задачи, пожалуйста!
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Как я уже писал выше, для каждой пары треугольников проверь, пересекаются ли их стороны (попарно, 9 пар, но реально, похоже, достаточно проверить 8). Текст процедуры для проверки перескаемости отрезков здесь.
Пиши и приноси на проверку.. smile.gif


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #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.
 К началу страницы 
+ Ответить 

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

 





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