IPB
ЛогинПароль:

> 

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> Cортировка слов по длине
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 1
Пол: Мужской

Репутация: -  0  +


Создать программу, которая в веденном предложении расположит слова в порядке убывания их длины (то есть, от самого длинного слова до самого короткого).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Знаток
****

Группа: Пользователи
Сообщений: 481
Пол: Мужской
Реальное имя: Федосеев Павел

Репутация: -  9  +


{.$define Debug}
PROGRAM SortWords;
TYPE
TRecWordProperty = RECORD
StartPos : Integer;
WordLen : Integer;
END;
TArrWordProperty = array [1..128] of TRecWordProperty;
PROCEDURE ProcessStr(VAR SStr, DStr : String);
VAR
m : TArrWordProperty;
WordCount : Integer;
i, j : Integer;
MinLen : Integer;
MinIndex : Integer;
BEGIN
WordCount:=0; {количество слов в строке}
i:=1; {текущая позиция в анализируемой строке}
while i<=Length(SStr) do begin
{ищем первую букву слова}
while (i<=Length(SStr)) do begin
if (SStr[i] = ' ')
then Inc(i)
else Break;
end;
if i>Length(SStr)
then Break;
Inc(WordCount);
m[WordCount].StartPos:=i;
{теперь просматриваем слово пока не закончится строка или
не начнутся ограничители слов}
while (i<=Length(SStr)) do
if (SStr[i] = ' ')
then Break
else Inc(i);
m[WordCount].WordLen:=i-m[WordCount].StartPos;
end;
{$IFDEF Debug}
for i:=1 to WordCount do
WriteLn(i:2,'. "',copy(SStr, m[i].StartPos, m[i].WordLen),'"');
{$ENDIF}
DStr:='';
for i:=1 to WordCount do begin
MinLen:=m[i].WordLen;
MinIndex:=i;
for j:=i+1 to WordCount do begin
if MinLen<m[j].WordLen
then begin
MinLen:=m[j].WordLen;
MinIndex:=j;
end;
end;
if i<>1 then DStr:=DStr+' ';
with m[MinIndex] do
DStr:=DStr+copy(SStr, StartPos, WordLen);
{тут можно сделать обмен, но массив нам дальше не понадобится}
if i<>MinIndex
then begin
m[MinIndex].WordLen :=m[i].WordLen;
m[MinIndex].StartPos:=m[i].StartPos;
end;
end;
END;

VAR
s,
SNew : String;
BEGIN
WriteLn('Input string:');
{$IFDEF Debug}
s:='один два три четыре пять шесть семь восемь девять a';
WriteLn(s);
{$ELSE}
ReadLn(s);
{$ENDIF}
ProcessStr(s, SNew);
WriteLn(SNew);
END.


Сообщение отредактировано: Федосеев Павел -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 4:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name