projectkx
1

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

09.04.2008, 18:20. Показов 2255. Ответов 5
Метки нет (Все метки)

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

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



надеюсь мне кто нибудь поможет
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
09.04.2008, 18:20
Ответы с готовыми решениями:

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

Даны 4 точки. Определить какие треугольники, образованные этими точками, обладают максимальными и минимальными S и P
знает кто как сделать?

найти множество точек и начертить
найти множество точек на плоскости комплексного переменного и начертить. |z+1+i|<=|z-2-i| Я...

Начертить треугольники по координатам, чтобы они не пересекались
Помогите начертить треугольники по координатам, чтоб они не пересекались???

5
Флудер
195 / 33 / 11
Регистрация: 23.03.2007
Сообщений: 334
09.04.2008, 19:18 2
касательно алгоритма:
Точки пронумеровать 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)!)
затем в этом массиве найти минимальный и максимальный
Вложения
Тип файла: zip combinations.delphi.zip (10.2 Кб, 40 просмотров)
0
1230 / 66 / 16
Регистрация: 23.04.2007
Сообщений: 127
09.04.2008, 21:22 3
Вот тебе кусок кода набросал. Дальше сам.

На форме: 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 раз.

Треугольник с мин. площадью выделяется светло-зеленым цветом, с макс. площадью – красным.
0
Флудер
195 / 33 / 11
Регистрация: 23.03.2007
Сообщений: 334
09.04.2008, 22:24 4
Delphiist, неучитывается то что невсякие 3 точки - треугольник. Т.е. треугольник это 3 точки не лежащие на одной прямой
0
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, спасибовам огромное! Я и не думал что мне прям так все в подробностях выложат Я теперь просто счастлив
10.04.2008, 13:54
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
10.04.2008, 13:54
Помогаю со студенческими работами здесь

Найти максимально возможное значение произведений любых трех различных по номерам элементов массива
Доброго времени суток! Помогите пожалуйста, решить эту задачу. Имеется не более 1 000 000 целых...

Найти все разносторонние треугольники
не могу выполнить, помогите Уточнение задания: определены структуры «точка» (координата_Х,...

Найти все прямоугольные треугольники
Есть программа на Visual Prolog, помогите пожалуйста перевести на Turbo Prolog. Код программы:...

Найти все разносторонние треугольники
Доброго вечера, товарищи. Такое дело. Имеется БД с координатами треугольников. Я научилась выводить...

Найти все равновеликие прямоугольные треугольники
Найти все равновеликие прямоугольные треугольники, катеты которых выражены целыми числами a и b, а...

Как в массиве вывести все символы после трёх точек?
Ребят, как в массиве вывести все символы после трёх точек?


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

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

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