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

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

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

2 страниц V < 1 2  
 Ответить  Открыть новую тему 
> Удав, Задача на координаты и направление
сообщение
Сообщение #21


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

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

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


Коллеги, я не вполне все же вас понял..
Michael_Rybak, если одно звено полностью включает другое (этот случай ты называешь "касанием"?) то это значит, что подходящие к внутреннему (полностью включенному другим) дадут то, что я называю пересечением (наличие общих точек, включая концы). Поскольку в задаче спрашивается, самопересекается удав или нет - то этого будет достаточно, чтобы ответить "ДА". Вывод программой конкретных пересечений - это моя блажь, отладочная инфа.

Другое дело, что у меня в релизации была откровенная ошибка, в результате чего находились несуществующие пересечения - признаю и извиняюсь.. Я просто недописал формулы для пересечения. Сейчас исправлено, код ниже.. Как водится, в результате прога стала только короче smile.gif.

Malice, твой первый тест (10L10L10R10R10R30) я прохожу нормально. А второй (ботинок с красным каблуком) я что-то не пойму.. Напиши его строчкой, плз.
Ааааа... понял. Приход обратно сзади... подкрасться тмхой сапой, и... O'kay, подумаю.

Остается одна проблема... Вот такая:
10L0L5
То есть звено нулевой длины и поворот назад. Такую ситуацию я не отлавливаю.. Но работаю над этим! 1.gif

const
m=100;

var
x,y:array[0..m]of integer;
Dir:record
x,y:integer
end;
i,j,n,e,l,z:integer;
c:char;
s:string;
f:file of char;

begin
x[0]:=0; y[0]:=0;
Dir.x:=1; Dir.y:=0;
Assign(f,'boa.dat');
Reset(f);
n:=0;
while not EoF(f) do begin
Read(f,c);
c:=UpCase©;
if (c in ['L','R'])or EoF(f) then begin
Inc(n);
if EoF(f) then s:=s+c;
Val(s,l,e);
x[n]:=x[n-1]+Dir.x*l;
y[n]:=y[n-1]+Dir.y*l;
s:='';
with Dir do case c of
'L':begin z:=x; x:=-y; y:=z end;
'R':begin z:=x; x:=y; y:=-z end;
end
end
else s:=s+c
end;

for i:=4 to n do begin
j:=i mod 2 +1;
while j<i-2 do begin
if Odd(i) and
((x[i]-x[j])*(x[i-1]-x[j])<=0) and ((y[j]-y[i])*(y[j-1]-y[i])<=0)
or not Odd(i) and
((y[i]-y[j])*(y[i-1]-y[j])<=0) and ((x[j]-x[i])*(x[j-1]-x[i])<=0)
then WriteLn('Bonds #',j,' and #',i,' are crossed over');
Inc(j,2)
end
end
end.


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


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

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

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


2 Malice:
Случай с подходом к хвосту сзади лечится добавлением минус-первой точки к массиву координат; ее координаты, как и координаты нулевой точки, нулевые: 0,0. Остальные звенья это нулевое звено не пересечет, так как оно нулевой длины. Соответственно, цикл while нужно начинать с (i+1)mod 2.

2 Lapp:
(разговоры самого-с-собой - первый признак помешательства.. smile.gif) Проверка на разворот не спасает: разворот может быть долгий:
10L0R0L0L5
Исключать пары нулевых звеньев типа L0R0 ? нет.. Ведь может и не быть пересечения после разворота:
10L0L0L5
- это просто поворот направо..
Неужели Michael_Rybak все же прав (сам того не зная smile.gif), и придется проверять параллельные звенья тоже??..


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


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

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

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


Цитата(Lapp @ 28.03.2007 3:23) *

Неужели Michael_Rybak все же прав (сам того не зная smile.gif), и придется проверять параллельные звенья тоже??..

!nono.gif
"Долгие повороты" не нужно учитывать никаким специальным образом при исследовании разворота. Дело в том, что последовательность
L0R0L0L0
- уже содержит перпендикулярное звено, которое будет учтено. Так что нужно отслеживать только действительный (быстрый) поворот назад, типа 10L0L5. Это я вставил, и оно, вроде, работает, но..

..Но тут другая проблема вылезает sad.gif. Действительно, чередующаяся последовательность нулевых звеньев вызовет ложное срабатывание:
10L0R0L0R0L5
- представляет собой прямую линию, но в середине есть три нулевых звена, которые все имеют общую точку с ненулевыми...
Вот такая фигня..
Может, запретить нулевые звенья совсем?.. Или убирать их при парсинге..


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


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

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

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


2 Lapp:
(а с кем еще и поговорить-то ночью.. smile.gif)
Вставил блок, убирающий парные повторы в массивах координат - после парсинга, но до основного алгоритма. Тем самым, проблема решена.. пока smile.gif

Ну, кто найдет еще баг?.. !box.gif
{ Finding self-crossings of a Boa }
{ by Lapp }
const
m=100;

var
x,y:array[-1..m]of integer;
Dir:record
x,y:integer
end;
i,j,n,e,l,z:integer;
Cross:boolean;
c:char;
s:string;
f:file of char;

begin
x[-1]:=0;y[-1]:=0;
x[0]:=0; y[0]:=0;
Dir.x:=1; Dir.y:=0;
Assign(f,'boa.dat');
Reset(f);

{парсинг входной строки}
n:=0;
while not EoF(f) do begin
Read(f,c);
c:=UpCase©;
if (c in ['L','R'])or EoF(f) then begin
Inc(n);
if EoF(f) then s:=s+c;
Val(s,l,e);
x[n]:=x[n-1]+Dir.x*l;
y[n]:=y[n-1]+Dir.y*l;
s:='';
with Dir do case c of
'L':begin z:=x; x:=-y; y:=z end;
'R':begin z:=x; x:=y; y:=-z end;
end
end
else s:=s+c
end;

{Убираем тройные точки}
for i:=n downto 3 do if (x[i]=x[i-1])and(x[i]=x[i-2])and(y[i]=y[i-1])and(y[i]=y[i-2]) then begin
for j:=i to n do begin
x[j-2]:=x[j];
y[j-2]:=y[j]
end;
Dec(n,2)
end;

{Основной поиск}
for i:=3 to n do begin
{проверка на разворот}
j:=i-2;
Cross:=Odd(i)and((x[j]-x[j-1])*(x[i]-x[i-1])<0)and(y[i]=y[j])
or not Odd(i)and((y[j]-y[j-1])*(y[i]-y[i-1])<0)and(x[i]=x[j]);
{поиск пересечений непараллельных звеньев}
if not Cross then j:=(i+1)mod 2-2;
while not Cross and(i>3)and(j<i-4) do begin
Inc(j,2);
Cross:=Odd(i) and
((x[i]-x[j])*(x[i-1]-x[j])<=0)and((y[j]-y[i])*(y[j-1]-y[i])<=0)
or not Odd(i) and
((y[i]-y[j])*(y[i-1]-y[j])<=0)and((x[j]-x[i])*(x[j-1]-x[i])<=0)
end;
if Cross then begin
WriteLn('Bonds #',j,' and #',i,' are crossed over');
Halt
end
end;
WriteLn('No crossings')
end.


Добавлено через 2 мин.
Да, еще: программа теперь останавливается сразу после нахождения первого пересечения (правда, пишет, чего с чем). Если пересечений нет - тоже сообщает об этом.

Исправлено (см. следующее сообщение)

Сообщение отредактировано: Lapp -


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


Новичок
*

Группа: Пользователи
Сообщений: 11
Пол: Мужской
Реальное имя: Kost

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


Если удав выглядит как спираль, например так 1R2R3R4R5R6
то программма не работает (пишет что пересечение 3 и 4, хотя на самом деле никаких пересечений быть не должно)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #26


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

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

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


Цитата(1qsd @ 28.03.2007 9:33) *

например так 1R2R3R4R5R6 ... программма не работает

Ошибка в этой строчке:
    while not Cross and(i>3)and(j<i-2) do begin

Нужно 2 заменить на 4. Я переставил увеличение j в начало цикла, нижний предел изменил, а верхний - забыл.. sad.gif

Сейчас исправлю в последнем тексте.


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


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

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

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


По ходу дела, посмотрев на все сложности, возникшие в геометрическом методе (надеюсь, они все все же преодолены smile.gif), я решил написать программку по методу "матрицы".
Получилось действительно намного проще, на ее написание ушло замееееетно меньше времени. Я использую симметричный байтовый массив, который, если удовлетворять ограничениям ТР, не должен превышать 64К. Это значит, если округлить, что поле выходит примерно от -100 до 100 по каждой координате.. Разумеется, ситуация намного улучшится в FPC (например на 1 ГБ памяти можно сделать поле от -15000 до +15000), но все равно вряд ли кто станет спорить, что геометрическое решение лучше в смысле эффективности (хотя, при большом количестве поворотов и небольшом диаметре они все же могут конкурировать).. Правда, остается еще вариант со сжатием матрицы на лету - но это уже извращение.. smile.gif

Хотя, разве не извращение уже и то, что я потратил несколько часов на эту задачу? smile.gif
Надеюсь, не совсем зря..
{Search for Boa crossings, matrix method}
{by Lapp}

const
m=100; n=100;

var
Z:array[-m..m,-n..n]of byte;
x,y,dx,dy,e,l,b:integer;
s:string;
c:char;
f:file of char;

begin
dx:=1; dy:=0;
x:=0; y:=0;
FillChar(Z,SizeOf(Z),0);
Z[0,0]:=1;
Assign(f,'boa.dat');
Reset(f);
while not EoF(f) do begin
Read(f,c);
c:=UpCase©;
if c in['0'..'9'] then s:=s+c;
if (c in['L','R'])or EoF(f) then begin
Val(s,l,e);
while l>0 do begin
Inc(x,dx);
Inc(y,dy);
if Z[x,y]=1 then begin
WriteLn('Crossing at ',x,',',y);
Halt
end
else Z[x,y]:=1;
Dec(l)
end;
s:='';
case c of
'L':begin b:=dx; dx:=-dy; dy:=b end;
'R':begin b:=dx; dx:=dy; dy:=-b end;
end
end
end;
WriteLn('No crossings')
end.


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


Профи
****

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

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


Теперь я думаю, как говорится, тема раскрыта smile.gif Я б вчера ответил и поговорил на эту тему, но, блин, пошел ребенка укладывать и сам заснул lol.gif Но все же для меня вопрос остался открыт: как правильно представить удава - в векторном виде (тогда имеются общие точки в углах и начало в точке 0х0) или кубиками (тогда по идее 0х0 не занята (хотя в последнем примере ты ее занял, что не дало пройти тест by Michael_Rybak 10L10L10L20) и отрезки друг к другу прикасаются, но общих точек не имеют.. Наверно правилен матричный способ (я сначала тоже векторным начал (к рекурсии свалился smile.gif ) и на нем остановиться, жаль только с размерностью неуниверсально получается sad.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #29


Michael_Rybak
*****

Группа: Пользователи
Сообщений: 1 046
Пол: Мужской
Реальное имя: Michael_Rybak

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


Я считаю, что нужно строго определить самопересечение, и тогда проблем не будет smile.gif Простите если слишком кратко, но мне кажется что ОП мог бы потрудиться и уточнить.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #30


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

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

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


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


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

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

 





- Текстовая версия 23.09.2020 10:47
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name