С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
Grisai
0 / 0 / 0
Регистрация: 08.12.2016
Сообщений: 10
1

Окружности

21.04.2017, 15:20. Просмотров 121. Ответов 0
Метки нет (Все метки)

Из заданного множества точек на плоскости выбрать две различные точки так, чтобы окружности заданного радиуса с центрами в этих точках содержали внутри себя одинаковое количество точек.

Программа вроде бы работает, но я не уверен что правильно.
Вопрос: правильно ли работает данная программа?


Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
program NYT;
 
uses GraphABC;
 
type
   point = record
      x, y: integer;
      end;
 
const
   Nmax = 100;
   Mmax = 10000;
   rc = 50;                                                                            //радиус
var
   a, m, pr, z, v, b, l, i, k, n, j: integer;
   p: array[1..Nmax] of point;                                                  //массив точек
   r: array[1..Mmax] of integer;                                                //массив расстояний 
   s: array[1..Nmax] of integer;                                                //массив точек входящих в окружность
   q: array[1..Nmax] of integer;
   h: array[1..Nmax] of integer;
   f: text;
   
   
   function Distance(x1,y1,x2,y2:integer):integer;
   begin
     pr:= round(sqrt(sqr(x2-x1)+sqr(y2-y1)));
   end;
   
  
begin
   
   assign(f,'circle.txt');
   reset(f);
   n:=0;
   while not eof(f) do begin
      n:= n + 1;
      read(f, p[n].x, p[n].y)
   end;
   
   l:=0;
   for i:=1 to n do begin
      for k:=1 to n do begin  
            Distance(p[i].x, p[i].y, p[k].x, p[k].y);
            l:= l + 1;
            r[l]:= pr;                                                          //расстояние между точками 
      end;        
   end;
   
   v:=1;
   b:=n;
   z:=0;
   for i:=1 to n do begin
      for k:=v to b do begin
         if i <> k then begin
            if rc >= r[k] then begin
               z:= z + 1;
            end;
         end;
         v:= v + 1;
      end;
   b:= b + n;
   s[i]:=0;
   s[i]:= s[i] + z - 1;
   z:=0;
   end;
   
   
   a:=1;
   m:=0;
   i:=1;
   k:=1;
   lockDrawing;
   for i:=1 to n do begin
      for k:=1 to n do begin
         if i <> k then begin                                                   //сравниваются точки содержащие одинаковые значения
            if s[i] = s[k] then                                                 
               repeat
               ClearWindow;
               SetWindowSize(900, 900);
               centerwindow;
               SetPenColor(clBlack);
               SetPenWidth(4);                                                                 
               
               circle(p[i].x, p[i].y, rc);
               circle(p[k].x, p[k].y, rc);
               circle(p[i].x, p[i].y, 1);
               circle(p[k].x, p[k].y, 1);
               
               SetPenColor(clRed);
 
               j:=1;
               for j:=1 to n do begin  
                  Distance(p[i].x, p[i].y, p[j].x, p[j].y);
                  q[j]:= pr;                                                          //расстояние между точками 
                  if i <> j then begin
                      if rc > q[j] then
                         circle(p[j].x, p[j].y, 1);
                  end;
               end;
               
               
               j:=1;
               for j:=1 to n do begin  
                  Distance(p[k].x, p[k].y, p[j].x, p[j].y);
                  h[j]:= pr;                                                          //расстояние между точками 
                  if k <> j then begin
                      if rc > h[j] then
                         circle(p[j].x, p[j].y, 1);
                  end;
               end;
               
               m:= m + 1;
               redraw;
               until a = m;
         end;
      end;
   end;   
end.
0
Вложения
Тип файла: txt circle.txt (160 байт, 1 просмотров)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
21.04.2017, 15:20
Ответы с готовыми решениями:

Рисование окружности
uses GraphABC; procedure BrezenCircle(cx, cy, r: integer); var x, y:...

Фрактальные окружности
uses GraphABC; const ang = 90; procedure DrawCircles(x, y, r: real);...

Вывести значения элементов окружности
Нужно написать программу с оператором &quot;case&quot; или &quot;if&quot;. Задача: элементы...

Длина окружности и площадь круга
Создать процедуру для вычисления длины окружности и площади круга по заданному...

Задача про отметку на окружности
Здравствуйте! Прошу помочь разобраться с решением задачи: Длина Московской...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
21.04.2017, 15:20

Некоторые окружности выходят за границы окна
Код: PROGRAM kalejdaskop; USES graphABC; TYPE kale = record x, ...

Найти точки, которые находятся на окружности
Дан круг и координаты точки, нужно найти координаты точек с целыми...

Найти координаты пересечения окружности и прямой
Заданы координаты центра окружности, ее радиус и коэффициенты a, b, c уравнения...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru