Удав, Задача на координаты и направление Опции

[Lapp]

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

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

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

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

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.

[Lapp]

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

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

[Lapp]

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

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

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

[Lapp]

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

Ну, кто найдет еще баг?..

{ 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 - 28.03.2007 10:24

[1qsd]

Если удав выглядит как спираль, например так 1R2R3R4R5R6
то программма не работает (пишет что пересечение 3 и 4, хотя на самом деле никаких пересечений быть не должно)

[Lapp]

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

Ошибка в этой строчке:

    while not Cross and(i>3)and(j<i-2) do begin

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

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

[Lapp]

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

Хотя, разве не извращение уже и то, что я потратил несколько часов на эту задачу?
Надеюсь, не совсем зря..

{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.

[Malice]

Теперь я думаю, как говорится, тема раскрыта Я б вчера ответил и поговорил на эту тему, но, блин, пошел ребенка укладывать и сам заснул Но все же для меня вопрос остался открыт: как правильно представить удава - в векторном виде (тогда имеются общие точки в углах и начало в точке 0х0) или кубиками (тогда по идее 0х0 не занята (хотя в последнем примере ты ее занял, что не дало пройти тест by Michael_Rybak 10L10L10L20) и отрезки друг к другу прикасаются, но общих точек не имеют.. Наверно правилен матричный способ (я сначала тоже векторным начал (к рекурсии свалился ) и на нем остановиться, жаль только с размерностью неуниверсально получается

[Michael_Rybak]

Я считаю, что нужно строго определить самопересечение, и тогда проблем не будет Простите если слишком кратко, но мне кажется что ОП мог бы потрудиться и уточнить.

[Lapp]

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