• Нахождение минимума и максимума двух, трех, четырех данных чисел без использования массивов и циклов.
read(a, b,c, d);
min:=a;
if (min>b) then min:=b;
if (min>c) then min:=c;
if (min>d) then min:=d;
• Нахождение всех корней заданного квадратного уравнения.
read(a, b,c);// решаем уравнение вида ax**2+bx+c=0
if (a=0) then
if (b<>0) then begin //если а=0 останется уравнение bx+с=0
x:=c/b; write(‘x=’,x:0:4);
end
else begin // если а=0 и b=0 останется уравнение с=0
if c=0 then write(‘решений бесконечное множество’)
else write(‘решения нет’)
end
else begin
d:=b*b-4*a*c;
if (d>0) then begin
x1:=(-b+sqrt(d))/2/a;
x1:=(-b-sqrt(d))/2/a;
write(‘x1=’,x1:0:4,‘, x2=’,x2:0:4);
end
else
if d<0 then
write (‘решения в действительных числах нет’)
else begin
x:=-b/(2*a);
write(‘x=’,x:0:4);
end;
end;
• Нахождение наибольшего общего делителя двух натуральных чисел (алгоритм Евклида).
read(a, b);
{1}
while a<>b do
if a>b then a:=a-b else b:=b-a;
nod:=a;
{2}
if a=b then nod:=a
else
while a=0 do
if a>b then begin
a:=a mod b;
nod:=b;
end
else begin
b:=b mod a;
nod:=a;
end;
//наименьшее общее кратное
Nok:=a*b;
while a<>b do
if a>b then a:=a-b else b:=b-a;
nod:=a;
nok:=nok/nod;
• Запись натурального числа в позиционной системе с основанием меньшим или равным 10. Обработка и преобразование такой записи числа.
//перевод десятичного числа в р-ичную систему счисления
read(a, p); //a – десятичное число, p<10 – основание системы
q:=’’;
while a>0 do
begin
b:=a mod p;
a:=a div p;
str(b, s); //собираем число в строку q
q:=s+q;
end;
write(q);
//перевод числа из р-ичной системе счисления в десятичную
read(p, q);
{1}
a:=0;
for i:=1 to length(q) do begin
a:=a*p+(ord(q[i])-ord(‘0’)); //схема Горнера
end;
{2}
a:=0;
b:=1;
for i:=length(q) downto 1 do begin
val(q[i],z, code);
a:=a+z*b; //развернутая форма
b:=b*p; //степень p
end;
write(a);
//выделение всех цифр числа и вывод в обратном порядке
read(a);
while a>0 do
begin
b:=a mod 10;
write(b);
a:= a div 10;
end;
//выделение всех цифр числа и нахождение суммы цифр
read(a);
s:=0;
while a>0 do
begin
b:=a mod 10;
s:=s+b;
a:= a div 10;
end;
write(s);
//нахождение количества четных цифр числа
read(a);
k:=0;
while a>0 do
begin
b:=a mod 10;
if b mod 2 =0 then k:=k+1;
a:= a div 10;
end;
write(k);
• Нахождение сумм, произведений элементов данной конечной числовой последовательности (или массива).
read(n);
s:=0;
p:=1;
for i:=1 to n do
begin
read(a);
s:=s+a;
p:=p*a;
end;
write(‘сумма=’,s,’, произведение=’,p);
• Использование цикла для решения простых переборных задач (поиск наименьшего простого делителя данного натурального числа, проверка числа на простоту, и т. д.).
//поиск наименьшего простого делителя числа
read(a);
k:=a div 2;
d:=1;
while k>1 do
if a mod k=0 then begin a:=a div k; d:=k; end
else k:=k-1;
write(d);
// 1-проверка числа на простоту
if d=1 then write(‘простое’) else write(‘не простое’);
// 2-проверка числа на простоту
read(a);
if a=1 then write(‘не простое’)
else begin
flag:=true;
for i:=2 to round(sqrt(a)) do
if a mod i = 0 then begin flag:=false; break; end;
if flag then write(‘простое’) else write(‘не простое’);
end;
• Заполнение элементов одномерного и двумерного массива по заданным правилам.
//заполнение матрицы a[n, n] змейкой
// 1 2 3
// 6 5 4
// 7 8 9
read(n);
k:=0;
for i:=1 to n div 2 do
for j:=1 to n do
begin
k:=k+1;
a[2*i-1,j]:=k;
end;
if 2*i<=n then
for j:=n downto 1 do
begin
k:=k+1;
a[2*i, j]:=k;
end;
//заполнение вектора a[n] числами Фибоначчи
read(n);
a[1]:=1; a[2]:=1;
for i:=3 to n do
a[i]:=a[i-1]+a[i-2];
//заполнение массива из введенных нечетных чисел
K:=0;
While not eoln()do begin
Read(a);
If odd(a) then begin
K:=k+1;
B[k]:=a;
End;
End;
For i:=1 to k do
Write(b[i], ’ ‘);
//самая длинная подпоследовательность из возрастающих
//(убывающих) элементов
K:=1;
Read(b);
C[k]:=b;
While b<>0 do begin
Read(a);
If a=0 then break;
If a>=b then k:=k+1 else k:=1;
C[k]:=a;
b:=a;
End;
For i:=1 to k do
Write(c[i],’ ‘);
• Операции с элементами массива. Линейный поиск элемента. Вставка и удаление элементов в массиве. Перестановка элементов данного массива в обратном порядке. Суммирование элементов массива. Проверка соответствия элементов массива некоторому условию.
//объявление и ввод массива
var a:array[1..100]of integer;
i, n:integer;
begin
read(n);
for i:=1 to n do
read(a[i]);
for i:=1 to n do
writeln(a[i]);
// Линейный поиск элемента
find:=false;
read(b);
for i:=1 to n do
if a[i]=b then begin find:=true; break; end;
if find then write(‘YES’) else write(‘NO’);
//Вставка элемента b в массив перед k-ым элементом
read(b, k);
for i:=n downto k do
a[i+1]:=a[i];
a[k]:=b;
//Удаление k-го элемента из массива
read(k);
for i:=k to n-1 do
a[i]:=a[i+1];
n:=n-1;
//Перестановка элементов данного массива в обратном порядке
for i:=1 to n div 2 do
begin
temp:=a[i];
a[i]:=a[n-i+1];
a[n-i+1]:=temp;
end;
//Вывод элементов массива в обратном порядке
for i:=n downto 1 do
write(a[i],‘ ’);
//Суммирование элементов массива
s:=0;
for i:=1 to n do
s:=s+a[i];
//Проверка соответствия элементов массива некоторому условию
k:=0;
for i:=1 to n do
if a[i] mod 5 = 0 then k:=k+1;
• Нахождение минимального (максимального) значения в данном массиве и количества элементов, равных ему, за однократный просмотр массива.
//Нахождение первого минимального (максимального) значения
min:=a[1]; max:=a[1];
for i:=2 to n do begin
if min>a[i] then min:=a[i];
if max<a[i] then max:=a[i];
end;
//Нахождение последнего минимального (максимального) значения
min:=a[1]; max:=a[1];
for i:=2 to n do begin
if min>=a[i] then min:=a[i];
if max<=a[i] then max:=a[i];
end;
//Нахождение минимального (максимального) значения по индексу
nmin:=a[1]; nmax:=a[1];
for i:=2 to n do begin
if a[nmin]>a[i] then nmin:=i;
if a[nmax]<a[i] then nmax:=i;
end;
//Нахождение количества элементов, равных минимальному //максимальному), за однократный просмотр массива
min:=a[1];k:=1;
for i:=2 to n do
if min>a[i] then begin
min:=a[i];k:=1;
end
else if min=a[i] then k:=k+1;
• Нахождение второго по величине (второго максимального или второго минимального) значения в данном массиве за однократный просмотр массива.
if a[1]>a[2] then begin min1:=a[2];min2:=a[1]; end
else begin
min2:=a[2];min1:=a[1];
end;
for i:=2 to n do
if min1>a[i] then begin
min2:=min1;
min1:=a[i];
end
else if min2>a[i] then min2:=a[i];
write(min2);
• Операции с элементами массива, отобранными по некоторому условию (например, нахождение минимального четного элемента в массиве (1), нахождение количества (2) и суммы всех четных элементов в массиве (3)).
{1}
k:=1;
while (k<=n)and(a[k] mod 2<>0) do k:=k+1;
if k>n then
begin
write(‘минимального четного нет’); exit;
end;
min:=a[k];
for i:=k+1 to n do
if (a[i] mod 2 =0) and (min>a[i]) then min:=a[i];
write(min);
{2}
k:=0;
for i:=1 to n do
if (a[i] mod 2 =0) then k:=k+1;
write(k);
{3}
s:=0;
for i:=1 to n do
if (a[i] mod 2 =0) then s:=s+a[i];
write(k);
• Сортировка массива.
Type mas=array[1..100]of integer;
Var T : mas;
//обменная сортировка пузырек
procedure sort1(var t:mas;n:integer);
var i, a,s:integer;
begin
for s:=1 to n-1 do
for i:=1 to n-s do
if t[i]>t[i+1] then
begin
a:=t[i];
t[i]:=t[i+1];
t[i+1]:= a;
end;
end;
//улучшенная обменная сортировка пузырек
procedure sort1(var t:mas;n:integer);
var i, a,s:integer; flag:boolean;
begin
for s:=1 to n-1 do begin
flag:=true;
for i:=1 to n-s do
if t[i]>t[i+1] then
begin
a:=t[i];
t[i]:=t[i+1];
t[i+1]:= a;
flag:=false;
end;
if flag then break;
end;
end;
//обменная сортировка челнок
procedure sort2(var t:mas;n:integer);
var i, a,d:integer;
begin
for d:=1 to n div 2 do begin
for i:=d to n-d do
if t[i]>t[i+1] then
begin
a:=t[i];
t[i]:=t[i+1];
t[i+1]:= a;
end;
for i:=n-d downto d+1 do
if t[i]<t[i-1] then
begin
a:=t[i];
t[i]:=t[i-1];
t[i-1]:= a;
end;
end;
end;
//сортировка выбором
procedure sort3(var t:mas;n:integer);
var i, k,s, a:integer;
begin
for s:=1 to n-1 do begin
k:=s;
for i:=s+1 to n do
if t[i]<t[k] then k:=i;
if k<>s then begin
a:=t[k];
t[k]:=t[s];
t[s]:=a;
end;
end;
end;
//сортировка вставками
procedure sort4(var t:mas;n:integer);
var i, k,a:integer;
begin
for k:=2 to n do
for i:=k-1 downto 1 do
if t[i+1]<t[i] then
begin
a:=t[i+1];
t[i+1]:=t[i];
t[i]:=a;
end
else break;
end;
• Слияние двух упорядоченных массивов в один без использования сортировки.
var i, j,k, m,z, n:integer;
a, b,c:array[1..100]of integer;
begin
read(n, m);
for i:=1 to n do
read(a[i]);
for i:=1 to m do
read(b[i]);
k:=1; z:=1; j:=0;
repeat
for i:=k to n do
if a[i]<=b[z] then
begin
j:=j+1;
c[j]:=a[i]
end
else begin
k:=i;
break;
end;
if i=n then
begin
for i:=z to m do
begin
j:=j+1;
c[j]:=b[i];
end;
z:=m+1;
end;
for i:=z to m do
if b[i]<=a[k] then
begin
j:=j+1;
c[j]:=b[i]
end
else begin
z:=i;
break;
end;
if i=m then
begin
for i:=k to n do
begin
j:=j+1;
c[j]:=a[i];
end;
k:=n+1;
end;
until ((k>=n) and (z>=m)) or (j>=n+m);
for i:=1 to n+m do
write(c[i],' ');
end.
• Обработка отдельных символов данной строки. Подсчет частоты появления символа в строке.
var a:array[‘a’..’z’]of integer;
i, c:char;
k:integer;
begin
for i:=’a’ to ‘z’ do
a[i]:=0;
k:=0;
read(c);
while ord(c)>13 do
begin
if c in [‘a’..’z’] then
begin
a[c]:=a[c]+1;
k:=k+1;
end;
read(c);
end;
for i:=’a’ to ‘z’ do
if a[i]<>0 then
writeln(i, ’ ’, a[i], ’ ’, a[i]*100/k:0:2, ‘%‘);
end.
• Работа с подстроками данной строки с разбиением на слова по пробельным символам.
n:=0;
s:=’’;
read(c);
while c<>#10 do begin
if (c=’ ’)and(s<>’’) then begin
n:=n+1;
a[n]:=s;
s:=’’;
end else
if c<>’ ’ then s:=s+c;
read(c);
end;
if s<>’’ then begin
n:=n+1;
a[n]:=s;
end;
for i:=1 to n do
writeln(a[i]);
• Поиск подстроки внутри данной строки, замена найденной подстроки на другую строку.
readln(s);
readln(w);k:=length(k);
readln(q);
z:=0;
p:= pos(w, s);
while p>0 do begin
delete(s, p,k);
insert(q, s,p);
p:= pos(w, s);
z:=z+1;
end;
writeln(z);
writeln(s);
