Строки!Помогите. пожалуйста Опции

[Дымка]

Дана строка, содержащая текст на русском языке. В предложениях некоторые из слов записаны подряд несколько раз (предложение заканчивается точкой или восклицательным знаком). Получить в новой строке отредактированный текст, в котором удалены подряд идущие вхождения слов в предложениях.
Не понимаю, как ее сделать!!Помогите, пожалуйста!!

[volvo]

Поиском не пробовал пользоваться? Я по-моему уже выкладывал что-то подобное...

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 ничего не происходит что не так?

[volvo]

Может уже произошло, и надо нажать на Alt+F5 чтобы посмотреть результат?

[Дымка]

Выдает измененную строку, но 33 раза подряд...

[volvo]

Ну, я же не просто так сюда решение закинул, наверное... Почему у меня работает, а у тебя нет? Значит, код менял... Или столько раз запускал программу до этого... Попробуй в начало поставить ClrScr и потом запустить...

В-общем, вот тебе файл (с латинскими символами, извини, но кириллица есть не у всех...) - запусти, а потом поменяй алфавит и строку на русские...

[Дымка]

Еще раз огромное спасибо...И еще один дурацкий вопрос, прости, но как еще можно сделать, чтобы вне зависимости от регистра повторные слова удалялись? Т.е программа не удаляет Ya ya, к примеру...Из-за первой Y

[volvo]

Переводи всю строку в верхний регистр:

s_res := StrUpper(s); { вместо s_res := s; }

Саму функцию StrUpper можешь взять здесь: FAQ: Модуль для работы со строками

[Дымка]

И за это спасибо...Хотя возник еще один вопрос...Удаляет правильно. Потом, с помощью StrLower возвращаюсь к первоначальному виду.Как сделать, чтобы заглавная буква была. а не все маленькие?

[volvo]

А, так тебе же к первоначальному виду возврашаться надо... Тогда все еще проще: измени тот фрагмент, что сейчас в программе на вот этот -

    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.

[volvo]

Ну не надо ничего придумывать... Я же сказал, что надо было сделать:

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))

[klem4]

А можно еще пару глупых вопросов и с этой задачей покончено?!
   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

Сообщение отредактировано: klem4 - 10.07.2005 13:42

[volvo]

Запихнула туда еще удаление пробелов и все пошло замечательно!!

Ты тот модуль, на который я ссылку давал, внимательно смотрела? Функцию

Function StrOneSpace(s: String): String;

там видела? Она как раз и удаляет из строки все лишние пробелы...

[Дымка]

а -$20, -$50?? это надо понимать, шестнадцатиричные числа...при чем тут они?

[volvo]

При том, что разность кодов символов в верхнем и нижнем регистре составляет или $20 (оно же 32 десятичное) или $50 (80 десятичное) в зависимости от самого символа...