Практические PASCAL

Пример №1.Подсчет различных букв в слове

var s:string;
r:real;
i,j,n:integer;
begin
r:=0;
readln(s);
for i:=1 to length(s) do begin
n:=0;
for j:=1 to length(s) do begin
if s[i]=s[j] then inc(n);
end;
r:=r+1/n;
end;
writeln('количество различных букв = ', r:1:0);
end.

2.Перестановка букв в слове (циклический сдвиг вправо)

var s:string;
i,j,n:integer;
begin
readln(s);
s:=s\[length(s)\] + copy(s,1,length(s)-1);
writeln(s);
end.

3.Определить, является ли слово «перевертышем»
Например, «шалаш», «казак» — перевертыш

var s1,s2:string;
i:integer;
begin
readln(s1); s2:='';
for i:=length(s1) downto 1 do begin
s2:=s2+s1[i];
end;
if s1=s2 then writeln(s1, ' - перевертыш')
else  writeln(s1, ' - не перевертыш');
end.

4.Печать всех делителей натурального числа A

var a,n,c,d:word;
begin { основная программа }
readln( a );
n:=1;
while ( n <= sqrt(a) ) do begin
c:=a mod n;
d:=a div n;
if c = 0 then begin
writeln( n );
if n <> d then writeln( d );
end;
inc( n );
end;
end.

5.Печать всех совершенных чисел до 10000

const LIMIT = 10000;
var n,i,j,s,lim,c,d : word;
begin { основная программа }
for i:=1 to LIMIT do begin
s:=1; lim:=round(sqrt(i));
for j:=2 to lim do begin
c:=i mod j;
d:=i div j;
if c = 0 then begin
inc(s,j);
if (j<>d) then inc(s,d); {дважды не складывать корень числа}
end;
end;
if s=i then writeln(i);
end;
end.

6.Печать всех простых чисел до 500

const LIMIT = 500;
var i,j,lim : word;
begin { основная программа }
writeln; {перевод строки, начинаем с новой строки}
for i:=1 to LIMIT do begin
j:=2; lim:=round(sqrt(i));
while (i mod j <> 0) and (j <= lim) do inc( j );
if (j > lim) then write( i,' ' );
end;
end.

7.Подсчет суммы элементов одномерного массива

var a:array[1..10] of integer;
s:longint;
i:integer;
begin
writeln('введите 10 элементов массива');
s:=0;
for i:=1 to 10 do begin
readln( a[i] );
s:=s+a[i];
end;
writeln( 'Сумма элементов массива = ', s );
end.

8.Подсчет суммы элементов двухмерного массива

var a:array[1..10,1..2] of integer;
s:longint;
i,j:integer;
begin
writeln('введете 20 элементов массива');
s:=0;
for i:=1 to 10 do begin
for j:=1 to 2 do begin
readln( a[i,j] );
s:=s+a[i,j];
end;
end;
writeln( 'Сумма элементов массива = ', s );
end.

9.Поиск минимального элемента в массиве?

var a:array[1..10] of integer;
min:integer;
i:integer;
begin
writeln('введите 10 элементов массива');
min:=MAXINT;
for i:=1 to 10 do begin
readln( a[i] );
if min>a[i] then min:=a[i];
end;
writeln( 'Максимальный элемент массива = ', min );
end.

10.Печать всех элементов массива из интервала C…D

код

var a:array[1..10] of integer;
c,d:integer;
i:integer;
begin
writeln('введите 10 элементов массива');
for i:=1 to 10 do readln( a[i] );
writeln('введите интервал C и D');
readln( c,d );
for i:=1 to 10 do begin
if (a[i]>=C) and (a[i]<=D) then writeln(a[i]);
end;
end.

var a:array[1..10] of integer;
c,d:integer;
i:integer;
begin
writeln('введите 10 элементов массива');
for i:=1 to 10 do readln( a[i] );
writeln('введите интервал C и D');
readln( c,d );
for i:=1 to 10 do begin
if (a[i]>=C) and (a[i]<=D) then writeln(a[i]);
end;
end.