Дана строка, содержащая текст на русском языке. В предложениях некоторые из слов записаны подряд несколько раз (предложение заканчивается точкой или восклицательным знаком). Получить в новой строке отредактированный текст, в котором удалены подряд идущие вхождения слов в предложениях.
Не понимаю, как ее сделать!!Помогите, пожалуйста!!
Полная версия: Строки!Помогите. пожалуйста
Поиском не пробовал пользоваться? Я по-моему уже выкладывал что-то подобное...
const
{ Здесь - символы, составляющие слова (без разделителей) }
abc = ['а'..'п', 'р'..'я', 'А'..'П', 'Р'..'Я'];
s: string = ' да да нет да нет три три три три.';
var
s_res, prev, _word: string;
p: byte;
begin
s_res := s; prev := '';
p := 1;
repeat
while not (s_res[p] in abc) and (p <= length(s_res))
do inc(p);
while (s_res[p] in abc) and (p <= length(s_res)) do begin
_word := _word + s_res[p];
inc(p);
end;
if _word = prev then begin
delete(s_res, p - length(_word), length(_word));
dec(p, length(_word));
end
else prev := _word;
_word := '';
until p > length(s_res);
writeln(s_res)
end.
Спасибо большое!!!...Только почему-то после нажатия сtrl F9 ничего не происходит 
что не так?
что не так?
Может уже произошло, и надо нажать на Alt+F5 чтобы посмотреть результат?
Выдает измененную строку, но 33 раза подряд...
Ну, я же не просто так сюда решение закинул, наверное... Почему у меня работает, а у тебя нет? Значит, код менял... Или столько раз запускал программу до этого... Попробуй в начало поставить ClrScr и потом запустить...
В-общем, вот тебе файл (с латинскими символами, извини, но кириллица есть не у всех...) - запусти, а потом поменяй алфавит и строку на русские...
В-общем, вот тебе файл (с латинскими символами, извини, но кириллица есть не у всех...) - запусти, а потом поменяй алфавит и строку на русские...
Еще раз огромное спасибо...И еще один дурацкий вопрос, прости, но как еще можно сделать, чтобы вне зависимости от регистра повторные слова удалялись? Т.е программа не удаляет Ya ya, к примеру...Из-за первой Y
Переводи всю строку в верхний регистр:
Саму функцию StrUpper можешь взять здесь: FAQ: Модуль для работы со строками
s_res := StrUpper(s); { вместо s_res := s; }
Саму функцию StrUpper можешь взять здесь: FAQ: Модуль для работы со строками
И за это спасибо...Хотя возник еще один вопрос...Удаляет правильно. Потом, с помощью StrLower возвращаюсь к первоначальному виду.Как сделать, чтобы заглавная буква была. а не все маленькие?
А, так тебе же к первоначальному виду возврашаться надо... 
Тогда все еще проще: измени тот фрагмент, что сейчас в программе на вот этот -
и не надо исправлений, о которых я говорил в посте №8...
Тогда все еще проще: измени тот фрагмент, что сейчас в программе на вот этот -if StrUpper(_word) = StrUpper(prev) then begin
delete(s_res, p - length(_word), length(_word));
dec(p, length(_word));
end
и не надо исправлений, о которых я говорил в посте №8...
Че-то я совсем запуталась...
Program Stroki;
uses crt;
Function StrUpper(s: String): String;
Var i: Byte;
Begin
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
#160 .. #175: s[i] := Chr(Ord(s[i])-$20);
#224 .. #239: s[i] := Chr(Ord(s[i])-$50)
End;
StrUpper := s
End;
Function StrLower(s: String):String;
Var i: Byte;
Begin
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'A' .. 'Z': s[i] := Chr(Ord(s[i])+$20);
#128 .. #143: s[i] := Chr(Ord(s[i])+$20);
#144 .. #159: s[i] := Chr(Ord(s[i])+$50)
End;
StrLower := s
End;
const
stUpper = ['A' .. 'Z', #128 .. #159];
abc = ['a'..'z','A'..'Z','1'..'9'];
var
s_res, prev, word: string;
p: integer;
S: string;
stnew: string;
blank: boolean;
i: integer;
begin
clrscr;
Write('Vvedite stroku,kotoraya zakan4ivaetsya');
Writeln(' na vosklicatelniy znak ili to4ku');
Readln(s);
s_res :=StrUpper(s);
prev := '';
p := 1;
repeat
while not (s_res[p] in abc) and (p <= length(s_res)) do
P:=p+1;
while (s_res[p] in abc) and (p <= length(s_res)) do
begin
word := word + s_res[p];
P:=p+1;
end;
if word = prev then
begin
delete(s_res, p - length(word), length(word));
dec(p, length(word));
end
else
prev := word;
word := '';
until p > length(s_res);
blank:= false;
stnew:= ' ';
for i:= 1 to length(s_res) do
begin
if s_res[i] <>' ' then
begin
stnew:= stnew + s_res[i];
blank:= false;
end
else if (not blank) then
begin
stnew:= stnew +s_res[i];
blank:=true;
end;
end;
while stnew[1]=' ' do
stnew:=copy(stnew,2,255);
while stnew[length(stnew)]=' ' do
delete(stnew,length(stnew),1);
s_res:=StrLower(stnew);
writeln (s_res);
end.
Код
Program Stroki;
uses crt;
Function StrUpper(s: String): String;
Var i: Byte;
Begin
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
#160 .. #175: s[i] := Chr(Ord(s[i])-$20);
#224 .. #239: s[i] := Chr(Ord(s[i])-$50)
End;
StrUpper := s
End;
Function StrLower(s: String):String;
Var i: Byte;
Begin
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'A' .. 'Z': s[i] := Chr(Ord(s[i])+$20);
#128 .. #143: s[i] := Chr(Ord(s[i])+$20);
#144 .. #159: s[i] := Chr(Ord(s[i])+$50)
End;
StrLower := s
End;
const
stUpper = ['A' .. 'Z', #128 .. #159];
abc = ['a'..'z','A'..'Z','1'..'9'];
var
s_res, prev, word: string;
p: integer;
S: string;
stnew: string;
blank: boolean;
i: integer;
begin
clrscr;
Write('Vvedite stroku,kotoraya zakan4ivaetsya');
Writeln(' na vosklicatelniy znak ili to4ku');
Readln(s);
s_res :=StrUpper(s);
prev := '';
p := 1;
repeat
while not (s_res[p] in abc) and (p <= length(s_res)) do
P:=p+1;
while (s_res[p] in abc) and (p <= length(s_res)) do
begin
word := word + s_res[p];
P:=p+1;
end;
if word = prev then
begin
delete(s_res, p - length(word), length(word));
dec(p, length(word));
end
else
prev := word;
word := '';
until p > length(s_res);
blank:= false;
stnew:= ' ';
for i:= 1 to length(s_res) do
begin
if s_res[i] <>' ' then
begin
stnew:= stnew + s_res[i];
blank:= false;
end
else if (not blank) then
begin
stnew:= stnew +s_res[i];
blank:=true;
end;
end;
while stnew[1]=' ' do
stnew:=copy(stnew,2,255);
while stnew[length(stnew)]=' ' do
delete(stnew,length(stnew),1);
s_res:=StrLower(stnew);
writeln (s_res);
end.
Ну не надо ничего придумывать... Я же сказал, что надо было сделать:
Function StrUpper(s: String): String;
Var i: Byte;
Begin
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
#160 .. #175: s[i] := Chr(Ord(s[i])-$20);
#224 .. #239: s[i] := Chr(Ord(s[i])-$50)
End;
StrUpper := s
End;
const
abc = ['a'..'z','A'..'Z','1'..'9'];
var
s_res, prev, _word: string;
p: byte;
begin
clrscr;
Write('Vvedite stroku,kotoraya zakan4ivaetsya');
Writeln(' na vosklicatelniy znak ili to4ku');
Readln(s);
s_res := s; prev := '';
p := 1;
repeat
while not (s_res[p] in abc) and (p <= length(s_res))
do inc(p);
while (s_res[p] in abc) and (p <= length(s_res)) do begin
_word := _word + s_res[p];
inc(p);
end;
if strUpper(_word) = strUpper(prev) then begin { <--- только здесь !!! }
delete(s_res, p - length(_word), length(_word));
dec(p, length(_word));
end
else prev := _word;
_word := '';
until p > length(s_res);
writeln(s_res)
end.
Запихнула туда еще удаление пробелов и все пошло замечательно!! Спасибо огромное 
Теперь еще одна задача, и можно приступать к созданию меню....
Теперь еще одна задача, и можно приступать к созданию меню....
А можно еще пару глупых вопросов и с этой задачей покончено?!
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
#160 .. #175: s[i] := Chr(Ord(s[i])-$20);
#224 .. #239: s[i] := Chr(Ord(s[i])-$50)
End;
Паскаль мой почти на школьном уровне, поясните . пожалуйста про Chr и Ord . Не совсем понимаю, что будет выполняться. и что значит -$20
И вот эту строчку...dec(p, length(_word))
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
#160 .. #175: s[i] := Chr(Ord(s[i])-$20);
#224 .. #239: s[i] := Chr(Ord(s[i])-$50)
End;
Паскаль мой почти на школьном уровне, поясните . пожалуйста про Chr и Ord . Не совсем понимаю, что будет выполняться. и что значит -$20
И вот эту строчку...dec(p, length(_word))
Цитата(Дымка @ 10.07.05 14:27)
А можно еще пару глупых вопросов и с этой задачей покончено?!
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
#160 .. #175: s[i] := Chr(Ord(s[i])-$20);
#224 .. #239: s[i] := Chr(Ord(s[i])-$50)
End;
Паскаль мой почти на школьном уровне, поясните . пожалуйста про Chr и Ord . Не совсем понимаю, что будет выполняться. и что значит -$20
И вот эту строчку...dec(p, length(_word))
For i := 1 To Ord(s[0]) Do
Case s[i] Of
'a' .. 'z': s[i] := Chr(Ord(s[i])-$20);
#160 .. #175: s[i] := Chr(Ord(s[i])-$20);
#224 .. #239: s[i] := Chr(Ord(s[i])-$50)
End;
Паскаль мой почти на школьном уровне, поясните . пожалуйста про Chr и Ord . Не совсем понимаю, что будет выполняться. и что значит -$20
И вот эту строчку...dec(p, length(_word))
Все просто :
Chr(97)='a'
ord('a')=97
обратные друг к другу ф-и одна возвращает код по символу, а другая символ по коду
dec( a,b ) равносильно a:=a-b;
inc( a,b ) равносильно a:=a+b;
dec(a) равносильно a:=a-1;
inc(a) равносильно a:=a+1;
соответственно dec(p, length(_word)) - уменьшает p на величину, равную длинне строки _word
Цитата(Дымка @ 10.07.05 13:11)
Запихнула туда еще удаление пробелов и все пошло замечательно!!
Ты тот модуль, на который я ссылку давал, внимательно смотрела? Функцию
Function StrOneSpace(s: String): String;там видела? Она как раз и удаляет из строки все лишние пробелы...
а -$20, -$50?? это надо понимать, шестнадцатиричные числа...при чем тут они?
При том, что разность кодов символов в верхнем и нижнем регистре составляет или $20 (оно же 32 десятичное) или $50 (80 десятичное) в зависимости от самого символа...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.