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

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

Why I got WAЈїЈїЈї HelpЈЎЈЎ
Послано XueMao 17 июл 2002 15:51
Program Image_Encoding;

Const hx:array[1..4] of integer=(1,0,-1,0);
      hy:array[1..4] of integer=(0,1,0,-1);
      g:array[1..4] of char=('R','T','L','B');

Var i,j,k,m,n,k1,k2,tot,t:integer;
    s:string;
    p:set of char;
    b:array[1..2] of integer;
    a,e:array[0..15,1..2] of integer;
    ans:array[0..15,1..4] of integer;
    mark:array[0..15] of integer;

Function Find(c:char):integer;
var i,j:integer;
begin
  j:=0;
  for i:=1 to 4 do
  if g[i]=c then
  begin
    j:=i;
    break;
  end;
  find:=j;
end;


Function Get(x,y:integer):integer;
var i,j:integer;
begin
  j:=0;
  for i:=1 to n do
  if mark[i]=0 then
  if (a[i,1]=x)and(a[i,2]=y) then
  begin
    j:=i;
    break;
  end;
  get:=j;
end;

Procedure Check(x:integer);
var i,j,k,m,n,x1,y1:integer;
begin
  for i:=1 to 4 do
  begin
    x1:=e[x,1]+hx[i];
    y1:=e[x,2]+hy[i];
    k:=get(x1,y1);
    if k<>0 then
    begin
      ans[x,i]:=1;
      mark[k]:=1;
      inc(t);
      e[t,1]:=x1;
      e[t,2]:=y1;
    end;
  end;
end;

Begin
  k:=0;
  while not(eoln) do
  begin
    inc(k);
    read(b[k]);
  end;
  readln;
  fillchar(a,sizeof(a),0);
  fillchar(e,sizeof(e),0);
  fillchar(ans,sizeof(ans),0);
  fillchar(mark,sizeof(mark),0);
  if k<2 then
  begin
    n:=b[1];
    for i:=1 to n do
    readln(a[i,1],a[i,2]);
    e[1,1]:=a[1,1];
    e[1,2]:=a[1,2];
    mark[1]:=1;
    t:=1;
    for i:=1 to n-1 do
    check(i);
    writeln(a[1,1],' ',a[1,2]);
    for i:=1 to n-1 do
    begin
      for j:=1 to 4 do
      if ans[i,j]=1 then write(g[j]);
      writeln(',');
    end;
    writeln('.');
  end
  else
  begin
    e[1,1]:=b[1];
    e[1,2]:=b[2];
    s:='';
    t:=0;
    tot:=1;
    p:=['R','T','L','B'];
    while s<>'.' do
    begin
      readln(s);
      inc(t);
      if s<>'.' then
      begin
        for i:=1 to length(s) do
        if s[i] in p then
        begin
          k:=find(s[i]);
          inc(tot);
          e[tot,1]:=e[t,1]+hx[k];
          e[tot,2]:=e[t,2]+hy[k];
        end;
      end;
    end;
    for i:=1 to tot-1 do
    for j:=i+1 to tot do
    if (e[j,1]<e[i,1])or(e[j,1]=e[i,1])and
    (e[j,2]<e[i,2]) then
    begin
      k:=e[j,1];
      e[j,1]:=e[i,1];
      e[i,1]:=k;
      k:=e[j,2];
      e[j,2]:=e[i,2];
      e[i,2]:=k;
    end;
    writeln(tot);
    for i:=1 to tot do
    writeln(e[i,1],' ',e[i,2]);
  end;
End.