Developing.ru

Код: Выделить всё

Program NN;
uses crt;
const
  Nmax=10;
  Mmax=15;
type
  Tmatr=array[1..Nmax,1..Mmax] of integer;
  Zmatr=array[1..Nmax] of integer;
var
  Z:Zmatr;
  D,Y:Tmatr;
  Nd,Md,Ny,My,iD,jD,iY,jY,Nz,Mz:byte;
Procedure EnterMatr (var Matr:tmatr; var N,M:byte; ch:char);
    var i,j:byte;
      begin
        writeln('Ââåäèòå ðàçìåð ìàòðèöû:',ch);
        write('Êîëè÷åñòâî ñòðîê:');
        read(N);
        write('Êîëè÷åñòâî ñòîëáöîâ');
        read(M);
        for i:=1 to N do
        for j:=1 to M do
          begin
            write(ch,'[',i,',',j,']=');
            readln(matr[i,j]);
          end
      end;
Procedure Minimum (const Matr:tmatr; N,M:byte;var imax,jmax:byte);
   Var
     i,j,imin,jmin:byte;
     min:integer;
   begin
     min:=matr[1,1];
     imin:=1;
     jmin:=1;
     for i:=2 to N do
     for j:=2 to M do
       if matr[i,j]<min then
         begin
           min:=matr[i,j];
           imin:=i;
           jmin:=j;
         end
   end;
Procedure FormZ (const Matr:tmatr;N,M:byte;var iMin,jMin:byte);
  Var
     i,j:byte;
 Begin
  begin
   for i:=1 to N do
   for j:=1 to N do
     Z[i]:=Matr[iMin,j];
  end;
End;
Procedure FormZ2 (const Matr:tmatr;N,M:byte;var iMin,jMin:byte);
Var
     i,j:byte;
 begin
  begin
   for i:=1 to N do
   for j:=1 to N do
     Z[i]:=Matr[i,jMin];
  end;
end;
  
Procedure PrintMatr (const Matr:tmatr; N:byte);
  Var iMin,jMin,i,j:byte;
    begin
      Writeln ('Matrica Z');
        For i:=1 to N do
          begin
            Write (Matr[i,j]:5);
            writeln;
          end
    end;
BEGIN
  EnterMatr (D,Nd,Md,'D');
  EnterMatr (Y,Ny,Ny,'Y');
  Minimum (D,Nd,Md,iD,jD);
  Minimum (Y,Ny,Ny,iY,jY);
  FormZ (Z,Nz,Mz,'Z');
  FormZ2 (Z,Nz,Mz,'Z');
  PrintMatr (Z,Nz,'Z');
END.

Код: Выделить всё

{Из матриц D(N,M) и Y(N,N) получить одномерный массив Z,
записывая в него сначала строки,затем столбцы,
содержащие минимальные элементы матриц D и Y}
const
  n=8;
  m=6;
type
  TData=integer;
  TArray=array [,] of TData;
  {Заполнение числами в диапазоне от Min до Max}
  procedure RandomFillArray(var Arr:TArray; Min,Max:integer);
  var
    i,j:integer;
  begin
    for i:=0 to pred(Length(Arr,0)) do for j:=0 to pred(Length(Arr,1)) do 
      Arr[i,j]:=random(Max-Min+1)+Min;
  end;
  {Вывод массива с заголовком}
  procedure PrintArray(const Arr:TArray; Header:string);
  var
    i,j:integer;
  begin
    writeln(Header);
    for i:=0 to pred(Length(Arr,0)) do begin
      for j:=0 to pred(Length(Arr,1)) do write(Arr[i,j]:5);
      writeln;
    end;
  end;
  {Поиск минимума}
  function MinVal(const Arr:TArray):TData;
  var
    i,j:integer;
  begin
    result:=Arr[0,0];
    for i:=0 to pred(Length(Arr,0)) do for j:=0 to pred(Length(Arr,1)) do 
      if Arr[i,j]<result then result:=Arr[i,j];
  end;
  {добавление элемента в массив}
  function AppendTo(var Arr:TArray; Val:TData):integer;
  begin
    result:=succ(Length(Arr,1));
    SetLength(Arr,1,result);
    Arr[0,pred(result)]:=Val;    
  end;

var
  D,Y,Z:TArray; {Z мы тоже объявили как двумерный, но он будет 
  содержать только 1 строку. Это позволит нам использовать ту же
  процедуру вывода массива}
  minD,minY:TData;
begin
  SetLength(D,N,M);
  SetLength(Y,N,N);
  RandomFillArray(D,-1000,1000);
  RandomFillArray(Y,-1000,1000);
  PrintArray(D,'Массив D');
  PrintArray(Y,'Массив Y');
  minD:=MinVal(D);
  writeln('Минимум D=',minD);
  minY:=MinVal(Y);
  writeln('Минимум Y=',minY);

  {Это демонстрация того,как элементы будут добавляться в 
  монотонно растущий массив Z}
  SetLength(Z,1,0);
  AppendTo(Z,123);
  AppendTo(Z,321);
  AppendTo(Z,333);
  PrintArray(Z,'Массив Z');
end.

Код: Выделить всё

{Это демонстрация того,как элементы будут добавляться в 
  монотонно растущий массив Z}
  SetLength(Z,1,0);
  AppendTo(Z,123);
  AppendTo(Z,321);
  AppendTo(Z,333);