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

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

To Leonid Volkov !!! Can you help me ??? What's wrong with my code ????
Послано Romanchik Vitaly 16 мар 2003 13:37
const nn=10;


      sum=1000000;


type my=array[1..1000]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;




procedure init;


var i,l:integer;


    ch:char;


begin


 assign(input,'');


 reset(input);


  readln(n);


  for i:=1 to n do


   begin


    ch:=#0;


    kol:=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;


      inc(kol);


      a[i][kol]:=ch;


     end;


    b[i]:=kol;


    read(ch);


    read(ch);


   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;


    sum:longint;


    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];


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


  end;


 b[1]:=b[1]-2*sk[1];


 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 write(a[k][i]);


     inc(i);


    end;


  end;


end;




procedure outt;


begin


 assign(output,'');


 rewrite(output);


  writeAns(1,1);


 close(output);


end;




begin


 init;


 solve;


 outt;


end.