Викиучебник

Книга программиста/Задачи с 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.
Источник — https://ru.wikibooks.org/w/index.php?title=Книга_программиста/Задачи_с_CyberForum_для_PascalABC&oldid=163551