Форум программистов, компьютерный форум, киберфорум
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
25 / 25 / 24
Регистрация: 11.04.2010
Сообщений: 87
1

Множество точек

05.04.2011, 14:10. Показов 885. Ответов 8
Метки нет (Все метки)

Добрый день. Нужно создать множество точек но не хватает опыта реализовать это.
Нужно например что-то типо этого:
type
TDot = record
X, Y : Longint;
end;
MrDot = set of TDot;
Но set of... работает только для целых чисел. Посоветуйте что нибудь. Нужно просто найти пересечение множества точек
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
05.04.2011, 14:10
Ответы с готовыми решениями:

Дано множество A из N точек на плоскости. Найти точку (вывести её номер и значение) среди всех точек этого множества
Дано множество A из N точек на плоскости. Найти точку (вывести её номер и значение) среди всех...

множество точек
program Covers; type (*Тип, задающий точку.*) TDot = record X : Extended; Y :...

Множество точек на плоскости.
Задана множина точок на площині. Знайти опуклу оболонку цієї множини, тобто опуклий многокутник з...

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

8
Почетный модератор
64083 / 47492 / 32734
Регистрация: 18.05.2008
Сообщений: 115,182
05.04.2011, 14:18 2
Здесь под множеством понимается не set of, а совокупность точек плоскости и ее можно записать в массив, например
Pascal
1
type MrDot = array[1..50] of TDot;
Добавлено через 1 минуту
Тогда пересечение будет такой же массив, в котором будут точки из двух массивов, координаты которых совпадают.
0
25 / 25 / 24
Регистрация: 11.04.2010
Сообщений: 87
05.04.2011, 14:41  [ТС] 3
Puporev, Спасибо с пересечениями разобрался. А как реализовать разность множеств?
0
Почетный модератор
64083 / 47492 / 32734
Регистрация: 18.05.2008
Сообщений: 115,182
05.04.2011, 14:59 4
Идем по массивам, если точка есть в первом и втором массиве, из первого ее удаляем, или составляем новый массив в котором будут только точки первого массива, которых нет во втором.
1
25 / 25 / 24
Регистрация: 11.04.2010
Сообщений: 87
05.04.2011, 17:51  [ТС] 5
Вот программа. Но тревожит ошибка в Процедуре разности.
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
{Заданы два множества точек на плоскости.
Построить пересечение и разность этих множеств.}
uses crt;
type
 TDot = record
     x, y : Longint;
     end;
 MasDot = array[1..50] of TDot;
 var A, B: MasDot;
     name:char;
     n,k,i: longint;
Procedure InDot (var A:Masdot; n:integer; name:char);
var i,j:integer;
 begin
  for i:=1 to n do
   begin
     write (name,'[',i,'].x= ');
     readln (A[i].x,A[i].y);
   end;
 end;
Procedure Peresech (A,B:MasDot);
var i,j:integer;
 begin
   writeln ('Пересечение:');
   for i:=1 to n do
    for j:=1 to n do
     if (A[i].x=B[j].x) and (A[i].y=B[j].y) then
         write ('(',A[i].x,',',A[i].y,') ');
 end;
Procedure Raznost (A:MasDot; B:MasDot);
var i,j:integer;
  begin
     for i:=1 to n do
     for j:=1 to n do
     if (A[i].x=B[j].x) and (A[i].y=B[j].y) then
           begin
             A[i].x:=A[i+1].x;
             A[i].y:=A[i+1].y;
           end;
     writeln;
     writeln ('Raznost: ');
     for i:=1 to n do
      write ('(',A[i].x,',',A[i].y,') ');
 end;
BEGIN
   clrscr;
   write ('n=');
   readln (n);
   InDot (A,n,'A');
   inDot (B,n,'B');
   clrscr;
   Peresech (A,B);
   Raznost(A,B);
   readln
   end.
Добавлено через 1 минуту
Дублирует результат. Я сделал чтобы результат перетирался последующим,а у меня он дублируется(((
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Procedure Raznost (A:MasDot; B:MasDot);
var i,j:integer;
  begin
     for i:=1 to n do
     for j:=1 to n do
     if (A[i].x=B[j].x) and (A[i].y=B[j].y) then
           begin
             A[i].x:=A[i+1].x;
             A[i].y:=A[i+1].y;
           end;
     writeln;
     writeln ('Raznost: ');
     for i:=1 to n do
      write ('(',A[i].x,',',A[i].y,') ');
 end;
0
25 / 25 / 24
Регистрация: 11.04.2010
Сообщений: 87
05.04.2011, 17:54  [ТС] 6
Вот файл
Вложения
Тип файла: rar 119.rar (602 байт, 13 просмотров)
0
Почетный модератор
64083 / 47492 / 32734
Регистрация: 18.05.2008
Сообщений: 115,182
05.04.2011, 17:56 7
Разность неправильно, удаление элементов из массива делается сдвигом., а не заменой на соседний.
Если действовать по принципу множеств, то там есть операции
m:=m1*m2
и m:=m1-m2;
поэтому если по аналогии, то проще создавать новые массивы.
1
25 / 25 / 24
Регистрация: 11.04.2010
Сообщений: 87
05.04.2011, 18:29  [ТС] 8
Помоги пожалуйста новый массив (разности) реализовать, не получается у меня((

Добавлено через 24 минуты
Спасибо, уже сам реализовал!! Тему можно закрыть
0
Почетный модератор
64083 / 47492 / 32734
Регистрация: 18.05.2008
Сообщений: 115,182
05.04.2011, 18:46 9
А я написал так.
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
123
124
125
126
127
128
129
130
131
132
{Заданы два множества точек на плоскости.
Построить пересечение и разность этих множеств.}
uses crt;
type
 TDot = record
     x, y : Longint;
     end;
MasDot = array[1..50] of TDot;
Procedure InDot (var A:Masdot; var n:integer; name:char);
var i:integer;
begin
writeln('Массив ',name);
repeat
write('Размер массива до 50 =');
readln(n);
until n in [1..50];
for i:=1 to n do
 begin
  write (name,'[',i,'].x= ');
  readln (A[i].x);
  write (name,'[',i,'].y= ');
  readln (A[i].y);
 end;
end;
 
Procedure OutDot(var A:Masdot;n:integer;name:string);
var i:integer;
begin
writeln('Массив ',name);
write('X:');
for i:=1 to n do
write(a[i].x:4);
writeln;
write('Y:');
for i:=1 to n do
write(a[i].y:4);
writeln;
end;
Procedure Peresech (A,B:MasDot;na,nb:integer;var C:MasDot;var nc:integer);
var i,j,k,p:integer;
begin
nc:=0;
i:=1;
while i<=na do
 begin
  j:=1;p:=0;
  while (j<=nb)and(p=0) do
  if (A[i].x=B[j].x) and (A[i].y=B[j].y) then
   begin
    p:=1;
    nc:=nc+1;
    C[nc].x:=A[i].x;
    C[nc].y:=A[i].y;
    if i=na then na:=na-1
    else
     begin
      for k:=i to na-1 do
      A[k]:=A[k+1];
      na:=na-1;
     end;
    if j=nb then nb:=nb-1
    else
     begin
      for k:=j to nb-1 do
      B[k]:=B[k+1];
      nb:=nb-1;
     end;
   end
  else j:=j+1;
 if p=0 then i:=i+1;
end;
if nc=0 then writeln('Пересечение множеств пустое')
else
 begin
  writeln('Пересечение:');
  write('X:');
  for i:=1 to nc do
  write(c[i].x:4);
  writeln;
  write('Y:');
  for i:=1 to nc do
  write(c[i].y:4);
  writeln;
 end;
end;
Procedure Raznost (A,B:MasDot;na,nb:integer;var C:MasDot;var nc:integer);
var i,j,p:integer;
begin
nc:=0;
i:=1;
while i<=na do
 begin
  j:=1;p:=0;
  while (j<=nb)and(p=0) do
  if (A[i].x=B[j].x) and (A[i].y=B[j].y) then p:=1
  else j:=j+1;
  if p=0 then
   begin
    nc:=nc+1;
    C[nc].x:=A[i].x;
    C[nc].y:=A[i].y;
   end;
 i:=i+1;
end;
if nc=0 then writeln('Разность множеств пустая')
else
 begin
  writeln('Разность:');
  write('X:');
  for i:=1 to nc do
  write(a[i].x:4);
  writeln;
  write('Y:');
  for i:=1 to nc do
  write(a[i].y:4);
  writeln;
 end;
end;
 
var A,B,P,R: MasDot;
    na,nb,np,nr:integer;
BEGIN
clrscr;
InDot(A,na,'A');
InDot(B,nb,'B');
clrscr;
OutDot (A,na,'A');
OutDot (B,nb,'B');
Peresech(A,B,na,nb,P,np);
Raznost(A,B,na,nb,R,nr);
readln
end.
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
05.04.2011, 18:46

Задано множество точек m в трехмерном пространстве.
Задано множество точек m в трехмерном пространстве. Найти такую из них, что шар заданного радиуса с...

Построить на экране множество точек, координаты которых удовлетворяют неравенству
Построить на экране множество точек, координаты которых удовлетворяют следующему неравенству: :...

Найдите уравнение какой-либо прямой, делящей данное множество точек на два подмножества
На плоскости заданы 2n точек своими координатами. Найдите уравнение какой-либо прямой, делящей...

Задать n точек. Найти m=3,4... точек и построить на них m-угольник такой что, количество точек , лежащих внутри и вне m-угольника , минимально различа
Задать n точек. Найти m=3,4... точек и построить на них m-угольник такой что, количество точек ,...


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru