Cортировка слов по длине Опции

[gedello]

Создать программу, которая в веденном предложении расположит слова в порядке убывания их длины (то есть, от самого длинного слова до самого короткого).

[Федосеев Павел]

{.$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.

Сообщение отредактировано: Федосеев Павел - 27.09.2017 5:05