VPF::Матрица - Форум программистов

Anonymous

Дата 20.7.2006, 15:07 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 26.4.2006

Репутация: нет
Всего: нет

Здравствуйте. У меня задача... Сформулировать ее сложно, т.к. четкой цели нет, мне, так сказать, объясняли на пальцах.
Текст моей программы во вложенном файле, очень долго в ручную забивать пришлось бы.
Смысл таков:
1. Вводим матрицу произвольного размера, но квадратную;
2. Транспонируем ее;
3. Складываем эл-ты каждого столбца, т.е. если матрица 3 на 3, у нас получится 3 суммы;
4. Сравниваем суммы, выводим на экран номер столбцов с макс и мин суммой;
5. В соответствии с этими суммами выстраиваем матрицу в порядке убывания (от большего к меньшему), если это пункт не понятен, ниже я привду пример;
6. Транспонировать еще раз и вывести на экран.

Пример:
1. Вводим матрицу 3 на 3 :   2  3  6
                                               5  7  9
                                               1  4  8
2. Транспонируем, получаем:    2  5  1
                                                    3  7  4
                                                    6  9  8
3. Находим суммы эл-тов:   1ый столбец = 11
                                             2ой =               21
                                             3ий=                13
4. Сравниваем, получаем, что макс сумма во 2ом столбце, а мин в 1ом, выводим
на экран;
5. В соответствии с суммами выстраиваем матрицу:  5  1  2
                                                                                      7  4  3
                                                                                      9  8  6
6. Транспонируем еще раз, получаем:   5  7  9
                                                                  1  4  8
                                                                  2  3  6
Вот это и надо вывести.

Теперь, загвоздка состоит в том, что не выводится транспонированная матрица (ниодна) и не выстраивается сама матрица.

Помогите, пожалуйста.
Заранее благодарен.

Присоединённый файл ( Кол-во скачиваний: 13 )

NE_ZNAU_.PAS 3,58 Kb

Palladin

Дата 20.7.2006, 15:32 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 932
Регистрация: 15.5.2007
Где: Беларусь г.Гомель

Репутация: нет
Всего: 17

Юзай поиск, такой вопрос уже был и не раз!

--------------------

Глуп тот кто полагается на истину авторитета, а не на авторитет истины
[color=red]KAV&KIS==Evil[/color]

Alexeis

Дата 20.7.2006, 15:38 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: нет
Всего: 459

Это не код а сплошной кошмар и ужас!
Зачем делать процедуру вывода матрицы если ее вывод и так производится по ходу дела.
Надо сильно реоганизовать алгоритм, поскольку в нем сильно страдает логика и прозрачность!

Это сообщение отредактировал(а) alexeis1 - 20.7.2006, 15:45

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Anonymous

Дата 20.7.2006, 15:39 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 26.4.2006

Репутация: нет
Всего: нет

Ну у меня же почти написана прога smile

, мне интересно, где ошибка. smile

Добавлено @ 15:49
мда... я рассчитывал на помощь....а на сколько понимаю, помогать отказываетесь?

Alexeis

Дата 20.7.2006, 15:57 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: нет
Всего: 459

Да ни кто не отказывается

Код


  for i:=1 to m
  do
    for j:=1 to n
    do
      C[i,j]:=D[i,j];

этот код дважды транспонирет матрицу
Нужно

Код


  for i:=1 to m
  do
    for j:=i + 1 to n
    do
      C[i,j]:=D[j,i];

либо кода транспонирования я вообще не нашел...

--------------------

Alexeis

Дата 20.7.2006, 16:21 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: нет
Всего: 459

И еще -
я непонял зачем числа n и m вводить если матрица квадратная, имеет смысл оставить только одно из них.

--------------------

VAngeL86

Дата 21.7.2006, 01:14 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 71
Регистрация: 29.4.2006
Где: Хабаровск

Репутация: нет
Всего: 1

Твой код не такой уж и большой

Код


Program Kurs;
const
maxim=20;
type
matrix_4=array [1..maxim,1..maxim] of integer;
var
m,n: integer;
a,b,c,d: matrix_4;

   procedure read_matrix;
   var
   i,j: integer;
   begin
   m:=0;
   writeln;
   while (m<=0) or (m>maxim) do begin
   writeln ('input kol-vo strok ish matr');
   readln (m);
   if (m<=0) or (m>maxim) then writeln ('M>0 and m<maxim');
   end;
   n:=0;
   while (n<=0) or (n>maxim) do begin
   writeln ('input kol-vo stolbcov ish matr');
   readln (n);
   if (n<=0) or (n>maxim) then writeln ('n must be >0 and <maxim');
   end;
   writeln;
   writeln ('input matr');
   for i:=1 to m do begin
   for j:=1 to n do begin
   writeln ('input el-ti matr A');
   readln (A[i,j]);
   end;
   end;
   end;

       procedure write_matrix (n,m: integer);
       var
       i,j: integer;
       begin
       for i:=1 to m do begin
       for j:=1 to n do write (' ',A[i,j]);
       writeln;
       end;
       end;

          procedure trans_matrix (n,m: integer);
          var
          i,j: integer;
          begin
          for i:=1 to m do
          for j:=1 to n do B[i,j]:=A[i,j];
          writeln ('trans matr');
          for i:=1 to m do begin
          for j:=1 to n do
          write (' ',B[i,j]);
          writeln;
          end;
          end;


             procedure process_matrix;
             var
             i,j,k,max_st,min_st: integer;
             max_st_sum,min_st_sum,sum: real;
             begin
             sum:=0;
             for i:=1 to m do sum:=sum+B[i,1];
             max_st_sum:=sum;
             max_st:=1;
             min_st_sum:=sum;
             min_st:=1;
             for j:=1 to n do begin
             sum:=0;
             for i:=1 to m do sum:=sum+B[i,j];
             if sum>max_st_sum then begin
             max_st_sum:=sum;
             max_st:=j;
             end;
             if sum<min_st_sum then begin
             min_st_sum:=sum;
             min_st:=j;
             end;
             end;
             writeln;
             writeln ('max sum stolbca v',max_st);
             writeln ('min sum stolbca v',min_st);


             if (max_st<>min_st) then begin
             for i:=1 to m do C[i,1]:=B[i,max_st];
             k:=1;
             for j:=1 to n do begin
             if (j<>max_st) and  (j<>min_st) then begin
             k:=k+1;
             for i:=1 to m do C[i,k]:=B[i,j];
             end;
             end;
             for i:=1 to m do C[i,m]:=A[i,min_st];
             {B:=C}
             for j:=1 to n do begin
             for i:=1 to m do B[i,j]:=C[i,j];
             end;
             end else begin
             writeln;
             writeln ('ERROR');
             end;
             end;


                  procedure trans_matrix (n,m: integer);
                  var
                  i,j: integer;
                  begin
                  for i:=1 to m do
                  for j:=1 to n do C[i,j]:=D[i,j];
                  writeln ('trans matr');
                  for i:=1 to m do begin
                  for j:=1 to n do
                  write (' ',D[i,j]);
                  writeln;
                  end;
                  end;

             begin
             writeln;
             read_matrix;
             writeln;
             writeln ('ish matr');
             write_matrix (n,m);
             process_matrix;
             writeln;
             writeln ('obrab matr');
             write_matrix (n,m);
             writeln;
             writeln ('press ENTER to EXIT');
             readln;
             end.

...но структура конечно ужасная...ну да ладно! Я верю ты исправишься! smile

Теперь ошибки:
1. У тебя действительно есть процедура Транспонирования исходной матрицы (A)...вот только транспонирование это
замена строк и столбцов местами, а у тебя простое приравнивание матрицы B к матрице A

Код


...
        for i:=1 to m do
          for j:=1 to n do B[i,j]:=A[i,j];
...

Нужно так

Код


...
        for i:=1 to m do
          for j:=1 to n do B[i,j]:=A[j,i];
...

2. Если пока не умеешь передавать процедуре параметр по ссылке, т.к. тебе нужно транспонировать сначала исходную
    матрицу, а потом и изменённую в соответствии с заданием (т.е. 2 разных матрицы) тебе нужно 2 процедуры Транспонирования
    что в принципе у тебя имеется, но вот названия они должны иметь разные!! Кстати во второй процедуре транспонирования
    ошибка аналогичная "1" (alexeis1 тебе на неё так же указывал). Но она не единственная! Нужно матрице D присваивать значения
    матрицы C, а не наоборот.

3. Ну и главное...процедуры то транспонирования ты написал, а использовать их кто будет?? smile

Код


...
            procedure process_matrix;
             var
             i,j,k,max_st,min_st: integer;
             max_st_sum,min_st_sum,sum: real;
             begin
             
    Trans_matrix(n, m);
    
            sum:=0;
             for i:=1 to m do sum:=sum+B[i,1];
             max_st_sum:=sum;
             max_st:=1;
             min_st_sum:=sum;
             min_st:=1;
             for j:=1 to n do begin
             sum:=0;
             for i:=1 to m do sum:=sum+B[i,j];
             if sum>max_st_sum then begin
             max_st_sum:=sum;
             max_st:=j;
             end;
             if sum<min_st_sum then begin
             min_st_sum:=sum;
             min_st:=j;
             end;
             end;
             writeln;
             writeln ('max sum stolbca v',max_st);
             writeln ('min sum stolbca v',min_st);


             if (max_st<>min_st) then begin
             for i:=1 to m do C[i,1]:=B[i,max_st];
             k:=1;
             for j:=1 to n do begin
             if (j<>max_st) and  (j<>min_st) then begin
             k:=k+1;
             for i:=1 to m do C[i,k]:=B[i,j];
             end;
             end;
             for i:=1 to m do C[i,m]:=A[i,min_st];
   
            {B:=C}
             for j:=1 to n do begin
             for i:=1 to m do B[i,j]:=C[i,j]; {Это вообще не к чему делать!}
             end;
   
 Trans_matrix2(n, m)

             end else begin
             writeln;
             writeln ('ERROR');
             end;
             end;

...здесь в процедуре Process_matrix используются 2 процедуры транспонирования, следовательно они в коде должны быть расположены выше процедуры Process_matrix!

4. На счет выстраивания матрицы в соответствии с суммами столбцов....я не проверял....но что то твой код мне не нравится...на сколько я
    визуально могу оценить, ты лишь ставишь столбец с максимальной суммой на 1 место, а с минимальной на последнее...а тебе нужно
    ОТСОРТИРОВАТЬ по убыванию! Для этого создай массив (одномерный ) с суммами по столбцам (т.е. massiv[1] = сумме элементов столбца
    исх.транспонир.матрицы). И сортируй по убыванию любым из известных тебе методом (метод вставок, пузерёк... ), но только
    когда будешь менять местами элементы меняй еще и соответствующие столбцы матрицы

5. У тебя процедура вывода матрица выводит лишь матрицу A, т.е исходную!! Здесь аналогия с "2"...не умеешь передавать по ссылке - пиши
    2 процедуры! Результат у тебя должен быть матрица D. Вот её и выводи.

...а вообще у тебя очень много лишнего в программе! Но это твоё детище! Успехов! smile

volvo877

Дата 21.7.2006, 01:20 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116

Цитата(VAngeL86 @ 21.7.2006, 01:14

)

У тебя процедура вывода матрица выводит лишь матрицу A, т.е исходную!! Здесь аналогия с "2"...не умеешь передавать по ссылке - пиши 2 процедуры!

А не снизойдет ли уважаемый и умеющий передавать параметры по ссылке VAngeL86 до объяснения нам, непонятливым, зачем, собственно, при ВЫВОДЕ матрицы, ее обязательно передавать по ссылке?

Если я ее передам по значению, от этого что, многое изменится? Или просто, чтобы пост выглядел более внушительным, желательно добавить много страшных слов? Так вот, ЭТОГО делать не надо! Если не знаешь чего-то - лучше об этом не пиши...

Anonymous

Дата 21.7.2006, 14:18 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 13
Регистрация: 26.4.2006

Репутация: нет
Всего: нет

Вот я тут сделал это же, но без процедур.

Код


Program Practica;
Var
I,j,k,m,n : integer;
A: array [1..10,1..10] of integer;
B: array [1..10,1..10] of integer;
C: array [1..10,1..10] of integer;
D: array [1..10,1..10] of integer;
Max_st, min_st: integer;
Max_st_sum, min_st_sum, sum: real;
Begin
Writeln (‘input stroki <10’);
Readln (m);
Writeln (‘input stolbci <10’);
Readln (n);
If ((1>n) or (n>10) or (1>m) or (m>10)) then
Begin
Writeln (‘____ERROR____’);
Halt;
End else 
Begin
Writeln (‘input matr’);
For i:=1 to m do
For j:=1 to n do
Read (a[i,j]);
End;
For i:=1 to m do
Begin
For j:=1 to n do
Write (a[i,j]);
Writeln;
End;
Begin
For i:=1 to m do
For j:=1 to n do B[i,j]:=A[j,i];
Writeln (‘trans matr:  ‘);
For i:=1 to m do begin
For j:=1 to n do
Write (B[i,j]);
Writeln;
End;
End;
Begin
Sum:=0;
For i:=1 to m do sum:=sum+b[i,1];
Max_st_sum:=sum;
Max_st:=1;
Min_st_sum:=sum;
Min_st:=1;
For j:=1 to n do begin
Sum:=0;
For i:=1 to m do sum:=sum+b[i,j];
If sum>max_st_sum then begin
Max_st_sum:=sum;
Max_st:=j;
End;
If sum< min_st_sum then begin
Min_st_sum:=sum;
Min_st:=j;
End;
End;
Writeln;
Writeln (‘max_sum v stolbce  ‘, max_st);
Writeln (‘min_sum v stolbce  ‘, min_st);
If (max_st<>min_st) then begin
For i:=1 to m do c[i,j]:=B[i,max_st];
K:=1;
For j:=1 to n do begin
If (i<>max_st) and (i<>min_st) then begin
K:=k+1;
For i:=1 to m do c[i,k]:= b[i,j];
End;
End;
For i:=1 to m do c[i,n]:=b[i,min_st];
For j:=1 to n do begin
For i:=1 to m do b[i,j]:=c[i,j];
Writeln;
End;
End else
Begin
Writeln;
Writeln (‘_____ERROR____’);
End;
begin
for I:=1 to m do 
for j:=i+1 to n do D[i,j]:=C[j,i];
writeln ('itog matr');
for i:=1 to m do begin
for j:=1 to n do
write (' ',D[i,j]);
writeln;
end;
end;
end.

Почему кроме ответа вывожу промежуточные операции? Это делаю для того, чтобы было видно, что, как и почему.

Это сообщение отредактировал(а) Anonymous - 21.7.2006, 14:20

Alexeis

Дата 21.7.2006, 19:41 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: нет
Всего: 459

Цитата(VAngeL86 @ 21.7.2006, 01:14

)

Нужно так

Код


  for i:=1 to m do
          for j:=1 to n do B[i,j]:=A[j,i];

VAngeL86, чтож вы так Anonymousа не любите smile

, свои ошибки подкидываете, я же писал как транспонировать

Код


  for i:=1 to m
  do
    for j:=i + 1 to n
    do
      C[i,j]:=D[j,i];

Проверьте что же получится в результате вашего преобразования!

--------------------

Fighter

Дата 28.7.2006, 03:11 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 810
Регистрация: 5.1.2005

Репутация: нет
Всего: 2

Короче, вот рабочий исходник. Я проверял по твоему примеру - все работает.

Код


uses crt;

const MAX = 20;

type
  masarr = array [1..MAX, 1..MAX] of integer;

procedure InputMatrix(var mas: masarr; m: integer);
var
  i,j: integer;
  curY: integer;
begin
  for i := 1 to m do
  begin
    curY := whereY;
    for j := 1 to m do
    begin
      gotoxy(j * 5, curY);
      read(mas[i,j]);
    end;
  end;
end;

procedure DrawMatrix(mas: masarr; m: integer);
var
  i,j: integer;
  curY: integer;
begin
  for i := 1 to m do
  begin
    curY := whereY;
    for j := 1 to m do
    begin
      gotoxy(j * 5, curY);
      write(mas[i,j]);
    end;
    writeln;
  end;
end;

procedure TransMatrix(var mas: masarr; m: integer);
var
  i,j: integer;
  d: masarr;
begin
  for i := 1 to m do
  begin
    for j := 1 to m do
    begin
      d[j,i] := mas[i,j];
    end;
  end;
  mas := d;
end;

function FindSumm(mas: masarr; m: integer; col: integer): integer;
var
  summ: integer;
  j: integer;
begin
  summ := 0;
  for j := 1 to m do
  begin
    summ := summ + mas[j][col];
  end;
  FindSumm := summ;
end;

procedure SwapCols(var mas: masarr; m: integer; col1, col2: integer);
var
  j: integer;
  t: integer;
begin
  for j := 1 to m do
  begin
    t := mas[j][col1];
    mas[j][col1] := mas[j][col2];
    mas[j][col2] := t;
  end;
end;

var
  m: integer;
  mas: masarr;
  sums: array [1..MAX] of integer;
  nums: array [1..MAX] of integer;
  i,j: integer;
  sorted: boolean;
  t: integer;

begin
  clrscr;
  write('Введите размерность матрицы: ');
  readln(m);
  InputMatrix(mas, m);
  writeln;
  TransMatrix(mas, m);
  DrawMatrix(mas, m);
  writeln;
  for i := 1 to m do
  begin
    sums[i] := FindSumm(mas, m, i);
    writeln('Сумма ', i, 'столбца равна: ', sums[i]);
  end;
  for i := 1 to m do
    nums[i] := i;
  sorted := false;
  while not sorted do
  begin
    sorted := true;
    for i := 2 to m do
    begin
      if sums[i] > sums[i-1] then
      begin
        t := sums[i];
        sums[i] := sums[i-1];
        sums[i-1] := t;
        SwapCols(mas, m, i, i-1);
      end;
    end;
  end;
  TransMatrix(mas, m);
  DrawMatrix(mas, m);

  readkey;
end.

VAngeL86

Дата 4.8.2006, 13:31 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 71
Регистрация: 29.4.2006
Где: Хабаровск

Репутация: нет
Всего: 1

Цитата(volvo877 @ 21.7.2006, 01:20

)

А не снизойдет ли уважаемый и умеющий передавать параметры по ссылке VAngeL86 до объяснения нам, непонятливым, зачем, собственно, при ВЫВОДЕ матрицы, ее обязательно передавать по ссылке?

Если я ее передам по значению, от этого что, многое изменится? Или просто, чтобы пост выглядел более внушительным, желательно добавить много страшных слов? Так вот, ЭТОГО делать не надо! Если не знаешь чего-то - лучше об этом не пиши...

Я не хотел быть более внушительным, просто это так называется ....но в выводе матрицы на экран этого ДЕЙСТВИТЕЛЬНО можно не делать! Но вот в процедурах, где происходит изменение матрицы это делать следует ...или я не прав?

Цитата(alexeis1 @ 21.7.2006, 19:41

)

VAngeL86, чтож вы так Anonymousа не любите smile , свои ошибки подкидываете, я же писал как транспонировать

мда...мда....не повторится!....

Fighter

Дата 6.8.2006, 01:41 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 810
Регистрация: 5.1.2005

Репутация: нет
Всего: 2

Цитата(VAngeL86 @ 4.8.2006, 13:31

)

Но вот в процедурах, где происходит изменение матрицы это делать следует ...или я не прав?

Ну почему, прав!!!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Object Pascal: кроссплатформенные технологии \| Следующая тема »