Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Райзап
0 / 0 / 1
Регистрация: 07.05.2017
Сообщений: 12
#1

Из множества выбрать три различные точки по условию -из Turbo Pascal во Free Pascal - Turbo Pascal

13.05.2017, 14:16. Просмотров 181. Ответов 1
Метки нет (Все метки)

Даны 2 множества точек на плоскости. Выбрать три различные точки первого множества так, чтобы круг ограниченный окружностью , проходящий через эти три точки , содержал все точки второго множества и имел минимальную площадь.
Программа сделана в Turbo Pascal.Программа отлично работает в Pascal ABC, но никак не отображается во Free Pascal. Что мне для этого нужно сделать? Может какие-то модули подключить? Заранее спасибо)

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
119
120
121
122
uses crt;
const nmax=100;{макс. кол. точек в множествах,
если взять больше долго будет искать}
e=0.01;{точнсть сравнения координат}
type
Point=record {точка}
x,y:real;{координаты}
end;
Okruz=record {окружность}
o:Point;{координаты центра}
r:real;{радиус}
end;
MassP=array[1..nmax] of Point; {множество-массив точек}
procedure Tochki(var t:MassP;var n:integer;k:byte);{создание множества точек}
var i:integer;
begin
writeln('Множество ',k);
repeat
write('Количество точек от 3 дo ',nmax,' n=');
readln(n);
until n in [3..nmax];
{сделаем множества без пересечений}
for i:=1 to n do
if k=1 then{первое в 1 четверти}
begin
t[i].x:=1+10*random;
t[i].y:=1+10*random;
end
else {второе в 3}
begin
t[i].x:=-1-10*random;
t[i].y:=-1-10*random;
end;
writeln('X:');
for i:=1 to n do
write(t[i].x:5:1);
writeln;
writeln('Y:');
for i:=1 to n do
write(t[i].y:5:1);
writeln;
end;
{вычисление параметров окружности, проходящей через три точки}
procedure Okr(t1,t2,t3:Point;var ok:Okruz);
var a,b,x,y:real;
k0,k1,k2,m0,m1,m2:real;
begin
k0:=sqr(t1.x)-sqr(t2.x)+sqr(t1.y)-sqr(t2.y);
k1:=2*(t1.y-t2.y);
k2:=2*(t1.x-t2.x);
m0:=sqr(t1.x)-sqr(t3.x)+sqr(t1.y)-sqr(t3.y);
m1:=2*(t1.y-t3.y);
m2:=2*(t1.x-t3.x);
a:=k2*m0-k0*m2;
b:=k2*m1-k1*m2;
if b=0 then exit;
y:=a/b;
ok.o.y:=y;
if abs(m2) > e then x:=(m0-y*m1)/m2
else
if abs(k2) > e then x:=(k0-y*k1)/k2
else exit;
ok.o.x:=x;
ok.r:=sqrt(sqr(t1.x-x)+sqr(t1.y-y));
end;
{определение принадлежности точки окружности}
function Prin(a:Point;ok:Okruz):boolean;
begin
Prin:=sqr(a.x-ok.o.x)+sqr(a.y-ok.o.y)<=sqr(ok.r)
end;
 
var t1,t2:MassP; {множества}
ok:Okruz; {окружность}
n1,n2,i,j,k,i1,j1,k1,p,q:integer;{размеры и счетчики}
r,x,y,min:real;{параметры искомой окружности}
f:boolean;{фиксатор наличия решения}
begin
clrscr;
randomize;
Tochki(t1,n1,1);{точки первого множества в 1 четверти}
Tochki(t2,n2,2);{точки второго множества в 3 четверти}
{отределим самую большую площадь круга для сравнеия при поиске минимальной
смотреть будем только радиус, поскольку площадь прямо пропорциональна радиусу}
min:=ok.r;
for i:=1 to n1-2 do
for j:=i+1 to n1-1 do
for k:=j+1 to n1 do
begin
Okr(t1[i],t1[j],t1[k],ok);{строим окружность}
if ok.r>min then min:=ok.r;
end;
min:=min+1;{увеличим, вдруг это и есть искомая окружность}
{будем искать нужную окружность}
f:=false;
for i:=1 to n1-2 do
for j:=i+1 to n1-1 do
for k:=j+1 to n1 do
begin
Okr(t1[i],t1[j],t1[k],ok);{строим окружность}
p:=0;{считаем сколько точек в окружности из 2 множ}
for q:=1 to n1 do
if Prin(t1[q],ok) then inc(p);
if (p=n1)and(ok.r<min) then{если все и площадь минимальна}
begin
f:=true;{значит есть, запоминаем параметры}
r:=ok.r;
x:=ok.o.x;
y:=ok.o.y;
i1:=i;
j1:=j;
k1:=k;
end;
end;
if not f then write('Нет окружности, содержащей все точки второго множества')
else
begin
writeln('Окружность образована точками ',i1,' ',j1,' ',k1,':');
writeln('- координаты центра x0=',x:0:2,' Y0=',y:0:2);
write('- радиус R=',r:0:2);
end;
readln
end.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
13.05.2017, 14:16
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Из множества выбрать три различные точки по условию -из Turbo Pascal во Free Pascal (Turbo Pascal):

Из множества выбрать три различные точки по условию
Даны два множества точек на плоскости.Bыбрать три различные точки первого...

Из множества выбрать три различные точки по условию
Даны 2 множества точек на плоскости. Выбрать три различные точки первого...

Выбрать три различные точки из заданного множества точек на плоскости по условию
вот у меня задача нарисовалась нужно выбрать три различные точки из заданного...

Turbo Pascal, Pascal ABC, Free Pascal, PascalABC.NET - в чем разница?
Всем привет, решил изучать Паскаль, но на форуме увидел 4 его версии - Turbo...

Выбрать три различные точки первого множества так, чтобы круг, ограниченный окружностью, проходящей через три точки
Даны два множества точек на плоскости. Выбрать три различные точки первого...

Выбрать три различные точки из заданного множества
Выбрать три различные точки из заданного множества точек на плоскости так,...

1
Puporev
Модератор
54136 / 41769 / 28880
Регистрация: 18.05.2008
Сообщений: 98,311
13.05.2017, 14:37 #2
Цитата Сообщение от Райзап Посмотреть сообщение
но никак не отображается во Free Pascal.
Прекрасно работает и отображается.
1
Миниатюры
Из множества выбрать три различные точки по условию -из Turbo Pascal во Free Pascal  
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
13.05.2017, 14:37
Привет! Вот еще темы с решениями:

Из первого множества выбрать три различные точки
{Даны два множества точек на плоскости. Из первого множества выбрать три...

Выбрать три различные точки из заданного множества
Доброго времени суток, буду вам очень признателен, если вы поможете мне решить...

Выбрать три различные точки из заданного множества точек
выбрать три различные точки из заданного множества точек на плоскости так,...

Нужен Turbo pascal или Free pascal на русском
Нужен Turbo pascal или Free pascal на русском языке, есть такой или нет? По...


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

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

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