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

String51. Дана строка, состоящая из русских слов, набранных заглавными буквами и разделенных пробелами (одним или несколькими). Вывести строку, содержащую эти же слова, разделенные одним пробелом и расположенные в алфавитном порядке.

Решение:

program String51;
var
 S:String;
 SA : array [1..225] of String;
 i,i2,Len,Len2,poz:integer;

procedure SwapString(var S1,S2:String);
var
 STemp:String;
begin
 STemp:=S1;
 S1:=S2;
 S2:=STemp;
end;


Function CompareString(S1,S2:string):boolean;
begin
 if S1<S2 then CompareString:=true
 else CompareString:=false;
end;

begin
  Write('S: ');
  Readln(S);

//наполняю массив словами
  Len:=0;
  poz:=pos(' ',S);
  While (poz<>0) do
   begin
    if poz=1 then delete(S,1,1);
    if poz>1 then
     begin
      inc(Len);
      SA[Len]:=copy(S,1,poz-1);
      Delete(S,1,poz);
     end;
    poz:=pos(' ',S);
   end;
  inc(Len);
  SA[Len]:=S;
//получился массив SA длинной len.
//сортирую массив
  Len2:=Len;
  for i:=1 to Len-1 do
   begin
    i2:=1;
    Len2:=Len2-1;
    while (i2<=Len2) do
     begin
      if not(CompareString(SA[i2],SA[i2+1])) then SwapString(SA[i2],SA[i2+1]);
      inc(i2);
     end;
   end;
//складываю массив в строку
  S:=SA[1];
  for i:=2 to Len do S:=S+' '+SA[i];
//вывожу массив
  Writeln(S);
end.

program String51;

var

S:String;

SA : array [1..225] of String;

i,i2,Len,Len2,poz:integer;

procedure SwapString(var S1,S2:String);

var

STemp:String;

begin

STemp:=S1;

S1:=S2;

S2:=STemp;

end;

Function CompareString(S1,S2:string):boolean;

begin

if S1<S2 then CompareString:=true

else CompareString:=false;

end;

begin

Write('S: ');

Readln(S);

//наполняю массив словами

Len:=0;

poz:=pos(' ',S);

While (poz<>0) do

begin

if poz=1 then delete(S,1,1);

if poz>1 then

begin

inc(Len);

SA[Len]:=copy(S,1,poz-1);

Delete(S,1,poz);

end;

poz:=pos(' ',S);

end;

inc(Len);

SA[Len]:=S;

//получился массив SA длинной len.

//сортирую массив

Len2:=Len;

for i:=1 to Len-1 do

begin

i2:=1;

Len2:=Len2-1;

while (i2<=Len2) do

begin

if not(CompareString(SA[i2],SA[i2+1])) then SwapString(SA[i2],SA[i2+1]);

inc(i2);

end;

//складываю массив в строку

S:=SA[1];

for i:=2 to Len do S:=S+' '+SA[i];

//вывожу массив

Writeln(S);

end.

Другие задачи из раздела String можно посмотреть здесь.

Комментарии 1

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

Комментарии:

Комментарии 1

Добавить комментарий Отменить ответ