mylib

UNIT MYLIB;

INTERFACE

uses crt;
type
  arr=array[1..18] of integer;
  mat=array[1..18,1..18] of real;
  store=array[1..5] of string [23];
const
  menus1:store= ('Input array',
                                'Output original array',
                                'Conditional sorting',
                                'Output changed array',
                                'Exit');
  menus2:store= ('Input matrix',
                                'Output original matrix',
                                'Conditional sorting',
                                'Output changed matrix',
                                'Exit');

procedure Frame (x1,y1,x2,y2,txt_col:Integer);
Procedure menu(var mode:Byte;const menus:store);
procedure input_array(var a,b:arr; var n:byte);
procedure output_array(a:arr;n:byte; const s:string);
procedure condit_sort1(var a:arr; n:byte);
procedure input_matrix(var a,b:mat; var n,m:byte);
procedure output_matrix(a:mat;n,m:byte; const s:string);
procedure condit_sort2(ori:mat;var ch:mat; n,m:byte);
function max_mat(a:mat;n,m:byte):real;
function ar_mean_under_main(a:mat;n,m:byte):real;
function row_sum(i:integer;a:mat;m:byte):real;

IMPLEMENTATION

procedure Frame (x1,y1,x2,y2,txt_col:Integer);
const
 a=#186; b=#187;
 c=#188; d=#200;
 e=#201; f=#205;
var
 i:Integer;
begin
 window(1,1,80,25);
 textColor(txt_col);
 gotoXY(x1,y1);
 Write(e);
 for i:=x1+1 to x2-1 do
  Write(f);
 Write(b);
 for i:=y1+1 to y2-1 do
 begin
  gotoXY(x1,i);
  write(a);
  gotoXY(x2,i);
  Write(a);
 end;
 gotoXY(x1,y2);
 Write(d);
 for i:=x1+1 to x2-1 do
  Write(f);
 Write(c);
 window(x1+1,y1+1,x2-1,y2-1);
 textColor(txt_col);
 clrscr;
end;





Procedure menu(var mode:Byte;const menus:store);
Var
 k,i:Byte;
 code:Char;
Begin
 frame (1,1,23,8,14);
 writeln('MENU');
 k:=1;
 code:=' ';
 While code<>#13 do
 begin
   For i:=1 to 5 do
   begin
     If i=k then
       TextBackGround(Green)
     else
       textbackground(black);
     GotoXY(1,i+1);
     Write(menus[i]);
   end;
   code:=ReadKey;
   If code=#0 then
   begin
     code:=ReadKey;
     If code=#72 then
       If k>1 then k:=k-1
       else k:=5
     else if code=#80 then
       If k<5 then k:=k+1
       else k:=1;
   end;
   mode:=k;
 end;
end;

procedure input_array(var a,b:arr; var n:byte);
var
  i:integer;
begin
  write('Enter num: ');
  read(n);
  writeln('Enter array: ');
  for i:=1 to n do
  begin
    read(a[i]);
    b[i]:=a[i];
  end;
end;

procedure output_array(a:arr;n:byte; const s:string);
var
  i:integer;
begin
  writeln(s);
  for i:=1 to n do
    write(a[i],' ');
end;
procedure condit_sort1(var a:arr; n:byte);
var
  s,i,k,r:integer;
begin
  s:=0;
  i:=1;
  while i<=n do
  begin
    s:=s+a[i];
    i:=i+2;
  end;
  writeln('s =',s,'; first el is ',a[1]);
  if s>a[1] then
  begin
    writeln('s>first el. Array should be sorted');

    for i:=1 to n-1 do
    begin
      if a[i]<a[i+1] then
      begin
        r:=a[i];
        a[i]:=a[i+1];
        a[i+1]:=r;
      end;
      if i>1 then  for k:=i downto 2 do
      begin
        if a[k-1]<a[k] then
        begin
          r:=a[k];
          a[k]:=a[k-1];
          a[k-1]:=r;
        end
        else break;
      end;
    end;
  end
  else write('s<=first el. Array should not be sorted');
end;
{
procedure condit_sort1(var a:arr; n:byte);
var
  s,i,k,r:integer;
begin
  s:=1;
  i:=1;
  while i<=n do
  begin
    s:=s+a[i];
    i:=i+2;
  end;
  writeln('s =',s,'; first el is ',a[i]);
  if s>a[1] then
  begin
    writeln('s>first el. Array should be sorted');

    for i:=1 to n-1 do
    begin
      if a[i]<a[i+1] then
      begin
        r:=a[i];
        a[i]:=a[i+1];
        a[i+1]:=a[i];
      end;
      if i>1 then  for k:=i+1 downto 2 do
      begin
        if a[k-1]<a[k] then
        begin
          r:=a[k];
          a[k]:=a[k-1];
          a[k-1]:=r;
        end
        else break;
      end;
  end;
end;


  }





procedure input_matrix(var a,b:mat; var n,m:byte);
var
  i,j:integer;
begin
  write('Enter num of rows: ');
  read(n);
  write('Enter num of columns: ');
  read(m);
  writeln('Enter matrix: ');
  for i:=1 to n do
    for j:=1 to n do
  begin
    write('[',i,',',j,']=');
    read(a[i,J]);
    b[i,J]:=a[i,J];
  end;
end;

procedure output_matrix(a:mat;n,m:byte; const s:string);
var
  i,j:integer;
begin
  writeln(s);
  for i:=1 to n do
  begin
    for j:=1 to m do
      write(a[i,j]:5:1);
    writeln;
  end;
end;

function max_mat(a:mat;n,m:byte):real;
var
  i,j:integer;
  max:real;
begin
  max:=a[1,1];
  for i:=1 to n do
    for j:=1 to m do
      if max<a[i,j] then
        max:=a[i,j];
  max_mat:=max;
end;

function ar_mean_under_main(a:mat;n,m:byte):real;
var
  i,j:integer;
  sum,num:real;
begin
  sum:=0;
  num:=0;
  for i:=2 to n do
    for j:=1 to i-1 do
    begin
      sum:=sum+a[i,j];
      num:=num+1;
    end;
  ar_mean_under_main:=sum/num;
end;

function row_sum(i:integer;a:mat;m:byte):real;
var
  j:integer;
  sum:real;
begin
  sum:=0;
  for j:=1 to m do
    sum:=sum+a[i,j];
  row_sum:=sum;
end;

procedure condit_sort2(ori:mat;var ch:mat; n,m:byte);
var
  s,i,j:integer;
  r:real;
  a:mat;
begin
  writeln('max el of mat:');
  writeln(max_mat(ori,n,m):5:2 );
  writeln('2*ar_mean_under_main:');
  writeln(2*ar_mean_under_main(ori,n,m):5:2);
    if max_mat(ori,n,m)<2*ar_mean_under_main(ori,n,m) then
    begin
    writeln('1>2 => sort');
      for i:=1 to n do
      begin
        a[i,1]:=i;

        a[i,2]:=row_sum(i,ori,m);
        write('sum[',i,']=', a[i,2]:5:1 );
      end;

      for i:=n-1 downto 1 do
        for j:=1 to i do
         if a[j,2]<a[j+1,2] then
         begin
           r:=a[j,2];
           a[j,2]:=a[j+1,2];
           a[j+1,2]:=r;

           r:=a[j,1];;
           a[j,1]:=a[j+1,1];
           a[j+1,1]:=r;
         end;

      output_matrix(a,n,2,'sorted rows');
      for i:=1 to n do
      begin
        for j:=1 to m do
        begin
          s:=round(a[i,1]);
          ch[i,j]:=ori[s,j];
        end;
      end;
end;


end;

begin

end.