Код: Выделить всё
program a;
uses crt;
type str=string;mass=array[1..20] of str;
var s,s1,s2,s3:string;i,j,k,l,n:integer;x:mass;
function quantity(s1,s2:str):integer;
var i,k:integer;
begin
k:=0;
for i:=1 to length(s2)-length(s1)+1 do
if copy(s2,i,length(s1))=s1 then k:=k+1;
quantity:=k; end;
function poisk(s1,s2:str):str;
var i:integer;k:str;
begin
k:='нет';
for i:=1 to length(s2)-length(s1)+1 do
if copy(s2,i,length(s1))=s1 then k:='да';
poisk:=k; end;
procedure inverse(var s1:str);
var i:integer;k:str;
begin
k:='';
for i:=1 to length(s1) do
k:=copy(s1,i,1)+k;
s1:=k; end;
procedure double(var s1:str);
var i:integer;k:str;
begin
k:='';
for i:=1 to length(s1) do
k:=k+copy(s1,i,1)+copy(s1,i,1);
s1:=k; end;
procedure zamena(var s1:str;s2,s3:str);
var i:integer;k:str;
begin
k:='';
for i:=1 to length(s1) do
if copy(s1,i,length(s2))=s2 then begin k:=k+s3;i:=i+length(s2)-1 end
else k:=k+copy(s1,i,1);
s1:=k; end;
procedure del(var s1:str;s2:str);
begin
zamena(s1,s2,'');
end;
procedure slova(s1:str;var k:integer;var x:mass);
var i,l:integer;
begin
l:=pos(' ',s1);
while l>0 do begin
zamena(s1,' ',' ');
l:=pos(' ',s1);end;
k:=1;l:=pos(' ',s1);
while l>0 do begin
x[k]:=copy(s1,1,l-1);
k:=k+1;
delete(s1,1,l);
l:=pos(' ',s1);
end;
x[k]:=copy(s1,1,length(s1));
end;
procedure printmass(k:integer;x:mass);
var i:integer;
begin
for i:=1 to k do Writeln(x[i]);
end;
end;
begin
writeln('введите предложение');
readln(s);
slova(s,n,x);
printmass(n,x);
end.1) внести изменения в программу, чтобы дополнительно печатались слова, у которых первый и последний символы совпадают
2) для каждого из слов указывалось, сколько раз оно встречается;
3) составить процедуру, которая удаляет в данном слове букву "а"
на выходе должно получиться 3 программы в соответствии с пунктами!
Заранее спасибо! буду ооооочень благодарна!