Вот - очень интересует решение даной задачи.
Буквы назовем “соседями”, если они входят в какую-либо пятерку подряд идущих букв русского алфавита, например ”КЛМНО”. Назовем слово «дружественным», если слово составлено из “соседей” (буквы могут входить в слово много раз, некоторые могут отсутствовать). Например, ГАВ, БАБА - «дружественные».
Дана строка, в которой слова разделены пробелами, вывести все дружественные слова.
Пример:
Входные данные: Выходные данные:
РАЗ ДВА ТРИ ЧЕТЫРЕ ПЯТЬ ДВА
АБВГД ГДЕ ЕЖ АБВГД ГДЕ ЕЖ
Полная версия: Работа со строками
NightPaladin
Можно предложить следующее: напиши функцию, которая будет находить самую первую и самую последнюю (по алфавиту) буквы, которае содержатся в данном слове. А потом просто проверить, если "разница" между этими буквами не больше 5, то слово - "дружественное" ...
Алгоритм разбиения строки на слова есть в ФАКе...
Можно предложить следующее: напиши функцию, которая будет находить самую первую и самую последнюю (по алфавиту) буквы, которае содержатся в данном слове. А потом просто проверить, если "разница" между этими буквами не больше 5, то слово - "дружественное" ...
Алгоритм разбиения строки на слова есть в ФАКе...
Спосибо большое сейчас попробую написать, а то у меня с идеями вобще не очень было. :D
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.
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.
Попробуй вот так:
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.
Код
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.
Заработало :no: , от всей души говорю VOLVO - ТЫ ЛУЧШИЙ.
Столько форумов обойти, и только в одном нашлось два человеа ответевших по существу, я ведь уж думал, что через форум ответа не получу.
Ещё раз всем и в частности volvo спасибо.
Буду обязательно посещать этот форум. Будут также, по мере своих (к сожаление, но надеюсь только пока - средних знагий) помагать людям.
Столько форумов обойти, и только в одном нашлось два человеа ответевших по существу, я ведь уж думал, что через форум ответа не получу.
Ещё раз всем и в частности volvo спасибо.
Буду обязательно посещать этот форум. Будут также, по мере своих (к сожаление, но надеюсь только пока - средних знагий) помагать людям.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.