Помощь - Поиск - Пользователи - Календарь
Полная версия: Точки треугольника
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
vano
Пожалуйста, помогите с решением вот такой задачки:

Задан треугольник (x1,y1,x2,y2,x3,y3) . Вычислить, какие точки с целыми координатами находятся внутри него и вывести в отдельный файл их количество и координаты.

У меня получилось такое:

Код

Program tochki_treugolnika;
uses crt;
var
  f : text;
  i, j, ymin, ymax, xmin, xmax, x1, y1, x2, y2, x3, y3, x, y, k : integer;


function rasst ( x1, x2, y1, y2 : real) : real;
  begin
     rasst := sqrt(sqr(x2-x1)+sqr(y2-y1))
  end;

function Angle ( c, a, b : real) : real;
var mycos, mysin : real;
  begin
     mycos := (a*a+b*b-c*c)/(a*b)/2;
     mysin := sqrt (1 - sqr (mycos));
     Angle := arctan (mysin/mycos)
  end;

function gde (x1,y1,x2,y2,x3,y3,x,y:real) : boolean;
  var
     an1, an2, an3 : real;
  begin
     an1 := Angle (rasst (x1, x2, y1, y2), rasst (x1, x, y1, y), rasst (x2, x, y2, y));
     an2 := Angle (rasst (x2, x3, y2, y3), rasst (x2, x, y2, y), rasst (x3, x, y3, y));
     an3 := Angle (rasst (x3, x1, y3, y1), rasst (x3, x, y3, y), rasst (x1, x, y1, y));
     gde := (an1 + an2 + an3 > 2*PI - 0.01)
  end;




begin
  clrscr;


  writeln ('Введите x1,y1,x2,y2,x3,y3');
  readln (x1,y1,x2,y2,x3,y3);

  {Assign (f,'c:\Pascal\samples\sample33.txt');
  Rewrite (f);
   }

  if x3 < x1 then
     if x2 < x3 then xmin := x2
     else xmin := x3
  else if x2 < x1 then xmin := x2 else xmin := x1;


  if x3 > x1 then
     if x2 > x3 then xmax := x2
     else xmax := x3
  else if x2 > x1 then xmax := x2 else xmax := x1;



  if y3 < y1 then
     if y2 < y3 then ymin := y2
     else ymin := y3
  else if y2 < y1 then ymin := y2 else ymin := y1;


  if y3 > y1 then
     if y2 > y3 then ymax := y2
     else ymax := y3
  else if y2 > y1 then ymax := y2 else ymax := y1;

  for x := xmin + 1 to xmax - 1 do
      for y := ymin + 1   to ymax - 1 do
          begin
               if gde (x1,y1,x2,y2,x3,y3,x,y) = false
               then
               begin
                    writeln ('Точка (',x,';',y,') находится внутри треугольника ');
                    inc(k);
               end;
          end;
  writeln ('f, ');
  writeln ( 'f‚ В треугольнике находится ',k,' точек');
 { close (f);}



  repeat until keypressed
end.



У меня возникает глюк в функции Angle при вычислении то-ли косинуса, то-ли синуса. как мне это исправить?
volvo
vano, я бы все-таки переписал функцию Angle, чтобы не было проблем при mycos = 0...

Код
function Angle ( c, a, b : real) : real;
var mycos, mysin : real;
 begin
    mycos := (a*a+b*b-c*c)/(a*b)/2;
    mysin := sqrt (1 - sqr (mycos));
    if abs(mycos) < 10E-4 then
      Angle := Pi/2
    else Angle := arctan (mysin/mycos)
 end;
Михаил Густокашин
можно заменить проверку условия на более простую: из точки проводить луч в любую сторону (например, влево) и считать количество пересечений луча со сторонами. если сторона полностью лежит на луче, то не добавлять ничего, если проходит через нижнюю точку стороны треугольника - тоже ничего, через верхнюю - добавлять.
если количество пересечений нечетно (в данном случае только 1, но алгорим универсальный и работает для любых многоугольников без самопересечений и самокасаний, в т.ч. невыпуклых) - то точка лежит внутри фигуры, иначе - вне.
volvo
Михаил Густокашин, человек ясно сказал:
Цитата(vano @ 17.02.05 12:50)
У меня возникает глюк в функции Angle при вычислении то-ли косинуса, то-ли синуса. как мне это исправить?

Предложения с Вашей стороны по теме вопроса есть? Если нет, извините, это флуд...
Михаил Густокашин
Цитата(volvo @ 17.02.05 17:48)
Михаил Густокашин, человек ясно сказал:

Предложения с Вашей стороны по теме вопроса есть? Если нет, извините, это флуд...


да, есть. человек писал:
"Пожалуйста, помогите с решением вот такой задачки:

Задан треугольник (x1,y1,x2,y2,x3,y3) . Вычислить, какие точки с целыми координатами находятся внутри него и вывести в отдельный файл их количество и координаты."

я предложил вариант решения, который прост и универсален.

где флуд?
volvo
Ну поймите Вы наконец... Человек пришел не за советами по изменению алгоритма, а с конкретным вопросом по программе... Глаза наверх поднимите - форум "Задачи", не теория, не обсуждение правильности алгоритма, а "Задачи". Тогда реализуйте Ваш вариант, и предложите его... Пока, кроме слов, я не вижу ничего...

Именно, в этом форуме предпочитают не болтать а показыват ькод, теория "форумом выше" smile.gif Админ.
Михаил Густокашин
извиняюсь. я просто думал, что перепечатка кода без понимания - плохо, разбираться по чистому коду - сложно, а по грамотному описанию написать код - легко. тысяча извинений. мне почему-то казалось, что понимание никогда не помешает. если человеку пишут объяснение метода решения задачи, а ему нужно только впихнуть написанный ребятами с форума исходник своему "преподавателю", то ему не будет тяжело пропустить сообщение с объяснением. а вот о тех, кто хочет разобраться, вы подумали? может им было бы полезно прочитать идеи?
Altair
Михаил Густокашин, я здесь уже год, поверь, таких, кто хочет разобрать 1 из 1000 если не меньше ;)
Guest
volvo, спасибо за подсказку, не сообразил.

Михаил Густокашин, спасибо за идею, надо попробовать.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.