0 / 0 / 0
Регистрация: 14.12.2018
Сообщений: 3
1

Выбрать три различные точки из множества

14.12.2018, 22:20. Показов 1920. Ответов 5
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Даны два множества точек на плоскости. Из первого множества выбрать три различные точки так, чтобы треугольник с вершинами в этих точках содержал (строго внутри себя) равное количество точек первого и второго множеств. (Сложность в том, что есть сложности с освоением языка и программы в целом, (знаю что основа паскаль, но все же)). Нужна помощь в написании кода.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
14.12.2018, 22:20
Ответы с готовыми решениями:

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

Массив: Выбрать три различные точки первого множества так, чтобы треугольник с вершинами в этих точках накрывал все точки второго множества
Здравствуйте. При реализации задачи я столкнулся с некоторой трудностью (ну, по крайней мере для...

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

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

5
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
15.12.2018, 13:24 2
Лучший ответ Сообщение было отмечено Valeron302 как решение

Решение

Цитата Сообщение от Valeron302 Посмотреть сообщение
равное количество точек первого и второго множеств.
по 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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Grids, ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    StringGrid3: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
 
  public
 
  end;
const n=15; //количество точек в множествах
 
var
  Form1: TForm1;
  x1,y1,x2,y2:array[1..n] of real;//массивы точек 1 и 2 множеств
  ir,jr,kr,mx:byte; //номера вершин искомого треугольника
implementation
 
{$R *.lfm}
{ TForm1 }
//заготовка таблиц
procedure TForm1.FormCreate(Sender: TObject);
var i:byte;
begin
randomize;
with StringGrid1 do
 begin
   fixedcols:=0;
   colcount:=n+1;
   defaultcolwidth:=40;
   fixedrows:=1;
   rowcount:=3;
   cells[0,0]:='№';
   cells[0,1]:='X';
   cells[0,2]:='Y';
   for i:=1 to n do
    begin
     cells[i,0]:=inttostr(i);
     x1[i]:=-10+20*random;
     cells[i,1]:=formatfloat('0.00',x1[i]);
     y1[i]:=-10+20*random;
     cells[i,2]:=formatfloat('0.00',y1[i]);
    end;
 end;
with StringGrid2 do
 begin
   fixedcols:=0;
   colcount:=n+1;
   defaultcolwidth:=40;
   fixedrows:=1;
   rowcount:=3;
   cells[0,0]:='№';
   cells[0,1]:='X';
   cells[0,2]:='Y';
   for i:=1 to n do
    begin
     cells[i,0]:=inttostr(i);
     x2[i]:=-10+20*random;
     cells[i,1]:=formatfloat('0.00',x2[i]);
     y2[i]:=-10+20*random;
     cells[i,2]:=formatfloat('0.00',y2[i]);
    end;
 end;
with StringGrid3 do
 begin
  fixedcols:=1;
  colcount:=3;
  defaultcolwidth:=40;
  fixedrows:=1;
  rowcount:=4;
  cells[0,0]:='№';
  cells[1,0]:='X';
  cells[2,0]:='Y';
 end;
Button2.Enabled:=false;//отключим пока кнопку 2
end;
procedure TForm1.Button1Click(Sender: TObject);
//лежит ли точка строго внутри треугольника
function Prin(x1,y1,x2,y2,x3,y3,x4,y4:real):boolean;
var p1,p2,p3:real;
begin
//вычислим косые(псевдоскалярные) произведения векторов и определим
//лежит ли точка по одну сторону от сторон треугольника
p1:=(x4-x1)*(y1-y2)-(y4-y1)*(x1-x2);
p2:=(x4-x2)*(y2-y3)-(y4-y2)*(x2-x3);
p3:=(x4-x3)*(y3-y1)-(y4-y3)*(x3-x1);
Prin:=((p1>0)and(p2>0)and(p3>0))or((p1<0)and(p2<0)and(p3<0))
end;
 
var i,j,k,p,k1,k2:byte;
 
begin
//номера искомых точек
ir:=0;
jr:=0;
kr:=0;
mx:=0;//максимальное равное количество точек внутри
for i:=1 to n-2 do
for j:=i+1 to n-1 do
for k:=j+1 to n do
 begin
  k1:=0;
  k2:=0;
  for p:=1 to n do
   begin
    if Prin(x1[i],y1[i],x1[j],y1[j],x1[k],y1[k],x1[p],y1[p]) then inc(k1);
    if Prin(x1[i],y1[i],x1[j],y1[j],x1[k],y1[k],x2[p],y2[p]) then inc(k2);
   end;
  if (k1>mx)and(k1=k2) then
   begin
     mx:=k1;
     //их номера
     ir:=i;
     jr:=j;
     kr:=k;
   end;
 end;
if mx=0 then ShowMessage('Нет треугольника с равным количеством точек'+#13#10+
                        'из обоих множеств, лежащих внутри его')
else with StringGrid3 do
  begin
   cells[0,1]:=inttostr(ir);
   cells[0,2]:=inttostr(jr);
   cells[0,3]:=inttostr(kr);
   cells[1,1]:=formatfloat('0.00',x1[ir]);
   cells[1,2]:=formatfloat('0.00',x1[jr]);
   cells[1,3]:=formatfloat('0.00',x1[kr]);
   cells[2,1]:=formatfloat('0.00',y1[ir]);
   cells[2,2]:=formatfloat('0.00',y1[jr]);
   cells[2,3]:=formatfloat('0.00',y1[kr]);
   Edit1.Text:=inttostr(mx);
  end;
Button2.Enabled:=true;//включим кнопку 2
end;
//рисование
procedure TForm1.Button2Click(Sender: TObject);
var c,i:integer;
    m:real;
begin
with Image1 do
 begin
  Width:=Height;
  c:=Height div 2; //центр=начало координат
  m:=(c-20)/10;//масштаб для ревода реальных координат в экранные
  with Image1.Canvas do
   begin
    //очистим имадже в белый цвет
    Brush.Color:=clWhite;
    Fillrect(Cliprect);
    //нарисуем рамку
    Pen.Width:=3;
    Rectangle(0,0,width,height);
    //нарисуем координатную сетку
    Pen.Width:=1;
    moveto(c-round(m*10),c);
    lineto(c+round(m*10),c);
    moveto(c,c-round(m*10));
    lineto(c,c+round(m*10));
    for i:=1 to 10 do
     begin
      moveto(c+round(i*m),c-3);
      lineto(c+round(i*m),c+3);
      moveto(c-round(i*m),c-3);
      lineto(c-round(i*m),c+3);
      if i mod 2=0 then
        begin
          textout(c+round(i*m),c+10,inttostr(i));
          textout(c-round(i*m),c+10,inttostr(i));
        end;
      moveto(c-3,c+round(i*m));
      lineto(c+3,c+round(i*m));
      moveto(c-3,c-round(i*m));
      lineto(c+3,c-round(i*m));
      if i mod 2=0 then
        begin
          textout(c+round(i*m),c+10,inttostr(i));
          textout(c-round(i*m),c+10,inttostr(i));
          textout(c-20,c+round(i*m)-5,inttostr(-i));
          textout(c-20,c-round(i*m)-5,inttostr(i));
        end;
     end;
    //нарисум все точки
    for i:=1 to n do
     begin
      //точки 2 множества
      brush.Color:=clLime;
      pen.Color:=clLime;
      ellipse(c+round(m*x2[i])-2,c-round(m*y2[i])-2,c+round(m*x2[i])+2,c-round(m*y2[i])+2);
      //тщчки 1 множества с номерами
      brush.Color:=clBlue;
      pen.Color:=clBlue;
      brush.Style:=bsSolid;
      ellipse(c+round(m*x1[i])-2,c-round(m*y1[i])-2,c+round(m*x1[i])+2,c-round(m*y1[i])+2);
      brush.Style:=bsClear;
      textout(c+round(m*x1[i])+5,c-round(m*y1[i]),inttostr(i));
     end;
    //если есть точки, рисуем треугольник
    if mx>0 then
      begin
        pen.Color:=clBlue;
        moveto(c+round(m*x1[ir]),c-round(m*y1[ir]));
        lineto(c+round(m*x1[jr]),c-round(m*y1[jr]));
        lineto(c+round(m*x1[kr]),c-round(m*y1[kr]));
        lineto(c+round(m*x1[ir]),c-round(m*y1[ir]));
      end;
    end;
   end;
end;
 
 
end.
Вложения
Тип файла: zip 2 множества точек.zip (128.7 Кб, 2 просмотров)
1
0 / 0 / 0
Регистрация: 14.12.2018
Сообщений: 3
15.12.2018, 13:39  [ТС] 3
Спасибо огромное
0
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
15.12.2018, 14:33 4
Вот немного улучшил, больше точек, можно не закрывая программу получить другие множества.
Вложения
Тип файла: zip 2 множества точек_1.zip (128.9 Кб, 4 просмотров)
1
Супер-модератор
Эксперт Pascal/DelphiАвтор FAQ
32830 / 21168 / 8147
Регистрация: 22.10.2011
Сообщений: 36,428
Записей в блоге: 8
15.12.2018, 15:10 5
Лучший ответ Сообщение было отмечено Valeron302 как решение

Решение

{$MODE_PERFECTION On}
Вот это:
Pascal
1
2
3
4
5
6
7
8
9
with StringGrid1 do
begin
// ...
   cells[0,0]:='№';
   cells[1,0]:='X';
   cells[2,0]:='Y';
   for i:=1 to n do
     cells[0,i]:=inttostr(i);
end;
Очень просто меняется на:
Pascal
1
2
3
4
5
6
with StringGrid1 do
begin
// ...
   Rows[0].CommaText:='№,X,Y';
   Options:=Options + [goFixedRowNumbering];
end;
Лишние циклы ни к чему, да и писанины в общем случае меньше... Тем более, что Options можно и в Инспекторе объектов изменить...

{$MODE_PERFECTION Off}
2
Почетный модератор
64299 / 47594 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
15.12.2018, 15:24 6
А для чего и куда
{$MODE_PERFECTION On}
{$MODE_PERFECTION Off}
вроде и без этого нормально.
0
15.12.2018, 15:24
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
15.12.2018, 15:24
Помогаю со студенческими работами здесь

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

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

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

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


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

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

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