if CharMax=10 (not 10^6) Test1 1 aaaaa aaaa# answer aaaaa aaaa Test2 aaaaa aaaaa answer:# in pascal eoln =chr(10) (not chr(10)chr(13)) 7 She w*7s *7 *2 *5 wom*7n. *3# wonderful# Everyone loved her *5. We will miss her *5.# Some text *6# very much# Another text *4# a# She was a wonderful very much woman. Everyone loved her very much. We will miss her very much. Try this case 2 *2# hello *10# if N<10 '0' must be print. I think than N<=10 but N<10 Edited by author 22.10.2005 20:59 My program writes '#'. It is correct because we have a cycle, isn't it? thanks a lot! AC now! The test that helped me on WA8: 3 *3*2 a# *3# b# right answer: "bb a" Thanx a lot it helped me too I have OLE #9 many times. Can anybody check my code? When I got "outpoot limit exceeded" at the first time, I add check when number of chars writed >100000 then programs must terminate. But that program got OLE again( What reason? I really don't understand. Maybe bug in checker? I think OLE is outer to checker in judge system and has fixed limit for all problems. my AC program for these test 4 zzz*2# *3*4# *2# www# gives output zzz it's wrong correct output is # Input 1 *2# What Output? On the test 1 aaa*2# The answer aaa OLE#9 What's wrong? Thanks. For example, when necrologue 1 uses necrologue 2, and 2 inserts 1. AC. But I still don't understand my mistake. I just rewrite the program. Interesting. At first I used scanf in C++ and got Crash, then I changed it on cin.get() and got AC!) Crash{Stack} or MLE! How to pass it? Thanks. Passed. Problems with test#9 DFS will work. At first,I just see if length >1000000 but got ML. I realize that the depth is too large.It has an improve, just use dfs without recursion. But there is a more simple way: It is clear that if the depth>n,there must be a cycle. So just recursion dfs can easily get AC. My pascal pro AC in 0.281sec 159 КБ and shorter than 1K. Maybe inrecursion will faster,but it is no need to do so... Is there any way else to solve this problem?I am glad to learn more algorithm. This problem may be solved using non-recursive DFS agorithm, but a defect is situated in this problem. An example of input: {!!!!!!!Beginning of the input on the next line!!!!!!!!} A simple line, wich hasn't any tricks, only two anchors:*2 and *4# *3# *2# This line is the last one in this input# {^The end of the input. This line doesn't belong to input^} The output due to the problem, must be "#", but why can't we skip the empty cycle "Line 2 - Line 3 - Line 2 - ,...,etc." ? In this way the output can be like this one: A simple line, wich hasn't any tricks, only two anchors: and This line is the last one in this input I think that using this remark, problem may become more difficult and more INTERESTING!!! What is Your opinion about all this? I don't know about triks in this problem !!! I solved it by such way: Maked a tree and then starting from leaves calculated the total quantity of letters !!! Then if the quantity in the root more than 1000000 outputes No else writed answer !!!! program Necrologues; const maxn=9; maxrange=1000000; maxlen=1000; var a:array [1..maxn,1..maxn] of boolean; st:array [1..maxn,1..maxlen] of char; l,len,q:array [1..maxn] of longint; visit,forbid:array [1..maxn] of boolean; n,i,j,k,head,tail:longint; ch:char; function num(ch:char):boolean; var k:longint; begin k:=ord(ch); num:=(k>=ord('1')) and (k<=ord('9')); end; function circle(u:longint):boolean; var i,j:longint; begin fillchar(visit,sizeof(visit),0); head:=1; tail:=1; q[1]:=u; visit[u]:=true; while head<=tail do begin i:=q[head]; for j:=1 to n do if not(visit[j]) and a[i,j] then begin visit[j]:=true; inc(tail); q[tail]:=j; end; inc(head); end; for i:=1 to n do if visit[i] and a[i,u] then begin circle:=true; exit; end; circle:=false; end; function getlen(i:longint):longint; var k,j:longint; begin if l[i]<>-1 then begin getlen:=l[i]; exit; end; l[i]:=0; k:=1; while k<=len[i] do if (st[i,k]='*') and (k<len[i]) and num(st[i,k+1]) then begin j:=ord(st[i,k+1])-ord('0'); inc(l[i],getlen(j)); if l[i]>maxrange then l[i]:=maxrange+1; inc(k,2); end else begin inc(l[i]); if l[i]>maxrange then l[i]:=maxrange+1; inc(k); end; getlen:=l[i]; end; procedure print(i:longint); var k,j:longint; begin k:=1; while k<=len[i] do if (st[i,k]='*') and (k<len[i]) and num(st[i,k+1]) then begin j:=ord(st[i,k+1])-ord('0'); print(j); inc(k,2); end else begin write(st[i,k]); inc(k); end; end; begin readln(n); for i:=1 to n do begin len[i]:=0; read(ch); while ch<>'#' do begin inc(len[i]); st[i,len[i]]:=ch; read(ch); end; readln; end; fillchar(a,sizeof(a),0); for i:=1 to n do for k:=1 to len[i] do if (st[i,k]='*') and (k<len[i]) and num(st[i,k+1]) then begin j:=ord(st[i,k+1])-ord('0'); a[i,j]:=true; end; for i:=1 to n do forbid[i]:=circle(i); fillchar(visit,sizeof(visit),0); head:=1; tail:=1; q[1]:=1; visit[1]:=true; while head<=tail do begin i:=q[head]; for j:=1 to n do if not(visit[j]) and a[i,j] then begin visit[j]:=true; inc(tail); q[tail]:=j; end; inc(head); end; for i:=1 to n do if visit[i] and forbid[i] then begin write('#'); exit; end; for i:=1 to n do l[i]:=-1; l[1]:=getlen(1); if l[1]>maxrange then begin write('#'); exit; end; print(1); end. I can give you some hints if you'll help me to solve other problems or discuss them !!! Create a Tree !!! And check it for cycles. Then (start from leaves and end in root)calc count of letters. Sorry for my English !!! 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. > 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 & 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. Try this test: 6 *2*2*2*2*2*2*2*2*2*2# *3*3*3*3*3*3*3*3*3*3# *4*4*4*4*4*4*4*4*4*4# *5*5*5*5*5*5*5*5*5*5# *6*6*6*6*6*6*6*6*6*6# a a a a # I think your answer is wrong! 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; 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; 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]; 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 begin write(a[k][i]); inc(kkk); end; inc(i); end; end; end; procedure outt; begin assign(output,''); rewrite(output); writeAns(1,1); writeln(kkk); close(output); end; begin init; solve; outt; end. > Try this test: > 6 > *2*2*2*2*2*2*2*2*2*2# > *3*3*3*3*3*3*3*3*3*3# > *4*4*4*4*4*4*4*4*4*4# > *5*5*5*5*5*5*5*5*5*5# > *6*6*6*6*6*6*6*6*6*6# > a > a > a > a > # > > I think your answer is wrong! #13#10 is one simbol? What do you mean ??? It's the "return symbol". In C/C++ "return symbol" is '\n', it is just 1 byte. But in Pascal "return symbol" is #13#10, it is 2 byte. My program made the same mistake as your :-) Good Luck! How can i delete this bug ?????? > How can i delete this bug ?????? Your program dont use constant "sum" you subscribe it in procedure calcSum as variable! DFS modification works very good!: b[i] = 0 when this necrologue was not visited. = 1 when necrologue is beeing processed = 2 when necrologue was processed. TextLen[i] = Length of i-th necrologue. Text[i][j] - j-th letter of i-th necrologue. 1. b[i] = 0, TextLen[i] = 0; for all necrologues i. 2. We call DFS_Visit(1); 1. DFS_Visit(v) v - necrologue 2. b[v] = 1 We are processing this necro 3. TextLen[v] = 0 Just in case 4. Sequently for all character s = 1, 2, 3, ... 5. If this is character of necro. increase TextLen[v] by 1 6. If this is link to other necro (say u) then do next 7. If b[u] = 1 then we gone to a loop write answer and exit 8. If b[u] = 2 then we already processed necro u and we know TextLen[u], so we can increase TextLen[v] by TextLen[u]. 9. If b[u] = 0 then we call DFS_Visit(u) and if it returned increase TextLen[v] by TextLen[u]. 10. b[v] = 0; With each increase of TextLen we must check wether it becomes greater than 1 000 000 if so Stop execution. i just do the dfs and then i write the answer with the recursion... but always TLE var n:array[1..9,0..1001]of char; b:array[1..9]of byte; textlen:array[1..9]of longint; wypisane,ile:longint; procedure wczytaj; var i,k:longint; zn:char; zb:text; begin {assign(zb,'1253.in'); reset(zb);} readln({zb,}ile); for i:=1 to ile do begin k:=0; read({zb,}zn); while zn<>'#'do begin inc(k); n[i,k]:=zn; read({zb,}zn) end; inc(k); n[i,k]:='#'; readln{(zb)} end; {close(zb)} end; procedure dzialaj(x:longint); var i,kt:longint; zn:char; begin i:=1; zn:=n[x,i]; while zn<>'#'do begin if zn='*' then begin kt:=ord(n[x,i+1])-48; i:=i+2; dzialaj(kt) end else begin write(zn); inc(i) end; zn:=n[x,i]; end; end; procedure koniec; begin writeln('#'); halt end; procedure dfsvisit(v:byte); var zn:char; i:integer; begin b[v]:=1; i:=1; textlen[v]:=0; zn:=n[v,i]; while zn<>'#'do begin if ((ord(zn)-48)>0)and((ord(zn)-48)<10)and(n[v,i-1]='*')then begin if b[ord(zn)-48]=1 then begin writeln('#'); halt end else if b[ord(zn)-48]=2 then begin textlen[v]:=textlen[v]+textlen[ord(zn)-48]; if textlen[v]>1000000 then koniec end else if b[ord(zn)-48]=0 then begin dfsvisit(ord(zn)-48); textlen[v]:=textlen[v]+textlen[ord(zn)-48]; if textlen[v]>1000000 then koniec end; inc(i) end else if zn='*'then inc(i) else begin inc(textlen[v]); if textlen[v]>1000000 then koniec; inc(i) end; zn:=n[v,i] end; b[v]:=2; end; procedure dfs; begin fillchar(b,sizeof(b),0); fillchar(textlen,sizeof(textlen),0); dfsvisit(1) end; begin wczytaj; dfs; dzialaj(1); end. It's the "return symbol". In C/C++ "return symbol" is '\n', it is just 1 byte. But in Pascal "return symbol" is #13#10, it is 2 byte. My program made the same mistake as your :-) Good Luck! > It's the "return symbol". > In C/C++ "return symbol" is '\n', it is just 1 byte. > But in Pascal "return symbol" is #13#10, it is 2 byte. > > My program made the same mistake as your :-) > Good Luck! Var k,i,j,n:Byte; S:Array[1..10,1..1000] of Byte; SS:Array[1..10] of Integer; M:Array[1..10,1..10] of Boolean; W:Array[1..10] of Boolean; O:Array[1..10] of Byte; Len:Array[1..10] of Extended; ch:Char; fl,fl2:Boolean; Procedure rec(n:Byte); Var i:Byte; begin For i:=1 to SS[n] Do begin If S[n,i]>10 then Write(chr(S[n,i])) else If S[n,i] = 10 then WriteLn else rec(S[n,i]); end; end; begin ReadLn(n); For i:=1 to n Do begin W[i]:=False; Len[i]:=-1; end; For i:=1 to n Do For j:=1 to n Do M[i,j]:=False; i:=1; SS[1]:=0; While i<=n Do begin Read(ch); if ch = #13 then begin Read(ch); inc(SS[i]); S[i,SS[i]]:=10; end else if ch = '*' then begin Repeat Read(ch); Until ch in ['1'..'9']; inc(SS[i]); S[i,SS[i]]:=ord(ch)-ord('0'); M[i,S[i,SS[i]]]:=True; end else if ch = '#' then begin ReadLn; inc(i); SS[i]:=0; end else begin inc(SS[i]); S[i,SS[i]]:=ord(ch); end; end; For i:=1 to n Do begin fl:=False; For j:=1 to n Do begin fl2:=True; For k:=1 to n Do If M[j,k] AND (Len[k] = -1) then begin fl2:=False; break; end; If fl2 then begin fl:=True; Len[j]:=0; For k:=1 to SS[j] Do If S[j,k]>10 then Len[j] := Len[j]+1 else if S[j,k]=10 then Len[j ]:= Len[j]+2 else Len[j] := Len[j] + Len[S[j,k]]; If Len[1] > 0 then begin fl:=False; break; end; end; end; If NOT fl then break; end; If (Len[1] < -0.5)OR(Len[1]>1000000.5) then Write('#') else begin rec(1); end; end. Why do I get Memory Limit Exceeded? Var ch: char; i,n: byte; tot: array [1..10] of word; d: array [1..10,1..1000] of char; Procedure escribe(n: byte); var i: word; begin i:= 1; While (i <= tot[n]) do begin if d[n,i]= '*' then begin Inc(i); escribe (ord(d[n,i])-48) end else write(output,d[n,i]); Inc(i); end; end; Begin readln(input,n); for i:= 1 to n do begin read(input,ch); tot[i]:= 0; while (ch<>'#') do begin Inc(tot[i]); d[i,tot[i]]:= ch; read(input,ch); end; readln(input); end; escribe(1); End. There can be next 2 Some strange text*2# Another text *1# You must check wether output is no longer than 1000000. It could grow so big without loops!!! 10 *2*2*2*2*2*2*2*2*2*2 Tra-la-la# *3*3*3*3*3*3*3*3*3*3 Tra-la-la# ... *9*9*9*9*9*9*9*9*9*9 Tra-la-la# Weird!!!# Replace Tra-la-la with something longer. |
|