ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1253. Necrologues

To Leonid Volkov !!! Can you help me ??? What's wrong with my code ????
Posted by Romanchik Vitaly 16 Mar 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.