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

Обсуждение задачи 1253. Некрологи

Help !!! Why WA now ???????????????
Послано Romanchik Vitaly 14 июн 2003 19:55
const nn=10;
      sum=1000000;

type my=array[1..3000]of char;
     integer=longint;

var a:array[1..nn]of my;
    n:integer;
    t:array[1..2,1..nn]of integer;
    q:array[1..nn,1..nn]of integer;
    kol:integer;
    b,bb:array[1..nn]of integer;
    sk:array[1..nn]of longint;
    koch,noch:integer;
    tt:array[1..nn]of set of 1..nn;
    kkk:longint;
    z:array[1..nn]of longint;

procedure init;
var i,l:integer;
    ch:char;
    k13:longint;
begin
 assign(input,'');
 reset(input);
  readln(n);
  for i:=1 to n do
   begin
    ch:=#0;
    kol:=0;
    k13:=0;
    while ch<>'#' do
     begin
      read(ch);
      if ch='#' then break;
      if ch='*' then
       begin
        inc(kol);
        a[i][kol]:=ch;
        read(ch);
        l:=ord(ch)-48;
        inc(q[i,l]);
        inc(sk[i]);
       end;
      if (ch=#10)and(a[i][kol]=#13)then inc(k13);
      inc(kol);
      a[i][kol]:=ch;
     end;
    b[i]:=kol;
    z[i]:=k13;
    readln;
   end;
 close(input);
end;

procedure outNo;
begin
 assign(output,'');
 rewrite(output);
  write('#');
 close(output);
 halt;
end;

procedure createTree;
var st:set of 1..nn;
    ch,i:integer;
begin
 koch:=1;
 noch:=1;
 st:=[1];
 t[1,koch]:=1;
 t[2,koch]:=0;
 tt[1]:=[1];
 while noch<=koch do
  begin
   ch:=t[1,noch];
   for i:=1 to n do
    if (q[ch,i]<>0)and(not (i in tt[noch]))then
     begin
      inc(koch);
      t[1,koch]:=i;
      t[2,koch]:=noch;
      tt[koch]:=tt[noch]+[i];
     end else
    if (q[ch,i]<>0)and(i in tt[noch])then outNo;
   inc(noch);
  end;
end;

procedure calcSum;
var i:integer;
    k1,k2,kk,ch:integer;
begin
 for i:=koch downto 2 do
  begin
   k1:=t[2,i];
   k2:=t[1,i];
   kk:=q[k1,k2];
   b[k2]:=b[k2]-2*sk[k2]-z[k2];
   b[k1]:=b[k1]+kk*b[k2];
  end;
 b[1]:=b[1]-2*sk[1]-z[k1];
 if b[1]>sum then outNo;
end;

procedure solve;
begin
 bb:=b;
 createTree;
 calcSum;
end;

procedure writeAns(k,pp:integer);
var i:integer;
    kk:integer;
begin
 i:=pp;
 while i<=bb[k] do
  begin
   if (a[k][i]='*')then
    begin
     kk:=ord(a[k][i+1])-48;
     writeAns(kk,1);
     inc(i,2);
    end else
    begin
     if (i<=bb[k]) then
      begin
       write(a[k][i]);
       inc(kkk);
      end;
     inc(i);
    end;
  end;
end;

procedure outt;
begin
 assign(output,'');
 rewrite(output);
  writeAns(1,1);
 close(output);
end;

begin
 init;
 solve;
 outt;
end.
Sorry, itis a wrong solution ! Now I get AC !!!
Послано Romanchik Vitaly 5 июл 2003 18:43
> const nn=10;


>       sum=1000000;


>


> type my=array[1..3000]of char;


>      integer=longint;


>


> var a:array[1..nn]of my;


>     n:integer;


>     t:array[1..2,1..nn]of integer;


>     q:array[1..nn,1..nn]of integer;


>     kol:integer;


>     b,bb:array[1..nn]of integer;


>     sk:array[1..nn]of longint;


>     koch,noch:integer;


>     tt:array[1..nn]of set of 1..nn;


>     kkk:longint;


>     z:array[1..nn]of longint;


>


> procedure init;


> var i,l:integer;


>     ch:char;


>     k13:longint;


> begin


>  assign(input,'');


>  reset(input);


>   readln(n);


>   for i:=1 to n do


>    begin


>     ch:=#0;


>     kol:=0;


>     k13:=0;


>     while ch<>'#' do


>      begin


>       read(ch);


>       if ch='#' then break;


>       if ch='*' then


>        begin


>         inc(kol);


>         a[i][kol]:=ch;


>         read(ch);


>         l:=ord(ch)-48;


>         inc(q[i,l]);


>         inc(sk[i]);


>        end;


>       if (ch=#10)and(a[i][kol]=#13)then inc(k13);


>       inc(kol);


>       a[i][kol]:=ch;


>      end;


>     b[i]:=kol;


>     z[i]:=k13;


>     readln;


>    end;


>  close(input);


> end;


>


> procedure outNo;


> begin


>  assign(output,'');


>  rewrite(output);


>   write('#');


>  close(output);


>  halt;


> end;


>


> procedure createTree;


> var st:set of 1..nn;


>     ch,i:integer;


> begin


>  koch:=1;


>  noch:=1;


>  st:=[1];


>  t[1,koch]:=1;


>  t[2,koch]:=0;


>  tt[1]:=[1];


>  while noch<=koch do


>   begin


>    ch:=t[1,noch];


>    for i:=1 to n do


>     if (q[ch,i]<>0)and(not (i in tt[noch]))then


>      begin


>       inc(koch);


>       t[1,koch]:=i;


>       t[2,koch]:=noch;


>       tt[koch]:=tt[noch]+[i];


>      end else


>     if (q[ch,i]<>0)and(i in tt[noch])then outNo;


>    inc(noch);


>   end;


> end;


>


> procedure calcSum;


> var i:integer;


>     k1,k2,kk,ch:integer;


> begin


>  for i:=koch downto 2 do


>   begin


>    k1:=t[2,i];


>    k2:=t[1,i];


>    kk:=q[k1,k2];


>    b[k2]:=b[k2]-2*sk[k2]-z[k2];


>    b[k1]:=b[k1]+kk*b[k2];


>   end;


>  b[1]:=b[1]-2*sk[1]-z[k1];


>  if b[1]>sum then outNo;


> end;


>


> procedure solve;


> begin


>  bb:=b;


>  createTree;


>  calcSum;


> end;


>


> procedure writeAns(k,pp:integer);


> var i:integer;


>     kk:integer;


> begin


>  i:=pp;


>  while i<=bb[k] do


>   begin


>    if (a[k][i]='*')then


>     begin


>      kk:=ord(a[k][i+1])-48;


>      writeAns(kk,1);


>      inc(i,2);


>     end else


>     begin


>      if (i<=bb[k]) then


>       begin


&amp