Работа со строками, задача на работу со строками/символами Опции

[NightPaladin]

Вот - очень интересует решение даной задачи.
Буквы назовем “соседями”, если они входят в какую-либо пятерку подряд идущих букв русского алфавита, например ”КЛМНО”. Назовем слово «дружественным», если слово составлено из “соседей” (буквы могут входить в слово много раз, некоторые могут отсутствовать). Например, ГАВ, БАБА - «дружественные».
Дана строка, в которой слова разделены пробелами, вывести все дружественные слова.
Пример:
Входные данные: Выходные данные:
РАЗ ДВА ТРИ ЧЕТЫРЕ ПЯТЬ ДВА
АБВГД ГДЕ ЕЖ АБВГД ГДЕ ЕЖ

[volvo]

NightPaladin
Можно предложить следующее: напиши функцию, которая будет находить самую первую и самую последнюю (по алфавиту) буквы, которае содержатся в данном слове. А потом просто проверить, если "разница" между этими буквами не больше 5, то слово - "дружественное" ...

Алгоритм разбиения строки на слова есть в ФАКе...

Сообщение отредактировано: volvo - 27.11.2004 21:00

[NightPaladin]

Спосибо большое сейчас попробую написать, а то у меня с идеями вобще не очень было. :D

[NightPaladin]

volvo или просто добрые люди посмотрите чё не так в коде а то глючит

Код

program asd;
Uses
CRT;
type
TWords = array[1..100] of String;
Function GetWords(s: String; Var mas: TWords): Byte;
Var i, j, p: Byte;
Begin

  Repeat
    p := Pos('  ', s);
    If p > 0 Then Delete(s, p, 1)
  Until p = 0;

  If s[1] = ' ' Then Delete(s, 1, 1);
  If s[Length(s)] = ' ' Then
    Delete(s, Length(s), 1);

  i := 0;
  Repeat
    p := Pos(' ', s); Inc(i);
    If p > 0 Then
      Begin
        mas[i] := Copy(s, 1, Pred(p)); Delete(s, 1, p) ;
      End
    Else mas[i] := s
  Until p = 0;
  GetWords := i
End;

Var

i, count: Word;
words: TWords;
a,sr : String;
f,g: byte;
q: String;
Const
s: String = ' That is   all folks ';
Begin
ClrScr;
Count := GetWords(s, words);
For i := 1 To count Do
  begin
   a:= Copy(words[i],1,1);
   sr:= Copy(words[i],Length(words[i]),1);
   f:= Chr(a);
   g:= Chr(sr);
   f:=f-g;
   If f <= 5 then   q:=q+' '+words[i];
  end;
  ReadKey;
End.

[volvo]

Попробуй вот так:

Код

Uses Crt;

Type
 TWords = Array[1 .. 100] of String;

Function GetWords(s: String; Var mas: TWords): Byte;
Var i, j, p: Byte;
Begin

 Repeat
   p := Pos('  ', s);
   If p > 0 Then Delete(s, p, 1)
 Until p = 0;

 If s[1] = ' ' Then Delete(s, 1, 1);
 If s[Length(s)] = ' ' Then
   Delete(s, Length(s), 1);

 i := 0;
 Repeat
   p := Pos(' ', s); Inc(i);
   If p > 0 Then
     Begin
       mas[i] := Copy(s, 1, Pred(p)); Delete(s, 1, p);
     End
   Else mas[i] := s
 Until p = 0;
 GetWords := i
End;

Var
 i, j, count: Word;
 words: TWords;

Const
 s: String = 'АБВГД ГДЕ ТЫ ЕЖ АБВГД ГДЕ ЕЖУ';

var
 now : string;
 min, max: char;
Begin
 ClrScr;
 Count := GetWords(s, words);
 For i := 1 To count Do
   Begin
     min := 'Я'; max := 'А';
     now := words[i];
     For j := 1 to length(now) do
       If now[j] < min Then min := now[j]
       Else If now[j] > max Then max := now[j];

     If ord(max) - ord(min) <= 5 Then
       WriteLn('Слово: ', now, ' дружественное');
   end;
 ReadKey;
End.

Сообщение отредактировано: volvo - 28.11.2004 20:34

[NightPaladin]

Заработало :no: , от всей души говорю VOLVO - ТЫ ЛУЧШИЙ.
Столько форумов обойти, и только в одном нашлось два человеа ответевших по существу, я ведь уж думал, что через форум ответа не получу.
Ещё раз всем и в частности volvo спасибо.
Буду обязательно посещать этот форум. Будут также, по мере своих (к сожаление, но надеюсь только пока - средних знагий) помагать людям.