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

Help !!! Why WA now ???????????????
Posted by Romanchik Vitaly 14 Jun 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 !!!
Posted by Romanchik Vitaly 5 Jul 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