Модераторы: Poseidon
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> [Pascal]Геометрия 
V
    Опции темы
dimentiys
Дата 17.3.2008, 17:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 13.3.2008

Репутация: нет
Всего: нет
С помощью графики отобразить на экране дисплея ход решения следующей задачи: из заданного на плоскости множества точек выбрать такие три точки, не лежащие на одной прямой, которые составляют треугольник наименьшей площади. 
PM MAIL   Вверх
ama_kid
Дата 19.3.2008, 13:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


АСУТП-кодер
***


Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95
Лови такой вариант:  smile 
Код
Program Triangles;
uses crt, graph;
const MaxPoints = 100;
const delta = 0.01;
type
 TPoint = PointType;
 TPointArray = array [1..MaxPoints] of TPoint;
 TMinimumInfo = record
  P1          : TPoint;
  P2          : TPoint;
  P3          : TPoint;
  Square      : double;
 end;
var
 gd,gm    :integer;
 NumPts   :integer;
 i        :integer;
 j,k      :integer;
 sleep    :longint;
 Points   :TPointArray;
 Min      :TMinimumInfo;

procedure CheckTriangleInfo(P1,P2,P3:TPoint;var MinimumInfo:TMinimumInfo);
var
 S:double;
 p:double;
 a,b,c:double;
begin
 a:=sqrt(sqr(1.0*(P2.X-P1.X))+sqr(1.0*(P2.Y-P1.Y)));
 b:=sqrt(sqr(1.0*(P3.X-P2.X))+sqr(1.0*(P3.Y-P2.Y)));
 c:=sqrt(sqr(1.0*(P1.X-P3.X))+sqr(1.0*(P1.Y-P3.Y)));
 p:=(a+b+c)/2;
 S:=sqrt(p*(p-a)*(p-b)*(p-c));
 if (S<MinimumInfo.Square)or(MinimumInfo.Square<0) then
  begin
   MinimumInfo.P1:=P1;
   MinimumInfo.P2:=P2;
   MinimumInfo.P3:=P3;
   MinimumInfo.Square:=S;
  end;
end;

function TriangleIsCorrect(P1,P2,P3:TPoint):boolean;
var
 a,b,c:double;
begin
 TriangleIsCorrect:=true;
 a:=sqrt(sqr(1.0*(P2.X-P1.X))+sqr(1.0*(P2.Y-P1.Y)));
 b:=sqrt(sqr(1.0*(P3.X-P2.X))+sqr(1.0*(P3.Y-P2.Y)));
 c:=sqrt(sqr(1.0*(P1.X-P3.X))+sqr(1.0*(P1.Y-P3.Y)));
 if (abs(a - (b+c))<delta)or
    (abs(b - (a+c))<delta)or
    (abs(c - (a+b))<delta) then TriangleIsCorrect:=false;
end;

Procedure DrawAllPoints;
var
 Cur:integer;
begin
 SetColor(white);
 for Cur:=1 to NumPts do
  begin
   Circle(Points[Cur].X,Points[Cur].Y,2);
   FloodFill(Points[Cur].X,Points[Cur].Y,white);
  end;
end;

procedure DrawTriangle(P1,P2,P3:TPoint;Filled:boolean);
var
 Pts:array [1..4] of TPoint;
begin
 Pts[1]:=P1;
 Pts[2]:=P2;
 Pts[3]:=P3;
 Pts[4]:=P1;
 SetColor(Random(10)+3);
 if not Filled then DrawPoly(4,Pts) else FillPoly(4,Pts);
end;

begin
 NumPts:=0;
 Min.Square:=-1.0;

 while (NumPts<=2)or(NumPts>MaxPoints) do
  begin
   clrscr;
   Write('Введите количество точек: ');
   Readln(NumPts);
  end;
 for i:=1 to NumPts do
  begin
   Write('Точка ',i,'. Координата Х (0..640):');
   Readln(Points[i].X);
   if (Points[i].X<10) then Points[i].X:=10;
   if (Points[i].X>630) then Points[i].X:=630;
   Write('Точка ',i,'. Координата Y (0..480):');
   Readln(Points[i].Y);
   if (Points[i].Y<10) then Points[i].Y:=10;
   if (Points[i].Y>470) then Points[i].Y:=470;
  end;
 InitGraph(gd,gm,'');
 ClearDevice;
 If GraphResult <> grOk Then
  begin
   Writeln('Не удалось инициализировать графический режим...');
   Writeln('Завершение работы');
   Halt(1);
  end;
 for i:=1 to NumPts-2 do
  for j:=i+1 to NumPts-1 do
   for k:=j+1 to NumPts do
    begin
     if not TriangleIsCorrect(Points[i],Points[j],Points[k]) then continue;
     ClearDevice;
     DrawAllPoints;
     CheckTriangleInfo(Points[i],Points[j],Points[k],Min);
     DrawTriangle(Points[i],Points[j],Points[k],false);
     for sleep:=1 to 100000000 do ;
    end;
 ClearDevice;
 DrawAllPoints;
 DrawTriangle(Min.P1,Min.P2,Min.P3,true);
 while keypressed do readkey;
 readkey;
 CloseGraph;
end.


Это сообщение отредактировал(а) ama_kid - 19.3.2008, 17:37


--------------------
самурай без меча подобен самураю с мечом, но только без меча 
PM MAIL   Вверх
ama_kid
Дата 19.3.2008, 17:37 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


АСУТП-кодер
***


Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95
подредактировал немного...


--------------------
самурай без меча подобен самураю с мечом, но только без меча 
PM MAIL   Вверх
dimentiys
Дата 19.3.2008, 19:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 13.3.2008

Репутация: нет
Всего: нет
[подредактировал немного... 



--------------------]
Скажи пожалуйста что это обозначает.
PM MAIL   Вверх
THandle
Дата 19.3.2008, 19:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Хранитель Клуба
Group Icon
Награды: 1



Профиль
Группа: Админ
Сообщений: 3639
Регистрация: 31.7.2007
Где: Moscow, Dubai

Репутация: 30
Всего: 372
dimentiys, это означает то что тот пост был написан в 13:26, а подредактирован в 17:37. То есть изначально там был другой код видимо smile 
PM   Вверх
ama_kid
Дата 19.3.2008, 19:33 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


АСУТП-кодер
***


Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95
Цитата(THandle @  19.3.2008,  19:28 Найти цитируемый пост)
То есть изначально там был другой код видимо
точно, я там просто внешний лоск небольшой навел, когда вернулся с местной командировки  smile 


--------------------
самурай без меча подобен самураю с мечом, но только без меча 
PM MAIL   Вверх
dimentiys
Дата 19.3.2008, 20:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 13.3.2008

Репутация: нет
Всего: нет
А у кого нибудь будет модуль graph?
PM MAIL   Вверх
ama_kid
Дата 19.3.2008, 21:35 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


АСУТП-кодер
***


Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95
Цитата(dimentiys @  19.3.2008,  20:56 Найти цитируемый пост)
А у кого нибудь будет модуль graph? 
Вобще-то, он лежит в папке Units стандартной поставки Turbo\Borland Pascal, но если у тебя нет(хотя маловероятно), то в аттаче прикрепляю (а также драйвер видеорежима, который должен лежать в папке с программой)... 
P.S. Проверь, что все пути в настройках указаны правильно...


Присоединённый файл ( Кол-во скачиваний: 3 )
Присоединённый файл  graph.rar 19,48 Kb


--------------------
самурай без меча подобен самураю с мечом, но только без меча 
PM MAIL   Вверх
dimentiys
Дата 19.3.2008, 22:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 13.3.2008

Репутация: нет
Всего: нет
Спасибо!
PM MAIL   Вверх
dimentiys
Дата 19.3.2008, 23:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 13.3.2008

Репутация: нет
Всего: нет
Я посмотрел твою прогу, в результате получается все точки на одной линии но на разном расстоянии, вне зависимости какие я координаты Y задавал.И еще может как нибудь можно в результате получившийся треугольник наименьшей площади из множества точек как нибудь выделить(соединить линиями). 

Это сообщение отредактировал(а) dimentiys - 19.3.2008, 23:22
PM MAIL   Вверх
ama_kid
Дата 20.3.2008, 00:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


АСУТП-кодер
***


Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95
dimentiys, что-то ты не то говоришь, у меня всё нормально работает... Покажи какие данные задавал, я проверю...


--------------------
самурай без меча подобен самураю с мечом, но только без меча 
PM MAIL   Вверх
dimentiys
Дата 20.3.2008, 17:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 17
Регистрация: 13.3.2008

Репутация: нет
Всего: нет
Например:(23-43),(132;234),(12;47),(78;367),(68;98)
PM MAIL   Вверх
ama_kid
Дата 20.3.2008, 18:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


АСУТП-кодер
***


Профиль
Группа: Комодератор
Сообщений: 1460
Регистрация: 5.3.2007
Где: Москва

Репутация: 16
Всего: 95
Цитата(dimentiys @  19.3.2008,  23:20 Найти цитируемый пост)
в результате получается все точки на одной линии но на разном расстоянии, вне зависимости какие я координаты Y задавал.
Не знаю, я ввел твои данные, все треугольники перебираемые - хорошо заметны (проверял программу как на винде, так и в чистом DOS на VM), я не заметил, чтобы точки лежали на одной линии... В общем, у меня все нормально отрабатывает...  smile 
Цитата(dimentiys @  19.3.2008,  23:20 Найти цитируемый пост)
может как нибудь можно в результате получившийся треугольник наименьшей площади из множества точек как нибудь выделить(соединить линиями).
Получившийся треугольник не только выделяется линиями в конце, но и закрашивается сплошным цветом вообще-то...



--------------------
самурай без меча подобен самураю с мечом, но только без меча 
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Центр помощи"

ВНИМАНИЕ! Прежде чем создавать темы, или писать сообщения в данный раздел, ознакомьтесь, пожалуйста, с Правилами форума и конкретно этого раздела.
Несоблюдение правил может повлечь за собой самые строгие меры от закрытия/удаления темы до бана пользователя!


  • Название темы должно отражать её суть! (Не следует добавлять туда слова "помогите", "срочно" и т.п.)
  • При создании темы, первым делом в квадратных скобках укажите область, из которой исходит вопрос (язык, дисциплина, диплом). Пример: [C++].
  • В названии темы не нужно указывать происхождение задачи (например "школьная задача", "задача из учебника" и т.п.), не нужно указывать ее сложность ("простая задача", "легкий вопрос" и т.п.). Все это можно писать в тексте самой задачи.
  • Если Вы ошиблись при вводе названия темы, отправьте письмо любому из модераторов раздела (через личные сообщения или report).
  • Для подсветки кода пользуйтесь тегами [code][/code] (выделяйте код и нажимаете на кнопку "Код"). Не забывайте выбирать при этом соответствующий язык.
  • Помните: один топик - один вопрос!
  • В данном разделе запрещено поднимать темы, т.е. при отсутствии ответов на Ваш вопрос добавлять новые ответы к теме, тем самым поднимая тему на верх списка.
  • Если вы хотите, чтобы вашу проблему решили при помощи определенного алгоритма, то не забудьте описать его!
  • Если вопрос решён, то воспользуйтесь ссылкой "Пометить как решённый", которая находится под кнопками создания темы или специальным флажком при ответе.

Более подробно с правилами данного раздела Вы можете ознакомится в этой теме.

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Poseidon, Rodman
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Центр помощи | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0996 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.