ENG  RUS Timus Online Judge
Online Judge
Problems
Authors
Online contests
Site news
Webboard
Problem set
Submit solution
Judge status
Guide
Register
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);
for i:=1 to n do
begin
ch:=#0;
kol:=0;
k13:=0;
while ch<>'#' do
begin
if ch='#' then break;
if ch='*' then
begin
inc(kol);
a[i][kol]:=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;
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);

>   for i:=1 to n do

>    begin

>     ch:=#0;

>     kol:=0;

>     k13:=0;

>     while ch<>'#' do

>      begin

>       if ch='#' then break;

>       if ch='*' then

>        begin

>         inc(kol);

>         a[i][kol]:=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;

>    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