Решение задач. День девятнадцатый. Proc31-40


proc31-40

Приветствуем читателей нашего сайта. Сегодня мы решаем proc31-40.

Proc31-40

Proc31. Описать функцию IsPalindrome(K), возвращающую True, если целый параметр K (> 0) является палиндромом (т. е. его запись читается одинаково слева направо и справа налево), и False в противном случае. С ее помощью найти количество палиндромов в наборе из 10 целых положительных чисел.

program proc31;

function IsPalindrom(k: integer): boolean;
var
  k_clone, digit, palindrom: integer;
begin
  k_clone := k;
  while k_clone <> 0 do
  begin
    digit := k_clone mod 10;
    palindrom := palindrom * 10 + digit;
    k_clone := k_clone div 10;
  end;
  if k = palindrom then IsPalindrom := true else IsPalindrom := false;
end;

var
  n, i: integer;

begin
  for i := 1 to 10 do
  begin
    write('Введите число: ');
    readln(n);
    writeln('Число ', n, ' палиндром - ', IsPalindrom(n))
  end
end.

Proc32. Описать функцию DegToRad(D) вещественного типа, находящую величину угла в радианах, если дана его величина D в градусах (D — вещественное число, 0 ≤ D < 360). Воспользоваться следующим соотношением: 180° = π радианов. В качестве значения π использовать 3.14. С помощью функции DegToRad перевести из градусов в радианы пять данных углов.

program proc32;

function DegToRad(d: real): real;
begin
  DegToRad := d * pi / 180; 
end;

const
  pi = 3.14;

var
  deg: real;
  i: integer;

begin
  for i := 1 to 5 do
  begin
    write('Введите величину угла в градусах: ');
    readln(deg);
    writeln(deg, ' гр. = ', DegToRad(deg):0:2, ' рад.')
  end
end.

Proc33. Описать функцию RadToDeg(R) вещественного типа, находящую величину угла в градусах, если дана его величина R в радианах (R — вещественное число, 0 ≤ R < 2·π). Воспользоваться следующим соотношением: 180° = π радианов. В качестве значения π использовать 3.14. С помощью функции RadToDeg перевести из радианов в градусы пять данных углов.

program proc33;

function RadToDeg(r: real): real;
begin
  RadToDeg := r * 180 / Pi;
end;

const
  pi = 3.14;

var
  rad: real;
  i: integer;

begin
  for i := 1 to 5 do
  begin
    write('Введите величину угла в радианах: ');
    readln(rad);
    writeln(rad, ' рад. = ', RadToDeg(rad):0:0, ' гр.')
  end
end.

Proc34. Описать функцию Fact(N) вещественного типа, вычисляющую значение факториала N! = 1·2·…·N (N > 0 — параметр целого типа; вещественное возвращаемое значение используется для того, чтобы избежать целочисленного переполнения при больших значениях N). С помощью этой функции найти факториалы пяти данных целых чисел.

program proc34;
//for19

function Fact(n: integer): real;
var
  i: integer;
begin
  Fact := 1; // По определению 0! = 1
  for i := 1 to N do Result := Result * i;
end;

var
  i, n: integer;

begin
  for i := 1 to 5 do
  begin
    write('N = ');
    readln(n);
    writeln(N, '! = ', Fact(N))
  end
end.

Proc35. Описать функцию Fact2(N) вещественного типа, вычисляющую двойной факториал:
N! = 1·3·5·…·N, если N — нечетное;
N! = 2·4·6·…·N, если N — четное
(N > 0 — параметр целого типа; вещественное возвращаемое значение используется для того, чтобы избежать целочисленного переполнения при больших значениях N). С помощью этой функции найти двойные факториалы пяти данных целых чисел.

program proc35;
//while6

function Fact2(n: integer): real;
var
  anva: integer;
begin
  result := n;
  anva := n;
  
  if (n <> 1) and (n <> 2) then 
    if odd(n) then // проверяем четность и нечетность. odd возвращает правду, если нечетно
      while anva <> 1 do //  пока не равно 1, выполняем цикл подсчета факториала 
      begin
        anva := anva - 2;
        result := result * anva;
      end
    else while anva <> 2 do // пока не равно 2, выполняем цикл
      begin
        anva := anva - 2;
        result := result * anva;
      end;
end;

var
  i, n: integer;

begin
  for i := 1 to 5 do
  begin
    write('N = ');
    readln(n);
    writeln(N, '! = ', Fact2(N))
  end
end.

Proc36. Описать функцию Fib(N) целого типа, вычисляющую N-й элемент последовательности чисел Фибоначчи FK, которая описывается следующими формулами:
F1 = 1, F2 = 1, FK = FK−2 + FK−1, K = 3, 4, ….

program proc36;
//program while_24;

function Fib(n: integer): integer;
var
  a, b, tmp: integer;
begin
  a := 1; // Первое число ряда Фибоначчи.
  b := 1; // второе число Фиббоначчи
  n := n - 2; //Первые два числа уже известны
  while (n <> 0) do
  begin
    tmp := b; // записываем второе число во временную переменную
    b := a + b; // записываем вместо второго числа, следующее число Фиббоначчи
    a := tmp; // переносим значение второго числа в первое
    Dec(n);
  end;
  Result := b;
end;

var
  N, i: integer;

begin
  for i := 1 to 5 do 
  begin
    write('N = ');
    readln(N);
    writeln('Число Фибоначчи под номером ', n, ' : ', Fib(N))
  end;
end.

Используя функцию Fib, найти пять чисел Фибоначчи с данными номерами N1, N2, …, N5.

Дополнительные задания на процедуры и функции

Proc37. Описать функцию Power1(A, B) вещественного типа, находящую величину AB по формуле AB = exp(B·ln(A)) (параметры A и B — вещественные). В случае нулевого или отрицательного параметра A функция возвращает 0. С помощью этой функции найти степени AP, BP, CP, если даны числа P, A, B, C.

program proc37;

function Power1(a, b: real): real;
begin
  if a <= 0 
  then 
    Power1 := 0 
  else
    Power1 := Exp(b * Ln(a));
end;

var
  a, b, c, p: real;

begin
  write('A = ');
  readln(a);
  write('B = ');
  readln(b);
  write('C = ');
  readln(c);
  write('P = ');
  readln(p);
  writeln(a, ' в степени ', p, ' равно ', Power1(a, p));
  writeln(b, ' в степени ', p, ' равно ', Power1(b, p));
  writeln(c, ' в степени ', p, ' равно ', Power1(c, p))
end.

Proc38. Описать функцию Power2(A, N) вещественного типа, находящую величину AN (A — вещественный, N — целый параметр) по следующим формулам:
A0 = 1;
AN = A·A·…·A (N сомножителей), если N > 0;
AN = 1/(A·A·…·A) (|N| сомножителей), если N < 0.
С помощью этой функции найти AK, AL, AM, если даны числа A, K, L, M.

program proc38;

function Power2(a: real; n: integer): real;
begin
  if n = 0 
    then 
    Power2 := 1
  else 
  if n < 0 
    then
    Power2 := 1 / (Exp(abs(n) * Ln(a))) // не забываем про модуль
  else 
    Power2 := Exp(n * Ln(a))
end;

var
  a: real; 
  k, l, m: integer ;

begin
  write('A = ');
  readln(a);
  write('K = ');
  readln(k);
  write('L = ');
  readln(l);
  write('M = ');
  readln(m);
  writeln(a, ' в степени ', k, ' равно ', Power2(a, k):0:2);
  writeln(a, ' в степени ', l, ' равно ', Power2(a, l):0:2);
  writeln(a, ' в степени ', m, ' равно ', Power2(a, m):0:2)
end.

Proc39. Используя функции Power1 и Power2 из Proc37 и Proc38, описать функцию Power3(A, B) вещественного типа с вещественными параметрами, находящую AB следующим образом: если B имеет нулевую дробную часть, то вызывается Power2(A, N), где N — переменная целого типа, равная числу B; иначе вызывается Power1(A, B). С помощью Power3 найти AP, BP, CP, если даны числа P, A, B, C.

program proc39;

function Power1(a, b: real): real;
begin
  if a <= 0 
    then 
    Power1 := 0 
  else
    Power1 := Exp(b * Ln(a));
end;

function Power2(a: real; n: integer): real;
begin
  if n = 0 
    then 
    Power2 := 1
  else 
  if n < 0 
    then
    Power2 := 1 / (Exp(abs(n) * Ln(a))) // не забываем про модуль
  else 
    Power2 := Exp(n * Ln(a))
end;

function Power3(a, b: real): real;
begin
  if Frac(b) = 0 then Power3 := Power2(A, Round(b)) else Power3 := Power1(A, B)
end;

var
  a, b, c, p: real;

begin
  write('A = ');
  readln(a);
  write('B = ');
  readln(b);
  write('C = ');
  readln(c);
  write('P = ');
  readln(p);
  writeln(a, ' в степени ', p, ' равно ', Power3(a, p):0:2);
  writeln(b, ' в степени ', p, ' равно ', Power3(b, p):0:2);
  writeln(c, ' в степени ', p, ' равно ', Power3(c, p):0:2)
end.

Proc40°. Описать функцию Exp1(x, ε) вещественного типа (параметры x, ε — вещественные, ε > 0), находящую приближенное значение функции exp(x):
exp(x) = 1 + x + x2/(2!) + x3/(3!) + … + xn/(n!) + …
(n! = 1·2·…·n). В сумме учитывать все слагаемые, большие ε. С помощью Exp1 найти приближенное значение экспоненты для данного x при шести данных ε.

program proc40;

function Exp1(var x, e: real): real;
var
  a: real;
  j: integer;
begin
  result := 1; 
  j := 1; 
  a := 1; 
  while a > e do 
  begin
    a := a * x / j; 
    result := result + a; 
    inc(j)
  end
end;

var
  e, x: real;
  i: integer;

begin
  write('x = ');
  readln(x);
  for i := 1 to 6 do 
  begin
    write('e = ');
    readln(e); 
    writeln('Экспонента в точке х: ', Exp1(x, e), ' (проверка) = ', Exp(x))
  end
end.

На сегодня все! Если у вас возникли проблемы с решением задач proc31-40 или с любыми другими задачами, то напишите их в комментариях.

Добавить комментарий

Ваш адрес email не будет опубликован. Обязательные поля помечены *