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

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

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

> Оптимизация процедурами
Tribunal
сообщение 22.12.2005 17:12
Сообщение #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 - 22.12.2005 17:12


--------------------
irreparabilium felix olivio rerum
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 5)
Tribunal
сообщение 22.12.2005 17:32
Сообщение #2


Бывалый
***

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

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


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


--------------------
irreparabilium felix olivio rerum
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 22.12.2005 17:36
Сообщение #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.
 К началу страницы 
+ Ответить 
Tribunal
сообщение 22.12.2005 17:45
Сообщение #4


Бывалый
***

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

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


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

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


--------------------
irreparabilium felix olivio rerum
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
volvo
сообщение 22.12.2005 17:48
Сообщение #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];

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


Бывалый
***

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

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


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

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


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

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

 



- Текстовая версия 19.06.2025 2:38
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"