Help !!! Why WA now ??????????????? 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 !!! > 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 & |