Задание 1. 15. Ввести с клавиатуры целое число.
1) Если число равно 20, то в данных матрицах и вычислить и отпечатать среднее арифметическое элементов расположенных под главной диагональю.
2) Если число равно -10, то вычислить сумму элементов заданной матрицы по столбцам. Найти наименьшую из этих сумм.
3) Если число равно -20, то создать файл, состоящий из целых чисел. Найти количество элементов этого файла, больших единицы и количество элементов этого файла, равных нулю. Выдать соответствующие сообщения на печать.
Набор тестовых примеров
1)
2)
3)
Листинг программы
Program Zadanie1;
uses CRT;
const L=10;
type
T2M = array[1.. L,1..L] of integer;
T1M = array[1.. L] of integer;
TF = file of integer;
Tname = string[4];
var
A,A1,A2,A3: T2M;
sra, srb: Real;
name:Tname;
B:T1M;
S1,S2,S3,buf,k:integer;
Imax,Knech,n,I,j:byte;
F1: file of integer;
ch:integer;
kb1,kr0: Integer;
// процедура для ввода матрицы
procedure VvodMx(var A:T2m; const N,M: byte; const name:Tname);
Var I,j:byte;
begin
writeLn('вводите элементы матрицы ',name);
for i:=1 to N do
for j:=1 to M do
begin
write('A[',i,',',j,']=');
readLn(A[i,j]);
end;
end;
// процедура для вывода матрицы
procedure VivodMx(const A:T2m; const N,M: byte; const name:Tname);
Var I,j:byte;
begin
writeLn('Матрица ',name,' после формирование:');
for i:=1 to N do
begin
for j:=1 to M do
write(A[i,j]:4);
writeLn;
end;
end;
// процедура для ввода файла
procedure VvodF(var F:TF; const name:Tname);
Var buf:integer;
begin
rewrite(F);
writeLn('введите первую компоненту файла ', name);
writeLn('признак конца ввода 999 ');
readLn(buf);
while buf<>999 do
begin
write(F,buf);
writeLn('введите следующую компоненту:');
readLn(buf);
end;
end;
// процедура вычисления сред арифметического элементов под гл диагональю
function SrArif(const A:T2m; const N,M:byte):real;
Var I,j,z:byte;
Srarifmet:Real;
begin
z:=0;
for i:=1 to N do
for j:=1 to M do
begin
if j<i then
begin
Srarifmet:=Srarifmet+A[i,j];
z:=z+1;
end;
end;
SrArif:=Srarifmet/z;
writeln(' Среднее арифметическое = ',Srarifmet);
end;
// процедура вычисления сумм по столбцам и нахождения наименьшей
procedure SummStolb(const A:T2m; const N,M:byte; const name:Tname);
Var I,j,z:byte;
S:T1M;
minS:Real;
begin
for j:=1 to M do
begin
S[j]:=0;
for i:=1 to N do
S[j]:=S[j]+A[i,j];
end;
minS:=S[1];
for j:=1 to M do
if minS>S[j] then
minS:=S[j];
for j:=1 to M do
Write(S[j]:5);
Writeln(' Минимальная сумма = ', minS:5:5);
end;
// Основная программа
BEGIN
ClrScr;
writeLn('введите целое число');
readLn(ch);
Case ch of 20:
begin
VvodMx(A1,4,4,'A1');
VvodMx(A2,5,5,'A2');
writeLn('исходные матрицы:');
VivodMx(A1,4,4,'A1');
VivodMx(A2,5,5,'A2');
sra:=SrArif(A1,4,4);
srb:=SrArif(A2,5,5);
Writeln('Ср арифметическое A: ',sra:3:3,' Среднее арифметическое B: ',vbsrb:3:3);
end;
-10:
begin
N:=6;
VvodMx(A1,N,N,'A1');
writeLn('исходные матрицы:');
VivodMx(A1,N,N,'A1');
// сумма матрицы по столбцам
SummStolb(A1,N,N,'A1');
end;
-20:
begin
// инициализация файла
Assign(F1,'F1.dat');
rewrite(F1);
VvodF(F1,'F1');
kb1:=0;
kr0:=0;
reset(F1);
while not EOF(F1) do
begin
read(F1,buf);
if buf>1 then
kb1:=kb1+1;
if buf=0 then
kr0:=kr0+1;
end;
writeln(' Количество элементов больше 1 = ', kb1:3);
writeln(' Количество элементов равных 0 = ', kr0:3);
close(F1);
end;
else
writeLn('символ находится вне допустимого диапазона');
end;
Readln;
END.
Задание 2. Массивы записного типа.
15. В автомастерской ведется реестр поступивших в ремонт автомобилей. В строке реестра автомобилей указаны фамилия владельца, номер квитанции, марка автомобиля, требующийся ремонт, наименование и код детали, необходимой для ремонта, их количество, стоимость одной детали. СУБД должна выдавать следующие сведения:
- по данным владельца стоимость ремонта;
Схема записи
Program subd;
Uses CRT,Dos;
type
Avto = Record
ReestrNumber: integer;
Famil: string[10];
NumberKv:Integer;
Marka: string[10];
TrebRem: string[20];
Detal : record
Naim : string[15];
Kod : byte;
Kolich : byte;
Stoim : Real;
end; {Detal}
end; {Avto}
Avt = Record
MarkaAVT: String[10];
end;
TBaseMass1 = array[1..255] of avt;
TBaseMass = array[1..255] of Avto;
// процедура формирования новой таблицы
procedure InputNewBase(var Base:TBaseMass; var NumOfRec:byte);