Удалить слово, Из текстового файла |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Удалить слово, Из текстового файла |
Wait |
27.02.2005 17:43
Сообщение
#1
|
Гость |
дан текстовый файл... Пользователь вводит слово. Если оно есть в файле, то прога удаляет его. Напишите, плиз, основную процедуру удаления. А то, что только не делал, и слова отделял, и сравнивал - не пашет...
Код program ex1; uses crt; procedure deleting(infile,outfile, word:string); var f_,v:text; st,wt:string; chars:set of char;i:byte; begin chars:=['a'..'z']; assign(f_,infile); reset(f_); assign(v,outfile); rewrite(v); while not eof(f_) do begin readln(f_,st); i:=1; repeat while not (st[i] in chars) and (i<=length(st)) do inc(i); wt:=''; while (st[i] in chars) and (i<=length(st)) do begin wt:=wt+st[i]; inc(i); end; if length(wt)<>0 then writeln(v,wt); until (i>length(st)) end; close(f_); close(v); reset(v); while not eof(v) do begin readln(v,st); if st=word then delete(st,1,length(word)); end; close(v); reset(v); end; var word1,st1,filename:string; f:text; begin write('word: '); readln(word1); writeln('from <f>ile?'); if (readkey='f') then begin write('filename: '); readln(filename) end else begin assign(f,'d:\bin\b.dat'); rewrite(f); writeln('input text'); repeat readln(st1); if st1<>'' then writeln(f,st1); until st1=''; close(f); filename:='d:\bin\b.dat'; end; deleting(filename,'d:\bin\res.dat',word1); assign(f,'d:\bin\res.dat'); reset(f); while not eof(f) do begin readln(f,st1); writeln(st1); end; end. Код ставим в теги... |
volvo |
27.02.2005 18:08
Сообщение
#2
|
Гость |
Wait
А зачем такие сложности? Все, по-моему, гораздо проще. Пишем функцию: Код function del_word(myword, str: string): string; begin p := pos(myword, str); if p <> 0 then delete(str, p, length(myword)); del_word := str; end; И теперь в основной программе читаем из исходного файла строку за строкой, но в результирующий файл пишем строку, на которой отработала вышеописанная функция: Код var f_in, f_out: text; ... while not eof(f_in) do begin readln(f_in, s); writeln(f_out, del_word(word_to_delete, s)); end; здесь word_to_delete - то слово, которое нужно удалить... |
W |
1.03.2005 21:21
Сообщение
#3
|
Гость |
Большое спасибо, но програма удаляет не только слова, а, например, если надо удалить "ттт", то в строке "рррттт" она удаляет "ттт", хотя это не является словом. ПОМОГИТЕ!!!!!!!!! Нужно еще, наверно, провеить на наличие пробелов или знаков до и после слова. Как это сделать? Очень прошу, помогите. Заранее благодарен
|
volvo |
1.03.2005 21:57
Сообщение
#4
|
Гость |
Ну тогда вот так (приведенная здесь функция isLetter проверяет, является ли символ латинской буквой; для работы с кириллицей нужно немного изменить функцию, поищите по форуму, она выкладывалась...):
Код function isLetter(ch: char): boolean; begin isLetter := upcase(ch) in ['A' .. 'Z'] end; (* Теперь функция del_word удаляет только те последовательности, справа и слева от которых стоят символы, не являющиеся буквами *) function del_word(myword, str: string): string; var p: byte; begin p := pos(myword, str); if p <> 0 then if ( (p > 1) and (not isLetter(str[pred(p)])) ) and ( (p + length(myword) < length(str)) and (not isLetter( str[ succ(p + length(myword)) ] )) ) then delete(str, p, length(myword)); del_word := str; end; |
Wait |
2.03.2005 13:35
Сообщение
#5
|
Гость |
Очень извиняюсь, но теперь она не удаляет просто слова, не входящего ни в какие слова, а то, что я просил, она выполняет. Здесь что-то не так, наверно, проверьте, пожалуйста еще раз, если не трудно.Вообще, моя задача звучит так: написать программу, которая содержит процедуру, которая удаляет слово в файле. Возможно, что-то в проге не так, но я все проверил.
Код undefinedprogram ex1; uses crt; procedure del(infile,outfile,w:string); var f_in,f_out,f_:text;word,s,wt:string;chars:set of char; i:byte; function letter(ch:char):boolean; begin letter:=ch in ['a'..'z'] end; function del_word(str,myword:string):string; var p:byte; begin p:=pos(myword,str); if p<>0 then if ((p>1)and(not letter(str[pred(p)]))) and((p+length(myword)<length(str))and(not letter(str[succ(p+length(myword))]))) then delete(str,p,length(myword)); del_word:=str; end; begin chars:=['a'..'z']; assign(f_in,'b.dat'); reset(f_in); assign(f_out,'res.dat'); rewrite(f_out); assign(f_,'res1.dat'); rewrite(f_); while not eof(f_in) do begin readln(f_in,s); i:=1; repeat while not(s[i] in chars) and (i<=length(s)) do inc(i); wt:=''; while (s[i] in chars) and (i<=length(s)) do begin wt:=wt+s[i]; inc(i); end; if length(wt)<>0 then writeln(f_out,wt); until(i>length(s)) end; close(f_in); close(f_out); reset(f_out); while not eof(f_out) do begin readln(f_out,s); writeln(f_,del_word(s,w)); end; close(f_); close(f_out); end; var f:text; word1,s1:string; begin writeln('vvedite slovo'); readln(word1); assign(f,'b.dat'); rewrite(f); writeln('input text'); repeat readln(s1); if s1<>'' then writeln(f,s1); until s1=''; close(f); writeln('---------------'); del('res.dat','res1.dat',word1); assign(f,'res1.dat'); reset(f); while not eof(f) do begin readln(f,s1); writeln(s1); end; readkey end. |
volvo |
2.03.2005 13:48
Сообщение
#6
|
Гость |
Цитата(volvo @ 1.03.05 20:57) (приведенная здесь функция isLetter проверяет, является ли символ латинской буквой; для работы с кириллицей нужно немного изменить функцию, поищите по форуму, она выкладывалась...) У Вас же наверняка работа с кириллицей !!! Внимательнее читайте ответы. Моя функция удаляет из строк отдельно стоящие слова (не являющиеся частью других слов)... Замените функцию Letter и она будет работать с кириллицей тоже. |
Guest |
2.03.2005 13:59
Сообщение
#7
|
Гость |
я прочитал ваш ответ, что-то заменил,но не понимаю, как ее правильно заменить. Если вам не трудно, пожалуйста, напишите, как должна выглядеть моя функция, а то уже не понимаю :molitva: :molitva: :molitva:
Добавлено (2.03.05, 01:14 PM): я с латинскими буквами работаю |
volvo |
2.03.2005 16:23
Сообщение
#8
|
Гость |
Да, я понял в чем проблема... Раньше просто не обратил на это внимание... Вот эта процедура del_word должна сработать (вставьте ее в свою программу). Кстети, можете погонять всю мою программу, изменяя входную строку, может быть еще какие-то комбинации не отрабатывают :
Код function isLetter(ch: char): boolean; begin isLetter := upcase(ch) in ['A' .. 'Z', '0' .. '9'] end; function del_word(myword, str: string): string; var p, last: byte; to_delete: boolean; first, start: integer; function FirstLetter: boolean; begin FirstLetter := (first > 0) and (isLetter(str[first])) end; function LastLetter: boolean; begin LastLetter := (last < length(str) + 1) and (isLetter(str[last])) end; begin start := 1; Repeat p := Pos(myWord, Copy(str, start, 255)); Inc(p, Byte(p > 0) * Pred(start)); Last := p + length(myword); First := Pred(p); If p > 0 Then Begin to_delete := true; if ( (first = 0) and LastLetter ) or ( (last = length(str) + 1) and FirstLetter ) or ( FirstLetter or LastLetter ) then to_delete := false; if to_delete then delete(str, p, length(myword)) else start := last end; until p = 0; del_word := str; end; begin writeln( del_word('start', 'starts11 jj stop, start begin start starts 22begin ') ) end. |
Wait |
2.03.2005 18:18
Сообщение
#9
|
Гость |
Гигантское спасибо!!!!!!!!!!!!!!!!!!!!!!!!!!
Только объясните, пожалуйста, если я вам еще не надоел, что означает byte(p>0)??? очень интересно... да и надо мне знать, что ответить, если спросят на защите :flowers: :rose: :thanks: :thanks: :thanks: ............... а вообще, моей благодарности нет пределов |
volvo |
2.03.2005 18:21
Сообщение
#10
|
Гость |
Код Inc(p, Byte(p > 0) * Pred(start)); можно заменить на вот это: Код If p > 0 Then Inc(p, Pred(start)); |
Guest |
2.03.2005 20:36
Сообщение
#11
|
Гость |
thanks
в подарок могу написать стих Ничего из прошлого Как трудно ничего из прошлого Не вспоминать, не выносить, Забыть все недостойное и ложное Как только сложно все забыть! Как трудно лгать тебе, что так мне хорошо, Как падший ангел, верить и лететь, Искать тот свет, что называется душой, Средь боли, в темноте, в безмерной пустоте. Ты меня сделал бессильной и слабой – Я так не привыкла тебя не любить, Может мне вспомнить все прошлое, дабы Легче стало обо всем забыть… Не чувствую, не вижу твоего лица, (не любим мы, но нелюбовь свою таим) Как жаль, я даже не могу начать с конца. Как я бессильна перед холодом твоим! Теперь я могу только дальше идти, Так и не вспомнив ничего и не забыв, Вперед время идет – назад нету пути, Осталась только боль – души разрыв. …Но я смогу взлететь, подняться ввысь. И меня к жизни вернет сама жизнь… |
Текстовая версия | 28.04.2024 8:34 |