Pascal abc как найти числа

Простейшие алгоритмы

№1. Сумма вводимых целых чисел

begin
  var n := ReadInteger('Введите число слагаемых:'); 

  var s := 0.0; 
  for var i:=1 to n do
  begin 
    var x := ReadReal($'Введите слагаемое №{i}:'); 
    s += x;
  end;

  Println($'Сумма равна {s}');
end.

В алгоритме используются интерполированные строки вида $’Сумма равна {s}’.
Они начинаются с $. Выражение в фигурных скобках, расположенное в такой строке, заменяется на его значение.

№2. Произведение целых чисел

begin
  var n := ReadInteger('Введите число множителей: ');

  var p := 1.0;
  for var i:=1 to n do
  begin
    var x := ReadReal('Введите множитель: ');
    p *= x;
  end;

  Println($'Произведение равно {p}');
end.

№3. Двойной факториал n!!=n*(n-2)*(n-4)*…*2 (или 1)

begin
  var x := ReadInteger('Введите x: ');

  var p := 1;
  while x>=2 do
  begin
    p *= x;
    x -= 2;
  end;

  Println($'Двойной факториал равен {p}');
end.

№4. Сколько нечетных среди n введенных

begin
  var n := ReadInteger('Введите n: ');

  var c := 0;
  for var i:=1 to n do
  begin
    var x := ReadInteger('Введите целое число: ');
    if x mod 2 <> 0 then
      c += 1;
  end;

  println($'Количество нечетных равно {c}');
end.

№5. Защита от неверного ввода

begin
  var x: real;
  repeat
    x := ReadReal('Введите x>0: ');
    if x<=0 then
      Println('Неверный ввод');
  until x>0;
end.

№6. Табулирование функции f(x) на отрезке в точках, разбивающих отрезок на N частей

Дан отрезок [a,b]

function f(x: real) := sin(x)*x;

begin
  var N := ReadInteger('Введите N: ');
  Assert(N>0);
  var (a,b) := ReadReal2('Введите a и b: ');

  var h := (b-a)/N;
  var x := a;
  loop N+1 do
  begin
    Writeln(x:5:2,f(x):10:4);
    x += h;
  end;
end.

№6a. Решение, использующее while. Погрешность округления и вычислительная погрешность

function f(x: real): real:= sin(x)*x;

begin
  var N:=ReadInteger('Введите N: ');
  Assert(N>0);
  var (a,b):=ReadReal2('Введите a и b: ');
 
  var h := (b-a)/N;
  var x := a;
  while x <= b+h/2 do
  begin
    writeln(x:5:2,f(x):10:4);
    x += h;
  end;
end.

Рекуррентные соотношения

№7. Вывод 10 первых степеней двойки

begin
  var x := 2;
  for var i := 1 to 10 do
  begin
    writeln(i:2,x:5);
    x *= 2;
  end;
end.

№8. Вывод всех двухзначных чисел, кратных 5

begin
  var x := 10;
  while x < 100 do
  begin
    writeln(x:3);
    x += 5;
  end;
end.

№9. Вывод n первых чисел Фибоначчи

begin
  var n := ReadInteger('Введите целое число n (n > 1): ');
  Assert(n>1);
  var (a,b) := (1,1);
  Print(a,b);
  loop n-2 do
  begin
    (a,b):=(b,a+b);
    Print(b);
  end;
end.

В алгоритме используются кортежи. В момент переприсваивания в цикле создаются буферные переменные, что позволяет нам избежать их объявления вручную.

№10. Найти НОД(A,B), используя алгоритм Евклида:

НОД(A,B) = НОД(B,A mod B); НОД(A,0) = A

begin
  var (a,b):=ReadInteger2('Введите целые числа A и B: ');
  while b<>0 do
    (A,B):=(B,A mod B);
  println($'НОД(A,B) = {A}');
end.

№11. Найти сумму цифр целого числа m

begin
  var m := ReadInteger('Введите целое число m: ');
 
  var (s,m1) := (0,abs(m));
  while m1 > 0 do
  begin
    s += m1 mod 10;
    m1 := m1 div 10;
  end;
 
  println($'Сумма цифр числа {m} равна {s}');
end.

Для работы с отрицательными числами в алгоритме используется стандартная функция abs(x) возвращающая модуль от x.

Максимумы и минимумы

№12. Найти max из введенных чисел

begin
  var n := ReadInteger('Введите целое число n (n>0): ');
  assert(n>0);
 
  var x := ReadReal('Введите 1 число: ');
  var max := x;
  for var i := 2 to n do
  begin
    x := ReadReal($'Введите {i} число: ');
    if max < x then
      max := x;
  end;
 
  Println($'Максимальное из введенных чисел: {max}');
end.

№12a. Найти min, удовлетворяющее условию p(x)

// Условие взятое как пример (Если число положительное, то условие p(x) возвращает true, иначе false)
function p(x: real): boolean:=x > 0;
 
begin
  var n := ReadInteger('Введите целое число n (n>0): ');
  assert(n>0);
 
  var min := real.MaxValue;
  for var i := 1 to n do
  begin
    var x := ReadReal($'Введите {i} число: ');
    if (x < min) and p(x) then
      min := x;
  end;
 
  if min = real.MaxValue then
    println('Нет чисел, удовлетворяющих условию')
  else println($'Минимальное из введенных чисел, удовлетворяющее условию: {min}');
end.

Суммирование рядов (конечных и бесконечных)

№13. Вычислить Σ(i=1..n) a^i/i!

begin
  var a:=ReadReal('Введите a: ');
  var n:=ReadInteger('Введите n (n>0): ');
  assert(n>0);
  var x := a;
  var s := x;
  for var i := 2 to n do
  begin
    x *= a / i;
    s += x;
  end;
  Println($'Сумма = {s}');
end.

№13a. Вычислить Σ(i=1..∞) (-1)^i * a^i/i!

begin
  var a:=ReadReal('Введите a (0 < a < 1): ');
  assert((a>0) and (a<1));
 
  var eps := 0.0001;
  var i := 1;
  var s := 0.0;
  var y := -a;
  repeat
    s += y / i;
    i += 1;
    y *= -a;
  until abs(y/i) < eps;
 
  Println($'Сумма = {s}');   
end.

Поиск значения

№14. Есть ли среди введенных число k?

var n,k: integer;
begin
  write('Введите целые числа n (n>0) и k: ');
  readln(n,k);
  assert(n>0);

  var Exists := false;
  for var i := 1 to n do
  begin
    write('Введите ', i, ' целое число: ');
    var x := ReadInteger;
    if x = k then
    begin
      Exists := true;
      break;
    end;
  end;

  if Exists then
    writeln('Число ', k, ' было введено')
  else writeln('Число ', k, ' не было введено');
end.

№14b. Есть ли среди введенных число k? (то же с использованием while)

var n,k: integer;
begin
  write('Введите целые числа n (n>0) и k: ');
  readln(n,k);
  assert(n>0);

  var Exists := false;
  var i := 1;
  while (i <= n) and not Exists do
  begin
    write('Введите ', i, ' целое число: ');
    var x := ReadInteger;
    i += 1;
    if x = k then
      Exists := true;
  end;

  if Exists then
    writeln('Число ', k, ' было введено')
  else writeln('Число ', k, ' не было введено');
end.

№15. Является ли число N>1 простым?

begin
  write('Введите целое число N (N>1): ');
  var N := ReadInteger;
  assert(N>1);

  var IsPrime := True;
  for var i := 2 to round(sqrt(N)) do
    if N mod i = 0 then
    begin
      IsPrime := False;
      break;
    end;

  if IsPrime then
    writeln('Число ', N, ' является простым')
  else writeln('Число ', N, ' является составным');
end.

Другие алгоритмы

№16. Разложение числа на простые множители

begin
  var x := ReadInteger('Введите целое число x (x>1): ');
  assert(x>1);

  var i := 2;
  write(x, ' = 1');
  repeat
    if x mod i = 0 then
    begin
      Print('*', i);
      x := x div i;
    end
    else i += 1;
  until x = 1;
end.

№17. Вычисление значения многочлена в точке x по схеме Горнера

var 
  x,a: real;
  n: integer;
begin
  write('Введите x: ');
  readln(x);
  write('Введите степень многочлена n (n>0): ');
  readln(n);
  assert(n>=0);
  write('Введите коэффициенты: ');
  readln(a);

  var s := a;
  for var i := 1 to n do
  begin
    write('Введите a_{', i+1,'}: ');
    readln(a);
    s := s*x + a;
  end;

  writeln('Значение многочлена p(x) = a_{1}*x^n + a_{2}*x^(n-1) + ... + a_{n}*x + a_{n+1} в точке x = ', x, ' равно ', s);
end.

№18. Дана непрерывная на отрезке функция f(x), имеющая на отрезке ровно один корень. Найти его методом половинного деления

Дан отрезок [a,b] (f(a)*f(b)<=0)

// В качестве примера взяты eps = 0.0001 и функция f(x) = sin(x)
const eps = 0.0001;
const f = sin;

var a,b: real;
begin
  write('Введите числа a и b (a<b): ');
  readln(a,b);
  assert(a<b);

  var fa := f(a);
  var fb := f(b);
  assert(fb*fa<0);

  while (b-a) > eps do
  begin
    var x := (b+a)/2;
    var fx := f(x);
    if fa*fx <= 0 then
      b := x;
    else
    begin
      a := x;
      fa := fx;
    end;
  end;

  writeln('Корень функции на [a,b] равен ',(b+a)/2);
end.

© Буцев Виктор, Белоусько Тихон, Зуев Семен, Гончаров Владислав, Батраков Михаил, Гаджиев Казанфар, Пак Владислав

Проще всего задача поиска максимального из трех, четырех и более чисел, решается перегрузкой функции нахождения максимума из двух.

Аналогичные функции можно написать для поиска минимального из чисел. Для этого достаточно сменить знак сравнения в функции с двумя аргументами(в первой из рассмотренных).

Для реализации сначала нужно написать функцию, которая находит максимальное из двух чисел.

Функция определения максимального из двух чисел

function Max(x1, x2 : integer) : integer;
begin
  if x1 > x2 then
    Max := x1
  else
    Max := x2;
end; 

Теперь у нас есть код, который возвращает наибольшее из двух чисел. Для того, чтобы расширить количество аргументов до трех, достаточно написать ещё одну функцию, которая будет дважды вызывать предыдущую.

Функция поиска наибольшего из трех чисел

function Max(x1, x2, x3 : integer) : integer;
begin
  Max := Max(Max(x1, x2), x3);
end;

А что если нужно сравнить четыре, пять и больше чисел, и найти максимальное из них?

Без проблем, мы можем писать столько перегруженных функций, сколько нам нужно.

Максимум из четырех чисел

function Max(x1, x2, x3, x4 : integer) : integer;
begin
  Max := Max(Max(x1, x2, x3), x4);
end; 

Эта функция использует вызов двух предыдущих.

Программа для поиска и вывода максимальных чисел

все приведенные выше функции должны быть размещены в том же порядке над телом основной программы

В зависимости от количества аргументов, компилятор выбирает какую из функций вызывать.

begin
  writeln(Max(1, 4));
  writeln(Max(9, 2, 7));
  writeln(Max(8, 3, 6, 5));
  readln;
end. 

Если предполагается сравнивать много чисел, то лучше всего представить их в виде массива, и искать минимальный или максимальный элемент в массиве.

Записывать данные в массива можно и без помощи readln, достаточно простой команды read. Приведём простой пример где считываем данные из массива и выводим:

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

Это было простое повторение. А теперь давайте попробуем написать программу, которая ищет в массиве число k, и если оно есть, то выводит yes или no:

for i:=1 to n do
 if a[i]=k then
  q:=1;
if q=1 then
 write('Yes')
else
 write('No');

Эту программу все всегда пишут с первого раза именно в таком виде.

Какие тут могут быть ошибки?

Ошибки довольно таки простые:

Например переменная q и так может быть равна 1, так как в разных средах Ваша программа будет воспринимать всё по разному. Тогда онулируем переменную в самом начале:

q:=0;
for i:=1 to n do
 if a[i]=k then
  q:=1;
if q=1 then
 write('Yes')
else
 write('No');

И видно что программа будет работать очень долго, если у нас будет массив из миллиарда элементов, так как наш цикл сначала проверит весь массив и только потом выдаст результат, что нам не нужно. Тогда ускорить программу нам поможет замена цикла на цикл с условием — while:

q:=0; i:=1;
while (q<>1) and (i<=n) do
begin
 if a[i]=k then
  q:=1;
 i:=i+1;
end;
if q=1 then 
 write('Yes')
else
 write('No');

Теперь программа стала работать быстрее, так как после нахождения нужного нам числа, цикл остановится, но эта программа ещё далека от совершенства. Теперь давайте попробуем вида-изменить цикл while, и убрать переменную q:

i:=1;
while (a[i]<>k) and (i<=n) do
 i:=i+1;
if q=1 then 
 write('Yes')
else
 write('No');

Наш цикл стал немного лучше, но всё же в нём есть грубые ошибки, и эти ошибки именно в цикле, а не в условии, так как мы его пока затрагивать не собираемся. И так какую же ошибку мы можем сейчас изменить? Ошибка очень проста, достаточно посмотреть на условие цикла, и всё станет понятно — мы говорим о том, что сначала цикл проверяет совпадение, а потом кончился ли цикл или нет, что может выдать ошибку.

То есть если у нас в программе строгие проверки с количеством элементов в массиве, то ошибка будет видна нам сразу, а так мы её и не заметим, то есть цикл может быть переполненным — значение i станет равно n+1, что нам не нужно, тогда достаточно просто поменять условия местами, и как известно в pascal — если одно условие не сработает, то и другое проверятся не будет:

i:=1;
while (i<=n) and (a[i]<>k) do
 i:=i+1;
if q=1 then 
 write('Yes')
else
 write('No');

Мы можем ещё упростить верхнюю часть:

Мы каждый раз проверяем в условии цикла — конец ли массива, что нам вообще и не нужно, если представить что у нас цикл с миллионом элементов, то каждый раз проверять конец ли массива нет смысла, для облегчения этой задачи используется Барьерный элемент. Что он из себя представляет:

Это самый последний элемент массива, добавленный вручную, который имеет искомое значение, то есть мы добавим искомое значение в конец массива, и при проверки условия будет проверять именно это — имеет ли переменная i значение n+1:

i:=1;
a[n+1]:=k;
while a[i]<>k do
 i:=i+1;
if i=n+1 then  write('No')
else write('Yes');

Мы добавили одну ячейку памяти и при этом ускорили программу вдвое.

Теперь перейдём к следующему:

Второй максимум.

То есть мы будем искать в массиве второй максимум, второй максимум — это число, которое меньше максимума, но больше других чисел.

Сначала напишем программу, которая просто находит максимальное число в массиве:

max:=a[1];
for i:=2 to n do
 if a[i]>max then
  max:=a[i];

Как видим — максимум у нас равен первому элементу, который мы будем сравнивать со всеми другими элементами.

До этого мы представляли себе — если у нас много чисел, то всех их нужно загонять в массив, но это не так — представьте себе что в Вашей программе нельзя использовать массивы, то как сделаете Вы?

Самое простое решение — это использование одной переменной для хранения всех значений:

readln(k);
max:=k
for i:=2 to n do
begin
 readln(k);
  if k>max then
   max:=k;
end;

Теперь перейдём к решению задачи со вторым максимумом.

Представим что изначально переменные max и max2 равны минус бесконечности.

Теперь изменим код предыдущей программы именно так, что бы он искал max2 и не было ни каких ошибок:

readln(k);
max:=k;
for i:=2 to n do
begin
 readln(k);
  if k>max then
  begin
   max2:=max;
   max:=k;
  end else
   if (k>max2) and (k<max) then
    max2:=k;
end;

В этой программе мы всё учли, даже то, что max может изначально иметь максимальное значение.

Представьте себе задачу подсчитать сколько максимумов в массиве, то как бы Вы реализовали её?

Мы предлагаем ввести в программу счётчик, который увеличивался на 1 при новом максимуме или числу равному максимуму. Увеличивать мы будем не по старинке — i:=i+1, а при помощи функции increment, сокращённо inc, и в скобках уже пишем имя переменной, эта функция увеличивает переменную на единицу. Также есть и функция, которая уменьшает значение на единицу — decrement, сокращённо dec.

Теперь давайте напишем нашу программу:

readln(k);
max:=k;
maxcount:=0;
for i:=2 to n do
begin
 readln(k);
  if k>max then
  begin
   inc(maxcount);
   max2:=max;
   max:=k;
  end else
   if (k>max2) and (k<max) then
    max2:=k
   else
    if max=k then
     inc(maxcount);
end;