Книга программиста/Задачи с CyberForum для PascalABC
Все программы, код которых выложен здесь, являются работоспособными. На момент написания программ использовалась среда PascalABC 3.0.1.35.
Простые задачи
[править]Модуль выражения
[править]Найти значения модуля |ax-b| при заданных a, b - вещественных числах.
var
A, X, B: real;
begin
Write('Введите A = ');
Readln(A);
Write('Введите X = ');
Readln(X);
Write('Введите B = ');
Readln(B);
Writeln('|ax - b| = ', Abs(A * X - B));
Readln();
end.
Заполнение массива в порядке возрастания
[править]Заполнить массив размера N числами от 1 до N в порядке возрастания.
var
A: array of integer;
N, i: integer;
begin
Readln(N);
SetLength(A, N);
for i := 0 to N - 1 do
A[i] := i + 1;
for i := 0 to N - 1 do
Write(A[i]);
Readln();
end.
Формирование матрицы
[править]Сформировать матрицу размера NxN вида:
| 1 | 0 | 0 |
| 0 | 1 | 0 |
| 0 | 0 | 1 |
const
N = 10;
var
A: array [0..N - 1, 0..N - 1] of integer;
i, j: integer;
begin
for i := 0 to N - 1 do
A[i, i] := 1;
for i := 0 to N - 1 do
begin
for j := 0 to N - 1 do
Write(A[i, j]);
Writeln();
end;
Readln();
end.
Последовательность единиц
[править]Дано натуральное число N не превышающее 10^9. Определить наибольшее количество идущих подряд единиц в двоичной записи этого числа. Если таких групп несколько, можно рассмотреть любую из них.
var
N: integer;
Max, Current: integer;
begin
Readln(N);
Max := 0;
while N <> 0 do
begin
if N mod 2 = 0 then Current := 0 else Current := Current + 1;
if Current > Max then Max := Current;
N := N div 2;
end;
Writeln(Max);
Readln();
end.
Наименьшая нечетная цифра
[править]Дано натуральное четырехзначное число. Найти наименьшую нечетную цифру в числовой записи данного числа.
var
N, C: integer;
Min: integer;
begin
Readln(N);
Min := 11;
while N <> 0 do
begin
C := N mod 10;
if (C < Min) and (C mod 2 <> 0) then Min := C;
N := N div 10;
end;
if Min = 11 then Writeln('Ошибка поиска: отсутствуют нечётные цифры.') else Writeln(Min);
Readln();
end.
Средняя сложность
[править]Квадраты чисел
[править]Найти все такие числа, запись которых совпадает с последними цифрами их квадрата.
function IsSuitable(a: integer): boolean;
var
b: integer;
begin
b := Sqr(a);
Result := true;
while Result and (a <> 0) do
begin
if a mod 10 <> b mod 10 then Result := false;
a := a div 10;
b := b div 10;
end;
end;
var
N: integer;
i: integer;
begin
Readln(N);
for i := 1 to N do
if IsSuitable(i) then Writeln(i);
end.
Два элемента массива
[править]Ввести массив произвольной длины. Поменять местами первый минимальный двузначный элемент и первый элемент, кратный 7.
uses Containers;
var
A: IntArray;
L, K: integer;
i: integer;
Min, MinI: integer;
MultipleI: integer;
begin
Writeln('Длина массива:');
Readln(L);
A := IntArray.Create();
for i := 1 to l do
begin
Readln(K);
A.Add(K);
end;
Min := 10000000;
MinI := -1;
for i := 1 to l do
if (Abs(A[i]) >= 10) and (Abs(A[i]) < 100) and (A[i] < Min) then
begin
Min := A[i];
MinI := i;
end;
MultipleI := -1;
for i := 1 to l do
if A[i] mod 7 = 0 then
begin
MultipleI := i;
break;
end;
Writeln('Изначальный массив:');
A.Println();
if (MinI = -1) or (MultipleI = -1) then
Writeln('Ошибка.')
else
begin
Writeln('Измененный массив:');
A.Exchange(MinI, MultipleI);
A.Println();
end;
end.
Обработка массива
[править]Дан массив из N элементов. Если самый большой элемент превосходит самый маленький более чем в два раза, то найдите произведение всех нечётных элементов массива, в противном случае найдите максимальный отрицательный элемент.
uses Containers;
var
A: IntArray;
i: integer;
K, N: integer;
Max, M: integer;
Found: boolean;
begin
Writeln('Длина:');
Readln(N);
A := IntArray.Create();
for i := 1 to N do
begin
Readln(K);
A.Add(K);
end;
M := 1;
if A.MinElement() * 2 < A.MaxElement() then
begin
for i := 1 to N do
if A[i] mod 2 <> 0 then
M := M * A[i];
Writeln('Произведение: ', M);
end
else
begin
Max := -100000;
Found := false;
for i := 1 to N do
if (A[i] < 0) and (A[i] > Max) then
begin
Max := A[i];
Found := true;
end;
if not Found then Writeln('Ошибка.') else Writeln('Максимальный отрицательный элемент: ', Max);
end;
end.
Задача про шкаф
[править]function F(a1, a2, b1, b2: real): boolean;
begin
Result := ((a1 < b1) and (a2 < b2)) or ((a2 < b1) and (a1 < b2));
end;
var
A, B, C: real;
X, Y: real;
begin
Readln(A, B, C);
Readln(X, Y);
Write('Протолкнуть шкаф в отверстие возможно: ');
if F(A, B, X, Y) or F(B, C, X, Y) or F(A, C, X, Y) then
Writeln('да.')
else
Writeln('нет.');
end.
Заполнение матрицы лесенкой
[править]const
N = 3;
var
A: array [0..N - 1, 0..N - 1] of boolean;
begin
for var i := 0 to N - 1 do
for var j := 0 to i do
A[i, j] := true;
for var i := 0 to N - 1 do
begin
for var j := 0 to N - 1 do
Write(Ord(A[i, j]) : 4);
Writeln();
end;
end.
Поменять местами элементы, удовлетворяющие условию
[править]Поменять местами максимальный элемент, кратный 5 и последний положительный элемент.
const
Capacity = 100;
Min = -1000000;
var
A: array [0..Capacity - 1, 0..Capacity - 1] of integer;
N, M: integer;
i, j: integer;
Max, MaxI, MaxJ, Last, LastI, LastJ: integer;
C: integer;
begin
Writeln('Введите размер матрицы:');
Readln(N, M);
Max := Min;
Last := -1;
Writeln('Введите элементы матрицы:');
for i := 0 to N - 1 do
for j := 0 to M - 1 do
begin
Readln(A[i, j]);
if (A[i, j] > Max) and (Abs(A[i, j]) mod 5 = 0) then
begin
Max := A[i, j];
MaxI := i;
MaxJ := j;
end;
if A[i, j] > 0 then
begin
Last := A[i, j];
LastI := i;
LastJ := j;
end;
end;
if (Max = Min) or (Last = -1) then
Writeln('Удовлетворяющих (-его) условию элементов (-а) не обнаружено.')
else
begin
Writeln(Max, ' ', Last);
C := A[MaxI, MaxJ];
A[MaxI, MaxJ] := A[LastI, LastJ];
A[LastI, LastJ] := C;
end;
end.