IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Оптимизация процедурами
сообщение
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 233
Пол: Женский
Реальное имя: Dasha

Репутация: -  0  +


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


Код

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 -


--------------------
irreparabilium felix olivio rerum
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Бывалый
***

Группа: Пользователи
Сообщений: 233
Пол: Женский
Реальное имя: Dasha

Репутация: -  0  +


помогите,пожалуйста...а то сдавать завтра....а голова после 4-ой ночи без сна уже не соображает=(


--------------------
irreparabilium felix olivio rerum
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Вот так хватит, или продолжить?
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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Бывалый
***

Группа: Пользователи
Сообщений: 233
Пол: Женский
Реальное имя: Dasha

Репутация: -  0  +


спасибо большое! smile.gif
этого вполне достаточно

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


--------------------
irreparabilium felix olivio rerum
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Вместо этого:
  for i:=1 to n do
for j:=1 to n do
m[i,j]:=b[i,j]+2*a[i,j];

и вот этого:
  for i:=1 to n do
for j:=1 to n do
m[i,j]:=c[i,j]-d[i,j];

пользуемся одной процедурой...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Бывалый
***

Группа: Пользователи
Сообщений: 233
Пол: Женский
Реальное имя: Dasha

Репутация: -  0  +


а почему всегда получается так,что во второй матрице обязательно присутствует максимально возможный элемент

так...всё,нормально...извиняюсь unsure.gif


--------------------
irreparabilium felix olivio rerum
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.05.2024 11:31
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name