Основы программирования

Задача 1

Условие задачи

Заданы три корня кубического уравнения: X₁, X₂, X₃. Найдите коэффициенты этого уравнения.

Блок-схема

Листинг с комментариями

Program Exercise₁;

var X1, X2, X3_: Real;

A, B, C, D: Real;

begin

Write ('X1: ');

Readln (X1);

Write ('X2: ');

Readln (X2);

Write ('X3: ');

Readln (X3);

Writeln;

A:= 1; // коэффициент при x в степени 3

B:= - (X1+X2+X3); // коэффициент при x в степени 2

C:= X1*X2+X1*X3+X2*X3; // коэффициент при x в степени 1

D:= - (X1*X2*X3); // свободный член

Writeln ('A = 1');

Writeln ('B = ', B:0:1);

Writeln ('C = ', C:0:1);

Writeln ('D = ', D:0:1);

Readln;

end.

Таблица исполнения

A = 1

B = - (1+2+3) = -6

C = 1*2+1*3+2*3 = 11

D = - (1*2*3) = -6

Таблица тестов

Задача 2

Условие задачи

Пройдет ли кирпич со сторонами a, b и c сквозь прямоугольное отверстие со сторонами r и s? Стороны отверстия должны быть параллельны граням кирпича.

Листинг с комментариями

Program Exercise₂;

var

a:array [1.3] of real;

b:array [1.2] of real;

i, j: integer;

k:real;

begin

// заполняем 1 массив

for i:=1 to 3 do

begin

case i of

1: Write ('Введите a: ');

2: Write ('Введите b: ');

3: Write ('Введите c: ');

end;

Readln (a[i]);

end;

// заполняем 2 массив

for i:=1 to 2 do

begin

case i of

1: Write ('Введите r: ');

2: Write ('Введите s: ');

end;

Readln (b[i]);

end;

// сортировка 1 массива

for i:=1 to 2 do

for j:=i+1 to 3 do

if a[i]

begin

k:=a[i];

a[i]:=a[j];

a[j]:=k;

end;

// сортировка 2 массива

if b[1]

begin

k:=b[1];

b[1]:=b[2];

b[2]:=k;

end;

// сравнение наиб. элементов массивов

if (a[2]

Writeln ('Пройдёт')

else

Writeln ('Не пройдёт');

Readln;

end.

Таблица исполнения

8<5 — ложь и 3<2 — ложь не пройдет Таблица тестов

Задача 3

Условие задачи

Для заданных a и p вычислить x = по реккурентному соотношению:

.

Сколько итераций надо выполнить, чтобы для заданной погрешности выполнялось соотношение: ?

Блок-схема

Листинг с комментариями

Program Exercise₃;

const

e=0.0001;

var

a, x, xn: real;

flag:boolean;

i, p: integer;

function kvadr (chislo:real; stepen: integer):real;

var

k:real;

g:integer;

begin

k:=1;

for g:=1 to stepen do

k:=k*chislo;

kvadr:=k;

end;

begin

flag:=true;

write ('введите а: ');

readln (a);

write ('введите p: ');

readln (p);

x:=a;

i:=0;

while flag do

begin

xn:=(1/p)*((p-1)*x+(a/kvadr (x, p-1)));

if abs (x-xn)

flag:=false

else

x:=xn;

i:=i+1;

end;

writeln ('x = ', x:3:2);

writeln ('интерации = ', i);

readln;

end.

Таблица исполнения

k=1*1=1, kvadr=1

k=1*1=1, kvadr=1

xn = (1/3)*((3−1)*1+1/1) = 1

|1−1| = 0 < 0.0001 верно x=1, i=0+1=1

Таблица тестов

Задача 4

Условие задачи

В массиве C (m) каждый третий элемент заменить полусуммой двух предыдущих, а стоящий перед ним — полусуммой соседних с ним элементов. Дополнительный (рабочий) массив не использовать.

Листинг с комментариями

Program Exercise₄;

Const

m=15;

var

C:array [1.m] of real;

i:integer;

i3, i4: real;

begin

Randomize;

for i:=1 to m do

C[i]: =Random (9);

for i:=1 to m do

Write (C[i]: 2:0,' '); // :2:0 ноль это дробная часть

Writeln;

i:=3;

while i<=m do

begin

i3:=(C [i-1]+ C [i-2])/2;

i4:=(C[i]+C [i-2])/2;

C[i]: =i3;

C [i-1]: =i4;

i:=i+3;

end;

for i:=1 to m do

Write (C[i]: 2:0,' '); // :2:0 ноль это дробнаячасть

Writeln;

readln;

end.

Таблица исполнения

С₂(1) = С₁(1) = 3 С₂(4) = С₁(4) = 7

С₂(2) = (3+1)/2 = 2 С₂(5) = (7+9)/2 = 8

С₂(3) = (3+5)/2 = 4 С₂(3) = (7+0)/2 = 3,5 4

Таблица тестов

Задача 5

Условие задачи

Матрицу А (m, n) заполнить следующим образом. Для заданных k и l элементу akl присвоить значение 1; элементам, окаймляющим его (соседним с ним по вертикали, горизонтали и диагоналям) — значение 2; элементам следующего окаймления — значение 3 и так далее до заполнения всей матрицы.

Листинг с комментариями

Program Exercise₅;

Const n=10;

m=15;

Var A: array [1.n, 1. m] of Integer;

i, j, r, k, l: Integer;

Begin

Write ('k= ');

Readln (k);

Write ('l= ');

Readln (l);

Writeln;

for i:=1 to n do

for j:=1 to m do

begin

if (abs (i-k)

r:=abs (j-l)

else r:=abs (i-k);

A [i, j]: =r+1;

end;

Writeln ('Otvet: ');

for i:=1 to n do

begin

for j:=1 to m do

Write (A [i, j]: 3);

Writeln;

end;

readln;

end.

Таблица исполнения

Таблица тестов

Задача 6

Условие задачи

Даны два целочисленных массива К (m) и L (n). Найти наибольший элемент массива K, не имеющий себе равных в массиве L.

Листинг с комментариями

Program Exercise₆;

Const m=15;

n=10;

Var k: array [1.m] of Integer;

l: array [1.n] of Integer;

i, j, imax, b, r: Integer;

flag: boolean;

begin

Randomize;

for i:= 1 to m do

k[i]: = -25 + random (75);

Write ('k: ');

for i:= 1 to m do

Write (k[i]: 4);

Writeln;

for i:= 1 to n do

l[i]: = -25 + random (75);

Write ('l: ');

for i:= 1 to n do

Write (l[i]: 4);

Writeln;

// сортировка массива k

for i:= 1 to m-1 do

begin

imax:= i;

for j:= i+1 to m do

if k[j]>k[imax] then

imax:=j;

b:=k[i];

k[i]:=k[imax];

k[imax]:=b;

end;

Writeln ('new_k: ');

for i:= 1 to m do

Write (k[i]: 4);

Writeln;

// Проверяем (с max) элементы k[i] на наличие их в массиве l

r:= 1;

flag:=true;

while flag and not (r=m+1) do // чтобы не выйти за пределы массива

begin

for i:=1 to n do

if k[r]=l[i] then

begin

r:=r+1; // переходим к следующему элементу массива k

break;

end

else flag:=false;

end;

if flag then

writeln ('net takogo');

end;

Writeln;

Writeln ('Otvet: ', k[r]);

Writeln;

Readln;

end.

Таблица исполнения

Таблица тестов

Задача 7

массив уравнение итерация матрица

Условие задачи

Упорядочить по неубыванию каждую строку матрицы A (m, n), а после этого перестановкой строк упорядочить всю матрицу по неубыванию элементов первого столбца.

Листинг с комментариями

Program Exercise₇;

const

m=10;

n=10;

var

a:array [1.m, 1. n] of integer;

b:array [1.m] of integer;

i, j, p, k, t, s: integer;

procedure change (one, two: integer);

var

i1: integer;

begin

for i1:= 1 to n do

begin

s:=a [one, i1];

a [one, i1]: =a [two, i1];

a [two, i1]: =s;

end;

end;

begin

Randomize;

for i:= 1 to m do

for j:= 1 to n do

a [i, j]: =Random (40);

// вывод массива

for i:= 1 to m do

begin

for j:= 1 to n do

Write (a[i, j]: 3);

writeln;

end;

writeln;

// Сортировка

for i:= 1 to m do

for j:= 1 to n-1 do

for t:= 1 to n-j do

if a [i, t]>a [i, t+1] then

begin

s:=a [i, t];

a [i, t]: =a [i, t+1];

a [i, t+1]: =s;

end;

// вывод массива

for i:= 1 to m do

begin

for j:= 1 to n do

Write (a[i, j]: 3);

writeln;

end;

writeln;

// замена

for i:= 1 to m-1 do

for j:= 1 to m-i do

if a [j, 1]>a [j+1,1] then

change (j, j+1);

// вывод массива

for i:= 1 to m do

begin

for j:= 1 to n do

Write (a[i, j]: 3);

writeln;

end;

readln;

end.

Таблица исполнения

Таблица тестов

Задача 10

Условие задачи

Даны длины a, b, c сторон некоторого треугольника. Найти медианы треугольника, сторонами которого являются медианы исходного треугольника. (Длина медианы, проведенной к стороне a, равна .

Листинг с комментариями

Program Exercise₁₀;

Var a, b, c: Integer;

a1, b1, c1, m1, m2, m3: Real;

begin

Write ('a = ');

Readln (a);

Write ('b = ');

Readln (b);

Write ('c = ');

Readln (c);

// проверка существования треугольника

if (a>=b+c) or (b>=a+c) or (c>=a+b) then

begin

Writeln ('Net');

readln;

end

else

a1:= 0.5*sqrt (2*b*b+2*c*c-a*a);

b1:= 0.5*sqrt (2*a*a+2*c*c-b*b);

c1:= 0.5*sqrt (2*a*a+2*b*b-c*c);

m1:= 0.5*sqrt (2*b1*b1+2*c1*c1-a1*a1);

m2:= 0.5*sqrt (2*a1*a1+2*c1*c1-b1*b1);

m3:= 0.5*sqrt (2*a1*a1+2*b1*b1-c1*c1);

Writeln ('m1 = ', m1:3:2);

Writeln ('m2 = ', m2:3:2);

Writeln ('m3 = ', m3:3:2);

Readln;

end.