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

var s:string;

i,j,n:integer;

begin

readln(s);

s:=s[length(s)] + copy(s,1,length(s)-1);

writeln(s);

end.

3. Определить, является ли слово "перевертышем"

{ Например, "шалаш", "казак" - перевертыш }

program primer1;

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.

Печать всех делителей натурального числа 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.

Печать всех совершенных чисел до 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.

Печать всех простых чисел до 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.

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

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.

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

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.

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

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;

x:integer;

i:integer;

begin

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln(a[i]);

x:=a[10];

for i:=10 to 2 do begin

a[i]:=a[i-1];

end;

a[1]:=x;

writeln('после сдвига:');

for i:=1 to 10 do writeln(a[i]);

end.

Печать самого часто встречающегося элемента из массива

var a:array[1..10] of integer;

i,j,m,p,n:integer;

begin

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln(a[i]);

m:=1; p:=1;

for i:=1 to 10 do begin

n:=0;

for j:=1 to 10 do begin

if a[i]=a[j] then inc(n);

end;

if n>m then begin

m:=n; p:=i;

end;

end;

writeln('самый часто встречающийся элемент:',a[p]);

end.

Все ли элементы массива различны?

Вариант с циклом WHILE

 

var a:array[1..10] of integer;

i,j:integer;

begin

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln(a[i]);

i:=1;

while (i<10) and (j<11) do begin

j:=i+1;

while (j<11) and (a[i]<>a[j]) do inc(j);

inc(i);

end;

if i<11 then writeln('в массиве есть одинаковые элементы')

else writeln('все элементы массива различны');

end.

Вариант с циклом FOR

var a:array[1..10] of integer;

i,j:integer;

begin

writeln('введите 10 элементов массива');

for i:=1 to 10 do readln(a[i]);

for i:=1 to 9 do begin

for j:=i+1 to 10 do begin

if a[i]=a[j] then break;

end;

if j<10 then break;

end;

if i<9 then writeln('в массиве есть одинаковые элементы')

else writeln('все элементы массива различны');

end.

14. Сортировка массива "пузырьком" по возрастанию

const n = 10; { количество элементов в массиве }

var a:array[1..n] of integer;

i,j,x:integer;

begin

writeln('введите ',n,' элементов массива');

for i:=1 to n do readln(a[i]);

 

for i:=1 to n-1 do begin

for j:=i+1 to n do begin

if a[i]>a[j] then begin

x:=a[i]; a[i]:=a[j]; a[j]:=x;

end;

end;

end;

writeln('после сортировки:');

for i:=1 to n do writeln(a[i]);

end.

15. Решение уравнения: A*x^2 + B*x + C = 0

var a,b,c,d,x:real;

begin

writeln('введите A,B,C');

readln(a,b,c);

d:=sqr(b)-4*a*c;

if d<0 then begin

writeln('действительных корней нет');

end else if d=0 then begin

x:=(-b)/2*a;

writeln('корень уравнения: ',x);

end else begin

x:=(-b+sqrt(d))/2*a;

writeln('1-й корень уравнения: ',x);

x:=(-b-sqrt(d))/2*a;

writeln('2-й корень уравнения: ',x);

end

end.

Вычисление длины отрезка

var x1,y1,x2,y2,d:real;

begin

writeln('введите A(X1,Y1) и B(X2,Y2)');

readln(x1,y1,x2,y2);

d:=sqrt(sqr(y2-y1)+sqr(x2-x1));

writeln('длина отрезка |AB|=',d);

end.

Какая точка (A или B) ближе к началу координат

var x1,y1,x2,y2,d1,d2:real;

begin

writeln('введите A(X1,Y1) и B(X2,Y2)');

readln(x1,y1,x2,y2);

d1:=sqrt(sqr(y1)+sqr(x1));

d2:=sqrt(sqr(y2)+sqr(x2));

if d1<d2 then writeln('Точка A ближе')

else if d1>d2 then writeln('Точка B ближе')

else writeln('Одинаково');

end.