Лабиринт Тезея найти кратчайший путь возвращения

[Izobara]

Кого натравить?

[BDA]

Abstraction, Вы меня натолкнули на мысль, что мой обход в ширину, не такой уж в ширину , точнее, вообще неправильный.

[Abstraction]

Кого натравить?

А*, улучшенный алгоритм Дейкстры.
У нас же фактически получается лабиринт, по которому надо кратчайшим путём пройти из точки А в точку Б. Правда, правило разрешения конфликтов для нескольких кратчайших путей мешает... Возможно, стоит использовать просто поиск в ширину, в секунду всё равно должны уложиться.

[Izobara]

Че там мешает - вывести первый из найденных. Они равноправны.
Еле понял, что А* - это ссылка

[BDA]

Попробуйте такой (на acmp.ru все тесты прошло):

const
  N = 1 shl 8;
  E = 2 shl 8;
  S = 4 shl 8;
  W = 8 shl 8;

type
  arr = array [-200 .. 200, -200 .. 200] of integer;

  tpoint = record
    x, y, lvl: integer;
  end;

var
  a: arr;
  i, j, k: integer;
  c: char;

procedure search(var a: arr; x, y: integer);
const
  count = 20;
var
  p: array [0 .. count - 1] of tpoint;
  cur, fr: integer;
begin
  cur := 0;
  fr := 1;
  p[cur].x := x;
  p[cur].y := y;
  p[cur].lvl := 1;
  while cur <> fr do
  begin
    if a[p[cur].y, p[cur].x] and 255 <> 0 then
    begin
      cur := (cur + 1) mod count;
      continue;
    end;
    a[p[cur].y, p[cur].x] := a[p[cur].y, p[cur].x] or p[cur].lvl;
    if a[p[cur].y, p[cur].x] and N > 0 then
    begin
      p[fr].y := p[cur].y + 1;
      p[fr].x := p[cur].x;
      p[fr].lvl := p[cur].lvl + 1;
      fr := (fr + 1) mod count;
    end;
    if a[p[cur].y, p[cur].x] and S > 0 then
    begin
      p[fr].y := p[cur].y - 1;
      p[fr].x := p[cur].x;
      p[fr].lvl := p[cur].lvl + 1;
      fr := (fr + 1) mod count;
    end;
    if a[p[cur].y, p[cur].x] and E > 0 then
    begin
      p[fr].y := p[cur].y;
      p[fr].x := p[cur].x + 1;
      p[fr].lvl := p[cur].lvl + 1;
      fr := (fr + 1) mod count;
    end;
    if a[p[cur].y, p[cur].x] and W > 0 then
    begin
      p[fr].y := p[cur].y;
      p[fr].x := p[cur].x - 1;
      p[fr].lvl := p[cur].lvl + 1;
      fr := (fr + 1) mod count;
    end;
    cur := (cur + 1) mod count;
  end;
end;

function printpath(const a: arr; x, y: integer): boolean;
var
  lvl: integer;
begin
  lvl := a[y, x] and 255;
  if lvl = 1 then
  begin
    printpath := True;
    exit;
  end;
  if (a[y, x] and S > 0) and (a[y - 1, x] and 255 = lvl - 1) and printpath(a,
    x, y - 1) then
  begin
    write('N');
    printpath := True;
    exit;
  end;
  if (a[y, x] and W > 0) and (a[y, x - 1] and 255 = lvl - 1) and printpath(a,
    x - 1, y) then
  begin
    write('E');
    printpath := True;
    exit;
  end;
  if (a[y, x] and N > 0) and (a[y + 1, x] and 255 = lvl - 1) and printpath(a,
    x, y + 1) then
  begin
    write('S');
    printpath := True;
    exit;
  end;
  if (a[y, x] and E > 0) and (a[y, x + 1] and 255 = lvl - 1) and printpath(a,
    x + 1, y) then
  begin
    write('W');
    printpath := True;
    exit;
  end;
  printpath := false;
end;

begin
  assign(input, 'input.txt');
  reset(input);
  assign(output, 'output.txt');
  rewrite(output);
  for i := -200 to 200 do
    for j := -200 to 200 do
      a[i, j] := 0;
  i := 0;
  j := 0;
  while not EOF do
  begin
    read(c);
    case c of
      'N':
        begin
          a[i, j] := a[i, j] or N;
          inc(i);
          a[i, j] := a[i, j] or S;
        end;
      'E':
        begin
          a[i, j] := a[i, j] or E;
          inc(j);
          a[i, j] := a[i, j] or W;
        end;
      'S':
        begin
          a[i, j] := a[i, j] or S;
          dec(i);
          a[i, j] := a[i, j] or N;
        end;
      'W':
        begin
          a[i, j] := a[i, j] or W;
          dec(j);
          a[i, j] := a[i, j] or E;
        end;
    end;
  end;
  search(a, j, i);
  printpath(a, 0, 0);
end.

[BDA]

<не поместилось>
А вот визуализатор, если интересно:

program Project1;
{$APPTYPE CONSOLE}

uses
  SysUtils,
  Graphics; // debug

const
  N = 1 shl 8;
  E = 2 shl 8;
  S = 4 shl 8;
  W = 8 shl 8;

type
  arr = array [-200 .. 200, -200 .. 200] of integer;

var
  a: arr;
  i, j, k: integer;
  c: char;

  // debug
  bmp: tbitmap;
  x, y, i0, j0: integer;

begin
  assign(input, 'input.txt');
  reset(input);
  assign(output, 'output.txt');
  rewrite(output);
  for i := -200 to 200 do
    for j := -200 to 200 do
      a[i, j] := 0;
  i := 0;
  j := 0;
  while not EOF do
  begin
    read(c);
    case c of
      'N':
        begin
          a[i, j] := a[i, j] or N;
          inc(i);
          a[i, j] := a[i, j] or S;
        end;
      'E':
        begin
          a[i, j] := a[i, j] or E;
          inc(j);
          a[i, j] := a[i, j] or W;
        end;
      'S':
        begin
          a[i, j] := a[i, j] or S;
          dec(i);
          a[i, j] := a[i, j] or N;
        end;
      'W':
        begin
          a[i, j] := a[i, j] or W;
          dec(j);
          a[i, j] := a[i, j] or E;
        end;
    end;
  end;
  j0 := j;
  i0 := i;
  bmp := tbitmap.create;
  bmp.SetSize(401 * 5, 401 * 5);
  with bmp.Canvas do
    for i := 200 downto -200 do
      for j := -200 to 200 do
      begin
        x := 5 * j + 200 * 5;
        y := -5 * i + 200 * 5;
        if a[i, j] and N > 0 then
        begin
          MoveTo(x + 2, y);
          LineTo(x + 2, y + 3);
        end;
        if a[i, j] and S > 0 then
        begin
          MoveTo(x + 2, y + 2);
          LineTo(x + 2, y + 5);
        end;
        if a[i, j] and W > 0 then
        begin
          MoveTo(x, y + 2);
          LineTo(x + 3, y + 2);
        end;
        if a[i, j] and E > 0 then
        begin
          MoveTo(x + 2, y + 2);
          LineTo(x + 5, y + 2);
        end;
        pixels[200 * 5 + 2, 200 * 5 + 2] := clred;
        pixels[200 * 5 + 2 + 5 * j0, 200 * 5 + 2 - 5 * i0] := clAqua;
      end;
  bmp.SaveToFile('output.bmp');
  bmp.Free;
end.

Update 0:10
А Вы и не сможете повысить репутацию
(нужно, чтобы у Вас была репутация больше 10)
Update 0:50
Немного "свернул" код решения:

const
  { N, E, S, W }
  d: array [0 .. 3, 0 .. 2] of integer = ((1 shl 8, 0, 1), (2 shl 8, 1, 0),
    (4 shl 8, 0, -1), (8 shl 8, -1, 0)); { offset,x,y }
  str = 'NESW';

type
  arr = array [-200 .. 200, -200 .. 200] of integer;

  tpoint = record
    x, y, lvl: integer;
  end;

var
  a: arr;
  i, j, k: integer;
  c: char;

procedure search(var a: arr; x, y: integer);
const
  count = 20;
var
  p: array [0 .. count - 1] of tpoint;
  cur, fr, i: integer;
begin
  cur := 0;
  fr := 1;
  p[cur].x := x;
  p[cur].y := y;
  p[cur].lvl := 1;
  while cur <> fr do
  begin
    if a[p[cur].y, p[cur].x] and 255 <> 0 then
    begin
      cur := (cur + 1) mod count;
      continue;
    end;
    a[p[cur].y, p[cur].x] := a[p[cur].y, p[cur].x] or p[cur].lvl;
    for i := 0 to 3 do
      if a[p[cur].y, p[cur].x] and d[i, 0] > 0 then
      begin
        p[fr].x := p[cur].x + d[i, 1];
        p[fr].y := p[cur].y + d[i, 2];
        p[fr].lvl := p[cur].lvl + 1;
        fr := (fr + 1) mod count;
      end;
    cur := (cur + 1) mod count;
  end;
end;

function printpath(const a: arr; x, y: integer): boolean;
var
  lvl, i: integer;
begin
  lvl := a[y, x] and 255;
  if lvl = 1 then
  begin
    printpath := True;
    exit;
  end;
  for i := 0 to 3 do
    if (a[y, x] and d[(i + 2) mod 4, 0] > 0) and (a[y + d[(i + 2) mod 4, 2],
      x + d[(i + 2) mod 4, 1]] and 255 = lvl - 1) and printpath(a,
      x + d[(i + 2) mod 4, 1], y + d[(i + 2) mod 4, 2]) then
    begin
      write(str[i + 1]);
      printpath := True;
      exit;
    end;
  printpath := false;
end;

begin
  assign(input, 'input.txt');
  reset(input);
  assign(output, 'output.txt');
  rewrite(output);
  for i := -200 to 200 do
    for j := -200 to 200 do
      a[i, j] := 0;
  i := 0;
  j := 0;
  while not EOF do
  begin
    read(c);
    k := pos(c, str);
    a[i, j] := a[i, j] or d[k - 1, 0];
    j := j + d[k - 1, 1];
    i := i + d[k - 1, 2];
    a[i, j] := a[i, j] or d[(k + 1) mod 4, 0];
  end;
  search(a, j, i);
  printpath(a, 0, 0);
end.

Update 2:20
Если не забуду, то сменю направление поиска (пока условия с акмп выполняются не строго).

[Izobara]

На асмпе проходит. Сервер олимпиады временно недоступен...
Мда, не могу повысить репутацию, требует плюсануть кого-то еще. Плюс модератору не помог
update хм... Ну ладно, подождем, пока оторвутся от vk благодарные мне вопрошатели.
Э, так они, по-моему, не смогут мне плюс влепить. Замкнутый круг.

На *****forum проще как-то. Вчера четвертый юбилей репы отпраздновал

[BDA]

Вот такой конечный вариант:

const
  d: array [0 .. 3, 0 .. 2] of integer = ((1 shl 8, 0, 1), (2 shl 8, 1, 0),
    (4 shl 8, 0, -1), (8 shl 8, -1, 0));
  str = 'NESW';

type
  arr = array [-200 .. 200, -200 .. 200] of integer;

  tpoint = record
    x, y, lvl: integer;
  end;

  tqueue = ^queue;

  queue = record
    Data: tpoint;
    Next: tqueue;
  end;

var
  a: arr;
  i, j, k: integer;
  c: char;

Procedure writeO(Var BeginO, EndO: tqueue; c: tpoint);
Var
  u: tqueue;
Begin
  new(u);
  u^.Data := c;
  u^.Next := Nil;
  if BeginO = Nil then
    BeginO := u
  else
    EndO^.Next := u;
  EndO := u;
End;

Procedure readO(Var BeginO: tqueue; Var c: tpoint);
Var
  u: tqueue;
Begin
  if BeginO <> nil then
  begin
    c := BeginO^.Data;
    u := BeginO;
    BeginO := BeginO^.Next;
    dispose(u);
  end;
End;

procedure search(var a: arr; x, y: integer);
var
  i: integer;
  BeginO, EndO: tqueue;
  t, tmp: tpoint;
begin
  BeginO := nil;
  EndO := nil;
  t.x := x;
  t.y := y;
  t.lvl := 1;
  writeO(BeginO, EndO, t);
  while BeginO <> nil do
  begin
    readO(BeginO, t);
    if a[t.y, t.x] and 255 <> 0 then
      continue;
    a[t.y, t.x] := a[t.y, t.x] or t.lvl;
    for i := 0 to 3 do
      if a[t.y, t.x] and d[i, 0] > 0 then
      begin
        tmp.x := t.x + d[i, 1];
        tmp.y := t.y + d[i, 2];
        tmp.lvl := t.lvl + 1;
        writeO(BeginO, EndO, tmp);
      end;
  end;
end;

procedure printpath(const a: arr; x, y: integer);
var
  lvl, i: integer;
begin
  lvl := a[y, x] and 255;
  while lvl <> 1 do
  begin
    for i := 0 to 3 do
      if (a[y, x] and d[i, 0] > 0) and
        (a[y + d[i, 2], x + d[i, 1]] and 255 = lvl - 1) then
      begin
        write(str[i + 1]);
        x := x + d[i, 1];
        y := y + d[i, 2];
        break;
      end;
    lvl := a[y, x] and 255;
  end;
end;

begin
  assign(input, 'input.txt');
  reset(input);
  assign(output, 'output.txt');
  rewrite(output);
  for i := -200 to 200 do
    for j := -200 to 200 do
      a[i, j] := 0;
  i := 0;
  j := 0;
  while not EOF do
  begin
    read(c);
    k := pos(c, str);
    a[i, j] := a[i, j] or d[k - 1, 0];
    j := j + d[k - 1, 1];
    i := i + d[k - 1, 2];
    a[i, j] := a[i, j] or d[(k + 1) mod 4, 0];
  end;
  search(a, 0, 0);
  printpath(a, j, i);
end.

По идее, должен удовлетворять условию выбора маршрута с приоритетом.
(Массив точек заменен на очередь точек)

[Izobara]

Хах, вовремя Выложили авторские решения - на acmp валит 3-ий тест... А не, если убрать перевод строки, то ассептед...

 #include <iostream>
#include <string>
#include <vector>
#include <algorithm>
#include <queue>
#include <map>
#include <set>
#include <cstdio>

using namespace std;

typedef pair<int, int> Point; //x, y

Point operator + (Point a, Point b)
{
    return Point(a.first+b.first, a.second+b.second);
}

Point operator - (Point a, Point b)
{
    return Point(a.first-b.first, a.second-b.second);
}

map<char, Point> Z;
map<Point, char> revZ;

int main()
{
    freopen("maze.in", "r", stdin);
    freopen("maze.out", "w", stdout);

    Z['S'] = Point(0,1);    revZ[Point(0,1)] = 'S';
    Z['N'] = Point(0,-1);   revZ[Point(0,-1)] = 'N';
    Z['W'] = Point(-1,0);    revZ[Point(-1,0)] = 'W';
    Z['E'] = Point(1,0);   revZ[Point(1,0)] = 'E';


    string way;
    cin >> way;

    map<Point, vector<Point> > G;

    Point S(1000,1000), T, curr = S;

    for (int i=0;i<way.length();i++)
    {
        Point curr2;
        curr2 = curr + Z[way[i] ];

        G[curr].push_back(curr2);
        G[curr2].push_back(curr);

        curr = curr2;
    }

    T = curr;

    set<Point> st;
    map<Point, int> len;
    map<Point, Point> prev;

    queue<Point> Q;
    Q.push(S);
    len[S] = 0;
    st.insert(S);

    while(!Q.empty() )
    {
        Point u = Q.front();
        Q.pop();

        //cout << u.first << " " << u.second << endl;

        vector<Point> &vect = G[u];
        for (int i=0;i<vect.size();i++)
        {
            Point v = vect[i];
            if (st.find(v) == st.end() )
            {
                Q.push(v);
                st.insert(v);
                len[v] = len[u] + 1;
                prev[v] = u;
            }
        }
    }


    //cout << len[T] << endl;\

    curr = T;
    while(len[curr])
    {
        Point p = prev[curr];
        cout << revZ[p-curr];
        curr = p;
    }

  //  cout << endl; перевод строки убрать для acmp.ru


    return 0;
}