Предусмотреть вывод на экран ФИО, № группы студента, сделавшего работу - Turbo Pascal
Формулировка задачи:
1. Задания
В качестве условия задачи берется задание из 5 лабораторной работы, но работать не с одной матрицей, а с двумя А1 и А2. В основной программе предусмотреть вызовы подпрограмм к обеим матрицам.
2. Правила оформления работы
1. Предусмотреть вывод на экран ФИО, № группы студента, сделавшего работу.
2. Автоматическое формирование исходного массива.
3. Вывод исходного массива, промежуточных результатов и конечного результата с пояснениями.
4. Оформить программу с использованием подпрограмм (процедур и функций – по необходимости). Обосновать использование процедур и функций. Обязательны процедуры формирования и вывода матрицы.
Вот 5я лаба (Найти число строк матрицы А(6,4), минимальный элемент которых равен 0.)
Решение задачи: «Предусмотреть вывод на экран ФИО, № группы студента, сделавшего работу»
textual
Листинг программы
unit matrix; interface uses crt; const x=10; y=5; type TELint=integer; TElem = double; IntARR =array[1 .. maxint div sizeof(TElint) ] of TElint; PARR = ^IntARR; TLine = array[1..maxint div sizeof(TElem)] of TElem; PLine = ^TLine; TCol = array[1..maxint div sizeof(PLine)] of PLine; PCol = ^TCol; PCmatr=^Cmatr; Cmatr=object private Fstr:word; Fstc:word; Fmatr:PCol; procedure F(err:word); public constructor Create(n,m:word); //выделение памяти под матрицу constructor copy(matr:PCmatr); //создание копии матрицы destructor done(); //освобождение памяти, уничтожение матрицы матрицы procedure putelem(i,j:word; elem:TElem); procedure getelem(i,j:word; var x:TElem); procedure Swap(n,m:smallint); procedure QuickSort; function getstr:word; function getstc:word; end; //********************************************************************************************************************************** implementation procedure Cmatr.F(err:word); begin case err of 1 : begin write('Ошибка выделения памяти'); end; 2 : begin write('Указаны нулевые индексы'); end; 3 : begin write('Указанных индексов в матрице нет'); end; 4 : begin write('Размеры таблицы превышают максимально допустимые размеры'); end; end; readkey; halt; end; constructor Cmatr.Create(n,m:word); var i,j:TELint; error:boolean=true; begin returnnilifgrowheapfails := true; begin Fstr:=n; Fstc:=m; getmem(Fmatr,Fstr*sizeof(PLine)); //выделяем память под строки if Fmatr<>NIL then begin for j:=1 to Fstr do begin getmem(Fmatr^[j],Fstc*sizeof(TElem));//выделяем память под столбцы if Fmatr^[j]=NIL then //если памяти недостаточно, то аварийный выход из цикла begin F(1); error:=false; F(1); end; end; if not(error) then for j:=j-1 downto 1 do freemem(Fmatr^[j],Fstc*sizeof(TElem));//освобождаем память end else begin freemem(Fmatr,Fstr*sizeof(PLine)); error:=false; F(1); end; end; end; //*********************************************************************************************************************************** constructor Cmatr.copy(matr:PCmatr); var i,j:TELint; begin returnnilifgrowheapfails := true; Create(matr^.Fstr,matr^.Fstc); for i:=1 to Fstr do for j:=1 to Fstc do Fmatr^[i]^[j]:=matr^.Fmatr^[i]^[j] end; //*********************************************************************************************************************************** destructor Cmatr.done(); var i, j: word; need: longint; begin need := longint(Fstc) * sizeof(TElem); {$R-} for i := 1 to Fstr do freeMem(Fmatr^[i], need); need:= longint(Fstr) * sizeof(PLine); freeMem(Fmatr, need); {$R+} end; //********************************************************************************************************************************* procedure Cmatr.putelem(i,j:word; elem:TElem); begin if ((i=0) or (j=0)) then f(2) else if ((i>Fstr) or (j>Fstc)) then F(3) else Fmatr^[i]^[j]:=elem; end; //********************************************************************************************************************************* procedure Cmatr.getelem(i,j:word;var X:Telem); begin if ((i=0) or (j=0)) then f(2) else if ((i>Fstr) or (j>Fstc)) then F(3) else X:=Fmatr^[i]^[j]; end; //*************************************************************************************************************************************** function Cmatr.getstr:word; begin getstr:=Fstr; end; //************************************************************************************************************************************* function Cmatr.getstc:word; begin getstc:=Fstc; end; //*********************************************************************************************************************************** procedure Cmatr.Swap(n,m:smallint); var j:smallint; u:TElem; begin for j:=1 to y do begin u:=Fmatr^[j]^[n]; Fmatr^[j]^[n]:=Fmatr^[j]^[m]; Fmatr^[j]^[m]:=u; end; end; procedure Cmatr.QuickSort; var Brr:PARR; i,j:word; Procedure QSort(l,r:smallint); var i,j,x,y:smallint; begin i:=l; j:=r; x:=Brr^[(r+l) div 2]; While i<j do begin While Brr^[i]>x do inc(i); While Brr^[j]<x do dec(j); if i<=j then begin Cmatr.Swap(i,j); y:=Brr^[i]; Brr^[i]:=Brr^[j]; Brr^[j]:=y; inc(i); dec(j); end; end; if i<r then QSort(i,r); if l<j then QSort(l,j); end; begin GetMem(Brr,Fstc*sizeof(TElem)); for i:=1 to Fstc do Brr^[i]:=0; for i:=1 to Fstc do for j:=1 to Fstr do if Fmatr^[j]^[i]<0 then inc(Brr^[i]); QSort(1,Fstc); FreeMem(Brr,Fstc*sizeof(TElem)); end; end.