Решение задач. День семнадцатый. Proc11-20

Learnpascal Proc Оставить комментарий

proc11-20

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

Proc11-20

Процедуры с числовыми параметрами

Proc11. Описать процедуру Minmax(X, Y), записывающую в переменную X минимальное из значений X и Y, а в переменную Y — максимальное из этих значений (X и Y — вещественные параметры, являющиеся одновременно входными и выходными). Используя четыре вызова этой процедуры, найти минимальное и максимальное из данных чисел A, B, C, D.

Используем процедуру Swap() из Proc10.

program proc11;

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

procedure MinMax(var x, y: real);

begin
 if x > y then Swap(x, y)
end;

var
  a, b, c, d: real;

begin
  write('A = ');
  readln(a);
  write('B = ');
  readln(b);
  write('C = ');
  readln(c);
  write('D = ');
  readln(d);
  MinMax(a, b);
  MinMax(c, d);
  MinMax(a, c);
  MinMax(b, d);
  writeln;
  writeln('Минимальное значение: ', a);
  writeln('Максимальное значение: ', d)
end.

Proc12. Описать процедуру SortInc3(A, B, C), меняющую содержимое переменных A, B, C таким образом, чтобы их значения оказались упорядоченными по возрастанию (A, B, C — вещественные параметры, являющиеся одновременно входными и выходными). С помощью этой процедуры упорядочить по возрастанию два данных набора из трех чисел: (A1, B1, C1) и (A2, B2, C2).

program proc12;

uses
  crt;

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

procedure MinMax(var x, y: real);

begin
  if x > y then Swap(x, y)
end;

procedure SortInc3(var x, y, z: real);
begin
  Minmax(y, z);
  MinMax(x, y);
  MinMax(y, z);
end;

var
  a, b, c: real;
  i: integer;

begin
  for i := 1 to 2 do
  begin
    ClrScr; //очищаем экран
    write('A = ');
    readln(a);
    write('B = ');
    readln(b);
    write('C = ');
    readln(c);
    SortInc3(a, b, c);
    writeln;
    writeln('A = ', a);
    writeln('B = ', b);
    writeln('C = ', c);
    ReadKey; //ждем нажатия
  end;
end.

Proc13. Описать процедуру SortDec3(A, B, C), меняющую содержимое переменных A, B, C таким образом, чтобы их значения оказались упорядоченными по убыванию (A, B, C — вещественные параметры, являющиеся одновременно входными и выходными). С помощью этой процедуры упорядочить по убыванию два данных набора из трех чисел: 

(A1, B1, C1) и (A2, B2, C2).

Оставим все так же, как в предыдущей задаче, поменяв процедуру MinMax на MaxMin.

program proc13;

uses
  crt;

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

procedure MaxMin(var x, y: real);

begin
//Теперь наибольшее значение записывается в х, а не в у
  if x < y then Swap(x, y) 
end;

procedure SortDec3(var x, y, z: real);
begin
  MaxMin(y, z);
  Maxmin(x, y);
  MaxMin(y, z);
end;

var
  a, b, c: real;
  i: integer;

begin
  for i := 1 to 6 do
  begin
    ClrScr;
    write('A = ');
    readln(a);
    write('B = ');
    readln(b);
    write('C = ');
    readln(c);
    SortDec3(a, b, c);
    writeln;
    writeln('A = ', a);
    writeln('B = ', b);
    writeln('C = ', c);
    ReadKey;
  end;
end.

Proc14. Описать процедуру ShiftRight3(A, B, C), выполняющую правый циклический сдвиг: значение A переходит в B, значение B — в C, значение C — в A (A, B, C — вещественные параметры, являющиеся одновременно входными и выходными). С помощью этой процедуры выполнить правый циклический сдвиг для двух данных наборов из трех чисел: (A1, B1, C1) и (A2, B2, C2).

program proc14;

uses
  crt;

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

var
  a, b, c: real;
  i: integer;

begin
  for i := 1 to 2 do
  begin
    ClrScr;
    write('A = ');
    readln(a);
    write('B = ');
    readln(b);
    write('C = ');
    readln(c);
    ShiftRight3(a, b, c);
    writeln;
    writeln('A = ', a);
    writeln('B = ', b);
    writeln('C = ', c);
    ReadKey;
  end;
end.

Proc15. Описать процедуру ShiftLeft3(A, B, C), выполняющую левый циклический сдвиг: значение A переходит в C, значение C — в B, значение B — в A (A, B, C — вещественные параметры, являющиеся одновременно входными и выходными). С помощью этой процедуры выполнить левый циклический сдвиг для двух данных наборов из трех чисел: (A1, B1, C1) и (A2, B2, C2).

program proc15;

uses
  crt;

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

var
  a, b, c: real;
  i: integer;

begin
  for i := 1 to 2 do
  begin
    ClrScr;
    write('A = ');
    readln(a);
    write('B = ');
    readln(b);
    write('C = ');
    readln(c);
    ShiftLeft3(a, b, c);
    writeln;
    writeln('A = ', a);
    writeln('B = ', b);
    writeln('C = ', c);
    ReadKey;
  end;
end.

Функции с числовыми параметрами

Proc16. Описать функцию Sign1(X) целого типа, возвращающую для вещественного числа X следующие значения:

-1, если X < 0;

0, если X = 0;

1, если X > 0.

С помощью этой функции найти значение выражения Sign1(A) + Sign1(B) для данных вещественных чисел A и B.

program proc16_func1;

function Sign1(x: real): integer;
begin
  if x > 0 then Sign1 := 1;
  if x < 0 then Sign1 := -1;
  if x = 0 then Sign1 := 0
end;

var
  a, b: real;
  summ: integer;

begin
  write('A = ');
  readln(a);
  write('B = ');
  readln(b);
  summ := Sign1(a) + Sign1(b);
  writeln(summ)
end.

Proc17. Описать функцию RootCount(A, B, C) целого типа, определяющую количество корней квадратного уравнения A·x2 + B·x + C = 0 (A, B, C — вещественные параметры, A <> 0). С ее помощью найти количество корней для каждого из трех квадратных уравнений с данными коэффициентами. Количество корней определять по значению дискременанта:
D= B2 — 4 * A * C.

program proc17_func2;

uses
  crt;

function RootsCount(a, b, c: real): integer;
var
  d: real;
begin
  d := Sqr(b) - 4 * a * c;
  if d < 0 
    then 
    RootsCount := 0
  else 
  if d = 0 
    then 
    RootsCount := 1
  else 
    RootsCount := 2;
end;

var
  a, b, c: real;
  i: integer;

begin
  for i := 1 to 3 do
  begin
    ClrScr;
    write('A = ');
    readln(a);
    write('B = ');
    readln(b);
    write('C = ');
    readln(c);
    write('Количество корней уравнения: ', RootsCount(a, b, c));
    ReadKey;
  end;
end.

Proc18. Описать функцию CircleS(R) вещественного типа, находящую площадь круга радиуса R (R — вещественное). С помощью этой функции найти площади трех кругов с данными радиусами. Площадь круга радиуса R вычисляется по формуле S = pi·R2. В качестве значения pi использовать 3,14.

program proc18_func3;

uses
  crt;

function CircleS(radius: real): real;
const
  pi = 3.14;
begin
  CircleS := Pi * Sqr(radius);
end;

var
  r: real;
  i: integer;

begin
  for i := 1 to 3 do
  begin
    ClrScr;
    write('R = ');
    readln(r);
    write('Площадь окружности: ', CircleS(r):0:2);
    ReadKey;
  end;
end.

Proc19. Описать функцию RingS(R1, R2) вещественного типа, находящую площадь кольца, заключенного между двумя окружностями с общим центром и радиусами R1 и R2 (R1 и R2 — вещественные, R1 > R2). С ее помощью найти площади трех колец, для которых даны внешние и внутренние радиусы. Воспользоваться формулой площади круга радиуса R: S = pi·R2. В качестве значения pi использовать 3,14.
Сравните с begin13

program proc19_func4;

uses
  crt;

function RingS(r1, r2: real): real;
const
  pi = 3.14;
begin
  RingS := pi * sqr(R1) -  pi * sqr(R2);
end;

var
  r1, r2: real;
  i: integer;

begin
  for i := 1 to 3 do
  begin
    ClrScr;
    write('R1 = ');
    readln(r1);
    write('R2 = ');
    readln(r2);
    write('Площадь кольца: ', RingS(r1, r2):0:2);
    ReadKey;
  end;
end.

Proc20°. Описать функцию TriangleP(a, h), находящую периметр равнобедренного треугольника по его основанию a и высоте h, проведенной к основанию (a и h — вещественные). С помощью этой функции найти периметры трех треугольников, для которых даны основания и высота. Для нахождения боковой стороны b треугольника использовать теорему Пифагора:

B2 = (a/2)2+h2.

program proc20_func5;

uses
  crt;

function TriangleP(a, h: real): real;
var
  b: real;
begin
  b := Sqrt(Sqr(a / 2) + Sqr(h));
  TriangleP := 2 * b + a;
end;

var
  a, h: real;
  i: integer;

begin
  for i := 1 to 3 do
  begin
    ClrScr;
    write('a = ');
    readln(a);
    write('h = ');
    readln(h);
    write('Периметр равнобедренного треугольника равен: ', TriangleP(a, h):0:2);
    ReadKey;
  end;
end.

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

Learn Pascal » Решение задач на Паскале » Proc

  1. Что означает Readkey? и почему в изпользовали цикл с параметром а потом снова уничтожили их

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

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