Автор: Kirk

Kirk — Sat, 20 May 2017 06:45:35 +0000

program s51;

type
 nummass = array [1..255] of integer; 
 stringmass = array [1..255] of string;
 charmass = array [1..127] of char;

// процедура: меняем присвоенную слову букву (49)
//            меняем присвоенную слову цифру (72)
procedure wordSwap(i,j:integer; var fullWord:stringmass; var firstLetter:charmass);
 var
  tempChar: char;
  tempWord: string;
 begin
  tempChar:=firstLetter[i]; // меняем букву
  firstLetter[i]:=firstLetter[j];
  firstLetter[j]:=tempChar;
  tempWord:=fullWord[i]; // меняем цифру
  fullWord[i]:=fullWord[j];
  fullWord[j]:=tempWord;
 end;

var
 firstLetter: charmass;
 wordLength,letterPlace: nummass;
 fullWord: stringmass;
 s,s1: string;
 i,j,q,words: integer;
 
begin
 write('S: ');
 readln(s);
 
 words:=1;
 firstLetter[words]:=s[1];
 letterPlace[words]:=1;
 wordLength[words]:=pos(' ',s)-1;
 
 i:=2; // убираем лишние пробелы
 while (i<=length(s)) do
  begin
   if (s[i]=' ') and (s[i-1]=' ') then
    begin
     delete(s,i,1);
     dec(i);
    end;
   inc(i);
  end;
 
 for i:=2 to length(s) do // находим количество слов, их первые буквы
   if (s[i]<>' ') and (s[i-1]=' ') then 
    begin
     inc(words);
     firstLetter[words]:=s[i];
     letterPlace[words]:=i;
    end;
 
 for i:=2 to words do // находим длину слов
  begin
   if (i<>words) then
    begin
     wordLength[i]:=0;
     j:=letterPlace[i];
     while (s[j]<>' ') do
      begin
       inc(wordLength[i]);
       inc(j);
      end;
    end
   else wordLength[i]:=length(s)-letterPlace[i]+1;
  end;
  
 for i:=words downto 1 do // формируем слова в формате string
  begin
   for j:=(wordLength[i]+letterPlace[i]-1) downto letterPlace[i] do
    fullWord[i]:=s[j]+fullWord[i];
  end;
 
 for q:=1 to words do // сортировка по алфавиту
  for i:=1 to words-1 do
   for j:=i+1 to words do
    if (ord(firstLetter[i]))>(ord(firstLetter[j])) then
     begin
      wordSwap(i,j,fullWord,firstLetter);
      break;
     end;
  
 s1:=fullword[1]; // выводим итоговую строку
 for i:=2 to words do s1:=s1+' '+fullword[i];
 writeln(s1);
end.

program s51;

type

nummass = array [1..255] of integer;

stringmass = array [1..255] of string;

charmass = array [1..127] of char;

// процедура: меняем присвоенную слову букву (49)

// меняем присвоенную слову цифру (72)

procedure wordSwap(i,j:integer; var fullWord:stringmass; var firstLetter:charmass);

var

tempChar: char;

tempWord: string;

begin

tempChar:=firstLetter[i]; // меняем букву

firstLetter[i]:=firstLetter[j];

firstLetter[j]:=tempChar;

tempWord:=fullWord[i]; // меняем цифру

fullWord[i]:=fullWord[j];

fullWord[j]:=tempWord;

end;

var

firstLetter: charmass;

wordLength,letterPlace: nummass;

fullWord: stringmass;

s,s1: string;

i,j,q,words: integer;

begin

write('S: ');

readln(s);

words:=1;

firstLetter[words]:=s[1];

letterPlace[words]:=1;

wordLength[words]:=pos(' ',s)-1;

i:=2; // убираем лишние пробелы

while (i<=length(s)) do

begin

if (s[i]=' ') and (s[i-1]=' ') then

begin

delete(s,i,1);

dec(i);

end;

inc(i);

end;

for i:=2 to length(s) do // находим количество слов, их первые буквы

if (s[i]<>' ') and (s[i-1]=' ') then

begin

inc(words);

firstLetter[words]:=s[i];

letterPlace[words]:=i;

end;

for i:=2 to words do // находим длину слов

begin

if (i<>words) then

begin

wordLength[i]:=0;

j:=letterPlace[i];

while (s[j]<>' ') do

begin

inc(wordLength[i]);

inc(j);

end;

end

else wordLength[i]:=length(s)-letterPlace[i]+1;

end;

for i:=words downto 1 do // формируем слова в формате string

begin

for j:=(wordLength[i]+letterPlace[i]-1) downto letterPlace[i] do

fullWord[i]:=s[j]+fullWord[i];

end;

for q:=1 to words do // сортировка по алфавиту

for i:=1 to words-1 do

for j:=i+1 to words do

if (ord(firstLetter[i]))>(ord(firstLetter[j])) then

begin

wordSwap(i,j,fullWord,firstLetter);

break;

end;

s1:=fullword[1]; // выводим итоговую строку

for i:=2 to words do s1:=s1+' '+fullword[i];

writeln(s1);

end.

Комментарии: Решаем задачи Абрамян на Паскале. String51

Автор: Kirk