Найти и начертить все треугольники, образованные сочетанием любых трех точек из К

09.04.2008, 18:20. **Показов** 2309. **Ответов** 5

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

Люди,если не сложно, помогите пожалуйста написать прогу, мне ее через 2 дня сдавать надо,а я полный ноль в делфи.

Заданное количество К(3..20) точек генерируется случайным образом на координатной плоскости 30 х 28 . Найти и начертить все треугольники, образованные сочетанием любых трех точек из К. Выдать по порядку информацию о всех треугольниках с указанием координат их вершин и площадей.
Найти треугольники с минимальной и максимальной площадью, выделить их графически и выдать их номера, координаты их вершин и площади

надеюсь мне кто нибудь поможет

@Ensase · 09.04.2008, 19:18

касательно алгоритма:
Точки пронумеровать 1..n.
Получить следующее сочетание из n по 3.
Проверить является ли комбинация данных точек треугольником:
sqrt(sqr(a[i].x-a[j]).x)+sqr(a[i].y-a[j]).y)) + sqrt(sqr(a[j].x-a[k]).x)+sqr(a[j].y-a[k]).y)) > sqrt(sqr(a[i].x-a[k]).x)+sqr(a[i].y-a[k]).y))
- неравенство треугольника. Если это неравенство выполняется - вычислить площадь треугольника по формуле Герона:
a:=sqrt(sqr(a[i].x-a[j]).x)+sqr(a[i].y-a[j]).y));
b:=sqrt(sqr(a[j].x-a[k]).x)+sqr(a[j].y-a[k]).y));
c:=sqrt(sqr(a[i].x-a[k]).x)+sqr(a[i].y-a[k]).y));
p:=(a+b+c)/2;
s:=sqrt(p*(p-a)*(p-b)*(p-b));
Где i, j, k получены алгоритмом сочетаний.
Площадь занести в динамический массив с длиной = n! / (3! * (n-3)!)
затем в этом массиве найти минимальный и максимальный

@Delphiist · 09.04.2008, 21:22

Вот тебе кусок кода набросал. Дальше сам.

На форме: Image1, Image2, Button1, ListBox1.

Код

procedure TForm1.FormCreate(Sender: TObject);
begin
   Randomize;
   Image1.Left := 32;
   Image1.Top := 24;
   Image1.Width := 30;
   Image1.Height := 28;
   Image2.Left := 88;
   Image2.Top := 24;
   Image2.Width := 150;
   Image2.Height := 140;
   ListBox1.Left := 320;
   ListBox1.Top := 40;
   ListBox1.Width := 329;
   ListBox1.Height := 353;
   Button1.Left := 200;
   Button1.Top := 192;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   i,j,n,k,t: Integer;
   a,b,c,p: Single;
   MinS, MaxS, MinIndex, MaxIndex, S: Integer;
   MinTrPoints, MaxTrPoints: array[0..2] of TPoint;
   ps: array of TPoint;
begin
   ListBox1.Items.Clear;
   k := Random(18) + 3; // 3..20
   SetLength(ps, k);
   ListBox1.Items.Add('k = ' + IntToStr(k));
   ListBox1.Items.Add('');
   for i := 0 to k - 1 do begin
      ps[i].x := Random(30);
      ps[i].y := Random(28);
      ListBox1.Items.Add('(' + IntToStr(ps[i].x) + ';' + IntToStr(ps[i].y) + ')');
   end;
   ListBox1.Items.Add('______');
   ListBox1.Items.Add('');
   t := 0;
   MinS := MAXINT;
   MaxS := 0;
   MinIndex := 0;
   MaxIndex := 0;
   Image1.Canvas.Pen.Color := clWhite;
   Image1.Canvas.Brush.Color := clWhite;
   Image1.Canvas.FillRect(Image1.ClientRect);
   Image1.Canvas.Pen.Color := clBlack;
   //-----------------------
   Image2.Canvas.Pen.Color := clWhite;
   Image2.Canvas.Brush.Color := clWhite;
   Image2.Canvas.FillRect(Image2.ClientRect);
   Image2.Canvas.Pen.Color := clBlack;
   //-----------------------
   for i := 0 to k - 1 do
      for j := i to k - 1 do
         for n := j to k - 1 do begin
            if (i <> j) and (j <> n) and (i <> n) then begin
               Inc(t);
               a := sqrt(sqr(ps[i].x - ps[j].x) + sqr(ps[i].y - ps[j].y));
               b := sqrt(sqr(ps[j].x - ps[n].x) + sqr(ps[j].y - ps[n].y));
               c := sqrt(sqr(ps[n].x - ps[i].x) + sqr(ps[n].y - ps[i].y));
               p := a + b + c;
               S := Round(sqrt(p * (p - a) * (p - b) * (p - c)));
               if S < MinS then begin
                  MinS := S;
                  MinIndex := t;
                  MinTrPoints[0].X := ps[i].x;
                  MinTrPoints[0].Y := ps[i].y;
                  MinTrPoints[1].X := ps[j].x;
                  MinTrPoints[1].Y := ps[j].y;
                  MinTrPoints[2].X := ps[n].x;
                  MinTrPoints[2].Y := ps[n].y;
               end;
               if S > MaxS then begin
                  MaxS := S;
                  MaxIndex := t;
                  MaxTrPoints[0].X := ps[i].x;
                  MaxTrPoints[0].Y := ps[i].y;
                  MaxTrPoints[1].X := ps[j].x;
                  MaxTrPoints[1].Y := ps[j].y;
                  MaxTrPoints[2].X := ps[n].x;
                  MaxTrPoints[2].Y := ps[n].y;
               end;
               ListBox1.Items.Add('[Triangle ' + IntToStr(t) + '] ' +
                                  'P1:' + '(' + IntToStr(ps[i].x) + ';' + IntToStr(ps[i].y) + ')' +
                                  ', P2:' + '(' + IntToStr(ps[j].x) + ';' + IntToStr(ps[j].y) + ')' +
                                  ', P3:' + '(' + IntToStr(ps[n].x) + ';' + IntToStr(ps[n].y) + ')' +
                                  ', S = ' + IntToStr(S));
               Image1.Canvas.MoveTo(ps[i].x, ps[i].y);
               Image1.Canvas.LineTo(ps[j].x, ps[j].y);
               Image1.Canvas.MoveTo(ps[j].x, ps[j].y);
               Image1.Canvas.LineTo(ps[n].x, ps[n].y);
               Image1.Canvas.MoveTo(ps[n].x, ps[n].y);
               Image1.Canvas.LineTo(ps[i].x, ps[i].y);
               //-----------------------
               Image2.Canvas.MoveTo(ps[i].x * 5, ps[i].y * 5);
               Image2.Canvas.LineTo(ps[j].x * 5, ps[j].y * 5);
               Image2.Canvas.MoveTo(ps[j].x * 5, ps[j].y * 5);
               Image2.Canvas.LineTo(ps[n].x * 5, ps[n].y * 5);
               Image2.Canvas.MoveTo(ps[n].x * 5, ps[n].y * 5);
               Image2.Canvas.LineTo(ps[i].x * 5, ps[i].y * 5);
               //-----------------------
            end;
         end;
   ListBox1.Items.Add('');      
   ListBox1.Items.Add('Triangles Count = ' + IntToStr(t));
   ListBox1.Items.Add('______');
   ListBox1.Items.Add('');
   ListBox1.Items.Add('[Min Triangle #' + IntToStr(MinIndex) + '] ' +
                      'P1:' + '(' + IntToStr(MinTrPoints[0].x) + ';' + IntToStr(MinTrPoints[0].y) + ')' +
                      ', P2:' + '(' + IntToStr(MinTrPoints[1].x) + ';' + IntToStr(MinTrPoints[1].y) + ')' +
                      ', P3:' + '(' + IntToStr(MinTrPoints[2].x) + ';' + IntToStr(MinTrPoints[2].y) + ')' +
                      ', S = ' + IntToStr(MinS));
   ListBox1.Items.Add('[Max Triangle #' + IntToStr(MaxIndex) + '] ' +
                      'P1:' + '(' + IntToStr(MaxTrPoints[0].x) + ';' + IntToStr(MaxTrPoints[0].y) + ')' +
                      ', P2:' + '(' + IntToStr(MaxTrPoints[1].x) + ';' + IntToStr(MaxTrPoints[1].y) + ')' +
                      ', P3:' + '(' + IntToStr(MaxTrPoints[2].x) + ';' + IntToStr(MaxTrPoints[2].y) + ')' +
                      ', S = ' + IntToStr(MaxS));

   // Triangle Min S
   Image1.Canvas.Pen.Color := clLime;
   Image2.Canvas.Pen.Color := clLime;
   Image1.Canvas.MoveTo(MinTrPoints[0].x, MinTrPoints[0].y);
   Image1.Canvas.LineTo(MinTrPoints[1].x, MinTrPoints[1].y);
   Image1.Canvas.MoveTo(MinTrPoints[1].x, MinTrPoints[1].y);
   Image1.Canvas.LineTo(MinTrPoints[2].x, MinTrPoints[2].y);
   Image1.Canvas.MoveTo(MinTrPoints[2].x, MinTrPoints[2].y);
   Image1.Canvas.LineTo(MinTrPoints[0].x, MinTrPoints[0].y);
   //-----------------------
   Image2.Canvas.MoveTo(MinTrPoints[0].x * 5, MinTrPoints[0].y * 5);
   Image2.Canvas.LineTo(MinTrPoints[1].x * 5, MinTrPoints[1].y * 5);
   Image2.Canvas.MoveTo(MinTrPoints[1].x * 5, MinTrPoints[1].y * 5);
   Image2.Canvas.LineTo(MinTrPoints[2].x * 5, MinTrPoints[2].y * 5);
   Image2.Canvas.MoveTo(MinTrPoints[2].x * 5, MinTrPoints[2].y * 5);
   Image2.Canvas.LineTo(MinTrPoints[0].x * 5, MinTrPoints[0].y * 5);
   //-----------------------

   // Triangle Max S
   Image1.Canvas.Pen.Color := clRed;
   Image2.Canvas.Pen.Color := clRed;
   Image1.Canvas.MoveTo(MaxTrPoints[0].x, MaxTrPoints[0].y);
   Image1.Canvas.LineTo(MaxTrPoints[1].x, MaxTrPoints[1].y);
   Image1.Canvas.MoveTo(MaxTrPoints[1].x, MaxTrPoints[1].y);
   Image1.Canvas.LineTo(MaxTrPoints[2].x, MaxTrPoints[2].y);
   Image1.Canvas.MoveTo(MaxTrPoints[2].x, MaxTrPoints[2].y);
   Image1.Canvas.LineTo(MaxTrPoints[0].x, MaxTrPoints[0].y);
   //-----------------------
   Image2.Canvas.MoveTo(MaxTrPoints[0].x * 5, MaxTrPoints[0].y * 5);
   Image2.Canvas.LineTo(MaxTrPoints[1].x * 5, MaxTrPoints[1].y * 5);
   Image2.Canvas.MoveTo(MaxTrPoints[1].x * 5, MaxTrPoints[1].y * 5);
   Image2.Canvas.LineTo(MaxTrPoints[2].x * 5, MaxTrPoints[2].y * 5);
   Image2.Canvas.MoveTo(MaxTrPoints[2].x * 5, MaxTrPoints[2].y * 5);
   Image2.Canvas.LineTo(MaxTrPoints[0].x * 5, MaxTrPoints[0].y * 5);
   //-----------------------
end;

30 x 28 - пикселей что-ли, не маловато

)
Код делает все, что ты хотел. На Image1 рисуются все треугольники на плоскости 30 x 28. На Image2 рисуется все тоже самое, что и на Image1 но увеличено в 5 раз.

Треугольник с мин. площадью выделяется светло-зеленым цветом, с макс. площадью – красным.

@Ensase · 09.04.2008, 22:24

Delphiist, неучитывается то что невсякие 3 точки - треугольник. Т.е. треугольник это 3 точки не лежащие на одной прямой

@Delphiist · 10.04.2008, 09:22

Да, действительно, не учел.

Добавляем еще переменных (коэффициенты из уравнения прямой):

Код

var
   ka,kb,kc: Integer;

Вставляем новый код в предыдущий (синим выделен новый кусок кода)

Код

...
Inc(t);
[COLOR="Blue"]ka := ps[j].y - ps[i].y;
kb := ps[i].x - ps[j].x;
kc := -ps[i].x * (ps[j].y - ps[i].y) + ps[i].y * (ps[j].x - ps[i].x);
if (ka * ps[n].x + kb * ps[n].y + kc) = 0 then begin
   // Не берем этот треугольник - линию :-)
   Continue;
end;[/COLOR]
a := sqrt(sqr(ps[i].x - ps[j].x) + sqr(ps[i].y - ps[j].y));
...

10.04.2008, 13:54

Ensase,Delphiist, спасибовам огромное!

Я и не думал что мне прям так все в подробностях выложат

Я теперь просто счастлив

projectkx
		1
	Найти и начертить все треугольники, образованные сочетанием любых трех точек из К 09.04.2008, 18:20. Показов 2309. Ответов 5 Метки нет (Все метки) Люди,если не сложно, помогите пожалуйста написать прогу, мне ее через 2 дня сдавать надо,а я полный ноль в делфи. Заданное количество К(3..20) точек генерируется случайным образом на координатной плоскости 30 х 28 . Найти и начертить все треугольники, образованные сочетанием любых трех точек из К. Выдать по порядку информацию о всех треугольниках с указанием координат их вершин и площадей. Найти треугольники с минимальной и максимальной площадью, выделить их графически и выдать их номера, координаты их вершин и площади надеюсь мне кто нибудь поможет

@Ensase Флудер 195 / 33 / 11 Регистрация: 23.03.2007 Сообщений: 334
	09.04.2008, 22:24	4
	Delphiist, неучитывается то что невсякие 3 точки - треугольник. Т.е. треугольник это 3 точки не лежащие на одной прямой 0

@Delphiist 1230 / 66 / 16 Регистрация: 23.04.2007 Сообщений: 127
	10.04.2008, 09:22	5
	Да, действительно, не учел. Добавляем еще переменных (коэффициенты из уравнения прямой): Код var ka,kb,kc: Integer; Вставляем новый код в предыдущий (синим выделен новый кусок кода) Код ... Inc(t); [COLOR="Blue"]ka := ps[j].y - ps[i].y; kb := ps[i].x - ps[j].x; kc := -ps[i].x * (ps[j].y - ps[i].y) + ps[i].y * (ps[j].x - ps[i].x); if (ka * ps[n].x + kb * ps[n].y + kc) = 0 then begin // Не берем этот треугольник - линию :-) Continue; end;[/COLOR] a := sqrt(sqr(ps[i].x - ps[j].x) + sqr(ps[i].y - ps[j].y)); ... 0

projectkx
	10.04.2008, 13:54	6
	Ensase,Delphiist, спасибовам огромное! Я и не думал что мне прям так все в подробностях выложат Я теперь просто счастлив