I solved this problem, but my program is wrong at 4 test.
Where is mistake?

var
l,k,j,m,n,mistake,o,sum,p,w:integer;  text1:string;
z,text:array[1..100]of string;
begin  o:=1;
repeat
inc(l);
readln(z[l]);
until z[l]='#';
dec(l);
repeat
inc(j);
readln(text[j]);
until text[j]=''; dec(j);
for k:=1 to l do
for m:=1 to j do
 begin
for n:=1 to length(text[m]) do
begin      text1:='';
while text[m][o] in ['a'..'z'] do
begin
text1:=text1+text[m][o]; inc(o);
end;
if length(text1)=length(z[k]) then
 begin
for w:=1 to length(z[k]) do
if text1[w]<>z[k][w] then inc(mistake);
if mistake=1 then
 begin
 inc(sum);
 for p:=1 to length(z[k]) do
  begin
  text[m][o-length(text1)+p-1]:=z[k][p];
  end;
 end;
mistake:=0;
end;  inc(o);
end;
o:=1;
(*----------------------*)
end;
for k:=1 to j do
writeln(text[k]);
writeln(sum);
end.

I have TLE#7
Can U give me some tests or hints about it?
Thanks a lot.

-The basic text can be longer, than 1000. Precisely I do not know how many a maximum, but to me has sufficed масcива in 10000 symbols.

-Also I advise to make more file on dictionary words. Their length should be made more also. I made a file on 200 words of length 20.

-The artful moment of a problem will be, that if the word is in the dictionary it to change it is not NECESSARY

The everything else - a trick.

If the initial code give your e-mail is necessary for someone.





-Основной текст может быть более длинным, чем 1000. Точно не знаю сколько максимум, но мне хватило масcива в 10000 символов.

-Также советую сделать побольше массив на словарные слова. Их длину следует сделать больше также. Я делал массив на 200 слов длины 20.

-Хитрый момент задачи состоит в том, что если слово есть в словаре, то его менять НЕ НАДО

Все остальное - дело техники.
Если кому-то нужен исходный код, то давайте мыло.

This program work! Use:

program Vocabulary_1089;
const
     MaxKolvoSlov=100;
     MaxDlinaSlov=8;
     StopSimvol='#';
type
    int_Kolvo=1..MaxKolvoSlov;
    int_Kolvo_0=0..100;
    int_Dlina=1..MaxDlinaSlov;
    Slovo_type=string[MaxDlinaSlov];
    Vocabulary=array [int_Kolvo] of Slovo_type;
var
   slovar:Vocabulary;
   k:int_Kolvo_0;
   slovo:Slovo_type;
   stroka:string;
   Errors:integer;


procedure Correct;
var
   i:int_kolvo;
   j:int_Dlina;
   b:char;
   p:byte;
   WasError:boolean;
begin
     for i:=1 to k do
         for j:=1 to length(Slovar[i]) do
         begin
              slovo:=slovar[i];
              for b:='a' to 'z' do
              begin
                   slovo[j]:=b;
                   repeat
                       WasError:=false;
                       p:=pos(slovo,stroka);
                       if (p>0)
                       and ((not(stroka[p-1] in ['a'..'z'])) or (p=1))
                       and ((not(stroka[p+length(slovo)] in ['a'..'z']) or (p+length(slovo)=length(stroka))))
                       and (slovo<>slovar[i]) then
                       begin
                            delete(stroka,p,length(slovo));
                            insert(slovar[i],stroka,p);
                            inc(errors);
                            WasError:=true;
                       end;
                   until Not WasError;
              end;
         end;
end;


BEGIN
     k:=0;
     repeat
           readln(slovo);
           if slovo<>StopSimvol then
           begin
                inc(k);
                slovar[k]:=slovo;
           end;
     until slovo=StopSimvol;

     Errors:=0;
     while not eof do
     begin
           readln(stroka);
           if (stroka='') and (eof) then break;
           Correct;
           writeln(stroka);
     end;

     write(Errors);
END.

1.the size of dict may be as large as 1000
2.a word in the dict may be as long as 256
3.a word in the text may be as long as 2048

fraction of my C/C++ code  , text reading part

...
...
char temp[100000];
int tempsize;
int c;
...
...
tempsize=0;
while ((c=fgetc(stdin))!=EOF) {
 temp[tempsize++]=c;
}
tempsize-=2; // cut the empty line at the end of input
...
...

I got WA
but if I change it to

...
...
char temp[100000];
int tempsize;
int c;
...
...
tempsize=0;
// CHANGEs HERE !!!
while (feof(stdin)) {
 temp[tempsize++]=fgetc(stdin);
}
tempsize-=2; // cut the empty line at the end of input
...
...

I got AC.

I don't know why , but I think it might be useful for others.

I always got WA,but I want to check my wrongs by myself

program test;
 var a:array[1..100] of string[10];
     str:string;
     count:longint;
     ch:char;
     errors:longint;
     wordstr:string;
 function like(stra,strb:string):boolean;
  var i:integer;
      h:integer;
   begin
     like:=false;
     if length(stra)=length(strb) then begin
       i:=1; h:=0;
       while (i<=length(stra))and(h<=1) do begin
         if stra[i]<>strb[i] then inc(h);
         inc(i);
       end;
       if h=1 then like:=true;
     end;
   end;

 function check(var str:string):boolean;
  var i:integer;
   begin
    check:=false;
    for i:=1 to count do
      if like(str,a[i]) then begin str:=a[i]; check:=true; break;
end;
     end;


    begin
   count:=0;
   readln(str);
   while str<>'#' do begin
     inc(count);
     a[count]:=str;
     readln(str);
   end;
   wordstr:='';
   errors:=0;
   while not eof do begin
     read(ch);
     if ch in ['a'..'z'] then wordstr:=wordstr+ch
     else begin
              if check(wordstr) then inc(errors);
             write(wordstr);
             wordstr:='';
             write(ch);
         end;
   end;
   writeln(errors);
    end.

#include <stdio.h>
#include <string.h>
#include <ctype.h>
FILE *in,*out;

char words[1000][100];
char data[10000];
char temp[5120];

int match( int k ){
 int d=0;
  int f=0;

   while ( temp[f] ){
    if ( words[k][f]!=temp[f] ) d++;
     if ( d>1 )
      return 0;
       f++;
   }
    return d==1;
}

void main( void ){
//in=fopen( "input.txt", "r" );
in=stdin;
out=stdout;

//char temp[512];
int i,j,k;
i=0;
while ( 1 ){
 fscanf( in, "%s", temp );
  if ( temp[0]=='#' )
   break;
  strcpy( words[i], temp );
  i++;
}

j=0;
fgetc(in);
while ( !feof(in) )
  data[j++]=fgetc(in);
j-=2;
data[j]=0;
///j-=2;

int ncorrect=0;
int p;

for ( k=0; k<j; k++ ){

  while ( ispunct(data[k]) )
   k++;
    p=0;
     while ( k<j && isalpha(data[k]) )
      temp[p++]=data[k++];
     temp[p]=0;
      int c;
 for ( c=0; c<i; c++ )
  if ( strlen(words[c])==p )
   if ( match(c) ){
    memcpy( &data[k-p],words[c],p );
    ncorrect++;
   }
 }

  for ( k=0; k<j; k++ )
   fputc( data[k], out );
 fprintf( out, "\n%d\n", ncorrect );

}

I get AC but not easy and as i understand the main problem for
people with this task is input.

Here is my input code. Hope it'll be usefull
------------
<read vocabulary>

while not eof do
begin
  readln(s);
  if (s = '') and eof then break;

  <process string>
  writeln;
end;

writeln(errorsCnt);
------------

There are some empty lines in the middle of the text, but there is
one empty line in the end. How to secern them?

1.There is one empty line in the end of text. You should not output
this line. But there are maybe some empty lines in the middle of
text, you should output these lines.

2.The lenght of words in the vocabulary may be larger than 8,the total
of words in the vocabulary may be exceed 100.

Program n1089;
  Const
    voc=['a'..'z'];
  Var
    a:array [1..101] of string[10];
    b:array [1..30000] of char;
    c:array [1..30000] of boolean;
    i,j,q,w,m,n,k,count:integer;
    pp:boolean;

Procedure Input;
  Begin
    n:=0;
    While true Do
      Begin
        Inc(n);
        ReadLn(a[n]);
        If a[n]='#' Then
          Begin
            Dec(n);
            Break;
          End;
      End;
    m:=0;
    While true Do
      Begin
        Inc(m);
        Read(b[m]);
        If Ord(b[m])=26 Then
          Break;
      End;
  End;

Procedure Solve;
  Begin
    count:=0;
    Repeat
      pp:=false;
      For i:=1 to m Do
        If (b[i] in voc) and (c[i]=false) Then
          Begin
            pp:=true;
            Break;
          End;
      For j:=(i+1) to m Do
        If Not(b[j] in voc) Then
          Break;
      For q:=1 to n Do
        If Length(a[q])=(j-i) Then
          Begin
            k:=0;
            For w:=1 to Length(a[q]) Do
              If a[q][w]<>b[i+w-1] Then
                Inc(k);
            If k=1 Then
              Begin
                For w:=1 to Length(a[q]) Do
                  If a[q][w]<>b[i+w-1] Then
                    Begin
                      b[i+w-1]:=a[q][w];
                      Break;
                    End;
                Inc(count);
                Break;
              End;
          End;
      For w:=i to (j-1) Do
        c[w]:=true;
    Until Not pp;
  End;

Procedure Output;
  Begin
    For i:=1 to m Do
      Write(b[i]);
    WriteLn;
    Write(count);
  End;

Begin
  Input;
  Solve;
  Output;
End.

const maxn=100;
      maxl=8;
type words=string[maxl];
var vocabulary:array [1..maxn] of words;
    mispell,i,n,l,k,s:byte;
    bf:char;
    now:words;
    mistake:word;
procedure judge;
begin
  if l>0 then
     begin
      now[0]:=char(l);s:=0;
      for i:=1 to n do
       if l=byte(vocabulary[i,0]) then
        begin
         mispell:=0;
         for k:=1 to l do
          if now[k]<>vocabulary[i,k] then
           begin
            inc(mispell);
            if mispell>1 then break;
           end;
         if mispell=0 then begin s:=0;break;end
          else if mispell=1 then s:=i;
        end;
      if s=0 then write(now)
       else
        begin
         write(vocabulary[s]);
         inc(mistake);
        end;
       l:=0;
     end;{if}
end;
begin
 n:=1;
 readln(vocabulary[n]);
 while (vocabulary[n]<>'#') do
  begin
   inc(n);
   readln(vocabulary[n]);
  end;
 dec(n);l:=0;mistake:=0;
 while not eof(input) do
  begin
   read(bf);
   case bf of
    'a'..'z':
    begin
     inc(l);
     now[l]:=bf;
    end
   else
    begin
     judge;
     write(bf);
    end;{else}
   end;{case}
  end;{while}
 judge;
 writeln(mistake);
end.

very simple problem, but I can't get accepted!

for example, what to do with empty lines??
does the first met empty line means the end of input of not?
should I output the last empty line or not?
the sample input does not contain empty lines at all, is it
possible??