Трегольник, стороны которого содержат максимальное... Опции

[art88]

Задача:
Среди треугольников с вершинами в заданном множестве точек на плоскости указать такой, стороны которого содержат максимальное число точек заданного множества (координаты тоек хранятся в файле).
-------------------------------------------------------------------------------------
Решение:
см. Triangle.pas
-------------------------------------------------------------------------------------
Проблема:
Не строится треугольник(проблемы в расчётах).
-------------------------------------------------------------------------------------
Просьба:
Помогите разобраться!!!
-------------------------------------------------------------------------------------

[volvo]

Не строится треугольник(проблемы в расчётах).

Ну, так что ты предлагаешь, заняться телепатией? Ты свой файл данных присоедини, мало ли что там у тебя творится...

[art88]

volvo, извини: совсем запарился

[volvo]

Ууууу... Ну, ты что-то перемудрил... Сейчас неохота лазить по дебрям кода, у тебя происходит выход за пределы массива (FPC очень хорошо ловит такие вещи)... Вот, глянь на картинку... Как ты думаешь, что произойдет?



Как результат (побочный эффект) - при запуске в TP вот в этом месте:

   OpenFile(inF);
   Combinate(10);

   { Перед входом в InputDots }
   InputDots(inF);

файл inF оказывается закрытым, и соответственно происходит ошибка...

[art88]

Я упростил программу(см. Triangle.pas), но построить треугольник так и не удалось:
происходит ошибка переполнения.
Причём если не заполнять массив(table), содержащий треугольники, то ошибки не происходит и строиться(естественно) треугольник, вырожденный в точку.

for d:= 1 to numP do begin
     p:= points[d];
     equal:= (d = i) or (d = j) or (d = k);
     if not equal then  begin
       {table[s].a:= p1;
         table[s].b:= p2;
         table[s].c:= p3;}
         if Includ(p, p1, p2) or							
            Includ(p, p1, p3) or
            Includ(p, p2, p3) then
               c:= c + 1
      end;
end;

[volvo]

art88, проблема тривиальна: у тебя происходят ошибки индексации. Смотри:

var
   Points	    : array[1..numP] of tPoint; { индексация начинается с ЕДИНИЦЫ !!! }

  { и что дальше? }
  s := 0;
  ...
  for d:= 1 to numP do begin
    p:= points[d];
    equal:= (d = i) or (d = j) or (d = k);
    if not equal then  begin
      table[s].a:= p1; { Всё! Индексация сбилась... Всему, что происходит дальше - верить нельзя }
  ...

Для того, чтобы избегать такого развития событий - компилируй программу в режиме {$R+} (поставь это самой первой строкой программы), тогда программа не будет "замалчивать" такие ошибки, а будет Run-Time Error, но ты будешь знать: что-то не в порядке...

происходит ошибка переполнения.

Попробуй перейти на сопроцессорные типы: {$N+} первой строкой программы, и Real заменить на Double (емкость Double гораздо больше; не поможет Double - пробуй Extended)...

[Pola]

Задача:
Среди треугольников с вершинами в заданном множестве точек на плоскости указать такой, стороны которого содержат максимальное число точек заданного множества (координаты тоек хранятся в файле).

Какая-то странная задача...
может точки должны быть внутри треугольника?

[volvo]

Какая-то странная задача...

Задача как задача. Если точки внутри треугольника - это решается элементарно, есть уже реализованные алгоритмы принадлежности точки многоугольнику. А ты попробуй вот эту задачу решить...

Только флейм не надо разводить. Отвечаем по теме...

[Pola]

Только флейм не надо разводить. Отвечаем по теме...

Не злись, volvo, студенты часто неправильно читают условие задачи...

Проверка принадлежности точки a отрезку bc

function Includ(a, b, c: tPoint): Boolean;
var                                            		
   x,y: real; 
begin
   if EqPoints(c, b) and not not EqPoints(a, b) then
   begin
       Includ:=false; exit;
   end;
   if (abs(b.x-c.x)<eps) and not (abs(b.x-a.x)<eps) then
   begin
       Includ:=false; exit;
   end;
   if (abs(b.y-c.y)<eps) and not (abs(b.y-a.y)<eps) then
   begin
       Includ:=false; exit;
   end;

   if EqPoints(a, b) or EqPoints(a, c) then
   begin
       Includ:=true; exit;
   end;
   
   y:=(b.y-a.y)*(a.y-c.y);
   x:=(b.x-a.x)*(a.x-c.x);
   if (abs(b.x-c.x)<eps) and (abs(b.x-a.x)<eps) then
   begin
       Includ:=y>0; exit;
   end;
   if (abs(b.y-c.y)<eps) and (abs(b.y-a.y)<eps) then
   begin
       Includ:=x>0; exit;
   end;
   Includ:= (y>0) and (x>0) and
            ((b.y-c.y)/(b.x-c.x)-(a.y-c.y)/(a.x-c.x) < eps);
end;

и строки

Код

        table[s].a:= p1;
                       table[s].b:= p2;
                       table[s].c:= p3;

лучше поставить между

Код

               s:= s + 1;
              triangles[s]:= c

[Гость]

добавить новый тип

Код

type
   . . .
   tmass= array[1..numT] of integer;

изменить тип переменной

Код

var
  . . .
  Triangles    : tmass;

изменить процедуру

procedure FindMaxTri(var mass: tmass);
var
	max: integer;
begin
   max:= 1;
   for i:= 1 to s do
    	if mass[i] > mass[max] then
      	max:= i;
   DrawTri(table[max].a, table[max].b, table[max].c);
end;

[Гость]

изменить способ составления треугольников i,j,k

begin
   OpenFile(inF); {ЋвЄалвЁҐ д ©« }
   InputDots(inF);
   s:= 0;
   {Џ®бв஥­ЁҐ ¬­®¦Ґбвў  ўбҐе ваҐгЈ®«м­ЁЄ®ў}
      for i:= 1 to numP-2 do
	 for j:= i+1 to numP-1 do
            for k:= j+1 to numP do begin
               p1.x:= points[i].x;
               p1.y:= points[i].y;
               p2.x:= points[j].x;
               p2.y:= points[j].y;
               p3.x:= points[k].x;
               p3.y:= points[k].y;
. . .

и вообщето еще убедиться, что нет среди этих трех точек p1,p2,p3 точек содинаковыми координатами
например так

Код

             if not EqPoints(p1,p2) and not EqPoints(p2,p3) then

а также не лежат ли все три на одной прямой...

Код

            if not Includ(p1,p2,p3) and not Includ(p2,p1,p3) and not Includ(p3,p1,p2) then

а то и треугольника не будет...

[Pola]

гостем была я
войти забыла....

[Гость]

а кто нить может переделать эту задачку без файлов?, плиз!

[ghy]

да да да! очень прошу. та же задача, но без файла
и воть ещё...
точка (x0,y0) лежит между двумя остальными, когда
(x1-x0)(x2-x0)<0 и (y1-y0)(y2-y0)<0

Сообщение отредактировано: ghy - 7.01.2010 20:35

[Lapp]

да да да!

Там, там, та-дамм... ТАМ та-да, та-да, та-дамммммм..

[Unconnected]

Моцарт - "Реквием"?

[Lapp]

Моцарт - "Реквием"?

Здрасьте вам, пианисты.. Уже Шопена от Моцарта не отличаем?..

[Unconnected]

Видимо, это был Глюк..

Сообщение отредактировано: Unconnected - 8.01.2010 16:46

[Lapp]

Видимо, это был глюк..

Чаще слушать советовать не буду
Ничего, главное отличать Beatles от Эдиты Пьехи.. ))

[Lapp]

это был Глюк..

Ах, вооот оно как?..
Нееет.. Глюк - это примерно так.. сейчас.. вот:
тии.. та-ти-та-та та ти та, тии та ти-та-та та ти та.. тии таа та-та тииии та-тааа....

2 ghy: извини, но на этом форуме не поощряется встревать в давно мертвые темы. Особенно, если тебе нужно, чтобы тебе сделали изменения в программе. Тебе нужно - ты и делай. Если будет вопрос ПО ПРОГРАММИРОВАНИЮ - мы с удовольствием ответим. Успехов тебе.