1 Способ
Program Problem14;
uses WinCrt;
const
n = 8;
type
t = array[1..n+1] of real;
var
a : t;
y, x : real;
i : integer;
{----------------------------------------------------------------------------------------}
Procedure gorner(x : real; a : t; var y : real);
var
i : integer;
begin
y := a[1];
for i := 2 to n + 1 do y := y*x + a[i];
writeln('Значение многочлена равно ', y:6:6)
end;
{----------------------------------------------------------------------------------------}
begin
for i := 1 to n + 1 do
begin
write('Введите ', i, '-й коэффициент ');
readln(a[i])
end;
writeln('Коэффициенты полинома');
for i := 1 to n + 1 do write(a[i]:3:3, ' ');
writeln;
write('Введите значение аргумента x '); readln(x);
gorner(x, a, y)
end.
2 Способ
Program Problem14a;
uses WinCrt;
const
n = 8;
type
t = array[1..n+1] of real;
var
a : t; y, x : real; i : integer;
{----------------------------------------------------------------------------------------}
Procedure polynomial(k : integer; x : real; var y : real);
label 1;
begin
if k = -1 then goto 1
else
begin
y := y*x + a[n-k+1];
polynomial(k-1, x, y)
end;
1: end;
{----------------------------------------------------------------------------------------}
begin
for i := 1 to n + 1 do
begin
write('Введите ', i, '-й коэффициент '); readln(a[i])
end;
write('Введите значение аргумента x '); readln(x);
polynomial(n, x, y);
writeln('Значение многочлена равно ', y:6:6)
end.
Задача 15. Процедура "решето Эратосфена".
Решение
Procedure eratosfen(n : integer; a : t; var c : t; var k : integer);
var
f, i, j, b : integer;
begin
f := trunc(sqrt(n));
for i := 2 to f do
begin
if a[i] <> 0 then
begin
b := a[i];
j := b*2;
while j <= n do
begin
if a[j] <> 0 then
begin
if a[j] mod b = 0
then a[j] := 0;
j := j + b
end
else
j := j + b
end
end
end;
k := 0;
for i := 2 to n do
if a[i] <> 0 then
begin
k := k + 1;
c[k] := a[i]
end;
end;
Задача 16. Рассмотрим программу ввода с клавиатуры третьего массива чисел с последующим выводом в виде таблицы на экран.
Решение
Program Problem16;
uses WinCrt;
const
m = 4; n = 5;
type
s = array[1..m] of integer;
t = array[1..n] of s;
var
a : t;
i, j : integer;
begin
for i := 1 to n do
for j := 1 to m do
begin
write('Введите элемент ', i, '-й строки ');
write(j, '-го столбца '); readln(a[i, j])
end;
writeln('Заданный двумерный числовой массив');
for i := 1 to n do
begin
for j := 1 to m do write(a[i, j]:6, ' ');
writeln
end
end.
Задача 17. В двумерном массиве найдите наибольшие элементы каждой строки.
Решение
Program Problem17.;
uses WinCrt;
const
n = 4; m = 5;
type
s = array[1..m] of integer;
t = array[1..n] of s;
st = array[1..n] of integer;
var
a : t;
b : st;
{----------------------------------------------------------------------------------------}
Procedure create_two(n, m : integer; var a : t);
var
i, j : integer;
begin
writeln('Заданный двумерный массив целых чисел');
randomize;
for i := 1 to n do
begin
for j := 1 to m do
begin
a[i, j] := random(201) - 100;
write(a[i, j]:6, ' ')
end;
writeln
end
end;
{----------------------------------------------------------------------------------------}
Procedure maxim_line(n, m : integer; a : t; var b : st);
var
i, j : integer;
begin
for i := 1 to n do
begin
b[i] := a[i, 1];
for j := 1 to m do
if a[i, j] > b[i] then b[i] := a[i, j];
end;
writeln('Наибольшие элементы каждой строки массива');
for i := 1 to n do write(b[i]:6, ' ');
writeln
end;
{----------------------------------------------------------------------------------------}
begin
create_two(n, m, a);
maxim_line(n, m, a, b)
end.
Задача 18.
Сформировать
матрицу размерности
из случайных чисел от 1 до 100. Расположить
их в порядке возрастания по следующей
схеме (см. рис.):
Решение