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

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

Why i got wa!!
Послано Old Man 12 ноя 2002 07:50
program Ural_1008(input,output);
const
  mmm         =11;
  way         :array [1..4,1..2] of integer
              =((1,0),(0,1),(-1,0),(0,-1));
  out         :array [1..4] of char
              =('R','T','L','B');
type
  xing        =array [0..mmm,0..mmm] of boolean;
  xing1       =array [1..101,1..2] of integer;
var
  map         :xing;
  res         :xing1;
  head,tail,k :integer;
  lx,ly,n     :integer;
  s           :string;

procedure init;
  var
    i,j       ,
    tx,ty     :integer;
  begin
    fillchar(map,sizeof(map),false);
    fillchar(res,sizeof(res),0);
    readln(lx,ly);
    map[lx,ly]:=true;
    for i:=2 to n do
      begin
        read(tx,ty);
        map[tx,ty]:=true;
        if tx<lx then
          begin
            lx:=tx; ly:=ty;
          end;
        if (tx=lx) and (ty<ly) then
          begin
            lx:=tx; ly:=ty;
          end;
      end;
    writeln(lx,' ',ly);
  end;

procedure solve;
  var
    i,j,sx,sy :integer;
  begin
    head:=1; tail:=1; map[lx,ly]:=false;
    res[1,1]:=lx; res[1,2]:=ly;
    while head<=tail do
      begin
        for i:=1 to 4 do
          begin
            sx:=res[head,1]+way[i,1];
            sy:=res[head,2]+way[i,2];
            for j:=1 to n do if map[sx,sy] then
              begin
                write(out[i]);
                inc(tail);
                res[tail,1]:=sx;
                res[tail,2]:=sy;
                map[sx,sy]:=false;
                break;
              end;
          end;
        if head<>n then writeln(',')
                   else writeln('.');
        inc(head);
      end;
  end;

procedure solve2;
  var
    i,j       :integer;
    sx,sy     ,
    tx,ty     :integer;
    t1,t2     :string;
  begin
    fillchar(map,sizeof(map),false);
    fillchar(res,sizeof(res),0);
    t1:=copy(s,1,pos(' ',s)-1);
    t2:=copy(s,length(t1)+2,length(s)-length(t1)-1);
    head:=1; tail:=1;
    val(t1,res[head,1],k);
    val(t2,res[head,2],k);
    map[res[head,1],res[head,2]]:=true;
    while head<=tail do
      begin
        readln(s);
        sx:=res[head,1];
        sy:=res[head,2];
        if length(s)<>1 then
          for i:=1 to length(s)-1 do
            begin
              case s[i] of
                'R':j:=1;
                'B':j:=2;
                'L':j:=3;
                'T':j:=4;
              end;
              tx:=sx+way[j,1];
              ty:=sy+way[j,2];
              map[tx,ty]:=true;
              inc(tail);
              res[tail,1]:=tx;
              res[tail,2]:=ty;
            end;
        inc(head);
      end;
    writeln(tail);
    for i:=1 to 10 do
      for j:=1 to 10 do if map[i,j] then writeln(i,' ',j);
  end;

Begin
  readln(s);
  if pos(' ',s)=0 then
    begin
      val(s,n,k);
      init;
      solve;
    end
                  else
    begin
      solve2;
    end;
End.