ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1008. Кодирование изображений

What's wrong??
Послано pr0grammer 23 фев 2003 13:52
program An_Image_Encoding;
const

  maxN = 10;
  maxQ = 310;

type

  punkt = record
    x, y : integer;
  end;

  queue = record
    tail, head : integer;
    c : array [1..maxQ] of punkt;
  end;

var
  map, u : array [1..maxN, 1..maxN] of boolean;
  q : queue;

  procedure initial;
  begin
    fillchar(map, sizeOf(map), false);
  end;

  procedure enqueue(var q : queue; p : punkt);
  begin
    q.c[q.tail] := p;
    if q.tail = maxQ then q.tail :=1
    else inc(q.tail);
  end;

  function dequeue(var q : queue) : punkt;
  var
    x : punkt;
  begin
    x := q.c[q.head];
    if q.head = maxQ then q.head := 1
    else inc(q.head);
    dequeue := x;
  end;

  function check(x, y : integer) : boolean;
  var
    p : punkt;
  begin
    if (x >= 1) and (y >= 1) and (x <= 10) and (y <= 10) and
      (map[x, y] = true) and (u[x, y] = false) then
      begin
        u[x, y] := true;
        p.x := x;
        p.y := y;
        enqueue(q, p);
        check := true;
      end
      else
        check := false;
  end;

  procedure solve;
  var
    n, m, p, code, x, y, i, sx, sy : integer;
    s, nt, mt : string;
    st, z, r : punkt;
    c : char;
  begin
    readln(s);
    while (s[length(s)] = ' ') do delete(s, length(s), 1);
    while (s[1] = ' ') do delete(s, 1, 1);
    p := pos(' ', s);
    if p <> 0 then
    begin
      nt := copy(s, 1, p - 1);
      mt := copy(s, p + 1, length(s));
      val(nt, st.x, code);
      val(mt, st.y, code);
      q.head := 1;
      q.tail := 1;
      enqueue(q, st);
      while q.head <> q.tail do
      begin
        z := dequeue(q);
        readln(s);
        map[z.x, z.y] := true;
        for i := 1 to length(s) - 1 do
        begin
          c := s[i];
          case c of
            'R' :
            begin
              map[z.x + 1, z.y] := true;
              r.x := z.x + 1;
              r.y := z.y;
              enqueue(q, r);
            end;
            'T':
            begin
              map[z.x, z.y + 1] := true;
              r.x := z.x;
              r.y := z.y + 1;
              enqueue(q, r);
            end;
            'L':
            begin
              map[z.x - 1, z.y] := true;
              r.x := z.x - 1;
              r.y := z.y;
              enqueue(q, r);
            end;
            'B':
            begin
              map[z.x, z.y - 1] := true;
              r.x := z.x;
              r.y := z.y - 1;
              enqueue(q, r);
            end;
          end;
        end;
      end;
        for x := 1 to 10 do
          for y := 1 to 10 do
            if (map[x, y]) then
              writeln(x, ' ', y);
    end
    else
    begin
      val(s, n, code);
      if n = 0 then
      begin
        exit;
      end;
      for i := 1 to n do
      begin
        readln(x, y);
        map[x, y] := true;
        if i = 1 then
        begin
          st.x := x;
          st.y := y;
        end;
      end;
      writeln(st.x, ' ', st.y);
      q.head := 1;
      q.tail := 1;
      enqueue(q, st);
      fillchar(u, sizeOf(u), false);
      while q.tail <> q.head do
      begin
        z := dequeue(q);
        u[z.x, z.y] := true;
        if check(z.x + 1, z.y) then write('R');
        if check(z.x, z.y + 1) then write('T');
        if check(z.x - 1, z.y) then write('L');
        if check(z.x, z.y - 1) then write('B');
        if q.head = q.tail then
          writeln('.') else
        writeln(',');
      end;
    end;
  end;

begin
  initial;
  solve;
end.