Нахождение равносторонних треугольников

@Piratcom · Регистрация: 05.08.2009

Студворк — интернет-сервис помощи студентам

Приветствую всех!

Есть задача:
Подсчитать количество равносторонних треугольников с различными длинами оснований и вершинами в заданном множестве точек на плоскости и определить пересекаются ли они.

Вобщем даже не знаю с чего начать...

@Mawrat · 26.10.2009, 21:21

Сначала надо решить первую часть задачи: "Подсчитать количество равносторонних треугольников с различными длинами оснований и вершинами". План решения может быть примерно такой:

Delphi
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
procedure TForm1.Button1Click(Sender: TObject);
type
 
  //Тип, задающий точку.
  TDot = record
    X      : Integer;
    Y      : Integer;
  end;
 
  //Тип, задающий треугольник (ABC).
  TTriangle = record
    A      : TDot;
    B      : TDot;
    C      : TDot;
    //Длина основания.
    Base   : Integer;
  end;
 
const
  //Величина приращения длины массива.
  Capacity       : Integer = 100;
 
var
  //Массив исходных точек.
  ArrDot         : array[1..100] of TDot;
  //Массив равносторонних треугольников.
  ArrTriangle    : array of TTriangle;
  //Количество равносторонних треугольников.
  TriangleCount  : Integer;
  //Счетчики для циклов.
  i, j, k        : Integer;
  //Длина основания треугольника.
  BaseTmp        : Integer;
  //Если TRUE - значит треугольник равносторонний.
  IsEqualSide    : Boolean;
  //Если TRUE - значит треугольник с таким основанием присутствует в массиве треугольников.
  IsPresent   : Boolean;
 
  //Переменные для второй части задачи. (О пересекающихся треугольниках).
 
  ...
 
begin
 
  //Подготовка исходных данных для задачи.
 
  //Квадратная сетка из точек: 10х10. Выглядит так:
 
  //    1  2  3  4  5  6  7  8  9  10
  //  1 .  .  .  .  .  .  .  .  .  .
  //  2 .  .  .  .  .  .  .  .  .  .
  //  3 .  .  .  .  .  .  .  .  .  .
  //  4 .  .  .  .  .  .  .  .  .  .
  //  5 .  .  .  .  .  .  .  .  .  .
  //  6 .  .  .  .  .  .  .  .  .  .
  //  7 .  .  .  .  .  .  .  .  .  .
  //  8 .  .  .  .  .  .  .  .  .  .
  //  9 .  .  .  .  .  .  .  .  .  .
  // 10 .  .  .  .  .  .  .  .  .  .
 
  //Формируем массив этих точек.
  for X := 1 to 10 do begin
    for Y := 1 to 10 do begin
      i := Pred(X) * 10 + Y;
      ArrDot[i].X := X;
      ArrDot[i].Y := Y;
    end;
  end;
 
  //Подготовка исходных данных выполнена.
 
  //Решение первой части задачи. - Поиск равносторонних треугольников.
 
  //Ищем равностронние треугольники и добавляем их в массив треугольников (ArrTriangle).
  for i := Low(ArrDot) to High(ArrDot) - 1 - 1 do begin
    for j := Low(ArrDot) + 1 to High(ArrDot) - 1 do begin
      for k := Low(ArrDot) + 1 + 1 to High(ArrDot) do begin
 
        //Проверяем, является ли очередной треугольник равносторонним.
        ...
        IsEqualSide := ...
        if not IsEqualSide then begin
          Continue;
        end;
 
        //Вычисляем длину основания треугольника.
        BaseTmp := ...;
 
        //Проверяем, нет ли треугольника с таким же по длине основанием в массиве треугольников.
        ...
        IsPresent := ...
        if IsPresent then begin
          Continue;
        end;
 
        //Подсчитываем очередной найденный равносторонний треугольник.
        Inc(TriangleCount);
        //Если требуется, увеличиваем длину массива треугольников.
        if Length(ArrTriangle) < TriangleCount then begin
          SetLength(ArrTriangle, Length(ArrTriangle) + Capacity);
        end;
        //Добавляем равносторонний треугольник в массив.
        ArrTriangle[TriangleCount - 1].A := ArrDot[i];
        ArrTriangle[TriangleCount - 1].B := ArrDot[j];
        ArrTriangle[TriangleCount - 1].C := ArrDot[k];
        ArrTriangle[TriangleCount - 1].Base := BaseTmp;
      end;
    end
  end;
 
  //Корректируем длину массива треугольников в соответствии с количеством
  //добавленных в него треугольников.
  SetLength(ArrTriangle, TriangleCount);
 
  //Теперь иы имеем массив равносторонних треугольников с уникальными длинами оснований. - Первая часть задачи решена.
 
  //Решение второй части задачи. - Найти пересекающиеся треугольники.
 
  ...
 
end;

Добавлено через 17 минут
Построение циклов надо поменять на такое:

Delphi
1
2
3
4
5
  ...
  for i := Low(ArrDot) to High(ArrDot) - 1 - 1 do begin
    for j := i + 1 to High(ArrDot) - 1 do begin
      for k := j + 1 to High(ArrDot) do begin
  ...

Тогда выбираться будут только уникальные треугольники. Вроде так... Дальше в теле цикла "по k" надо выполнять все требуемые исследования очередного треугольника.

@Piratcom · 27.10.2009, 06:55 **[ТС]**

Очень интересная задача.

Просмотрел код, первая часть впринципе понятна, сейчас попробую написать код, удовлетворяющий условию задачи, а именно "в заданном множестве точек". т.е. изначально размеры сетки не заданы и если я правильно понял условие задачи, то эти размеры должен задавать сам пользователь...

@Piratcom · 27.10.2009, 16:05 **[ТС]**

Думаю что стоит ввести ограничение, минимальный размер сетки, например 3x3 или 2x3 или 3x2... Иначе треугольников то вообще не получиться или получиться один...

Добавлено через 30 минут
Вот начал код писать, возникла проблема с массивами, не знаю как сделать динамический массив

Delphi
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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  TDot=record //Тип задающий координаты точки
  end;
 
  TTriangle=record  //Тип, задающий треугольник
    A:TDot;
    B:TDot;
    C:TDot;
    Base: integer; //Длина основания
  end;
 
var
  Form1: TForm1;
  ax,ay,max: integer;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  if (Edit1.Text<>'')and(Edit2.Text<>'') then
  begin
    ax:=StrToInt(Edit1.Text);
    ay:=StrToInt(Edit2.Text);
    if (ax<3)or(ay<3) then begin ShowMessage('Минимальный шаг сетки "3"'); Exit; end else
    begin
      max:=ax*ay;
      //Создание массивов точек и треугольников
    end;
  end else
  begin
    ShowMessage('Заполните все поля.');
  end;
end;
end.

@Mawrat · 27.10.2009, 23:37

Сообщение от Piratcom

Думаю что стоит ввести ограничение, минимальный размер сетки, например 3x3 или 2x3 или 3x2... Иначе треугольников то вообще не получиться или получиться один...

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

В общем, можно доказать, что у равностороннего треугольника хотябы одна вершина обязательно будет иметь вещественные координаты (не целые). И здесь не поможет конфигурация сетки: 3x3 или 2x3 или ещё как-то. Первый вывод:
1. ТОЧНОЕ построение равносторонних треугольников возможно только при использовании точек с вещественными координатами.
---
Следующая проблема. Предположим, мы решили использовать точки с вещественными координатами. Если мы сформируем массив таких точек через генератор случайных чисел, то вероятность, что мы сможем на этом массиве построить хотябы один равносторонний треугольник близка к нулю! (Как это ни странно звучит).
Отсюда следует, что для демонстрации задачи, мы можем пойти по какому-то из двух путей:
- Вычислить координаты вершин нескольких равносторонних треугольников и поместить их в исходный массив. Здесь, продумывая план, мы увидим, что придётся использовать приближения. Когда имеешь дело с вещественными числами - без приближений не обойтись.
- Либо можно изначально не предпринимать попыток заранее расчитать координаты вершин равносторонних треугольников. В этом варианте будем опираться на охват окрестностей точек с целыми координатами.
Т. е. идея здесь вот в чём: если мы имеем 3 точки и построенный по ним треугольник "немного" не дотягивает до равностороннего - это признак того, что в окрестности выбранных точек (вершин) лежат истинные точки (вершины) равностороннего треугольника. Значит, нам достаточно задать радиус окрестностей и мы сможем достаточно точно строить равносторонние треугольники имя точки с целочисленными координатами. Именно на этом варианте и надо остановиться. Это самое естественное решение, я считаю.
Итак, второй вывод:
2. Мы будем использовать исходный массив точек с целочисленными координатами. Но при расчётах зададим радиус "охвата" - точность вычисления. В этот радиус охвата с весьма большой вероятностью попадут истинные точки, образующие вершины равносторонних треугольников.
На основе этих соображений я написал код. Программа содержит:
1. Статический массив, содержащий исходное множество точек с целочисленными координатами.
2. Динамический массив, в который по ходу вычислений записываются найденные "почти" равносторонние треугольники (записываются те, которые удовлетворяют исходному условию задачи).
3. Применён механизм указателей, который позволил избежать большого числа стековых операций (при вызове процедур). (Этот же механизм позволяет избежать переполнения стека).
4. После окончания вычислений на форме рисуются все треугольники из сформированного массива.

Delphi
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
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //Тип, задающий точку.
  TDot = record
    X         : Integer;
    Y         : Integer;
  end;
 
  //Тип, задающий треугольник (ABC).
  TTriangle = record
    A         : TDot;
    B         : TDot;
    C         : TDot;
    //Длина основания.
    Base      : Extended;
  end;
 
  //Тип массива для хранения равносторонних треугольников. Вид массива - динамический.
  TArrTriangle    = array of TTriangle;
  //Указатель на динамический массив треугольников.
  TPArrTriangle   = ^TArrTriangle;
 
const
  //Размер квадратной матрицы - 20x20 точек.
  N = 20;
  //Точность применяемая при сравнении вещественных чисел.
  //Этот параметр мы будем применять для сравнения длин отрезков.
  Epsilon   : Extended = 0.2;
  //Precision задаёт точность округления в функции RoundTo.
  //-3 означает округление до 1e-3.
  //Этот параметр следует выбирать на 2 порядка меньшим (т. е. меньшим в 100 раз),
  //чем Epsilon.
  Precision : Integer  = -3;
 
var
  Form1: TForm1;
 
  //Массив равносторонних треугольников.
  ArrTri   : TArrTriangle;
 
implementation
 
uses Math;
 
{$R *.dfm}
 
//Рисование на канве.
 
//Рисует треугольник aTri на канве aCanvas.
//При прорисовке применяет масштаб aZoom.
procedure DrawTri(aCanvas : TCanvas; aZoom : Integer; aTri : TTriangle);
begin
  aCanvas.MoveTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.B.X) * aZoom, Pred(aTri.B.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.C.X) * aZoom, Pred(aTri.C.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
end;
 
//Рисует на канве aCanvas массив треугольников, на который ссылается указатель aPArrTri.
//При прорисовке применяет масштаб aZoom.
procedure DrawArrTri(aCanvas : TCanvas; aZoom : Integer; aPArrTri : TPArrTriangle);
var
  i : Integer;
begin
  for i := Low(aPArrTri^) to High(aPArrTri^) do begin
    DrawTri(aCanvas, aZoom, aPArrTri^[i]);
  end;
end;
 
//Вычисления.
 
//Эта функция определяет: является ли треугольник равносторонним.
//Если треугольник оказался равносторонним, то вычисляет длину его основания.
function IsEqualSideTri(var aTri : TTriangle) : Boolean;
var
  //Разность координат двух точек.
  DX,
  DY           : Integer;
  //Длины сторон треугольника.
  LengthAB,
  LengthBC,
  LengthCA     : Extended;
begin
 
  Result := False;
 
  //Сторона AB.
  DX := abs(aTri.A.X - aTri.B.X);
  DY := abs(aTri.A.Y - aTri.B.Y);
  LengthAB := RoundTo(Sqrt(DX * DX + DY * DY), Precision);
 
  //Сторона BC.
  DX := abs(aTri.B.X - aTri.C.X);
  DY := abs(aTri.B.Y - aTri.C.Y);
  LengthBC := RoundTo(Sqrt(DX * DX + DY * DY), Precision);
 
  //Сторона CA.
  DX := abs(aTri.C.X - aTri.A.X);
  DY := abs(aTri.C.Y - aTri.A.Y);
  LengthCA := RoundTo(Sqrt(DX * DX + DY * DY), Precision);
 
  if
    ( Abs(LengthAB - LengthBC) < Epsilon )
    and ( Abs(LengthBC - LengthCA) < Epsilon )
  then begin
    //Длина основания у равностороннего треугольника равна длине любой его стороны.
    aTri.Base := LengthAB;
    Result := True;
  end;
 
end;
 
//Эта функция определяет: является ли треугольник равнобедренным.
//Если треугольник оказался равнобедренным, то вычисляет длину его основания.
function IsEqualHipTri(var aTri : TTriangle) : Boolean;
var
  //Разность координат двух точек.
  DX,
  DY           : Integer;
  //Длины сторон треугольника.
  LengthAB,
  LengthBC,
  LengthCA     : Extended;
begin
 
  Result := False;
 
  //Сторона AB.
  DX := Abs(aTri.A.X - aTri.B.X);
  DY := Abs(aTri.A.Y - aTri.B.Y);
  LengthAB := RoundTo(Sqrt(DX * DX + DY * DY), Precision);
 
  //Сторона BC.
  DX := Abs(aTri.B.X - aTri.C.X);
  DY := Abs(aTri.B.Y - aTri.C.Y);
  LengthBC := RoundTo(Sqrt(DX * DX + DY * DY), Precision);
 
  //Сторона CA.
  DX := Abs(aTri.C.X - aTri.A.X);
  DY := Abs(aTri.C.Y - aTri.A.Y);
  LengthCA := RoundTo(Sqrt(DX * DX + DY * DY), Precision);
 
  //Определяем рёбра и основание.
  if Abs(LengthAB - LengthBC) < Epsilon then begin
    if Abs(LengthAB + LengthBC - LengthCA) > Epsilon then begin
      aTri.Base := LengthCA;
      Result := True;
    end;
  end else if Abs(LengthBC - LengthCA) < Epsilon then begin
    if Abs(LengthBC + LengthCA - LengthAB) > Epsilon then begin
      aTri.Base := LengthAB;
      Result := True;
    end;
  end else if Abs(LengthCA - LengthAB) < Epsilon then begin
    if Abs(LengthCA + LengthAB - LengthBC) > Epsilon then begin
      aTri.Base := LengthBC;
      Result := True;
    end;
  end;
 
end;
 
//Проверяет, есть ли в массиве треугольников треугольник с таким же основанием.
//На массив треугольников ссылается указатель aPArrTri.
function IsPresent(aPArrTri : TPArrTriangle; aTri : TTriangle) : Boolean;
var
  i : Integer;
begin
  Result := False;
  for i := Low(aPArrTri^) to High(aPArrTri^) do begin
    if Abs(aPArrTri^[i].Base - aTri.Base) < Epsilon then begin
      Result := True;
      Break;
    end;
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Величина приращения длины массива.
  Capacity       : Integer = 100;
 
var
  //Массив исходных точек.
  ArrDot         : array[1..N * N] of TDot;
  //Количество равносторонних треугольников.
  TriCount       : Integer;
  //Треугольник.
  Tri            : TTriangle;
  //Счетчики для циклов.
  i, j, k        : Integer;
  //Координаты точки.
  X, Y           : Integer;
 
  //Переменные для второй части задачи. (О пересекающихся треугольниках).
 
  //...
 
begin
 
  //Подготовка исходных данных для задачи.
 
  //Квадратная сетка из точек: 20х20. Выглядит так:
 
  //     1   2   3   4   5   6   7   8   9   10  ...  19  20
  //  1  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  2  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  3  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  4  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  5  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  6  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  7  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  8  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  9  .   .   .   .   .   .   .   .   .   .        .   .
 
  // 10  .   .   .   .   .   .   .   .   .   .        .   .
 
  // ...
 
  // 19  .   .   .   .   .   .   .   .   .   .   ...  .   .
 
  // 20  .   .   .   .   .   .   .   .   .   .   ...  .   .
 
  //Формируем массив этих точек.
  for X := 1 to N do begin
    for Y := 1 to N do begin
      i := Pred(X) * N + Y;
      ArrDot[i].X := X;
      ArrDot[i].Y := Y;
    end;
  end;
 
  //Подготовка исходных данных выполнена.
 
  //Решение первой части задачи. - Поиск равносторонних треугольников.
 
  //Если массив треугольников не пустой, то обнуляем его
  SetLength(ArrTri, 0);
  TriCount := 0;
 
  //Ищем равностронние треугольники и добавляем их в массив треугольников (ArrTriangle).
  for i := Low(ArrDot) to High(ArrDot) - 1 - 1 do begin
    for j := i + 1 to High(ArrDot) - 1 do begin
      for k := j + 1 to High(ArrDot) do begin
        //Очередной треугольник.
        Tri.A := ArrDot[i];
        Tri.B := ArrDot[j];
        Tri.C := ArrDot[k];
        Tri.Base := -1;
 
        //Проверяем, является ли очередной треугольник равносторонним.
        //Одновременно вычисляем длину основания треугольника.
        if not IsEqualSideTri(Tri) then begin //Равносторонний треугльник.
        //if not IsEqualHipTri(Tri) then begin //Равнобедренный треугльник.
          Continue;
        end;
 
        //Проверяем, нет ли треугольника с таким же по длине основанием в массиве треугольников.
        if IsPresent(Addr(ArrTri), Tri) then begin
          Continue;
        end;
 
        //Подсчитываем очередной найденный равносторонний треугольник.
        Inc(TriCount);
        //Если требуется, увеличиваем длину массива треугольников.
        if Length(ArrTri) < TriCount then begin
          SetLength(ArrTri, Length(ArrTri) + Capacity);
        end;
        //Добавляем равносторонний треугольник в массив.
        ArrTri[TriCount - 1] := Tri;
      end;
    end
  end;
 
  //Корректируем длину массива треугольников в соответствии с количеством
  //добавленных в него треугольников.
  SetLength(ArrTri, TriCount);
 
  //Теперь иы имеем массив равносторонних треугольников с уникальными длинами оснований. - Первая часть задачи решена.
 
  //Чертим найденные треугольники на канве.
 
  //Будем рисовать треугольники синим цветом.
  Image1.Canvas.Pen.Color := RGB(0, 0, 255);
  //Рисуем массив треугольников на канве компонента Image1.
  DrawArrTri(Image1.Canvas, Image1.Width div N, Addr(ArrTri));
 
  //Решение второй части задачи. - Найти пересекающиеся треугольники.
 
  //...
 
end;
 
initialization
 
finalization
 
  Finalize(ArrTri);
 
end.

В этой программе можешь поэксперементировать с параметром Epsilon. Чем больше Epsilon, тем большее колчество равносторонних треугольников будет находить программа. - Потому что тем больше радиус охвата вокруг каждой из исходных точек.
И ещё использована техника работы с указателями, про которую я тебе еще не рассказывал. - Но это позже, по ходу обсуждения расскажу.

@odip · 28.10.2009, 00:12

и определить пересекаются ли они

Это просто.
1) Есть известный алгоритм который определяет лежит ли точка внутри треугольника.
2) Пусть есть два треугольника: A0,A1,A2 и B0,B1,B2.
Нужно проверить что хотя бы одна из точек B0,B1,B2 лежит в треугольнике A0,A1,A2
или наоборот что одна из точек A0,A1,A2 лежит в треугольнике B0,B1,B2.
Если лежит - то пересекаются, иначе нет.
3) Проверить пункт 2 по всем парам треугольников.

@Mawrat · 28.10.2009, 00:27

Оdip, тут видимо не совсем так. Вот представь - имеем "высокий" треугольник с горизонтальным основанием. И имеем "вытянутый" треугольник с вертикальным основанием. - Вполне может быть, что стороны одного из них пересекают стороны другого. Но ни одна из их вершин не лежит внутри другого.
Хотя... весь вопрос в том, какое дать определение пресечению треугольников. Если пересечение - это обязательно нахождение одной из вершин одного треугольника внутри другого - это одно. А если пересечением считать факт персечения сторон - это другое.
Надо у Piratcom уточнить - что в его задании под пересечением понимается?

@Piratcom · 28.10.2009, 05:20 **[ТС]**

2odip: Это типа как в дискретной математике, определить является ли множество подмножеством данного множества... Кругами Эйлера изображается...

Я кстати кроме этого варианта больше ничего не предполагал...

Сообщение от Mawrat

Мы будем использовать исходный массив точек с целочисленными координатами. Но при расчётах зададим радиус "охвата" - точность вычисления.

Надоже, действительно грамотное решение, я даже предположить не мог, что так возможно, и что такие сложности возникнут...

На сколько я понял, то Epsilon это и есть радиус окружности, проведённой около целочисленной вершины, и реальная нецелочисленная вершина берётся в её пределах => чем больше радиус, тем больше возможных вершин, при котором получатся равносторонние треугольники =Ю их будет больше... Как я понимаю радиус Epsilon не может быть меньше 0.1, точнее может, только смысла в этом не будет, потому что если есть вероятность, что не построится ни оддин такой треугольник...

На счёт координатной сетки, как я понял, лучше сделать её постоянных размеров, и начее я пока что-то не понял как сделать, ну листинг почитаю. может что в голову придёт

Сообщение от Mawrat

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

Я вот об этом тоже достаточно долг думал и почему-то мне казалось что нужно определить пересекаются ли стороны, сегодня уточню, но есть одно но, если я начну уточнять, мне скажут "Конечно и так и так должно быть!"

Поэтому остаётся надеятся на лучшее

Хотя если бдут оба варианта, это ещё лучше, ведь чем задача сложнее, тем она интересней...

@odip · 28.10.2009, 13:23

2) Пусть есть два треугольника: A0,A1,A2 и B0,B1,B2.
Нужно проверить что хотя бы одна из точек B0,B1,B2 лежит в треугольнике A0,A1,A2
или наоборот что одна из точек A0,A1,A2 лежит в треугольнике B0,B1,B2.
Если лежит - то пересекаются, иначе нет.

Да - вариант неправильный.
Тогда определим что треугольники пересекаются, если пересекаются их стороны.
Значит берем три стороны A0-A1, A0-A2, A1-A2.
И проверяем пересекаются ли они со сторонами B0-B1, B0-B2, B1-B2.
Если хотя бы одно перечение есть - то треугольники пересекаются, иначе нет.
Пересечение проверять с точностью EPSILON, например EPLISON = 0.00001

@Piratcom · 28.10.2009, 14:04 **[ТС]**

Сообщение от odip

Тогда определим что треугольники пересекаются, если пересекаются их стороны.

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

@Mawrat · 29.10.2009, 08:27

Сегодня вечером попытаюсь написать процедуру для определения пересекаются ли 2 отрезка или нет. Я тут, вроде, придумал метод такого вычисления. По ходу реализации сравню его с классическим.

Классический - это через определение уравнения прямых и вычисления координат точки их пересечения. Затем, сравнение - покрываются ли координаты (проекции на координатные оси) найденной точки на проекции прямых. Мой способ вполне вероятно сможет по скорости выигрывать. - Там сразу определяется накладываются ли проекции прямых по обеим осям - если да, то пересечение возмжно, нет - пересечения нет. Далее - нужно последовательно вычислять пары углов. Здесь максимально 4 шага - 2, 4, 6 или 8 значений уголов надо вычислить. Как только встретится пара уголов, которые в сумме дают больше 180 градусов - значит пересечения нет. Если такой пары не нашлось - пересечение есть. Я на картинке потом это всё поясню.

---
Про Epsilon в первой части задачи. Epsilon обозначает часть расстояния между ближайшими соседними точками (расстояние по оси Х или по оси У). Пэтому для Epsilon максимальное значение должно быть 0.5. Потому что при Epxilon > 0.5 в охватываемую зону вокруг заданной точки могут начать попадать искомые вещественные вершнины из окрестностей соседних точек. Т. е. поиск начнёт выдавать неверные результаты. Минимальное Epsilon может быть разным - чем больше исходных точек, тем меньше можно выставлять Epsilon.

@Piratcom · 29.10.2009, 14:14 **[ТС]**

Сообщение от Mawrat

Классический - это через определение уравнения прямых и вычисления координат точки их пересечения.

я тож так думал, найти значение, при которых 2 функции имеют одинаковое значение, вроде так...
Я вот так что-то подумал, а можно ли сделать так: например построили треуголькик, и одну вершину взять за центр окружности, так чтобы она полностью пересекала треугольник, и если в её радиусе есть вершина другого треугольника, то они пересекаются... А может и бред...

@Piratcom · 31.10.2009, 05:10 **[ТС]**

Наткнуля в интернете, на такую вот статейку
Как определить пересекаются ли два прямых отрезка на плоскости ?

Есть задача: требуется определить пересекаются ли два прямых отрезка
на плоскости(есть PointStart и PointEnd для обоих отрезков).Пробовал
математически решить,но привидение пикселей к int все проваливает.
Кто поможет?

Если надо условие пересечения отрезков, то как вариант:

- Прямая A*x+B*y+C=0 по двум точкам P1(x1,y1), P2(x2,y2):
A = y2-y2
B = x1-x2
C = -A*x1-B*y1 = y1*x2 - x1*y2
- Расстояние от точки S(x0,y0) до прямой:
r = A*x0 + B*y0 + C /sqrt(A*A + B*B)

обозначим как

Q(P1(x1,y1),P2(x2,y2),S(x0,y0)) = r*sqrt(A*A+B*B) =
x0*(y2-y1)+y0*(x1-x2) + y1*x2 - x1*y2

- Тогда условие пересечения двуч отрезков(a,b) и (A,B):
Q(a,b;A)*Q(a,b;B)<0 && Q(A,B;a)*Q(A,B;b)<0

пример ф-и на паскале:

function Q(ax,ay,bx,by,tx,ty:longint):real;
begin
Q:=tx*(by-ay)+ty*(ax-bx)+ay*bx-ax*by;
end;

Сейчас думаю как приминить это...

Добавлено через 2 минуты
Эта задача подтверждение то, что целочисленными координатами тут не обойдёшся...

@Puporev · 31.10.2009, 13:57

Условие "равеснтва" двух вещественных чисел, например совпадения двух точек, полученных в результате вычисления.

Pascal
1
2
t:=0.00001;
if abs(x1-x2)<t then совпадают

@Mawrat · 31.10.2009, 16:31

Piratcom, в четверг и пятницу не ответил я - у меня времени не было.
В общем, я написал все нужные процедуры:
1. Проверка пересечения линий.
2. Проверка вхождения точки внутрь треугольника.
3. Проверка пересечения треугольников - проверяет пресекаются ли стороны треугольника и еще проверяет на вхождение вершин одного треугольника внутрь другого - это на случай, когда один треугольник полностью лежит внутри другого.
Сегодня вчером выложу.
Piratcom, ещё надо такой момент уточнить - в условии задачи: "найти персекающиеся треугольники". Т. е. какой здесь отчёт должен быть? Например так можно:
Треугольник 1 (координаты) пересекается с: ...
Треугольник 2 (координаты) пересекается с: ...
...
Так?

@Piratcom · 31.10.2009, 19:49 **[ТС]**

Сообщение от Mawrat

Т. е. какой здесь отчёт должен быть?

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

Но впринципе думаю не сложно координаты треугольников вывести, алгоритм примерно такой: Если одна из сторон треугольника пересекается с какой либо стороной другого треугольника => Вывести координаты вершин и инкриментировать счётчик пересекающихся треугольников. И зациклить эту проверку, т.е. пройтись по всем существующим треугольникам...

Сообщение от Mawrat

и еще проверяет на вхождение вершин одного треугольника внутрь другого - это на случай, когда один треугольник полностью лежит внутри другого.

Этот вариант я вообще не учёл, забыл...

@odip · 31.10.2009, 22:31

Проверка пересечения треугольников - проверяет пресекаются ли стороны треугольника и еще проверяет на вхождение вершин одного треугольника внутрь другого - это на случай, когда один треугольник полностью лежит внутри другого.

Точно !
Вообще в условии задачи сказано: проверить пересекаются ли треугольники.
Если считать что треугольники пересекаются, когда у них есть хотя бы одна общая точка, тогда надо проверять еще и этот вариант что один лежит внутри другого.

@Piratcom · 01.11.2009, 05:17 **[ТС]**

http://window.edu.ru/window_ca... ktikum.pdf
Страница №66, задача №39, случайно нашёл задачник... =))) Но в нём тоже ничего не уточняется...

@Mawrat · 01.11.2009, 17:09

Piratcom, вот рабочий вариант. Я погонял - вроде, всё работает правильно. Но! Я перечитал задание и теперь понимаю его немного подругому.

В варианте, который выложен в этом посте, алгоритм построен так: ищутся равносторонние треугольники. У них замеряются длины оснований и если далее в процессе поиска встречаются другие треугольники с такими же длинами оснований - то они игнорируются и не попадают в результирующий массив. Именно по этому на рисунке, который генерирует программа, все обнаруженные треугольники прижаты к левому верхнему углу. - Потому что поиск начинается с точки (1;1). И другие встретившиеся треугольники с такими же основаниями - отсеяны. В результате мы получаем массив равносторонних треугольников, у которых основания уникальны в пределах сформированного массива...
Но в задании сказано: "Подсчитать количество равносторонних треугольников с различными длинами оснований и вершинами ...". Т. е., видимо, надо найти такие равносторонние треугольники, которые имеют уникальное основание на всём множестве равносторонних треугольников, которые могут быть построены на массиве исходных точек.

Т. е. если мы нашли какой-то равносторонний треугольник, а потом по ходу поиска нашли другой равносторонний треугольник, то мы должны из результирующего массива исключить и первый и второй найденные треугольники. А не только второй (и последующие).
---
Если мы нашли какой-то равносторонний треугольник с основанием, которое раньше ещё не встречалось. И в процессе дальнейшего поиска больше треугольников с таким основанием не нашли, то вот такой треугольник мы и должны включить в результирующий массив.
---

Delphi
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
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Panel1: TPanel;
    Image1: TImage;
    BtnClearMemo: TButton;
    procedure Button1Click(Sender: TObject);
    procedure BtnClearMemoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
  //Тип, задающий точку.
  TDot = record
    X         : Integer;
    Y         : Integer;
  end;
 
  //Тип, задающий треугольник (ABC).
  TTriangle = record
    A         : TDot;
    B         : TDot;
    C         : TDot;
    //Длина основания.
    Base      : Extended;
  end;
 
  //Тип - линия (AB).
  TLine = record
    A         : TDot;
    B         : TDot;
    //Длина линии.
    Length    : Extended;
  end;
 
  //Тип массива для хранения равносторонних треугольников. Вид массива - динамический.
  TArrTriangle   = array of TTriangle;
  //Указатель на динамический массив треугольников.
  TPArrTriangle  = ^TArrTriangle;
 
const
  //Значение радиана (в градусах):
  Radian         : Extended = 180 / Pi;
  //Размер квадратной матрицы - 20x20 точек.
  N = 20;
  //Точность сравнения длин отрезков. Расстояние между ближайшими соседними точками сетки,
  //взятое по оси Х или по оси Y равно 1.
  EpsilonLen     : Extended = 0.2;
  //Точность сравнения углов. В градусах.
  EpsilonAngle   : Extended = 0.001;
  //Точность сравнения параметров уравнений прямых.
  EpsilonKoef    : Extended = 0.001;
var
  Form1: TForm1;
 
  //Массив равносторонних треугольников.
  ArrTri   : TArrTriangle;
 
implementation
 
uses Math;
 
{$R *.dfm}
 
//Рисование на канве.
 
//Рисует треугольник aTri на канве aCanvas.
//При прорисовке применяет масштаб aZoom.
procedure DrawTri(aCanvas : TCanvas; aZoom : Integer; aTri : TTriangle);
begin
  aCanvas.MoveTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.B.X) * aZoom, Pred(aTri.B.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.C.X) * aZoom, Pred(aTri.C.Y) * aZoom);
  aCanvas.LineTo(Pred(aTri.A.X) * aZoom, Pred(aTri.A.Y) * aZoom);
end;
 
//Рисует на канве aCanvas массив треугольников, на который ссылается указатель aPArrTri.
//При прорисовке применяет масштаб aZoom.
procedure DrawArrTri(aCanvas : TCanvas; aZoom : Integer; aPArrTri : TPArrTriangle);
var
  i : Integer;
begin
  for i := Low(aPArrTri^) to High(aPArrTri^) do begin
    DrawTri(aCanvas, aZoom, aPArrTri^[i]);
  end;
end;
 
//Вычисления.
 
//Эта функция определяет: является ли треугольник равносторонним.
//Если треугольник оказался равносторонним, то вычисляет длину его основания.
function IsEqualSideTri(var aTri : TTriangle) : Boolean;
var
  //Разность координат двух точек.
  DX,
  DY           : Integer;
  //Длины сторон треугольника.
  LengthAB,
  LengthBC,
  LengthCA     : Extended;
begin
 
  Result := False;
 
  //Сторона AB.
  DX := abs(aTri.A.X - aTri.B.X);
  DY := abs(aTri.A.Y - aTri.B.Y);
  LengthAB := Sqrt(DX * DX + DY * DY);
 
  //Сторона BC.
  DX := abs(aTri.B.X - aTri.C.X);
  DY := abs(aTri.B.Y - aTri.C.Y);
  LengthBC := Sqrt(DX * DX + DY * DY);
 
  //Сторона CA.
  DX := abs(aTri.C.X - aTri.A.X);
  DY := abs(aTri.C.Y - aTri.A.Y);
  LengthCA := Sqrt(DX * DX + DY * DY);
 
  if
    ( Abs(LengthAB - LengthBC) < EpsilonLen )
    and ( Abs(LengthBC - LengthCA) < EpsilonLen )
  then begin
    //Длина основания у равностороннего треугольника равна длине любой его стороны.
    aTri.Base := LengthAB;
    Result := True;
  end;
 
end;
 
//Эта функция определяет: является ли треугольник равнобедренным.
//Если треугольник оказался равнобедренным, то вычисляет длину его основания.
function IsEqualHipTri(var aTri : TTriangle) : Boolean;
var
  //Разность координат двух точек.
  DX,
  DY           : Integer;
  //Длины сторон треугольника.
  LengthAB,
  LengthBC,
  LengthCA     : Extended;
begin
 
  Result := False;
 
  //Сторона AB.
  DX := Abs(aTri.A.X - aTri.B.X);
  DY := Abs(aTri.A.Y - aTri.B.Y);
  LengthAB := Sqrt(DX * DX + DY * DY);
 
  //Сторона BC.
  DX := Abs(aTri.B.X - aTri.C.X);
  DY := Abs(aTri.B.Y - aTri.C.Y);
  LengthBC := Sqrt(DX * DX + DY * DY);
 
  //Сторона CA.
  DX := Abs(aTri.C.X - aTri.A.X);
  DY := Abs(aTri.C.Y - aTri.A.Y);
  LengthCA := Sqrt(DX * DX + DY * DY);
 
  //Определяем рёбра и основание.
  if Abs(LengthAB - LengthBC) < EpsilonLen then begin
    if Abs(LengthAB + LengthBC - LengthCA) > EpsilonLen then begin
      aTri.Base := LengthCA;
      Result := True;
    end;
  end else if Abs(LengthBC - LengthCA) < EpsilonLen then begin
    if Abs(LengthBC + LengthCA - LengthAB) > EpsilonLen then begin
      aTri.Base := LengthAB;
      Result := True;
    end;
  end else if Abs(LengthCA - LengthAB) < EpsilonLen then begin
    if Abs(LengthCA + LengthAB - LengthBC) > EpsilonLen then begin
      aTri.Base := LengthBC;
      Result := True;
    end;
  end;
 
end;
 
//Проверяет, есть ли в массиве треугольников треугольник с таким же основанием.
//На массив треугольников ссылается указатель aPArrTri.
function IsPresent(aPArrTri : TPArrTriangle; aTri : TTriangle) : Boolean;
var
  i : Integer;
begin
  Result := False;
  for i := Low(aPArrTri^) to High(aPArrTri^) do begin
    if Abs(aPArrTri^[i].Base - aTri.Base) < EpsilonLen then begin
      Result := True;
      Break;
    end;
  end;
end;
 
 
//------------------------------------------------------------------------------
//Для второй части задачи.
//------------------------------------------------------------------------------
 
//Определяет: пересекаются ли отрезки aLine1 и aLine2.
function CrossLine (aLine1, aLine2 : TLine) : Boolean;
var
  //Флаг, показыавющий параллелен ли отрезок оси Y.
  LineVert1,
  LineVert2       : Boolean;
 
  //Параметры уравнения прямой aLine1.
  K1, C1,
  //Параметры уравнения прямой aLine2.
  K2, C2          : Extended;
  //Координаты точки пересечения прямых aLine1 и aLine2.
  XCross, YCross  : Extended;
begin
 
  Result := False;
 
  //Будем использовать "уравнение прямой с уголовым коэффициентом":
  //Уравнение прямой aLine1: Y = K1*X + C1;
  //Уравнение прямой aLine2: Y = K2*X + C2;
  //Уравнение такого вида не определено в случае, когда прямая параллельна оси Y.
 
  //Провека наложения проекций отрезков на оси X и Y.
  //Если имеется наложение проекций по обеим осям, тогда пересечение отрезков возможно.
  //Если хотябы на одной из осей наложения не обнаружено - такие отрезки не могут пересекаться.
  if
    not (
      ( ( aLine1.A.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.A.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine1.B.X >= Min(aLine2.A.X, aLine2.B.X) ) and ( aLine1.B.X <= Max(aLine2.A.X, aLine2.B.X) ) )
      or ( ( aLine2.A.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.A.X <= Max(aLine1.A.X, aLine1.B.X) ) )
      or ( ( aLine2.B.X >= Min(aLine1.A.X, aLine1.B.X) ) and ( aLine2.B.X <= Max(aLine1.A.X, aLine1.B.X) ) )
    )
  then begin
    Result := False;
    Exit;
  end;
 
  //Параллельность отрезка aLine1 оси Y.
  LineVert1 := False;
  if aLine1.A.X = aLine1.B.X then begin
    LineVert1 := True;
  end;
 
  //Параллельность отрезка aLine2 оси Y.
  LineVert2 := False;
  if aLine2.A.X = aLine2.B.X then begin
    LineVert2 := True;
  end;
 
  if LineVert1 and LineVert2 then begin
    //Случай, когда оба отрезка параллельны оси Y.
    if aLine1.A.X = aLine2.A.X then begin
      //Оба отрезка расположены на одной прямой.
      //Отрезки пересекаются.
      Result := True;
    end else begin
      //Отрезки расположены на разных прямых. Значит - не могут пересекаться.
      Result := False;
    end;
    Exit;
  end;
 
  if not LineVert1 then begin
    //Отрезок aLine1 не параллелен оси Y.
    //Значит, можно составить уравнение с угловым коэффициентом.
    //Параметры прямой aLine1.
    K1 := (aLine1.A.Y - aLine1.B.Y) / (aLine1.A.X - aLine1.B.X);
    C1 := aLine1.A.Y - K1 * aLine1.A.X;
 
    if LineVert2 then begin
      //Отрезок aLine2 параллелен оси Y.
      //Координаты точки пересечения прямых aLine1 и aLine2.
      XCross := aLine2.A.X;
      YCross := K1 * XCross + C1;
      if
            ( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
        and ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
      //and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
        and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
      then begin
        //Координаты точки пересечения прямых накладываются на все проекции обоих отрезков.
        //Т. о. отрезки пересекаются.
        Result := True;
      end else begin
        //Координаты точки пересечения прямых не накладываются на все проекции
        //обоих отрезков.
        Result := False;
      end;
      Exit;
    end;
  end;
 
  if not LineVert2 then begin
    //Отрезок aLine2 не параллелен оси Y.
    //Значит, можно составить уравнение с угловым коэффициентом.
    //Параметры прямой aLine2.
    K2 := (aLine2.A.Y - aLine2.B.Y) / (aLine2.A.X - aLine2.B.X);
    C2 := aLine2.A.Y - K2 * aLine2.A.X;
 
    if LineVert1 then begin
      //Отрезок aLine2 параллелен оси Y.
      //Координаты точки пересечения прямых aLine1 и aLine2.
      XCross := aLine1.A.X;
      YCross := K2 * XCross + C2;
      if
          //( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
            ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
        and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
        and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
      then begin
        //Координаты точки пересечения прямых накладываются на все проекции обоих отрезков.
        //Т. о. отрезки пересекаются.
        Result := True;
      end else begin
        //Координаты точки пересечения прямых не накладываются на все проекции
        //обоих отрезков.
        Result := False;
      end;
      Exit;
    end;
  end;
 
  //Ни один из отрезков не параллелен оси Y.
 
  //Координаты точки пересечения двух прямых неопределены, если прямые
  //параллельны друг другу.
 
  if SameValue(K1, K2, EpsilonKoef) then begin
    //Случай, когда отрезки параллельны друг другу.
    if SameValue(C1, C2, EpsilonKoef) then begin
      //Оба отрезка лежат на одной и той же прямой.
      //Отрезки пересекаются (накладываются).
      Result := True;
    end else begin
      //Отрезки лежат на разных параллельних прямых. Т. е. не пересекаются.
      Result := False;
    end;
    Exit;
  end;
 
  //Отрезки лежат на прямых, непараллельных друг другу.
 
  //Точка пересечения прямых.
 
  XCross := (C1 - C2) / (K2 - K1);
  YCross := (K2 * C1 - K1 * C2) / (K2 - K1);
  if
        ( ( XCross >= Min(aLine1.A.X, aLine1.B.X) ) and ( XCross <= Max(aLine1.A.X, aLine1.B.X) ) )
    and ( ( YCross >= Min(aLine1.A.Y, aLine1.B.Y) ) and ( YCross <= Max(aLine1.A.Y, aLine1.B.Y) ) )
    and ( ( XCross >= Min(aLine2.A.X, aLine2.B.X) ) and ( XCross <= Max(aLine2.A.X, aLine2.B.X) ) )
    and ( ( YCross >= Min(aLine2.A.Y, aLine2.B.Y) ) and ( YCross <= Max(aLine2.A.Y, aLine2.B.Y) ) )
  then begin
    //Координаты точки пересечения прямых накладываются на все проекции обоих отрезков.
    //Т. о. отрезки пересекаются.
    Result := True;
  end else begin
    //Координаты точки пересечения прямых не накладываются на все проекции
    //обоих отрезков.
    Result := False;
  end;
 
end;
 
//Возвращает значение угла ABC. (В градусах).
function GetAngleABC(aA, aB, aC : TDot) : Extended;
var
  LineBA    : Extended;
  LineBC    : Extended;
  LineAC    : Extended;
begin
 
  // Теорема косинусов:
  //AC^2 = BA^2 + BC^2 - 2*BA*BC*cosABC
  //-> cosABC = (AC^2 - BA^2 - BC^2)/2*BA*BC
  //-> ABC = ArcCos( cosABC ) - В радианах
  //-> ABC = ArcCos( cosABC ) * Radian - В градусах.
 
  LineBA := Sqrt( Sqr(aB.X - aA.X) + Sqr(aB.Y - aA.Y) );
  LineBC := Sqrt( Sqr(aB.X - aC.X) + Sqr(aB.Y - aC.Y) );
  LineAC := Sqrt( Sqr(aA.X - aC.X) + Sqr(aA.Y - aC.Y) );
  Result :=
    Radian * ArcCos(
      ( - Sqr(LineAC) + Sqr(LineBA) + Sqr(LineBC) ) / ( 2 * LineBA * LineBC )
    );
end;
 
//Проверяет: попадает ли точка aDot внутрь треугольника aTri.
function DotInTriangle(aTri : TTriangle; aDot : TDot) : Boolean;
begin
  //Если точка D расположена внутри треугольника ABC, то выполнятся следующие 3 условия:
  //1. Углы: ABD + CBD = ABC
  //2. Углы: ACD + BCD = ACB
  //3. Углы: BAD + CAD = BAC
  //Если точка D расположена вне треугольника ABC, то какие-то два из трёх приведенных
  //выше условий будут нарушены таким образом:
  //1. Углы: ABD + CBD > ABC
  //2. Углы: ACD + BCD > ACB
  //3. Углы: BAD + CAD > BAC
  //Если при последовательной проверке трёх обнаружено первое нарушение -
  //это однозначно говорит о том, что точка D лежит за пределами треугольника ABC.
  //На этом и построим алгоритм.
  //
  //                     <A>
  //                     /|\
  //                    / | \
  //                   /  |  \
  //                  /   |   \
  //                 /    |    \
  //                /    <D>    \
  //               /   /     \   \
  //              /  /         \  \
  //             / /             \ \
  //            //                 \\
  //          <B>-------------------<C>
 
  Result := False;
 
  //1. Если углы: ABD + CBD > ABC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.B, aDot) + GetAngleABC(aTri.C, aTri.B, aDot)
      - GetAngleABC(aTri.A, aTri.B, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //2. Если углы: ACD + BCD > ACB -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.A, aTri.C, aDot) + GetAngleABC(aTri.B, aTri.C, aDot)
      - GetAngleABC(aTri.A, aTri.C, aTri.B)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //3. Если углы: BAD + CAD > BAC -> точка D за пределами треугольника.
  if
    Abs(
      GetAngleABC(aTri.B, aTri.A, aDot) + GetAngleABC(aTri.C, aTri.A, aDot)
      - GetAngleABC(aTri.B, aTri.A, aTri.C)
    ) > EpsilonAngle
  then begin
    Exit;
  end;
 
  //4. Точка D лежит внутри треугольника.
 
  Result := True;
end;
 
//Определяет: пересекаются ли треуголькики aTri1 и aTri2.
function CrossTriangle(aTri1, aTri2 : TTriangle) : Boolean;
var
  aLine1, aLine2       : TLine;
begin
  Result := True;
 
  //Пересекается ли сторона AB треугольника aTri1 с любой из сторон треугольника aTri2
 
  aLine1.A := aTri1.A;
  aLine1.B := aTri1.B;
 
  aLine2.A := aTri2.A;
  aLine2.B := aTri2.B;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.B;
  aLine2.B := aTri2.C;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.C;
  aLine2.B := aTri2.A;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона BC треугольника aTri1 с любой из сторон треугольника aTri2
 
  aLine1.A := aTri1.B;
  aLine1.B := aTri1.C;
 
  aLine2.A := aTri2.A;
  aLine2.B := aTri2.B;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.B;
  aLine2.B := aTri2.C;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.C;
  aLine2.B := aTri2.A;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  //Пересекается ли сторона CA треугольника aTri1 с любой из сторон треугольника aTri2
 
  aLine1.A := aTri1.C;
  aLine1.B := aTri1.A;
 
  aLine2.A := aTri2.A;
  aLine2.B := aTri2.B;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.B;
  aLine2.B := aTri2.C;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  aLine2.A := aTri2.C;
  aLine2.B := aTri2.A;
  if CrossLine(aLine1, aLine2) then begin
    Exit;
  end;
 
  //В этой точке алгоритма мы знаем, что стороны треугольников не пересекаются.
  //Теперь проверяем не лежит ли один треугольник полностью внутри другого.
  //Если один треугольник полностью лежит внутри другого, это означает, что все
  //вершины этого треугольника тоже лежат внутри другого.
  //Поэтому нам достаточно выполнить такую проверку только для одной вершнины каждого
  //из треугольников.
  //Если один треугольник полностью лежит внутри другого, то будем считать, что
  //такие треугольники пересекаются.
 
  //Если треугольник aTri2 полностью лежит внутри треугольника aTri1, то все
  //вершины треугольника aTri2 лежат внутри треугольника aTri1.
  if DotInTriangle(aTri1, aTri2.A) then begin
    Exit;
  end;
 
  //Если треугольник aTri1 полностью лежит внутри треугольника aTri2, то все
  //вершины треугольника aTri1 лежат внутри треугольника aTri2.
  if DotInTriangle(aTri2, aTri1.A) then begin
    Exit;
  end;
 
  Result := False;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
  //Величина приращения длины массива.
  Capacity       : Integer = 100;
 
var
  //Массив исходных точек.
  ArrDot         : array[1..N * N] of TDot;
  //Количество равносторонних треугольников.
  TriCount       : Integer;
  //Треугольник.
  Tri            : TTriangle;
  //Счетчики для циклов.
  i, j, k        : Integer;
  //Координаты точки.
  X, Y           : Integer;
 
begin
 
  //Подготовка исходных данных для задачи.
 
  //Квадратная сетка из точек: 20х20. Выглядит так:
 
  //     1   2   3   4   5   6   7   8   9   10  ...  19  20
  //  1  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  2  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  3  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  4  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  5  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  6  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  7  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  8  .   .   .   .   .   .   .   .   .   .        .   .
 
  //  9  .   .   .   .   .   .   .   .   .   .        .   .
 
  // 10  .   .   .   .   .   .   .   .   .   .        .   .
 
  // ...
 
  // 19  .   .   .   .   .   .   .   .   .   .   ...  .   .
 
  // 20  .   .   .   .   .   .   .   .   .   .   ...  .   .
 
  //Формируем массив этих точек.
  for X := 1 to N do begin
    for Y := 1 to N do begin
      i := Pred(X) * N + Y;
      ArrDot[i].X := X;
      ArrDot[i].Y := Y;
    end;
  end;
 
  //Подготовка исходных данных выполнена.
 
  //Решение первой части задачи. - Поиск равносторонних треугольников.
 
  //Если массив треугольников не пустой, то обнуляем его
  SetLength(ArrTri, 0);
  TriCount := 0;
 
  //Ищем равностронние треугольники и добавляем их в массив треугольников (ArrTriangle).
  //for i := Low(ArrDot) to High(ArrDot) - 1 - 1 do begin
  for i := Low(ArrDot) to High(ArrDot) div 2 do begin
    for j := High(ArrDot) - 1 downto i + 1 do begin
      for k := High(ArrDot) downto j + 1 do begin
        //Очередной треугольник.
        Tri.A := ArrDot[i];
        Tri.B := ArrDot[j];
        Tri.C := ArrDot[k];
        Tri.Base := -1;
 
        //Проверяем, является ли очередной треугольник равносторонним.
        //Одновременно вычисляем длину основания треугольника.
        if not IsEqualSideTri(Tri) then begin //Равносторонний треугльник.
        //if not IsEqualHipTri(Tri) then begin //Равнобедренный треугльник.
          Continue;
        end;
 
        //Проверяем, нет ли треугольника с таким же по длине основанием в массиве треугольников.
        if IsPresent(Addr(ArrTri), Tri) then begin
          Continue;
        end;
 
        //Подсчитываем очередной найденный равносторонний треугольник.
        Inc(TriCount);
        //Если требуется, увеличиваем длину массива треугольников.
        if Length(ArrTri) < TriCount then begin
          SetLength(ArrTri, Length(ArrTri) + Capacity);
        end;
        //Добавляем равносторонний треугольник в массив.
        ArrTri[TriCount - 1] := Tri;
      end;
    end
  end;
 
  //Корректируем длину массива треугольников в соответствии с количеством
  //добавленных в него треугольников.
  SetLength(ArrTri, TriCount);
 
  //Теперь иы имеем массив равносторонних треугольников с уникальными длинами оснований. - Первая часть задачи решена.
 
  //Чертим найденные треугольники на канве.
 
  //Будем рисовать треугольники синим цветом.
  Image1.Canvas.Pen.Color := RGB(0, 0, 255);
  //Рисуем массив треугольников на канве компонента Image1.
  DrawArrTri(Image1.Canvas, Image1.Width div N, Addr(ArrTri));
 
  //Решение второй части задачи. - Найти пересекающиеся треугольники.
 
  Memo1.Lines.Add( 'Всего треугольников: ' + IntToStr(Length(ArrTri)) );
  for i := Low(ArrTri) to High(ArrTri) - 1 do begin
    Memo1.Lines.Add(
      'Треугольник: (' + IntToStr(ArrTri[i].A.X) + ', ' + IntToStr(ArrTri[i].A.Y) + ')'
      + '; (' + IntToStr(ArrTri[i].B.X) + ', ' + IntToStr(ArrTri[i].B.Y) + ')'
      + '; (' + IntToStr(ArrTri[i].C.X) + ', ' + IntToStr(ArrTri[i].C.Y) + ')'
    );
    k := 0;
    for j := Low(ArrTri) to High(ArrTri) do begin
      if i = j then begin
        Continue;
      end;
      if CrossTriangle(ArrTri[i], ArrTri[j]) then begin
        Inc(k);
      end;
    end;
    Memo1.Lines.Add('число пересекающихся с ним треугольников: ' + IntToStr(k));
  end;
 
end;
 
procedure TForm1.BtnClearMemoClick(Sender: TObject);
begin
  Memo1.Clear;
end;
 
initialization
 
finalization
 
  Finalize(ArrTri);
 
end.

В общем, все базовые процедуры - определение пересечения линий, вхождение точки внутрь треугольника, пересечение треугольников - здесь ничего менять не надо. Нужно поменять только основной алгоритм.
Этот вариант я попозже сделаю. (Может быть сегодня).

@Piratcom · 01.11.2009, 18:22 **[ТС]**

Сообщение от Mawrat

Если мы нашли какой-то равносторонний треугольник с основанием, которое раньше ещё не встречалось. И в процессе дальнейшего поиска больше треугольников с таким основанием не нашли, то вот такой треугольник мы и должны включить в результирующий массив.

Да, я также понимаю...

Огромное спасибо, начал изучать...

Новые блоги и статьи Все статьи Все блоги /
Контроль корректности заполнения дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .	Подстановка значения реквизита справочника в табличную часть документа Maks 10.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: при выборе сотрудника (справочник Сотрудники) в ТЧ документа. . .	Очистка реквизитов документа при копировании Maks 09.04.2026 Алгоритм из решения ниже применим как для типовых, так и для нетиповых документов на самых различных конфигурациях. Задача: при копировании документа очищать определенные реквизиты и табличную. . .
модель ЗдравоСохранения 8. Подготовка к разному выполнению заданий anaschu 08.04.2026 https:/ / github. com/ shumilovas/ med2. git main ветка * содержимое блока дэлэй из старой модели теперь внутри зайца новой модели 8ATzM_2aurI	Блокировка документа от изменений, если он открыт у другого пользователя Maks 08.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа, разработанного в конфигурации КА2. Задача: запретить редактирование документа, если он открыт у другого пользователя. / / . . .	Система безопасности+живучести для сервера-слоя интернета (сети). Двойная привязка. Hrethgir 08.04.2026 Далее были размышления о системе безопасности. Сообщения с наклонным текстом - мои. А как нам будет можно проверить, что ссылка наша, а не подделана хулиганами, которая выбросит на другую ветку и. . .	Модель ЗдрввоСохранения 7: больше работников, больше ресурсов. anaschu 08.04.2026 работников и заданий может быть сколько угодно, но настроено всё так, что используется пока что только 20% kYBz3eJf3jQ

@Piratcom 21 / 21 / 3 Регистрация: 05.08.2009 Сообщений: 243

	Нахождение равносторонних треугольников 26.10.2009, 13:10. Показов 11584. Ответов 29 Метки нет (Все метки) Приветствую всех! Есть задача: Подсчитать количество равносторонних треугольников с различными длинами оснований и вершинами в заданном множестве точек на плоскости и определить пересекаются ли они. Вобщем даже не знаю с чего начать... 0

@Piratcom 21 / 21 / 3 Регистрация: 05.08.2009 Сообщений: 243
	27.10.2009, 06:55 [ТС]
	Очень интересная задача. Просмотрел код, первая часть впринципе понятна, сейчас попробую написать код, удовлетворяющий условию задачи, а именно "в заданном множестве точек". т.е. изначально размеры сетки не заданы и если я правильно понял условие задачи, то эти размеры должен задавать сам пользователь... 0

@Mawrat 13116 / 5897 / 1708 Регистрация: 19.09.2009 Сообщений: 8,809
	28.10.2009, 00:27
	Оdip, тут видимо не совсем так. Вот представь - имеем "высокий" треугольник с горизонтальным основанием. И имеем "вытянутый" треугольник с вертикальным основанием. - Вполне может быть, что стороны одного из них пересекают стороны другого. Но ни одна из их вершин не лежит внутри другого. Хотя... весь вопрос в том, какое дать определение пресечению треугольников. Если пересечение - это обязательно нахождение одной из вершин одного треугольника внутри другого - это одно. А если пересечением считать факт персечения сторон - это другое. Надо у Piratcom уточнить - что в его задании под пересечением понимается? 1

@Mawrat 13116 / 5897 / 1708 Регистрация: 19.09.2009 Сообщений: 8,809
	29.10.2009, 08:27
	Сегодня вечером попытаюсь написать процедуру для определения пересекаются ли 2 отрезка или нет. Я тут, вроде, придумал метод такого вычисления. По ходу реализации сравню его с классическим. Классический - это через определение уравнения прямых и вычисления координат точки их пересечения. Затем, сравнение - покрываются ли координаты (проекции на координатные оси) найденной точки на проекции прямых. Мой способ вполне вероятно сможет по скорости выигрывать. - Там сразу определяется накладываются ли проекции прямых по обеим осям - если да, то пересечение возмжно, нет - пересечения нет. Далее - нужно последовательно вычислять пары углов. Здесь максимально 4 шага - 2, 4, 6 или 8 значений уголов надо вычислить. Как только встретится пара уголов, которые в сумме дают больше 180 градусов - значит пересечения нет. Если такой пары не нашлось - пересечение есть. Я на картинке потом это всё поясню. --- Про Epsilon в первой части задачи. Epsilon обозначает часть расстояния между ближайшими соседними точками (расстояние по оси Х или по оси У). Пэтому для Epsilon максимальное значение должно быть 0.5. Потому что при Epxilon > 0.5 в охватываемую зону вокруг заданной точки могут начать попадать искомые вещественные вершнины из окрестностей соседних точек. Т. е. поиск начнёт выдавать неверные результаты. Минимальное Epsilon может быть разным - чем больше исходных точек, тем меньше можно выставлять Epsilon. 1

@Piratcom 21 / 21 / 3 Регистрация: 05.08.2009 Сообщений: 243
	31.10.2009, 05:10 [ТС]
	Наткнуля в интернете, на такую вот статейку Как определить пересекаются ли два прямых отрезка на плоскости ? Есть задача: требуется определить пересекаются ли два прямых отрезка на плоскости(есть PointStart и PointEnd для обоих отрезков).Пробовал математически решить,но привидение пикселей к int все проваливает. Кто поможет? Если надо условие пересечения отрезков, то как вариант: - Прямая Ax+By+C=0 по двум точкам P1(x1,y1), P2(x2,y2): A = y2-y2 B = x1-x2 C = -Ax1-By1 = y1x2 - x1y2 - Расстояние от точки S(x0,y0) до прямой: r = Ax0 + By0 + C /sqrt(AA + BB) обозначим как Q(P1(x1,y1),P2(x2,y2),S(x0,y0)) = rsqrt(AA+BB) = x0(y2-y1)+y0(x1-x2) + y1x2 - x1y2 - Тогда условие пересечения двуч отрезков(a,b) и (A,B): Q(a,b;A)Q(a,b;B)<0 && Q(A,B;a)Q(A,B;b)<0 пример ф-и на паскале: function Q(ax,ay,bx,by,tx,ty:longint):real; begin Q:=tx(by-ay)+ty(ax-bx)+aybx-axby; end; Сейчас думаю как приминить это... Добавлено через 2 минуты* Эта задача подтверждение то, что целочисленными координатами тут не обойдёшся... 0

@Mawrat 13116 / 5897 / 1708 Регистрация: 19.09.2009 Сообщений: 8,809
	31.10.2009, 16:31
	Piratcom, в четверг и пятницу не ответил я - у меня времени не было. В общем, я написал все нужные процедуры: 1. Проверка пересечения линий. 2. Проверка вхождения точки внутрь треугольника. 3. Проверка пересечения треугольников - проверяет пресекаются ли стороны треугольника и еще проверяет на вхождение вершин одного треугольника внутрь другого - это на случай, когда один треугольник полностью лежит внутри другого. Сегодня вчером выложу. Piratcom, ещё надо такой момент уточнить - в условии задачи: "найти персекающиеся треугольники". Т. е. какой здесь отчёт должен быть? Например так можно: Треугольник 1 (координаты) пересекается с: ... Треугольник 2 (координаты) пересекается с: ... ... Так? 1

@Piratcom 21 / 21 / 3 Регистрация: 05.08.2009 Сообщений: 243
	01.11.2009, 05:17 [ТС]
	http://window.edu.ru/window_ca... ktikum.pdf Страница №66, задача №39, случайно нашёл задачник... =))) Но в нём тоже ничего не уточняется... 0