IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Минимальное множество прямых (рекурсия с возвратом)
Даша
сообщение 17.04.2011 17:13
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 20
Пол: Женский

Репутация: -  1  +


Всем доброго времени суток! Прошу помочь со следующей задачей: найти минимальное множество прямых, проходящих через все заданные точки. То есть заданы координаты точек и ответом должно быть число прямых. Не знаю как организовать перебор всех вариантов, очень прошу написать хотя бы в общем виде сам алгоритм.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Lapp
сообщение 19.04.2011 11:41
Сообщение #2


Уникум
*******

Группа: Модераторы
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Даша, я так понимаю, что у тебя особого прогресса нет - да?
Я вот набросал прожку. Посмотри ее..
Если честно, она мне не нравится. Что-то я к вечеру не смог ничего лучше придумать.. Рекурсия там в результате оказалась притянута за уши. Но все же она есть, и прога, вроде, считает. Я проверил на простых конфинурациях до 6 точек )). Проверь получше, если найдешь ошибки - говори.

const
m= 100;
e= 1e-7;

type
tPoint= record
x,y: double;
end;

var
p: array [1..m] of tPoint;
Lines,n: integer;
f: text;

function Eq(a,b: tPoint): boolean;
begin
Eq:= (a.x=b.x) and (a.y=b.y)
end;

function Aligned(a,b,c: tPoint): boolean;
var
d: tPoint;
begin
if a.x=b.x then begin
d:= a;
a:= c;
c:= d
end
else if a.x=c.x then begin
d:= a;
a:= b;
b:= d
end;
Aligned:=
Eq(a,b) or
Eq(b,c) or
Eq(c,a) or
(a.x=b.x) and (a.x=c.x) or
(Abs((b.y-a.y)/(b.x-a.x)-(c.y-a.y)/(c.x-a.x))<e)
end;

procedure Count(k: integer);
var
i,j: integer;
begin
for i:=k+1 to n do begin
j:= 1;
while (j<i) and not Aligned(p[k],p[i],p[j]) or (j=k) do Inc(j);
if j=i then begin
WriteLn(p[k].x:5:0,p[k].y:5:0,' ',p[i].x:5:0,p[i].y:5:0);
Inc(Lines)
end
end;
if k<n then Count(k+1)
end;

begin
Assign(f,'dasha.dat');
Reset(f);
n:= 0;
while not EoF(f) do begin
Inc(n);
ReadLn(f,p[n].x,p[n].y)
end;
Close(f);
Lines:= 0;
Count(1);
WriteLn(Lines);
ReadLn
end.

Входные данные задаются в текстовом файле dasha.dat, по одной точке на строку. Координаты можно задавать действительными числами, но я пока только целые давал. Вот пример:
0 0
4 0
0 4
4 4
2 2
3 3

Заметь, что в конце НЕ ДОЛЖНО быть пустых строк (то есть курсор стрелками дальше последней строки не должен заходить). На этом примере ответ 8.

Пиши, что непонятно, я попробую объяснить smile.gif.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Даша   Минимальное множество прямых (рекурсия с возвратом)   17.04.2011 17:13
Lapp   Всем доброго времени суток! Прошу помочь со сл...   17.04.2011 21:36
Даша   Вот это как раз непонятно. Как организовать пере...   17.04.2011 22:10
Lapp   Вот это как раз непонятно. Как организовать перебо...   18.04.2011 6:08
Lapp   Даша, я так понимаю, что у тебя особого прогресса ...   19.04.2011 11:41
Даша   Прощу прощения за то что долго не отвечала, не был...   19.04.2011 21:20
Lapp   Прощу прощения за то что долго не отвечала, не был...   20.04.2011 6:03
Lapp   Вот. Выстругал буратинку )). Но снова она мне не ...   20.04.2011 8:40
Даша   Еще раз выражаю огромную благодарность :) По коду...   20.04.2011 16:28
-TarasBer-   А разве для быстрого переноса Паскальных программ ...   20.04.2011 19:19
Lapp   По коду в принципе всё понятно,Даша, не обижайся, ...   21.04.2011 1:47
-TarasBer-   > А зачем? Чтоб растянуть удовольствие? Для бы...   21.04.2011 13:35
Даша   Что же, попробую ответить на ваши вопросы: 1. Что...   21.04.2011 17:13
Lapp   Для быстрого переноса Паскальных программ, и чтобы...   22.04.2011 7:35


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 19.07.2025 21:10
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"