Розв’язок задач на мові програмування Pascal

Begin

prugolosna[1]:='б';

prugolosna[2]:='в';

prugolosna[3]:='г';

prugolosna[4]:='д';

prugolosna[5]:='ж';

prugolosna[6]:='з';

prugolosna[7]:='й';

prugolosna[8]:='к';

prugolosna[9]:='л';

prugolosna[10]:='м';

prugolosna[11]:='н';

prugolosna[12]:='п';

prugolosna[13]:='р';

prugolosna[14]:='с';

prugolosna[15]:='т';

prugolosna[16]:='ф';

prugolosna[17]:='х';

prugolosna[18]:='ц';

prugolosna[19]:='ч';

prugolosna[20]:='ш';

prugolosna[21]:='щ';

prugolosna[22]:='ь';

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=Pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

delete(s,1,r);

dov:=length(s);

for j:=1 to 22 do

if s1[1]=prugolosna[j] then

write(s1,' ');

і:=і+1

end

else

begin

s1:=s;

dov1:=length(s1);

for j:=1 to 22 do

if s1[1]=prugolosna[j] then

write(s1,' ');

dov:=0;

end;

end;

readln;

End.

Program z_13_61;

Const n=126;

Var

S,s1,s2:string;

R,dov,і,j,k,dov1:integer;

golosna:array[1..10] of char;

prugolosna:array[1..22] of char;

Begin

golosna[1]:='а';

golosna[2]:='е';

golosna[3]:='є';

golosna[4]:='и';

golosna[5]:='і';

golosna[6]:='ї';

golosna[7]:='о';

golosna[8]:='у';

golosna[9]:='ю';

golosna[10]:='я';

prugolosna[1]:='б';

prugolosna[2]:='в';

prugolosna[3]:='г';

prugolosna[4]:='д';

prugolosna[5]:='ж';

prugolosna[6]:='з';

prugolosna[7]:='й';

prugolosna[8]:='к';

prugolosna[9]:='л';

prugolosna[10]:='м';

prugolosna[11]:='н';

prugolosna[12]:='п';

prugolosna[13]:='р';

prugolosna[14]:='с';

prugolosna[15]:='т';

prugolosna[16]:='ф';

prugolosna[17]:='х';

prugolosna[18]:='ц';

prugolosna[19]:='ч';

prugolosna[20]:='ш';

prugolosna[21]:='щ';

prugolosna[22]:='ь';

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=Pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

for j:=1 to 22 do

begin

if s1[dov1]=prugolosna[j] then

begin

for k:=1 to 10 do

if s[1]=golosna[k] then

write(s1,' ');

end;

end;

delete(s,1,r);

dov:=length(s);

і:=і+1

end

else

begin

s1:=s;

dov1:=length(s1);

for j:=1 to 22 do

begin

if s1[dov1]=prugolosna[j] then

begin

for k:=1 to 10 do

if s[1]=golosna[k] then

write(s1,' ');

end;

end;

dov:=0;

end;

end;

readln;

End.

Program z_13_62;

Const n=126;

Var

S,s1,s2:string;

R,dov,і,j,k,dov1:integer;

golosna:array[1..10] of char;

prugolosna:array[1..22] of char;

Begin

golosna[1]:='а';

golosna[2]:='е';

golosna[3]:='є';

golosna[4]:='и';

golosna[5]:='і';

golosna[6]:='ї';

golosna[7]:='о';

golosna[8]:='у';

golosna[9]:='ю';

golosna[10]:='я';

prugolosna[1]:='б';

prugolosna[2]:='в';

prugolosna[3]:='г';

prugolosna[4]:='д';

prugolosna[5]:='ж';

prugolosna[6]:='з';

prugolosna[7]:='й';

prugolosna[8]:='к';

prugolosna[9]:='л';

prugolosna[10]:='м';

prugolosna[11]:='н';

prugolosna[12]:='п';

prugolosna[13]:='р';

prugolosna[14]:='с';

prugolosna[15]:='т';

prugolosna[16]:='ф';

prugolosna[17]:='х';

prugolosna[18]:='ц';

prugolosna[19]:='ч';

prugolosna[20]:='ш';

prugolosna[21]:='щ';

prugolosna[22]:='ь';

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

End;

r:=Pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

for j:=1 to 22 do

begin

if s1[1]=prugolosna[j] then

begin

for k:=1 to 10 do

if s[dov1]=golosna[k] then

write(s1,' ');

end;

end;

delete(s,1,r);

dov:=length(s);

і:=і+1

end

else

begin

s1:=s;

dov1:=length(s1);

for j:=1 to 22 do

begin

if s1[1]=prugolosna[j] then

begin

for k:=1 to 10 do

if s[dov1]=golosna[k] then

write(s1,' ');

end;

end;

dov:=0;

end;

end;

readln;

End.

Program z_13_7;

Const n=126;

Var

S,s1,s2:string;

R,dov,і,j,dov1:integer;

litera:array[1..30] of char;

Begin

litera[1]:='А';

litera[2]:='Б';

litera[3]:='В';

litera[4]:='Г';

litera[5]:='Д';

litera[6]:='Е';

litera[7]:='Є';

litera[8]:='Ж';

litera[9]:='З';

litera[10]:='І';

litera[11]:='Ї';

litera[12]:='Й';

litera[13]:='К';

litera[14]:='Л';

litera[15]:='М';

litera[16]:='Н';

litera[17]:='О';

litera[18]:='П';

litera[19]:='Р';

litera[20]:='С';

litera[21]:='Т';

litera[22]:='У';

litera[23]:='Ф';

litera[24]:='Х';

litera[25]:='Ц';

litera[26]:='Ч';

litera[27]:='Ш';

litera[28]:='Щ';

litera[29]:='Ю';

litera[30]:='Я';

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=Pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

for j:=1 to 30 do

if s1[1]=litera[j] then

write(s1,' ');

delete(s,1,r);

dov:=length(s);

і:=і+1

end

else

begin

s1:=s;

dov1:=length(s1);

for j:=1 to 30 do

if s1[1]=litera[j] then

write(s1,' ');

dov:=0;

end;

end;

readln;

End.

Program z_13_81;

Const n=126;

Var

S,s1,s2:string;

R,dov,і,j,dov1,k:integer;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=Pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

if (dov1 mod 2)=0 then

write(s1,' ');

delete(s,1,r);

dov:=length(s);

і:=і+1

end

else

begin

s1:=s;

dov1:=length(s1);

if (dov1 mod 2)=0 then

write(s1,' ');

dov:=0;

end;

end;

readln;

End.

Program z_13_82;

Const n=126;

Var

S,s1,s2:string;

R,dov,і,j,dov1,k:integer;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=Pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

if (dov1 mod 2)<>0 then

write(s1,' ');

delete(s,1,r);

dov:=length(s);

і:=і+1

end

else

begin

s1:=s;

dov1:=length(s1);

if (dov1 mod 2)<>0 then

write(s1,' ');

dov:=0;

end;

end;

readln;

End.

Program z_13_9;

Const

n=126;

n1=5;

Var

S,s2:string;

R,dov,і,j,dov1,d,max,n_max ,min,n_min:integer;

d1:array[1..n1] of integer;

s1:array[1..n1] of string;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=Pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

dov1:=length(s1[і]);

d1[і]:=dov1;

delete(s,1,r);

dov:=length(s);

і:=і+1

end

else

begin

s1[n1]:=s;

dov1:=length(s1[n1]);

d1[n1]:=dov1;

dov:=0;

end;

end;

for j:=1 to n1 do

Write( d1[j]:4 );

WriteLn;

min:=d1[1];

max:=d1[1];

n_max:=1;

n_min:=1;

for j:=2 to n1 do

if d1[j]>max then

begin

max:=d1[j];

n_max:=j;

end;

for j:=2 to n1 do

if d1[і]<min then

begin

min:=d1[j];

n_min:=j;

end;

writeln('Najdovshe slovo: ',s1[n_max]);

writeln('Najkorotshe slovo: ',s1[n_min]);

readln;

End.

Program z_13_9;

Const

n=126;

n1=5;

Var

S,s2:string;

R,dov,і,j,dov1,d,syma,min,n_min,A_ser:integer;

d1:array[1..n1] of integer;

s1:array[1..n1] of string;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=Pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

dov1:=length(s1[і]);

d1[і]:=dov1;

delete(s,1,r);

dov:=length(s);

і:=і+1

end

else

begin

s1[n1]:=s;

dov1:=length(s1[n1]);

d1[n1]:=dov1;

dov:=0;

end;

end;

syma:=0;

for j:=1 to n1 do

Write( d1[j]:4 );

WriteLn;

for j:=1 to n1 do

syma:=syma+d1[j];

A_ser:=round(syma/n1);

WriteLn( A_ser );

min:=abs(d1[1]-A_ser);

n_min:=1;

for j:=2 to n1 do

if abs(d1[j]-A_ser)<min then

begin

min:=abs(d1[j]-A_ser);

n_min:=j;

end;

writeln(' Slovo, dovghuna jakogo najblughcha do serednoj : ',s1[n_min]);

readln;

End.

Задача 14

Для заданого тексту

1. Видаліть задане слово;

2. Видаліть кожне парне (непарне) слово;

3. Видаліть всі входження першого слова (слова, номер якого визначений користувачем;

4. Залиште лише одне входження кожного слова;

5. Видаліть слова, що зустрічаються в тексті більше одного разу;

6. Поміняйте місцями слова з заданими номерами;

7. Замініть кожне входження одного слова на інше слово (слово визначає користувач);

8. Для кожного зі слів визначте, скільки разів воно трапляється у тексті.

Program Z_14_1;

Const n=126;

Var

S,s1,s2:string;

R,dov,dov1,і:integer;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Write('Yvedit slovo, jake neobxidno vudalutu =>');

Readln(S2);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

delete(s,1,r);

dov:=length(s);

if s1=s2 then

delete(s1,1,dov1)

else

Write( s1,' ' );

і:=і+1;

end

else

begin

s1:=copy(s,1,dov);

dov1:=length(s1);

if s1=s2 then

delete(s1,1,dov1)

else

write(s1);

delete(s,1,dov);

dov:=0;

end;

end;

readln;

End.

Program Z_14_21;

Const n=126;

Var

S,s1,s2:string;

R,dov,dov1,і:integer;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

delete(s,1,r);

dov:=length(s);

if (і mod 2)=0 then

delete(s1,1,dov1)

else

Write( s1,' ' );

і:=і+1;

end

else

begin

s1:=copy(s,1,dov);

dov1:=length(s1);

if (і mod 2)=0 then

delete(s1,1,dov1)

else

write(s1);

delete(s,1,dov);

dov:=0;

end;

End;

Program Z_14_22;

Const

n=126;

Var

S,s1,s2:string;

R,dov,dov1,і:integer;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

delete(s,1,r);

dov:=length(s);

if (і mod 2)<>0 then

delete(s1,1,dov1)

else

Write( s1,' ' );

і:=і+1;

end

else

begin

s1:=copy(s,1,dov);

dov1:=length(s1);

if (і mod 2)<>0 then

delete(s1,1,dov1)

else

write(s1);

delete(s,1,dov);

dov:=0;

end;

end;

readln;

End.

Program Z_14_31;

Const n=126;

Var

S,s1,s2:string;

R,dov,dov1,і:integer;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

delete(s,1,r);

dov:=length(s);

if і=1 then

delete(s1,1,dov1)

else

Write( s1,' ' );

і:=і+1;

end

else

begin

s1:=copy(s,1,dov);

dov1:=length(s1);

if і=1 then

delete(s1,1,dov1)

else

write(s1);

delete(s,1,dov);

dov:=0;

end;

end;

readln;

End.

Program Z_14_32;

Const n=126;

Var

S,s1,s2:string;

R,dov,dov1,і,m:integer;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Write('Yvedit nomer slova =>');

Readln(m);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1:=copy(s,1,r-1);

dov1:=length(s1);

delete(s,1,r);

dov:=length(s);

if і=m then

delete(s1,1,dov1)

else

Write( s1,' ' );

і:=і+1;

end

else

begin

s1:=copy(s,1,dov);

dov1:=length(s1);

if і=m then

delete(s1,1,dov1)

else

write(s1);

delete(s,1,dov);

dov:=0;

end;

end;

readln;

End.

Program Z_14_4;

Const n=126;

Var

S,s2:string;

R,dov,dov1,і,k,m,l:integer;

s1:array[1..n] of string;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

k:=0;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

delete(s,1,r);

dov:=length(s);

і:=і+1;

end

else

begin

s1[і]:=s;

dov:=0;

end;

end;

for l:=1 to і-1 do

begin

for m:=l+1 to і do

begin

dov1:=length(s1[m]);

if s1[l]=s1[m] then

delete(s1[m],1,dov1);

end;

end;

for і:=1 to і do

write(s1[і],' ');

readln;

End.

Program Z_14_5;

Const n=126;

Var

S,s2:string;

R,dov,dov1,і,k,m,l:integer;

s1:array[1..n] of string;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

k:=0;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

delete(s,1,r);

dov:=length(s);

і:=і+1;

end

else

begin

s1[і]:=s;

dov:=0;

end;

end;

for l:=1 to і-1 do

begin

for m:=l+1 to і do

begin

dov1:=length(s1[m]);

if s1[l]=s1[m] then

delete(s1[m],1,dov1);

end;

end;

for і:=1 to і do

write(s1[і],' ');

readln;

End.

Program Z_14_6;

Const n=126;

Var

S,s2:string;

R,dov,dov1,і,k,p,m,l:integer;

s1:array[1..n] of string;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Write('Yvedit nomeru sliv, jaki bydemo minjatu =>');

Readln(k,p);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

delete(s,1,r);

dov:=length(s);

і:=і+1;

end

else

begin

s1[і]:=s;

dov:=0;

end;

end;

s2:=s1[k];

s1[k]:=s1[p];

s1[p]:=s2;

for і:=1 to і do

write(s1[і],' ');

readln;

End.

Program Z_14_7;

Const n=126;

Var

S,s2:string;

R,dov,dov1,і,k,m,l:integer;

s1:array[1..n] of string;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Write('Yvedit nomer slova, jake bydemo zminjvatu =>');

Readln(k);

Write('Yvedit slovo =>');

Readln(S2);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

delete(s,1,r);

dov:=length(s);

і:=і+1;

end

else

begin

s1[і]:=s;

dov:=0;

end;

end;

for l:=1 to і do

begin

if l=k then

begin

for m:=l+1 to і do

begin

if (s1[l]=s1[m]) then

begin

s1[m]:=s2;

s1[l]:=s2;

end;

end;

end;

end;

s1[k]:=s2;

for і:=1 to і do

write(s1[і],' ');

readln;

End.

Program Z_14_8;

Const n=126;

Var

S,s2:string;

R,dov,dov1,і,k,p,m,l:integer;

s1:array[1..n] of string;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(S);

і:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

delete(s,1,r);

dov:=length(s);

і:=і+1;

end

else

begin

s1[і]:=s;

dov:=0;

end;

end;

k:=1;

for l:=1 to і-1 do

begin

for m:=l+1 to і do

begin

dov1:=length(s1[m]);

if s1[l]=s1[m] then

begin

k:=k+1;

delete(s1[m],1,dov1);

end

end;

WriteLn( s1[l],' ',k );

k:=1;

end;

readln;

End.

Задача 15

Вводяться два числа, розділених символом арифметичної операції. Необхідно визначити:

1. які числа розміщено в тексті;

2. яку арифметичну операцію необхідно виконати;

3. результат виконання цієї дії.

Program text_calc;

Const n=20;

Var

S1:array[1..n] of string;

R,r1,dov,dov1,x,y,і,errcode:integer;

s:string;

z:real;

Begin

Write('Yvedit tekctovuj fragment =>');

Readln(S);

Dov:=length(s);

І:=1;

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

for і:=1 to dov do

begin

r:=pos(' ',s);

if r<>0 then

begin

delete(s,r,1);

dov:=length(s);

end;

end;

for і:=1 to dov do

if (s[і]='+')or(s[і]='-')or(s[і]='*')or(s[і]='/') then

r1:=і;

s1[1]:=copy(s,1,r1-1);

delete(s,1,r1-1);

dov:=length(s);

dov1:=length(s1[1]);

r1:=r1-dov1;

s1[2]:=copy(s,1,r1);

delete(s,r1,1);

dov:=length(s);

s1[3]:=s;

val(s1[1],x,errcode);

if errcode<>0 then

writeln('oshibka vvoda');

val(s1[3],y,errcode);

if errcode<>0 then

writeln('oshibka vvoda');

for і:=1 to 4 do

if s1[2]='+' then z:=x+y;

if s1[2]='-' then z:=x-y;

if s1[2]='*' then z:=x*y;

if s1[2]='/' then z:=x/y;

writeln('z=',z:4:2);

readln;

End.

Задача 16

Виведіть на екран ті слова, що трапляються в кожному з двох уведених користувачем речень.

Program dva_rechennja;

Const n=50;

Var

S1:array[1..n] of string;

s3:array[1..n] of string;

R,r1,dov,dov1,a,b,і,j:integer;

s,s2:string;

z:real;

Begin

Write('Yvedit pershuj tekctovuj fragment =>');

Readln(S);

Write('Yvedit dryguj tekctovuj fragment =>');

Readln(S2);

Dov:=length(s);

dov1:=length(s2);

i:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

a:=dov;

r:=pos(' ',s);

if r<>0 then

begin

s1[і]:=copy(s,1,r-1);

delete(s,1,r);

dov:=length(s);

і:=і+1;

end

else

begin

s1[і]:=s;

dov:=0;

end;

end;

j:=1;

while dov1<>0 do

begin

while (s2[dov1]=' ')and(dov1<>0) do

begin

Delete(S2,dov1-1,1);

Dov1:=length(S2);

end;

b:=dov1;

r1:=pos(' ',s2);

if r1<>0 then

begin

s3[j]:=copy(s2,1,r1-1);

delete(s2,1,r1);

dov1:=length(s2);

j:=j+1;

end

else

begin

s3[j]:=s2;

dov1:=0;

end;

end;

for і:=1 to і do

begin

for j:=1 to j do

if s1[і]=s3[j] then

write(s1[j],' ');

end;

readln;

End.

Задача 17

Задано два довільних текстових фрагменти. Подвойте кожен символ того тексту, у якому сумарна кількість українських голосних більша.

Programm Main;

Var

s,s1,s4,s5:string;

R,r1,dov,dov1,і,j,e,k,k1,l,l1,a,b:integer;

golosna:array[1..10] of char;

s2:array[1..n] of string;

s3:array[1..n] of string;

Begin

golosna[1]:='а';

golosna[2]:='е';

golosna[3]:='є';

golosna[4]:='и';

golosna[5]:='і';

golosna[6]:='ї';

golosna[7]:='о';

golosna[8]:='у';

golosna[9]:='ю';

golosna[10]:='я';

Write('Yvedit pershuj tekctovuj fragment =>');

Readln(S);

Write('Yvedit dryguj tekctovuj fragment =>');

Readln(S1);

Dov:=length(s);

dov1:=length(s1);

s4:=s;

a:=dov;

s5:=s1;

b:=dov1;

k:=0;

k1:=0;

i:=1;

while dov<>0 do

begin

while (s[dov]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos(' ',s);

if r<>0 then

begin

s2[і]:=copy(s,1,r);

for l:=1 to r-1 do

for j:=1 to 10 do

if s2[і][l]=golosna[j] then

k:=k+1;

delete(s,1,r);

dov:=length(s);

і:=і+1;

end

else

begin

s2[і]:=s;

for l:=1 to dov do

for j:=1 to 10 do

if s2[і][l]=golosna[j] then

k:=k+1;

WriteLn( k );

dov:=0;

end;

end;

e:=1;

while dov1<>0 do

begin

while (s1[dov1]=' ')and(dov1<>0) do

begin

Delete(S1,dov1-1,1);

Dov1:=length(S1);

end;

r1:=pos(' ',s1);

if r1<>0 then

begin

s3[e]:=copy(s1,1,r1);

for l1:=1 to r1-1 do

for j:=1 to 10 do

if s3[e][l1]=golosna[j] then

k1:=k1+1;

delete(s1,1,r1);

dov1:=length(s1);

e:=e+1;

end

else

begin

s3[e]:=s1;

for l1:=1 to dov1 do

for j:=1 to 10 do

if s3[e][l1]=golosna[j] then

k1:=k1+1;

WriteLn( k1 );

dov1:=0;

end;

end;

dov:=length(s2[і]);

delete(s2[і],1,dov);

dov1:=length(s3[e]);

delete(s3[e],1,dov1);

if k1<k then

begin

i:=1;

while a<>0 do

begin

while (s4[a]=' ')and(a<>0) do

begin

Delete(S4,a-1,1);

Dov:=length(S);

end;

r:=pos(' ',s4);

if r<>0 then

begin

s2[і]:=copy(s4,1,r-1);

l:=1;

while l<(r+r-2) do

begin

insert(s2[і][l],s2[і],l);

l:=L+2;

end;

write(s2[і],' ');

delete(s4,1,r);

a:=length(s4);

і:=і+1;

end

else

begin

s2[і]:=s4;

l:=1;

while l<(a+a-1) do

begin

insert(s2[і][l],s2[і],l);

l:=L+2;

end;

write(s2[і],' ');

a:=0;

end;

end;

end

else

begin

e:=1;

while b<>0 do

begin

while (s5[b]=' ')and(b<>0) do

begin

Delete(S5,b-1,1);

Dov:=length(S5);

end;

r1:=pos(' ',s5);

if r1<>0 then

begin

s3[e]:=copy(s5,1,r1-1);

l1:=1;

while l1<(r1+r1-2) do

begin

insert(s3[e][l1],s3[e],l1);

l1:=L1+2;

end;

write(s3[e],' ');

delete(s5,1,r1);

b:=length(s5);

e:=e+1;

end

else

begin

s3[e]:=s5;

l1:=1;

while l1<(b+b) do

begin

insert(s3[e][l1],s3[e],l1);

l1:=L1+2;

end;

write(s3[e],' ');

b:=0;

end;

end;

end;

readln;

End.

Задача 18

Текст складається з речень, розділених крапками. Після кожної крапки в кінці речення повинен бути один пропуск. Перше слово в реченні повинно починатися з великої літери.

Program rechennja;

Const n=50;

Var

s,s1:string;

R,dov,і:integer;

litera:char;

Procedure Vellit;

begin

Case litera Of

'a','b','c','d','e','f','g','h','і','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z':

write(Chr(Ord(litera)-32));

'а','б','в','г','д','е','ж','з','и','й','к','л','м','н','о','п','р','с','т','у','ф','х','ц','ч','ш','щ','э','ю','я':

write(Chr(Ord(litera)-32));

'і':

write( Chr(Ord(litera)-1));

'ї','є','ё' :

write(Chr(Ord(litera)-16));

Else

write(Chr(Ord(litera)));

end;

end;

Begin

Write('Yvedit text =>');

Readln(S);

Dov:=length(s);

і:=1;

while dov<>0 do

begin

while (s[1]=' ')and(dov<>0) do

begin

Delete(S,1,1);

Dov:=length(S);

end;

r:=pos('.',s);

if r<>0 then

begin

s1:=copy(s,1,r);

litera:=s[1];

vellit;

for і:=2 to r do

write(s1[і]);

if s[r+1]<>' ' then

insert(' ',s,r+1);

write(' ');

delete(s,1,r+1);

dov:=length(s);

і:=і+1;

end

end;

readln;

End.

Задача 19

Необхідно створити поштову програму, яка самостійно визначає ім'я одержувача листа, виділивши його з електронної адреси, та розміщує це ім'я в тексті листа після вітання. Лист закінчується підписом, який поштова програма формує самостійно, визначивши ім'я відправника листа з його електронної адреси.

Program elektr_poshta;

Const n=50;

Var

s,s1,s2,s3,s4,s5,s6:string;

R,r1,r2,r3,r4,r5,r6,dov,dov1,dov2,dov3,dov4,і,j,k:integer;

a,b:char;

Begin

Write('Yvedit adresy oderghyvacha =>');

Readln(S1);

Dov1:=length(s1);

Write('Yvedit adresy avtora lusta =>');

Readln(S2);

Dov2:=length(s2);

Write('Yvedit texst povidomlennja =>');

Readln(S);

Dov:=length(s);

r1:=pos(':',s1);

delete(s1,1,r1);

r2:=pos('@',s1);

s3:=copy(s1,1,r2-1);

a:=s3[1];

a:=chr(ord(a)-32);

delete(s3,1,1);

insert(a,s3,1);

r3:=pos(':',s2);

delete(s2,1,r3);

r4:=pos('@',s2);

s4:=copy(s2,1,r4-1);

b:=s4[1];

b:=chr(ord(b)-32);

delete(s4,1,1);

insert(b,s4,1);

r:=pos(':',s);

delete(s,1,r);

insert('Електронний лист:',s,1);

r:=pos(':',s);

s5:='Вітаю, шановний ';

dov3:=length(s5);

insert(s3,s5,dov3+1);

dov3:=length(s5);

insert('!',s5,dov3+1);

insert(s5,s,r+1);

dov:=length(s);

s6:='З повагою, ';

dov4:=length(s6);

insert(s4,s6,dov4+1);

dov4:=length(s6);

insert('.',s6,dov4+1);

insert(s6,s,dov+1);

dov:=length(s);

for і:=1 to dov do

write(s[і]);

readln;

End.

Задача 20

Необхідно створити програму, яка формуватиме вітальну листівку. Прізвище та ім'я одержувача зазначені в списку. Побажання вибираються зі списку випадково. До листівки додається електронна адреса одержувача.

Program vital_lustivka;

Const n=50;

Var

s,s1,s2,s3,s4,s5,s6:string;

j,k, R,r1,r2,dov,dov1,dov2,dov4,dov5,dov6,і,m:integer;

a,b:char;

Begin

Write('Yvedit spusok oderghyvachachiv =>');

Readln(S1);

Dov1:=length(s1);

Write('Yvedit elektronni adresu oderghyvachiv =>');

Readln(S2);

Dov2:=length(s2);

Write('Yvedit spusok pobaghan =>');

Readln(S);

Dov:=length(s);

і:=1;

while dov1<>0 do

begin

r1:=pos(',',s1);

if r1<>0 then

begin

s3:=copy(s1,1,r1-1);

insert('Дорогий ',s3,1);

dov4:=length(s3);

Delete(s1,1,r1);

dov1:=length(s1);

for j:=1 to 3 do

begin

randomize;

s5:=s;

m:=random(6);

WriteLn(m);

r:=pos(',',s5);

k:=1;

while k<m do

begin

delete(s5,1,r);

r:=pos(',',s5);

k:=k+1;

end;

s4:=copy(s5,1,r);

end;

insert('Бажаю ',s4,1);

dov5:=length(s4);

delete(s4,dov5,1);

dov5:=length(s4);

insert('.',s4,dov5+1);

dov5:=length(s4);

r2:=pos(',',s2);

s6:=copy(s2,1,r2);

insert('Електронна адреса: ',s6,1);

dov6:=length(s6);

Delete(s2,1,r2);

dov2:=length(s2);

for і:=1 to dov6 do

write(s6[і]);

WriteLn;

for і:=1 to dov4 do

write(s3[і]);

WriteLn;

for і:=1 to dov5 do

write(s4[і]);

WriteLn;

end

else

begin

s3:=s1;

insert('Дорогий ',s3,1);

dov4:=length(s3);

for j:=1 to 3 do

begin

randomize;

s5:=s;

m:=random(6);

r:=pos(',',s5);

k:=1;

while k<m do

begin

delete(s5,1,r);

r:=pos(',',s5);

k:=k+1;

end;

s4:=copy(s5,1,r);

end;

insert('Бажаю ',s4,1);

dov5:=length(s4);

delete(s4,dov5,1);

dov5:=length(s4);

insert('.',s4,dov5+1);

dov5:=length(s4);

s6:=s2;

insert('Електронна адреса: ',s6,1);

dov6:=length(s6);

for і:=1 to dov6 do

write(s6[і]);

WriteLn;

for і:=1 to dov4 do

write(s3[і]);

WriteLn;

for і:=1 to dov5 do

write(s4[і]);

dov2:=0;

dov1:=0;

end;

end;

readln;

End.

Задача 21

Необхідно визначити, яка тема є найпопулярнішою на сайті. Форум сайту має таку структуруЖ кожне повідомлення або починає нову тему, або є відповіддю на певне попереднє повідомлення, тому належить тій самій темію Кількість повідомлень, призначених для аналізу, визначає користувач. Форум має такий вигляд:

· якщо повідомлення починає нову тему, воно складається з трьох рядків.

Перший рядок містить число 0(це ознакою нової теми на форумі).

Другий рядок містить назву теми (її довжина не перевищує 30 символів).

У третьому рядку розміщено саме повідомлення.

· якщо повідомлення є відповіддю на попереднє, то воно складається з двох рядків.

Перший рядок у цьому разі містить ціле число - номер повідомлення, відповіддю на яке воно є. Повідомлення нумерують, починаючи з одиниці.

Другий рядок містить текст повідомлення.

Програма повинна повідомляти найпопулярнішу тему форуму, зазначивши кількість повідомлень з цієї теми.

Program forym;

Const n = 100;

Var

m,і,nt,j,k,max:integer;

tema:array[1..n] of string;

t,p:string;

Begin

{Введення повідомлень}

Write( 'vedit kilkist povidomlen: ' );

ReadLn( m );

for і:=1 to m do

begin

WriteLn( '0 - nove povidomlennja, nomer - vidpovid');

ReadLn( k );

if k=0 then

begin

Write( 'Tema: ' );

ReadLn( t );

Write( 'Povidomlennja: ' );

ReadLn( p );

tema[і]:=t;

end

else

begin

Write( 'Povidomlennja: ' );

ReadLn( p );

tema[і]:=t;

end;

end;

{Знаходження кількості повідомлень}

max:=0;

nt:=0;

for і:=1 to m-1 do

begin

k:=1;

for j:=і+1 to m do

if tema[і]=tema[j] then

k:=k+1;

if k>max then

begin

max:=k;

nt:=і

end;

end;

WriteLn( 'Najpopyljarnisha tema' );

WriteLn( tema[nt] );

WriteLn( 'Kilkist povidomlen ' );

WriteLn( max );

readln;

End.

Задача 22

Перше слово в рядку є словом-донором, а всі інші слова - новими словами, що побудовані з літер початкового слова. Кожна літера в новому слові повинна використовуватись не більше того числа, що визначає кількість входжень літери в слово-донор. Необхідно визначити слова вірно створені із слова-донора.

Program Donor_slovo;

Const n=50;

Var

R, dov, і:integer;

strAll, strG, str2 : string;

Function virno(str1, str2:string):boolean;

Var

k1, k2 : integer;

nFlag : boolean;

begin

nFlag := False;

for k1:=1 to Length(str1) do

for k2:=1 to Length(str2) do

if str1[k1] = str2[k2] then

begin

Delete(str2, k2, 1);

break;

end;

if Length(str2) = 0 then nFlag := True;

virno := nFlag;

end;

Function FindWord():string;

Var

r : integer;

str1 : string;

begin

r:=Pos(',',strAll);

if r=0 then

begin

str1 := strAll;

dov := 0;

end

else

begin

str1 := Copy(strAll,1,r-1);

delete(strAll,1,r+1);

Dov := length(strAll);

end;

FindWord := str1;

end;

Begin

Write('Yvedit slova =>');

Readln(StrAll);

strG := FindWord;

і := 1;

while (dov<>0)or(і<>Length(strAll)) do

begin

if strAll[і] = ',' then

begin

str2 := FindWord;

if Virno(strG, str2) then Writeln(strG,' ',str2);

і:=1;

end;

і:=і+1;

end;

ReadLn;

End.

Задача 23

Необхідно розробити програму, що перетворює натуральне число, записане в римській нумерації, на десяткове число, записане арабськими числами.

Program rumski;

Var

s:string;

n,c,c1,і,a:integer;

Begin

writeln('Yvedit chuslo');

readln(s);

c:=0;n:=0;

for і:=1 to length(s) do

begin

c1:=c;

if s[і]='І' then c:=1;

if s[і]='V' then c:=5;

if s[і]='X' then c:=10;

if s[і]='L' then c:=50;

if s[і]='C' then c:=100;

if s[і]='D' then c:=500;

if s[і]='M' then c:=1000;

if c>c1 then a:=-2*c1

else a:=0;

n:=n+a+c

end;

writeln('Ze chuclo = ',n)

End.

Завдання для самостійної роботи

1. Запитайте у користувача числа, перетворіть їх у рядки, зробіть їх зчеплення в різних поєднаннях і виведіть на екран. Не забудьте поставити між рядками пробіл, в кінці крапку і почати з великої літери.

2. Запитайте у користувача кілька рядків і виведіть на екран їх довжину, результат конкатенації в деякому порядку і зробіть перевірку, чи можна перетворити ці рядки в числа.

3. Запитайте у користувача рядок, що складається з 5 символів, і перевірте чи є він прикладом, додаються два однозначних числа, кожне з яких менше п'яти, якщо є, то обчисліть його.

4. Запитайте у користувача рядок, що складається з декількох слів, розділених пробілом, і виведіть їх на екран так, щоб кожне слово починалося з нового рядка.

5. Запитайте у користувача два рядки і порівняйте їх довжину, перший і останній символ кожного рядка, а також виведіть на екран ці рядки з великої літери.

6. Визначте іменник 1-ої відміни, який закінчується на "а". Перевірте правильність введення. Надрукуйте це слово у всіх відмінках. Застосовуйте підпрограми.

7. Задані прізвище, ім'я та по батькові учня, розділені пропуском. Надрукуйте його прізвище та ініціали. Застосовуйте підпрограми.

8. Підрахуйте кількість цифр у наведеною рядку символів. Застосовуйте підпрограми.

9. Задані прізвище, ім'я та по батькові учня, розділені пропуском. Надрукуйте його прізвище та ініціали. Застосовуйте підпрограми.

10. Порахуйте кількість цифр у наведеною рядку символів. Застосовуйте підпрограми.

11. Складіть програму обчислення суми місць, на яких в слові Х стоять літери "в" і "п".

12. Написати (в порядку появи в тексті) усі слова, довжина яких потрапляє в інтервал [X, Y]. Тут X і Y цілі числа, задаються користувачем.

13. У даному реченні знайти кількість слів, що містять подвоєну приголосну (букви латинські). Слова в реченні розділяються пробілами, в кінці речення - крапка.

14. Складіть програму, викреслюйте кожну третю букву слова Х в заданому реченні.

15. Дана рядок символів до крапки. Групи символів у ній між групами прогалин вважаються словами. Визначити, скільки слів містять рівно 3 букви "е".

16. Дан текст. Підрахувати кількість слів, що закінчуються на задану літеру і перенести їх в інший рядок, написавши через кому. Вивести отриману рядок на екран.

17. Дано 2 текст. Знайти одне із загальних слів, що зустрічаються в текстах.

18. Для кожного заданого слова вказати кількість приголосних. Визначити слово в якому кількість приголосних максимальна.

Размещено на Allbest.ru