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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 22.03.2018, 18:13   #1
ArcadianMan
Новичок
Джуниор
 
Регистрация: 22.03.2018
Сообщений: 2
По умолчанию определить радиус и центр окружности, проходящей по крайней мере через три точки множества и содержащей внутри себя наибольшее количество точек

Определить радиус и центр окружности, проходящей по крайней мере через три точки множества и содержащей внутри себя наибольшее количество точек
Прошу помочь с решением задачи.
У меня есть уже некоторые наработки
файл с данными xy1.txt
Недоделанный код.
Не знаю, как грамотно написать процедуру принадлежности и нахождения окружности, включающей в себя максимальное количество точек.
Код:
program okr;

uses GraphABC;
const
   nmax = 120;
   r = 2;

type
   tPoint = record
      x, y: real;
   end;
   tVertex = record
      P0, P1, P2, P3: tPoint;
   end;
   tOkr = record//тип окружность, координаты центра и радиус
      o: tPoint;
      r: real;
   end;
   tStorage = record
      n: integer;
      T: array[1..nmax] of tPoint;//массив для точек
      O: array[1..nmax] of tOkr;//массив для окружностей
   end;

var
   name: string;
   x0, y0, r0: real;
   S1: tStorage;
   f1: text;
   NFirst, i, j, k, ires, jres, kres: integer;

procedure LoadPoints(var f: text; var S: tStorage);//загружаем координаты первого и первого множества
begin
   S.n := 0;
   while not eof(f) do 
   begin
      S.n := S.n + 1;
      readln(f, S.T[S.n].x, S.T[S.n].y);
   end;
end;

procedure DrawPoints(S: tStorage);//рисуем точки множества
var
   i: integer;
begin
   for i := 1 to S.n do
      Circle(round(S.T[i].x), round(S.T[i].y), r);
end;

procedure Okr1(P1, P2, P3: tPoint; var x0, y0, r0: real);//вычисляем параметры нужной окружности
var
   a, b, x, y: real;
   k0, k1, k2, m0, m1, m2: real;
begin
   k0 := sqr(P1.x) - sqr(P2.x) + sqr(P1.y) - sqr(P2.y);
   k1 := 2 * (P1.y - P2.y);
   k2 := 2 * (P1.x - P2.x);
   m0 := sqr(P1.x) - sqr(P3.x) + sqr(P1.y) - sqr(P3.y);
   m1 := 2 * (P1.y - P3.y);
   m2 := 2 * (P1.x - P3.x);
   a := k2 * m0 - k0 * m2;
   b := k2 * m1 - k1 * m2;
   if b <> 0 then 
      y0 := a / b;
   if abs(m2) > e then 
      x0 := (m0 - y0 * m1) / m2
   else if abs(k2) > e then 
      x0 := (k0 - y0 * k1) / k2;
   r0 := sqrt(sqr(P1.x - x0) + sqr(P1.y - y0));
end;

procedure FindTriplet(P1, P2: tPoint; S: tStorage; var ires, jres, kres: integer);//находим тройки координат
var
   i, j, k, m, n, max: integer;
   x, y, r,a, b: real;
begin
   for i := 1 to S.n-2 do
      for j := i + 1 to S.n-1 do
         for k := j + 1 to S.n do begin
            { Найти радиус и цент окр-и, проходящей через i-ю, j-ю, и k-ю точки }
               Okr1( S.T[i], S.T[j], S.T[k], x, y, r);
            {Подсчитать количество точек n, попадающих внутрь окр-ти с центром x, y и радиусом r }
               n := 0;
               for m := 1 to S.n do
                  if 
                     n := n + 1;

            {Сравнить n с текущим максимальным (?) и если n больше, то изменить максимальное и запомнить тройку точек }   
            
            
            ires := i;
            jres := j;
            kres := k;
         end;
         writeln (n);//выводим количество окружностей
end;

begin
   CenterWindow;
   writeln('Определить радиус и центр окружности, проходящей через три точки множества и содержащей внутри себя наибольшее количество точек');
   writeln('Файл с координатами множества?'); readln(name);
   assign(f1, name);
   reset(f1);
   LoadPoints(f1, S1); // Загрузка данных из файла
   SetPenColor(clRed);
   DrawPoints(S1);
   FindTriplet(S1, ires, jres, kres);
   DrawCircle(round(x0), round(y0), round(r0));//рисуем окружность
end.
_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

Последний раз редактировалось Serge_Bliznykov; 23.03.2018 в 09:46.
ArcadianMan вне форума Ответить с цитированием
Старый 23.03.2018, 10:07   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Okr1 проверяли, она корректно работает?


Цитата:
Сообщение от ArcadianMan Посмотреть сообщение
Не знаю, как грамотно написать процедуру принадлежности и нахождения окружности, включающей в себя максимальное количество точек.
Так всё просто напишите функцию:
Код:
function CountPointInCircle(  S: tStorage; x0,y0, r: real  ): Integer;
var i, res : integer;
begin
   res :=0;
   for i:=1 to S.n do
     if  (sqr(S.T[i].x - x0) + sqr(S.T[i].y - y0) ) < sqr(r) then Inc(res);
   CountPointInCircle := res
end;
и потом, после получения новой окружности Okr1, можно найти максимальное значение:
Код:
procedure FindTriplet(P1, P2: tPoint; S: tStorage; var ires, jres, kres: integer);//находим тройки координат
var
   i, j, k, curcount, max: integer;
   x0, y0, r : real;
begin
   max := 0;
   ires := -1;
   jres := -1;
   kres := -1;
   for i := 1 to S.n-2 do
      for j := i + 1 to S.n-1 do
         for k := j + 1 to S.n do begin
               { Найти радиус и цент окр-и, проходящей через i-ю, j-ю, и k-ю точки }
               Okr1( S.T[i], S.T[j], S.T[k], x0, y0, r);
               {Подсчитать количество точек n, попадающих внутрь окр-ти с центром x, y и радиусом r }
               curcount := CountPointInCircle( S, x0, y0, r );
              {Сравнить n с текущим максимальным (?) и если n больше, то изменить максимальное и запомнить тройку точек }   
               if curcount > max then begin
                     ires := i;
                     jres := j;
                     kres := k;
                     curcount := max;
               end;            
         end;    
end;
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Помощь с задачей:Даны два множества точек на плоскости. Найти радиус и центр окружности, проходящей через n (n>=3) точек множества artiom4356 Помощь студентам 5 16.12.2015 21:42
Найти минимальный радиус шара, который будет охватывать все заданные точки(центр окружности лежит на одной из заданных точек) ExploiT243 Помощь студентам 1 27.05.2012 10:31
определить радиус и центр окружности Degster Паскаль, Turbo Pascal, PascalABC.NET 3 12.06.2011 17:38
определить радиус и центр окружности, на кот. лежит наиб.число точек заданного на плоскости мн-ва точек) kcю Помощь студентам 0 17.11.2009 19:50
Определить радиус и центр окружности на которой лежит наибольшее число точек. Zoratul Помощь студентам 2 11.01.2008 16:00