Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.05.2014, 18:11   #1
KirillP123
 
Регистрация: 20.03.2014
Сообщений: 6
По умолчанию Геометрическая задача (Pascal)

Построить множество всех выпуклых четырехугольников с вершинами в заданном множестве точек на плоскости. Решение этой задачи я нашел на форуме, однако оно длинное и для меня непонятное. Прошу объяснить нерадивому студенту как работает нижеуказанный код или же предложить альтернативное решение. Спасибо за внимание.

Код:
program convex_quadrilateral;
const MaxDotCount = 100;
type dot=record x,y:real; end;
var
   epsilon:real;
   space:array [0..MaxDotCount] of dot;
   dotCount:integer;
   a,b,c,d,count,i:integer;
 
function getY(const a,b,c:integer):real;
         begin
              getY:=(space[c].x * (space[b].y - space[a].y) + space[a].y * space[b].x -
              space[b].y * space[a].x) / (space[b].x - space[a].x);
         end;
 
function onOneLine(const a,b,c:integer):boolean;
         begin
              if (abs(space[a].x-space[b].x)<=epsilon) then 
                  begin
                       if (abs (space[b].x - space[c].x) <= epsilon) then
                          onOneLine:=true else onOneLine:=false; 
                       exit;
                  end                  
                  else if (abs(space[a].y-space[b].y)<=epsilon) then
                           begin
                                if (abs (space[b].y - space[c].y) <= epsilon) then
                                    onOneLine:=true else onOneLine:=false;
                                exit;
                           end                                
                           else if (abs (space[c].y - getY (a, b, c)) <= epsilon) then
                                    onOneLine:=true
                                    else onOneLine:=false;
         end;
function diagonalRule(const a1,a2,b1,b2:integer):boolean;
         var
            y1,y2:real;
         begin
              if abs(space[a1].x - space[a2].x)<= epsilon then 
                  begin
                        if ((space[a1].x - space[b1].x) * (space[a1].x - space[b2].x)) < 0 then
                            diagonalRule:=true else diagonalRule:=false; 
                        exit;                        
                  end                      
                 else if (abs (space[a1].y - space[a2].y) <= epsilon) then begin
                          y1:=space[a1].y;
                          y2:=space[a1].y;
                      end
                         else begin
                                   y1:= getY (a1, a2, b1);
                                   y2:= getY (a1, a2, b2);
                              end;
              if ((y1 - space[b1].y) * (y2 - space[b2].y)) < 0 then
                  diagonalRule:=true else diagonalRule:=false;
end;
KirillP123 вне форума Ответить с цитированием
Старый 20.05.2014, 18:13   #2
KirillP123
 
Регистрация: 20.03.2014
Сообщений: 6
По умолчанию

Код:
begin
     write('Vedite tochnost vichislenii epsilon=');
     readln(epsilon);
     writeln('Vvedite kol-vo tochek');
     readln(dotCount);
     for i:=0 to dotCount-1 do begin
         write('Vvedite x[',i,'] y[',i,']');
         readln(space[i].x,space[i].y);
         end;
     writeln('Resultat');
         if (dotCount < 4) then
             writeln('Ne hvataet tochek,minimum 4')
             else begin
                       count:=0;
                       for a:=0 to dotCount - 4 do
                begin
                           for b:= a + 1 to dotCount - 3 do
                                begin
                                 for c:= b + 1 to dotCount - 2 do
                                        begin
                                         if onOneLine (a, b, c)= false then
                                                begin
                                                  for d:= c + 1 to dotCount-1 do
                                                        begin
                                                      if (diagonalRule (a, c, b, d)=true) and (diagonalRule (b, d, a, c)=true) then begin
                                                          count:=count+1;
                                                          writeln (count,':',a, b, c, d);                                                        
                                                          end
 
                                                          else if (diagonalRule (a, b, c, d)=true) and (diagonalRule (c, d, a, b)=true) then begin
                                                                   count:=count+1;
                                                                   writeln (count,':',a, c, b, d);
                                                                   end
                                                                   else if (diagonalRule (a, d, b, c)=true) and (diagonalRule (b, c, a, d)=true) then 
                                                                        begin
                                                                             count:=count+1;
                                                                             writeln(count,':',a, b, d, c);
                                                                        end; 
                                                        end;
                                                end;
                                        end;
                                end;                                                                         
                end;
                      if count = 0 then 
                         writeln ('Net Vipuklih');
	 end;
     writeln ('Nazhmite lubuu klavishu');
     readln;
end.
KirillP123 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Геометрическая задача (C++) Day Stiff Фриланс 4 12.07.2012 12:50
геометрическая задача Nurik1 Паскаль, Turbo Pascal, PascalABC.NET 3 20.11.2011 12:07
Геометрическая задача Liza Dalbek Помощь студентам 2 22.12.2010 19:48
Геометрическая задача Liza Dalbek Общие вопросы C/C++ 0 22.12.2010 14:18
Геометрическая задача С++ bloo[d] Общие вопросы C/C++ 9 30.01.2008 18:27