Строка: Поменять местами слово, содержащее максимальное число гласных и слово с минимальной длиной. - Turbo Pascal
Формулировка задачи:
Решение задачи: «Строка: Поменять местами слово, содержащее максимальное число гласных и слово с минимальной длиной.»
const Blank=[#9,' ']; Vovels = ['A','E','I','O','U','Y','a','e','i','o','u','y', 'А','Е','Ё','И','О','У','Ы','Э','Ю','Я', 'а','е','ё','и','о','у','ы','э','ю','я']; function GetWord(const s: String; var r: String; var i: Integer): Boolean; var j: Integer; begin while (i<=Length(s)) and (s[i] in Blank) do Inc(i); j:=i; while (i<=Length(s)) and not (s[i] in Blank) do Inc(i); r:=Copy(s,j,i-j); GetWord:=i>j; end; function VovCount(const s: String): Integer; var i, r: Integer; begin r:=0; for i:=1 to Length(s) do if s[i] in Vovels then Inc(r); VovCount:=r; end; procedure Task1(s: String); var smx, smn, t: String; i, mx, mn, imx, imn, c: Integer; begin mx:=-MaxInt-1; mn:=MaxInt; i:=1; while GetWord(s,t,i) do begin c:=VovCount(t); if mx<c then begin mx:=c; imx:=i-Length(t); smx:=t; end; if mn>Length(t) then begin mn:=Length(t); imn:=i-mn; smn:=t; end; end; if imx>imn then begin Delete(s,imx,Length(smx)); Insert(smn,s,imx); end; if imx<>imn then begin Delete(s,imn,Length(smn)); Insert(smx,s,imn); end; if imx<imn then begin Delete(s,imx,Length(smx)); Insert(smn,s,imx); end; WriteLn('max гласных: "',smx,'", min длина: "',smn,'"'); WriteLn('Строка: ',s); end; procedure Task2(s: String; b: Char); var i, n: Integer; t: String; begin i:=1; n:=0; while GetWord(s,t,i) do if t[Length(t)]=b then begin Inc(n); Delete(s,i-Length(t)-1,Length(t)+1); s:=t+' '+s; end; WriteLn('Слов, заканчивающихся на "',b,'": ',n); WriteLn('Строка: ',s); end; var s, smx, smv, t: String; i, mx, mn, imx, imn, c: Integer; b: Char; begin Write('Введите строку: '); ReadLn(s); Write('Введите букву: '); ReadLn(b); WriteLn('1.'); Task1(s); WriteLn('2.'); Task2(s,b); end.
Объяснение кода листинга программы
const
Blank = [#9, ' '];
Vovels = ['A','E','I','O','U','Y','a','e','i','o','u','y',
'А','Е','Ё','И','О','У','Ы','Э','Ю','Я',
'а','е','ё','и','о','у','ы','э','ю','я'];
function GetWord(const s: String; var r: String; var i: Integer): Boolean;
var j: Integer;
begin
while (i<=Length(s)) and (s[i] in Blank) do Inc(i); j:=i;
while (i<=Length(s)) and not (s[i] in Blank) do Inc(i);
r:=Copy(s,j,i-j);
GetWord:=i>j;
end;
function VovCount(const s: String): Integer;
var i, r: Integer;
begin
r:=0; for i:=1 to Length(s) do if s[i] in Vovels then Inc(r);
VovCount:=r;
end;
procedure Task1(s: String);
var
smx, smn, t: String;
i, mx, mn, imx, imn, c: Integer;
begin
mx:=-MaxInt-1; mn:=MaxInt; i:=1;
while GetWord(s,t,i) do begin
c:=VovCount(t);
if mx<c then begin mx:=c; imx:=i-Length(t); smx:=t; end;
if mn>Length(t) then begin mn:=Length(t); imn:=i-mn; smn:=t; end;
end;
if imx>imn then begin Delete(s,imx,Length(smx)); Insert(smn,s,imx); end;
if imx<>imn then begin Delete(s,imn,Length(smn)); Insert(smx,s,imn); end;
if imx<imn then begin Delete(s,imx,Length(smx)); Insert(smn,s,imx); end;
WriteLn('max гласных: ',smx,'
, min длина: ',smn,'
');
WriteLn('Строка: ',s);
end;
procedure Task2(s: String; b: Char);
var
i, n: Integer;
t: String;
begin
i:=1; n:=0;
while GetWord(s,t,i) do
begin
if t[Length(t)]=b then begin
Inc(n);
Delete(s,i-Length(t)-1,Length(t)+1);
s:=t+' '+s;
end;
end;
WriteLn('Слов, заканчивающихся на ',b,'
: ',n);
WriteLn('Строка: ',s);
end;
var
s, smx, smv, t: String;
i, mx, mn, imx, imn, c: Integer;
b: Char;
begin
Write('Введите строку: '); ReadLn(s);
Write('Введите букву: '); ReadLn(b);
WriteLn('1.'); Task1(s);
WriteLn('2.'); Task2(s,b);
end.