Перестановка букв в слове (циклический сдвиг вправо)
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.