Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 31.03.2019, 19:38   #1 (permalink)
Maria_Meri
Новичок
 
Регистрация: 31.03.2019
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию Небольшая подсказка

Подскажите, как сделать программу для удаления из текста каждое N-ое вхождение в него заданного слова.
При этом:
Данные записываются в файл прямого доступа (если входные данные символы, то сначала нужно перевести их в коды, а потом записать в файл);
обработать данные (использовать прямой доступ к компонентам файла) и записать результат в текстовый файл.
После обработки файла создать его копию путем записи его содержимого в другой файл с использованием механизма «бестиповых файлов».

НЕ ОБРАЩАЙТЕ ВНИМАНИЕ ПРО PHP, просто так код более читабельный
PHP код:
Uses crt;
type
matr 
= array[1..5]of integer;
tFile file of integer;

//Вывожу на экран, что есть в файле
procedure show(var f:text);
var 
s:string;
begin
  Assign
(f'input.txt');
  
reset(f);
  while 
not eof(f) do
  
begin
    readln
(fs);
    
writeln(s);
  
end;
  
Close(f);
  
end;

//Перевожу символы в ascii-коды
(здесь пользователь вводит словокоторое надо удалить)
procedure input(var a:matr; var delword:string);
var 
i:integer;
   
begin
  readln
(delword);
  for 
i:=1 to length(delword) do
   
begin
   a
[i]:=ord(delword[i]);
   
end;
   
end;

//Перевожу все символы в ascii-коды
(здесь словакоторые были в файле)
procedure transfer(var f:text; var f3:tFile);
var 
s:stringi,k:integer;
begin
  reset
(f);
  
assign(f3'ascii');
  
rewrite(f3);
  while 
not eof(f) do
   
begin
   readln
(f,s);
   for 
i:=1 to length(s) do
    
begin
     k
:=ord(s[i]);
     
write(f3,k);
    
end;
    
write(f3,10);
   
end;
   
close(f3);
end;  

//Неудачная попытка удалить   
procedure process (var f3:tFile; var f2:text;a:matr;delword:string);
var 
k,i,ptimecount:integerflag:boolean;
begin
flag
:=false;
readln(time);
count :=0;
 
reset(f3);
   
Assign(f2'output.txt');
   
rewrite(f2);
  while 
not eof(f3) do
  
begin
    read
(f3k);
    for 
i:= 1 to length(delword) do
     
begin
      
if a[i] = k then
      begin
      inc
(count);
      if 
count mod time 0 then 
      k
:=32;
      
end
      
else
      if 
10 then writeln(f2'');
      if 
<> 10 then
      write
(f2,chr(k));
      
write(chr(k));

      
end;
    
end;
  
close(f2);
  
close(f3);
 
end;
 
 
var
  
ff2text;
  
f3:tFile;
  
delwordstring;
  
a:matrtime:integer;
begin
clrscr
;
show(f);
input(adelword);
transfer(ff3);
process(f3f2adelword);
end
У меня каждый символ в слове, котором пользователь ввел сравнивается с каждым символом слова, которые есть в файле. Поэтому вывод неправильный. Получается один и тот же символ выводится несколько раз.

Подскажите, как можно это реализовать(алгоритм) сравнение для удаления.
Спасибо.
Maria_Meri вне форума   Ответить с цитированием

Старый 31.03.2019, 19:38
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Обязательно обратите внимание на аналогичные топики

Групповая политика, нужена подсказка
ТП-60-10 нужна подсказка
Нужна подсказка
нужна подсказка знающих
Нужна подсказка по светодиодам

Старый 31.03.2019, 19:49   #2 (permalink)
Maria_Meri
Новичок
 
Регистрация: 31.03.2019
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Язык - Turbo Pascal 7.0
Maria_Meri вне форума   Ответить с цитированием
Старый 01.04.2019, 11:26   #3 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,304
Сказал(а) спасибо: 287
Поблагодарили 506 раз(а) в 164 сообщениях
Репутация: 91675
По умолчанию

Да... хороша себе "небольшая подсказка"!
Исправил кучу ошибок, причесал, отладил, протестировал. Работает.
Код:
Uses crt;
Type
 matr = array[1..5] of integer;
 tFile = file of integer;

//Вывожу на экран, что есть в файле
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;

//Перевожу символы в ascii-коды
//(здесь пользователь вводит слово, которое надо удалить)
procedure input(var a:matr; var delword:string; var L:integer);
var i:integer;
begin
 writeln('Enter delword:');
 readln(delword);
 L:=Length(delword);
 for i:=1 to length(delword) do a[i]:=ord(delword[i]);
end;

//Перевожу все символы в ascii-коды
//(здесь слова, которые были в файле)
procedure transfer(var f:text; var f3:tFile);
var s:string; i,k:integer;
begin
 reset(f);
 assign(f3, 'ascii');
 rewrite(f3);
 while not eof(f) do
  begin
   readln(f,s);
   for i:=1 to length(s) do
    begin
     k:=ord(s[i]);
     write(f3,k);
    end;
   k:=10;
   write(f3,k);
  end;
 close(f);
 close(f3);
end;

//Удачная попытка удалить
procedure process (var f3:tFile; var f2:text; a:matr; L:integer);
var
 k,i,p,time,count:integer;
 flag,flag1,flag2:boolean;
 b:array[1..30] of integer;
begin
 writeln('Enter time:');
 readln(time);
 count :=0;
 reset(f3);
 Assign(f2, 'output.txt');
 rewrite(f2);
 while not eof(f3) do
  begin
   p:=0;
   repeat
    inc(p);
    read(f3, k);
    b[p]:=k;
   until (k=10) or eof(f3);
   if k=10 then dec(p);
   if p=L then
    begin
     i:=0;
     flag2:=true;
     repeat
      inc(i);
      flag1:=b[i]=a[i];
     until (flag1=false) or (i=L);
     if flag1 then
      begin
       inc(count);
       if count mod time = 0 then flag2:=false;
      end;
     flag:=flag2;
    end else flag:=true;
   if flag then
    begin
     for i:=1 to p do write(f2,chr(b[i]));
     writeln(f2);
     for i:=1 to p do write(chr(b[i]));
     writeln;
    end;
  end;
 Readln;
 close(f2);
 close(f3);
end;


var
  f,f2: text;
  f3:tFile;
  delword: string;
  a:matr;
  time,L:integer;
begin
 clrscr;
 show(f);
 input(a, delword,L);
 transfer(f, f3);
 process(f3, f2, a, L);
end.
Замечу, например, что если велено работать с кодами, то в процедуре Process строковой переменной Delword делать нечего: пользовательское слово мы в процедуре Input перевели в кодовый массив, вот с ним и надлежит работать. Ну и ещё много чего по мелочи.
И ещё парочка пожеланий (необязательных).
1. При использовании форматирования листинга очень желательно, чтобы горизонтальные отступы сопряженных begin и end были строго одинаковыми (как у меня). Это позволяет сразу увидеть вложенность операторов.
2. Использование одинаковых идентификаторов в качестве параметров подпрограмм и глобальных переменных хоть и не запрещено, но крайне нежелательно, поскольку снижает читабельность. Я уж исправлять не стал, но если будете ещё программировать, учтите этот момент.

P.S. И ещё. В своей программе Вы (и я вслед за Вами) исходите из того, что в исходном файле каждое слово расположено в своей отдельной строке. Это так в задании оговорено или Вы "упростили"? Потому что если это не так, то требуется довольно муторная процедура выделения отдельных слов.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 03.04.2019, 20:30   #4 (permalink)
Maria_Meri
Новичок
 
Регистрация: 31.03.2019
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Vladimir_S, я для тестирования сама себе такое "упрощение" сделала. И как я поняла, в моем способе(который Вы реализовали) есть недостаток, что при time = 1, удаляется все потому что любое число делится на 1 без остатка.
Спасибо Вам за помощь и советы. Постараюсь попробовать реализовать процедуру выделения отдельных слов.
Maria_Meri вне форума   Ответить с цитированием
Старый 03.04.2019, 20:35   #5 (permalink)
Maria_Meri
Новичок
 
Регистрация: 31.03.2019
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Например,
Код:
one
two
one
three
one
four
Введем слово: one
Time = 1
Выведется:
Код:
two
three
four
Maria_Meri вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Старый 04.04.2019, 09:43   #6 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,304
Сказал(а) спасибо: 287
Поблагодарили 506 раз(а) в 164 сообщениях
Репутация: 91675
По умолчанию

Цитата:
Сообщение от Maria_Meri Посмотреть сообщение
есть недостаток, что при time = 1, удаляется все потому что любое число делится на 1 без остатка
Какой же это недостаток? Наоборот, полностью соответствует условию задачи. "Убрать каждое первое" и значит убрать все. Всё правильно.
Цитата:
Сообщение от Maria_Meri Посмотреть сообщение
Постараюсь попробовать реализовать процедуру выделения отдельных слов.
Успехов! Подскажу: пожалуй, проще всего организовать другой входной файл и в него перекатать содержимое исходного по следующему алгоритму:
1. Читаем символы исходного файла, пока не наткнемся на символ, отличный от пробела.
2. Копируем символы в новый файл до того, как появится очередной пробел или EoF.
3. Если "не EoF", то переводим строку в новом файле.
4. Возвращаемся к п.1.
Далее работаем с новым файлом по существующей программе.
Я бы так действовал.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 05.04.2019, 10:31   #7 (permalink)
Maria_Meri
Новичок
 
Регистрация: 31.03.2019
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

подскажите, что я сделала не так? Или я не так поняла Вашу мысль? Потому что я создала еще file of integer и начала к нему перекатывать символы.
Код:
Uses crt;

type
  matr = array[1..5] of integer;
  tFile = file of integer;

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: matr; var delword: string; var L: integer);
var
  i: integer;
begin
  writeln('Enter delword:');
  readln(delword);
  L := Length(delword);
  for i := 1 to length(delword) do a[i] := ord(delword[i]);
end;

procedure transfer(var f: text; var f3: tFile);
var
  s: string; i, k: integer;
begin
  reset(f);
  assign(f3, 'ascii');
  rewrite(f3);
  while not eof(f) do
  begin
    readln(f, s);
    for i := 1 to length(s) do
    begin
      k := ord(s[i]);
      write(f3, k);
    end;
  end;
  close(f);
  close(f3);
end;

//подскажите, где я не так поняла Вашу мысль
procedure preprocess(var f3: tFile; var f4: tFile);
var
  k: integer;
begin
  reset(f3);
  assign(f4, 'preoutput');
  rewrite(f4);
  while not eof(f3) do 
  begin
    repeat
      read(f3, k);
      write(f4, k);
    until (k = 32) or eof(f3);
    if not eof(f3) then writeln(f3);
  end;
  close(f3);
  close(f4);
end;

procedure process(var f4: tFile; var f2: text; a: matr; L: integer);
var
  k, i, p, time, count: integer;
  flag, flag1, flag2: boolean;
  b: array[1..30] of integer;
begin
  writeln('Enter time:');
  readln(time);
  count := 0;
  reset(f4);
  Assign(f2, 'output.txt');
  rewrite(f2);
  while not eof(f4) do
  begin
    p := 0;
    repeat
      inc(p);
      read(f4, k);
      b[p] := k;
    until (k = 10) or eof(f4);
    if k = 10 then dec(p);
    if p = L then
    begin
      i := 0;
      flag2 := true;
      repeat
        inc(i);
        flag1 := b[i] = a[i];
      until (flag1 = false) or (i = L);
      if flag1 then
      begin
        inc(count);
        if count mod time = 0 then flag2 := false;
      end;
      flag := flag2;
    end else flag := true;
    if flag then
    begin
      for i := 1 to p do write(f2, chr(b[i]));
      writeln(f2);
      for i := 1 to p do write(chr(b[i]));
      writeln;
    end;
  end;
  Readln;
  close(f2);
  close(f4);
end;


var
  f, f2: text;
  f3, f4: tFile;
  delword: string;
  a: matr;
  time, L: integer;

begin
  clrscr;
  show(f);
  input(a, delword, L);
  transfer(f, f3);
  preprocess(f3, f4);
  process(f4, f2, a, L);
end.
Для пример я взяла такой файл. Я добавила знаки препинания, но думаю, что если вводимое слово не будет стоять рядом с (, . ? !), то все будет нормально
Код:
one five, six, please! 
two seven? No, it can do it.
one eight! Thank you very much.
three read.
one
four
Maria_Meri вне форума   Ответить с цитированием
Старый 05.04.2019, 10:47   #8 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,304
Сказал(а) спасибо: 287
Поблагодарили 506 раз(а) в 164 сообщениях
Репутация: 91675
По умолчанию

Цитата:
Сообщение от Maria_Meri Посмотреть сообщение
подскажите, что я сделала не так? Или я не так поняла Вашу мысль? Потому что я создала еще file of integer и начала к нему перекатывать символы.
Нет-нет, я имел в виду совсем другое: вспомогательный ТЕКСТОВЫЙ файл, в котором слова из исходного расположатся каждое в своей строке.
Цитата:
Сообщение от Maria_Meri Посмотреть сообщение
Я добавила знаки препинания
О, Боже!.. Вот это поворот... Ладно, поразмыслим.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 05.04.2019, 14:27   #9 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,304
Сказал(а) спасибо: 287
Поблагодарили 506 раз(а) в 164 сообщениях
Репутация: 91675
По умолчанию

Так, ну, вроде, что-то такое слепилось и даже работает. Совсем голову сломал с этими символами 10 и 13 (не спрашивайте, что такое 13: боролся с ним эмпирически). Отличия от предыдущего варианта:
1. Исходный текст нужно поместить в файл preinput.txt. Файл input.txt, в котором каждое слово (со знаком препинания, если есть) занимает свою строку, сгенерит сама программа.
2. Понимает знаки препинания. Если после искомого пользовательского слова стоит, например, запятая, то она учитываться не будет.

Теперь так. В выводном файле каждое слово занимает свою строку. Не, ну можно, конечно, запомнить структуру исходного файла а потом выходной файл отформатировать в соответствии с этой структурой, но мне кажется, это уже будет перебор.
Код:
Uses crt;
Const
 CC:Set of Char=['!',',','.','?',':',';'];

Type
 matr = array[1..30] of integer;
 tFile = file of integer;

Procedure Inp_file(var g1:Text;var g2:Text);
var C:Char;
begin
 Assign(g1,'preinput.txt');
 Reset(g1);
 Assign(g2,'input.txt');
 Rewrite(g2);
 Repeat
  repeat
   Read(g1,C);
  until C<>' ';
  if (Ord(C)<>10) and (Ord(C)<>13) then Write(g2,C);
  repeat
   Read(g1,C);
   if (C<>' ') and (Ord(C)<>10) and (Ord(C)<>13) then Write(g2,C);
  until (C=' ') or (EoLn(g1));
  Writeln(g2);
 Until EoF(g1);
 Close(g1);
 Close(g2);
end;
//Вывожу на экран, что есть в файле
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;

//Перевожу символы в ascii-коды
//(здесь пользователь вводит слово, которое надо удалить)
procedure input(var a:matr; var delword:string; var L:integer);
var i:integer;
begin
 writeln('Enter delword:');
 readln(delword);
 L:=Length(delword);
 for i:=1 to length(delword) do a[i]:=ord(delword[i]);
end;

//Перевожу все символы в ascii-коды
//(здесь слова, которые были в файле)
procedure transfer(var f:text; var f3:tFile);
var s:string; i,k:integer;
begin
 reset(f);
 assign(f3, 'ascii');
 rewrite(f3);
 while not eof(f) do
  begin
   readln(f,s);
   for i:=1 to length(s) do
    begin
     k:=ord(s[i]);
     write(f3,k);
    end;
   k:=10;
   write(f3,k);
  end;
 close(f);
 close(f3);
end;

//Удачная попытка удалить
procedure process (var f3:tFile; var f2:text; a:matr; L:integer);
var
 k,i,p,p1,time,count:integer;
 flag,flag1,flag2:boolean;
 b:matr;
begin
 writeln('Enter time:');
 readln(time);
 count :=0;
 reset(f3);
 Assign(f2, 'output.txt');
 rewrite(f2);
 while not eof(f3) do
  begin
   p:=0;
   repeat
    inc(p);
    read(f3, k);
    b[p]:=k;
   until (k=10) or EoF(f3);
   repeat
    if (b[p]=10) or (b[p]=13) then dec(p);
   until (b[p]<>10) and (b[p]<>13);
   if Chr(b[p]) in CC then p1:=p-1 else p1:=p;
   if p1=L then
    begin
     i:=0;
     flag2:=true;
     repeat
      inc(i);
      flag1:=b[i]=a[i];
     until (flag1=false) or (i=L);
     if flag1 then
      begin
       inc(count);
       if count mod time = 0 then flag2:=false;
      end;
     flag:=flag2;
    end else flag:=true;
   if (flag=false) and (Chr(b[p]) in CC) then
    begin
     Writeln(f2,Chr(b[p]));
     Writeln(Chr(b[p]));
    end;
   if flag then
    begin
     for i:=1 to p do
      if (b[i]<>10) and (b[i]<>13) then write(f2,chr(b[i]));
     writeln(f2);
     for i:=1 to p do
      if (b[i]<>10) and (b[i]<>13) then write(chr(b[i]));
     writeln;
    end;
  end;
 Readln;
 close(f2);
 close(f3);
end;


var
  f0,f,f2: text;
  f3:tFile;
  delword: string;
  a:matr;
  time,L:integer;
begin
 clrscr;
 Inp_file(f0,f);
 show(f);
 input(a, delword,L);
 transfer(f, f3);
 process(f3, f2, a, L);
end.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 06.04.2019, 00:47   #10 (permalink)
Maria_Meri
Новичок
 
Регистрация: 31.03.2019
Сообщений: 7
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

Vladimir_S, Ааааа, вот что вы имели ввиду. Но я всё-таки думаю, что нужно отформатировать. Так как в задание написано удалить текст, я вывела на экран файл "preinpur.txt". На выводе я бы вывела в таком же формате, только без удаленных слов. Было бы странно, если вместо текста пользователь получает строки с одним словом.
Попробую отформатировать(додуматься бы только, ведь наша программасчитывает по одному слову, игнорируя строки). Можно ли просто в конце каждого предложения поставить
Код:
   
   k:=10;
   write(f3,k);
как мы уже делали, считывать слово (словом будет являться все символы до пробела, до встречи с 32). Сравниваем по длине и буквам. А после 10 переходить на новую строку?
Спасибо Вам огромное!
Maria_Meri вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 23:37.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.