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#

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

3
a*2#
*3#
*2#

I have OLE #9 many times. Can anybody check my code?

INPUT:
2
*22#
q#

OUTPUT:
q2

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?

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?

OLE#9
What's wrong?

Thanks.

Crash{Stack} or MLE!
How to pass it?

Thanks.

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?

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.

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..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.

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.