Оптимизация процедурами Опции

[Tribunal]

подскажите,пожалуйста,как текст этой программы упростить с помощью процедур?

Код

program rgr;
uses crt;

   const
      n=4;
      r=4;
   type
      matrix= array[1..n,1..n] of integer;
   var
      k,i,j,s1,s2:integer;
      a,b,c,d,m:matrix;

begin
clrscr;
   writeln('matrix A:');
   randomize;
   for i:=1 to n do
   begin
      for j:=1 to n do
      begin
      a[i,j]:=random(r)+1;
      write(a[i,j]:4);
      end;
      writeln;
   end;

   writeln;

   writeln('matrix B:');
   for i:=1 to n do
   for j:=1 to n do
   if i=1 then b[i,j]:=j
   else begin
           if j=1 then k:=n else k:=j-1;
           b[i,j]:=-b[i-1,k];
        end;
   for i:=1 to n do
        begin
           for j:=1 to n do
           write(b[i,j]:4);
           writeln;
        end;
  writeln;

  s1:=a[1,1];
  for i:=1 to n do
  for j:=1 to n do
  if a[i,j]>s1 then s1:=a[i,j];
  writeln('s1=',s1);

  s2:=b[1,1];
  for i:=1 to n do
  for j:=1 to n do
  if b[i,j]>s2 then s2:=b[i,j];
  writeln('s2=',s2);
  writeln;

  if s1<s2
  then
  begin
     for i:=1 to n do
     for j:=1 to n do
     begin
        c[i,j]:=0;
        for k:=1 to n do
        c[i,j]:=c[i,j]+a[i,k]*b[k,j];
     end;

     for i:=1 to n do
     for j:=1 to n do
     begin
        d[i,j]:=0;
        for k:=1 to n do
        d[i,j]:=d[i,j]+b[i,k]*a[k,j];
     end;

     for i:=1 to n do
     for j:=1 to n do
     m[i,j]:=c[i,j]-d[i,j];

     writeln('s1<s2,matrix M:');
     for i:=1 to n  do
     begin
        for j:=1 to n do
        write(m[i,j]:4);
        writeln;
     end;
  end
  else
  begin
     for i:=1 to n do
     for j:=1 to n do
     m[i,j]:=b[i,j]+2*a[i,j];

     writeln('s1>s2,matrix M:');
     for i:=1 to n do
     begin
        for j:=1 to n do
        write(m[i,j]:4);
        writeln;
     end;
  end;
end.

Сообщение отредактировано: Tribunal - 22.12.2005 21:12

[volvo]

Вот так хватит, или продолжить?

program rgr;
uses crt;

   const
      n=4;
      r=4;
   type
      matrix= array[1..n,1..n] of integer;

function max(mx: matrix): integer;
var i, j, s: integer;
begin
  s := mx[1, 1];
  for i:=1 to n do
    for j:=1 to n do
      if mx[i, j] > s then s := mx[i, j];
  max := s
end;

procedure mult(var res: matrix; one, two: matrix);
var i, j, k: integer;
begin
  for i:=1 to n do
    for j:=1 to n do begin
      res[i, j] := 0;
      for k := 1 to n do
        res[i,j] := res[i,j] + one[i,k] * two[k,j];
  end;
end;

procedure scale(var res: matrix; one: matrix;
          multby: integer; two: matrix);
var i, j: integer;
begin
  for i:=1 to n do
    for j:=1 to n do
      res[i, j] := one[i, j] + multby * two[i, j];
end;

procedure print(s: string; mx: matrix);
var i, j: integer;
begin
  writeln(s);
  for i:=1 to n do begin
    for j:=1 to n do
      write(mx[i, j]:4);
    writeln;
  end;
end;


var
  k,i,j,s1,s2:integer;
  a,b,c,d,m:matrix;

begin
clrscr;
   writeln('matrix A:');
   randomize;
   for i:=1 to n do
   begin
      for j:=1 to n do
      begin
      a[i,j]:=random( r )+1;
      write(a[i,j]:4);
      end;
      writeln;
   end;

   writeln;

   writeln('matrix B:');
   for i:=1 to n do
   for j:=1 to n do
   if i=1 then b[i,j]:=j
   else begin
           if j=1 then k:=n else k:=j-1;
           b[i,j]:=-b[i-1,k];
        end;

  print('', b);
  writeln;

  s1 := max(a); s2 := max(b);
  writeln('s1=',s1);
  writeln('s2=',s2);
  writeln;

  if s1<s2
  then
  begin
     mult(c, a, b);
     mult(d, b, a);
     scale(m, c, -1, d);
     print('s1<s2,matrix M:', m);
  end
  else
  begin
     scale(m, b, 2, a);
     print('s1>s2,matrix M:', m);
  end;
end.