Решение задач. День шестнадцатый. Proc1-10


proc1-10

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

Proc1-10

Proc1. Описать процедуру PowerA3(A, B), вычисляющую третью степень числа A и возвращающую ее в переменной B (A — входной, B — выходной параметр; оба параметра являются вещественными). С помощью этой процедуры найти третьи степени пяти данных чисел.

program proc1;

procedure PowerA3(x: real; var y: real);
{Связываю y и b. Теперь все, что я
сделаю с у, сделается и с b.
А значение х = а}
begin
  y := x * x * x;
end;

var
  a, b: real;

begin
  write('Введите число: ');
  readln(a);
  PowerA3(a, b); {Вызываю процедуру}
  write(a, ' в третьей степени ', b);
end.

Proc2. Описать процедуру PowerA234(A, B, C, D), вычисляющую вторую, третью и четвертую степень числа A и возвращающую эти степени соответственно в переменных B, C и D (A — входной, B, C, D — выходные параметры; все параметры являются вещественными). 

program proc2;

procedure PowerA234(x: real; var y2, y3, y4: real);
begin
  y2 := x * x; 
  y3 := x * x * x;
  y4 := y2 * y2;
end;

var
  a, b, c, d: real;

begin
  write('Введите число: ');
  readln(a);
  PowerA234(a, b, c, d); {Вызываю процедуру}
  writeln(a, ' во второй степени ', b);
  writeln(a, ' в третьей степени ', c);
  writeln(a, ' в четвертой степени ', d);
end.

Proc3. Описать процедуру Mean(X, Y, AMean, GMean), вычисляющую среднее арифметическое AMean = (X+Y)/2 и среднее геометрическое GMean = √(X * Y) двух положительных чисел X и Y (X и Y — входные, AMean и GMean — выходные параметры вещественного типа). С помощью этой процедуры найти среднее арифметическое и среднее геометрическое для пар (A, B), (A, C), (A, D), если даны A, B, C, D.

program proc3;

procedure Mean(x, y: real; var a, g: real);
begin
  a := (x + y) / 2;
  g := Sqrt(x * y)
end;

var
  a, b, c, d, AMean, GMean: real;

begin
  write('A = ');
  readln(a);
  write('B = ');
  readln(b);
  write('C = ');
  readln(c);
  write('D = ');
  readln(d);
  Mean(a, b, AMean, GMean); {Вызываю процедуру}
  writeln('Среднее арифметическое ', a, ' и ', b, ' равно ', AMean);
  writeln('Среднее геометрическое ', a, ' и ', b, ' равно ', GMean:3:2);
  Mean(a, c, AMean, GMean); {Вызываю процедуру}
  writeln('Среднее арифметическое ', a, ' и ', c, ' равно ', AMean);
  writeln('Среднее геометрическое ', a, ' и ', c, ' равно ', GMean:3:2);
  Mean(a, d, AMean, GMean); {Вызываю процедуру}
  writeln('Среднее арифметическое ', a, ' и ', d, ' равно ', AMean);
  writeln('Среднее геометрическое ', a, ' и ', d, ' равно ', GMean:3:2);
end.

Proc4°. Описать процедуру TrianglePS(a, P, S), вычисляющую по стороне a равностороннего треугольника его периметр P = 3·a и площадь S = a2 *√3 / 4. (a — входной, P и S — выходные параметры; все параметры являются вещественными). С помощью этой процедуры найти периметры и площади трех равносторонних треугольников с данными сторонами.

program proc4;

procedure TrianglePS(x: real; var perimeter, area: real);
begin
  perimeter := 3 * x;
  area := Sqr(x) * Sqrt(3) / 4
end;

var
  a, P, S: real;

begin
  write('Введите сторону равностороннего треугольника: ');
  readln(a);
  TrianglePS(a, P, S);
  writeln('Площадь равностороннего треугольника со стороной ', a, ' равна ', S:3:2);
  writeln('Периметр равностороннего треугольника со стороной ', a, ' равен ', P);
end.

Proc5. Описать процедуру RectPS(x1, y1, x2, y2, P, S), вычисляющую периметр P и площадь S прямоугольника со сторонами, параллельными осям координат, по координатам (x1, y1), (x2, y2) его противоположных вершин (x1, y1, x2, y2 — входные, P и S — выходные параметры вещественного типа). С помощью этой процедуры найти периметры и площади трех прямоугольников с данными противоположными вершинами.
Сравните эту задачу с Begin19.

program proc5;

procedure RectPS(x1, y1, x2, y2: real; var P, S: real);
var
  a, b: real;

begin
  a := abs(x2 - x1); 
  b := abs(y2 - y1); 
  P := 2 * (a + b); 
  S := a * b
end;

var
  x1, y1, x2, y2, P, S: real;

begin
  write('Введите координаты двух точек х1 у1 х2 у2 : ');
  read(x1, y1, x2, y2);
  RectPS(x1, y1, x2, y2, P, S);
  writeln('Периметр прямоугольника равен ', P); 
  writeln('Площадь прямоугольника равна ', S:0:2)
end.

Proc6. Описать процедуру DigitCountSum(K, C, S), находящую количество C цифр целого положительного числа K, а также их сумму S (K — входной, C и S — выходные параметры целого типа). С помощью этой процедуры найти количество и сумму цифр для каждого из пяти данных целых чисел.
Сравните с while18.

program proc6;

procedure DigitCountSum(n: integer; var count, summ:integer);
begin
  while n > 0 do
  begin
    summ := summ + n mod 10; 
    n := n div 10; 
    inc(count); 
  end;
end;

var
  k, c, s :integer;

begin
  write('Введите число: ');
  readln(k);
  DigitCountSum(k, c, s);
  writeln('Количество цифр: ', c); 
  writeln('Сумма цифр: ', s)
end.



Proc7. Описать процедуру InvertDigits(K), меняющую порядок следования цифр целого положительного числа K на обратный (K — параметр целого типа, являющийся одновременно входным и выходным). С помощью этой процедуры поменять порядок следования цифр на обратный для каждого из пяти данных целых чисел.

program proc7;

procedure InvDigits(var inv_k: integer);
var
  norma_k: integer;
begin
  norma_k := inv_K; 
  inv_k := 0; 
  while norma_k > 0 do
  begin
    inv_k := 10 * inv_k + norma_k mod 10; 
    norma_k := norma_k div 10; 
  end;
end;

var
  k: integer;

begin
  write('Введите целое положительное число: ');
  readln(k);  
  InvDigits(k); 
  writeln('Инвертированное число: ', K); 
end.


 

Proc8°. Описать процедуру AddRightDigit(D, K), добавляющую к целому положительному числу K справа цифру D (D — входной параметр целого типа, лежащий в диапазоне 0–9, K — параметр целого типа, являющийся одновременно входным и выходным). С помощью этой процедуры последовательно добавить к данному числу K справа данные цифры D1 и D2. Выводя результат каждого добавления.

program proc8;

procedure AddRightDigit(digit: word; var number: integer);
begin
  number := number * 10 + digit
end;

var
  k: integer;
  d1, d2: word;

begin
  write('Введите целое положительное число: ');
  readln(k);
  write('Введите первую цифру: ');
  readln(d1);
  AddRightDigit(d1, k);
  writeln('Получившееся число: ', k);
  write('Введите вторую цифру: ');
  readln(d2);
  AddRightDigit(d2, k);
  writeln('Получившееся число: ', k);
end.

 

Proc9. Описать процедуру AddLeftDigit(D, K), добавляющую к целому положительному числу K слева цифру D (D — входной параметр целого типа, лежащий в диапазоне 1–9, K — параметр целого типа, являющийся одновременно входным и выходным). С помощью этой процедуры последовательно добавить к данному числу K слева данные цифры D1 и D2, выводя результат каждого добавления.

program proc9;

 {Процедура, считающая 10. например. 
 543 - 3 цифры - 10 * 10 * 10 = 1000}
procedure DigitCount_10(n: integer; var count_10: integer);
begin
  while n > 0 do
  begin
    n := n div 10; 
    count_10 := count_10 * 10;; 
  end;
end;

 {Добавляет цифру слева. Пример:
 543 и 9. 9 * 1000 + 543 = 9543}
procedure AddLeftDigit(digit: word; var number: integer);
var
  count_10: integer;
begin
  count_10 := 1;
  DigitCount_10(number, count_10); {Вызываем процедуру подстчета 10}
  number := digit * count_10 + number
end;

var
  k: integer;
  d1, d2: word;

begin
  write('Введите целое положительное число: ');
  readln(k); 
  write('Введите первую цифру: ');
  readln(d1);
  AddLeftDigit(d1, k); 
  writeln('Получившееся число: ', k); 
  write('Введите вторую цифру: ');
  readln(d2);
  AddLeftDigit(d2, k); 
  writeln('Получившееся число: ', k); 
end.

 

Proc10°. Описать процедуру Swap(X, Y), меняющую содержимое переменных X и Y (X и Y — вещественные параметры, являющиеся одновременно входными и выходными). С ее помощью для данных переменных A, B, C, D последовательно поменять содержимое следующих пар: A и B, С и D, B и С и вывести новые значения A, B, C, D.
Сравните с begin22.

program proc10;

procedure Swap(var x, y: real);
var
  tmp: real;
begin
  tmp := x;
  x := y;
  y := tmp;
end;

var
  a, b, c, d: real;

begin
  write('A = ');
  readln(a);
  write('B = ');
  readln(b);
  write('C = ');
  readln(c);
  write('D = ');
  readln(d);
  Swap(a, b);
  Swap(c, d);
  Swap(b, c);
  writeln;
  writeln('A = ', a);
  writeln('B = ', b);
  writeln('C = ', c);
  writeln('D = ', d)
end.

 

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

  1. Привет всем учащимся)).
    В Вашем решении задачи proc10 не взято во внимание область видимости переменных, именно из-за этого
    ответ не будет верен, хотя логика решения правильна, но реализация…увы.
    По сути этот вариант решения задачи отчасти правильный:

    procedure Swap(x,y:real);
    var temp:real;
    begin
    temp := x;
    x := y;
    y := temp;
    write(x)
    end;
    var a,b,c,d:real;
    begin
    Task(‘proc10’);
    readln(a,b,c,d);
    Swap(a,b);
    Swap(b,d);
    Swap(c,a);
    Swap(d,c)
    end.
    С ув. ко всему живому!
    PS: ничего получше из вариантов решения в голову не пришло.

  2. Так проще, по моему:
    program Proc_9;

    var
    k, d : integer;

    procedure AddLeftDigit(dig: integer; var N: integer);
    var
    num:integer :=n;

    begin
    repeat
    num:= num div 10;
    dig:= dig*10;
    until num=0;
    n:=dig+n;
    end;

    begin
    write(‘Введите K: ‘);
    readln(k);

    for var i:=1 to 2 do
    begin
    write(‘Введите D’, i, ‘: ‘);
    readln(d);
    AddLeftDigit(d, k);
    writeln( k);
    end;
    end.

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

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