Технический форум - Небольшая подсказка

Технический форум (http://www.tehnari.ru/)

- Помощь студентам (http://www.tehnari.ru/f41/)

- - Небольшая подсказка (http://www.tehnari.ru/f41/t263644/)

Да-аа, дорогая Мария-Мэри, ну Вы и обеспечили меня головной болью! Продираюсь потихоньку. Там та-акие подводные камни вылезают (особенно в преобразовании текстового файла в типизированный ЧЕРЕЗ СТРОКИ), что только держись! И не подозревал. Не зря я в практической работе всегда старался держаться от типизированных файлов подальше (не всегда, правда, удавалось), обходясь текстовыми, с которыми всё ясно и понятно.
Надеюсь, что скоро "добью".
Но задачка чертовски интересная. Это не поиск максимального элемента массива и пр., с которыми, в основном, лоботрясы сюда и обращаются.

Уж не знаю, актуально ещё или нет, но я это дело таки добил! Уф, ну задачка...
Значит, так.
Во-первых, никаких строк! Сочетание строк с типизированным файлом это, как оказалось, гремучая смесь: постоянно вылезают заморочки с нумерацией, обработкой служебных символов и т.п. Поэтому работаем с исходным файлом, как он есть, никаких преобразований в формат "строка-слово". Исходный текст должен быть в файле input.txt. Единственное место, где оставлена строка, это считывание пользовательского слова. Всё!
Во-вторых, убраны все экранные выводы. Ни к чему они там.
В-третьих, процедура process построена совершенно иначе по сравнению с предыдущими вариантами. Суть: проходится файл ascii и формируются два массива е1 и е2 порядковых номеров начал (е1) и концов (е2) цепочек символов, подлежащих удалению. Дальше вновь проходится файл ascii и в файл output.txt отправляются только символы, не входящие в указанные цепочки. Таким образом, структура файла сохраняется.

Код:

Uses crt;



Type

 matr = array[1..30] of integer;

 tFile = file of integer;





//Перевожу символы в ascii-коды

//(здесь пользователь вводит слово, которое надо удалить)

procedure input(var a:matr; var L:integer; var T:integer);

var

 i:integer;

 delword:string;

begin

 write(' Enter delword: ');

 readln(delword);

 L:=Length(delword);

 for i:=1 to length(delword) do a[i]:=ord(delword[i]);

 write(' Enter time: ');

 readln(T);

end;



//Перевожу все символы в ascii-коды

//(здесь слова, которые были в файле)

procedure transfer(var f:text; var f3:tFile);

var

 C:Char;

 k:integer;

begin

 Assign(f,'input.txt');

 reset(f);

 Assign(f3, 'ascii');

 rewrite(f3);

 repeat

  Read(f,C);

  k:=Ord(C);

  Write(f3,k);

 until EoF(f);

 Close(f);

 Close(f3);

end;



function Compare(a,b:matr; L:integer):boolean;

var

 i:integer;

 bb:boolean;

begin

 i:=0;

 repeat

  Inc(i);

  bb:=a[i]=b[i];

 until (bb=false) or (i=L);

 Compare:=bb;

end;



//Удачная попытка удалить

procedure process (var f3:tFile; var f2:text; a:matr; L:integer; T:integer);

var

 k,i,j,m,count,n:integer;

 b,e1,e2:matr;

begin

 count :=0;

 Assign(f3,'ascii');

 reset(f3);

 Assign(f2, 'output.txt');

 rewrite(f2);

 n:=0;

 j:=0;

 for i:=1 to L do

  begin

   read(f3,k);

   b[i]:=k;

   Inc(j);

  end;

 if Compare(a,b,L) then Inc(count);

 if (count mod T)=0 then

  begin

   Inc(n);

   e1[1]:=1;

   e2[1]:=L;

  end;

 Repeat

  if Not(EoF(f3)) then

   begin

    Inc(j);

    for i:=2 to L do b[i-1]:=b[i];

    read(f3,k);

    b[L]:=k;

    if Compare(a,b,L) then Inc(count);

    if Compare(a,b,L) and ((count mod T)=0) then

     begin

      Inc(n);

      e1[n]:=j-(L-1);

      e2[n]:=j;

     end;

   end;

 Until EoF(f3);



 Reset(f3);

 if e1[1]>1 then

  for i:=1 to e1[1]-1 do

   begin

    Read(f3,k);

    Write(f2,Chr(k));

   end;

 for m:=1 to n do

  begin

   for i:=e1[m] to e2[m] do Read(f3,k);

   if m<n then

    for i:=e2[m]+1 to e1[m+1]-1 do

     begin

      Read(f3,k);

      Write(f2,Chr(k));

     end;

  end;

  While Not(EoF(f3)) do

   begin

    Read(f3,k);

    Write(f2, Chr(k));

   end;

 Close(f3);

 Close(f2)

end;



var

  f0,f,f2: text;

  f3:tFile;

  delword: string;

  a:matr;

  time,L:integer;

Begin

 clrscr;

 input(a, L, time);

 transfer(f, f3);

 process(f3, f2, a, L, time);

End.

Вложение 436590
Вложение 436591
Вложение 436592

Vladimir_S, Вау, Вы смогли ее добить!:lupoglaz: Оказывается надо просто работать с исходным файлом, а я Вам какие-то преобразования "строка-слово"навязалаtehno003 Спасибо Вам огромное-преогромное!tehno003

Цитата:

Сообщение от Maria_Meri (Сообщение 2641285)

Спасибо Вам огромное-преогромное!

Да пожалуйста, обращайтесь, если что. А с этой задачкой — самого зацепило и не отпускало, пока не добил. :D

Дополнительные вопросы

Vladimir_S, здравствуйте. У меня несколько вопросов к реализуемой Вами программе.
Мой первый вопрос: При большом объеме текста, программа выдает ошибку о нехвате памяти, поэтому я попробовала реализовать через динамические переменные, а именно FreeMem, GetMem. Но как-то получается, что сначала я ищу количество совпадений, выделяю память, а потом только по массиву делею перепись. Хотела бы узнать, как реализовать более эффективно.
Мой второй вопрос: допустим у нас предложение: "it is his brother". Так как программа реализует проверку по посимвольному сдвигу, то после удаления слова "is", у нас останется "it h brother". Так и нужно? Ведь слова "his" и "is" это разные слова.
Спасибо Вам за ответы.

Код:

Uses crt;



type

  mas_int=^TTmas;

  TTmas=array[1..1] of integer;

  tFile = file of integer;

{$R-}

procedure show(var f: text);

var

  s: string;

begin

  Assign(f, 'input.txt');

  reset(f);

  while not eof(f) do

  begin

    readln(f, s);

    writeln(s);

  end;

  Close(f);

end;



procedure input(var a: mas_int; var L: integer; var T: integer);

var

  i: integer;

  delword: string;

begin

  write(' Enter delword: ');

  readln(delword);

  L := Length(delword);

  getmem (a, sizeof(mas_int)*L);

  for i := 1 to L do a^[i] := ord(delword[i]);

  write(' Enter time: ');

  readln(T);

end;





procedure transfer(var f: text; var f3: tFile);

var

  C: Char;

  k: integer;

begin

  Assign(f, 'input.txt');

  reset(f);

  Assign(f3, 'ascii');

  rewrite(f3);

  repeat

    Read(f, C);

    k := Ord(C);

    Write(f3, k);

  until EoF(f);

  Close(f);

  Close(f3);

end;



function Compare(a, b: mas_int; L: integer): boolean; {$F+}

var

  i: integer;

  bb: boolean;

begin

  i := 0;

  repeat

    Inc(i);

    bb := a^[i] = b^[i];

  until (bb = false) or (i = L);

  Compare := bb;

end;





procedure process(var f3: tFile; var f2: text; a: mas_int; L: integer; T: integer);

var

  k, i, j, m, count, n,p: integer;

  b, e1, e2: mas_int;

begin

  count := 0;

  Assign(f3, 'ascii');

  reset(f3);

  Assign(f2, 'output.txt');

  rewrite(f2);

  n := 0;

  j := 0;

  getmem (b, sizeof(integer)*L);

  for i := 1 to L do

  begin

    read(f3, k);

    b^[i] := k;

    Inc(j);

  end;



  if Compare(a, b, L) then Inc(count);

  if (count mod T) = 0 then

  begin

    Inc(n);

  end;



  repeat

    if not (EoF(f3)) then

    begin

      Inc(j);

      for i := 2 to L do b^[i - 1] := b^[i];

      read(f3, k);

      b^[L] := k;

      if Compare(a, b, L) then Inc(count);

      if Compare(a, b, L) and ((count mod T) = 0) then

      begin

        Inc(n);

      end;

    end;

  until EoF(f3);

  close(f3);

  getmem (e1, sizeof(integer)*n);

  getmem (e2, sizeof(integer)*n);



  reset(f3);

  j:=0;

  n:=0;

  count:=0;

  if Compare(a, b, L) then Inc(count);

  if (count mod T) = 0 then

  begin

    inc(n);

    e1^[1] := 1;

    e2^[1] := L;

  end;



  repeat

    if not (EoF(f3)) then

    begin

      Inc(j);

      for i := 2 to L do b^[i - 1] := b^[i];

      read(f3, k);

      b^[L] := k;

      if Compare(a, b, L) then Inc(count);

      if Compare(a, b, L) and ((count mod T) = 0) then

      begin

        inc(n);

        e1^[n] := j - (L - 1);

        e2^[n] := j;

      end;

    end;

  until EoF(f3);

  close(f3);



  Reset(f3);

  if e1^[1] > 1 then

    for i := 1 to e1^[1] - 1 do

    begin

      Read(f3, k);

      Write(f2, Chr(k));

    end;

  for m := 1 to n do

  begin

    for i := e1^[m] to e2^[m] do Read(f3, k);

    if m < n then

      for i := e2^[m] + 1 to e1^[m + 1] - 1 do

      begin

        Read(f3, k);

        Write(f2, Chr(k));

      end;

  end;

  while not (EoF(f3)) do

  begin

    Read(f3, k);

    Write(f2, Chr(k));

  end;

  Close(f3);

  Close(f2)

end;



var

  f0, f, f2: text;

  f3: tFile;

  delword: string;

  a: mas_int;

  time, L: integer;



begin

  clrscr;

  show(f);

  input(a, L, time);

  transfer(f, f3);

  process(f3, f2, a, L, time);

end.

Цитата: