Сортировка матрицы

@MrSmmiT · Регистрация: 06.06.2012

Студворк — интернет-сервис помощи студентам

Добрый день. Подскажите пожалуйста кое-что по сортировке.
Матрицу нужно сортировать так, чтобы модуль суммы элементов матрицы, кроме a[i,i], был меньше модуля a[i,i].
Например:

Pascal
1
2
3
1  2  4       6  1  5
6  1  5   ->  0  3  2
0  3  2       1  2  4

Добавлено через 15 минут
В общем нужно сортировать матрицу так, чтобы она была пригодна для решения СЛАУ методом Зейделя.
P.S. Сам метод у меня есть, работает, вся проблема в сортировке.

@volvo · 27.01.2014, 15:15

Я уже давал ссылку на эту тему: В матрице переставьте строки так, чтобы сумма элементов главной диагонали была максимальна Код оттуда выдает идеально совпадающий с твоим результат:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
const
   n = 5;
type
   vector = array[1 .. n] of integer;
   matrix = array[1 .. n] of vector;
 
var
  // Это твоя матрица из примера, правда?
  a : matrix = (
    (1, 2, 4),
    (6, 1, 5),
    (0, 3, 2)
  );
 
  x : vector;
 
// Это алгоритм получения следующей перестановки в лексикографическом порядке
function NextPermutation:Boolean;
var
   k, t, y : Integer;
begin
   if N <= 0 then
   begin
      NextPermutation := False;
      Exit;
   end;
   K:=1;
   while K<=N do
   begin
      if (X[K]<1) or (X[K]>N) then
      begin
         NextPermutation := False;
         Exit;
      end;
      Inc(K);
   end;
 
   k := n-1;
   while k>0 do
   begin
      if x[k]<=x[k+1] then
      begin
         Break;
      end;
      k := k-1;
   end;
   if k<>0 then
   begin
      t := k+1;
      while t<n do
      begin
         if x[t+1]<=x[k] then
         begin
            Break;
         end;
         t := t+1;
      end;
      y := x[k];
      x[k] := x[t];
      x[t] := y;
      t := 0;
      while t<(n-k) div 2 do
      begin
         y := x[n-t];
         x[n-t] := x[k+1+t];
         x[k+1+t] := y;
         t := t+1;
      end;
      NextPermutation := True;
   end
   else
      NextPermutation := False;
end;
 
 
var
  i, j : integer;
  T : vector;
 
  max, s : longint;
 
 
begin
  writeln('Исходная матрица');
  for i := 1 to n do
  begin
    for j := 1 to n do
      write(a[i, j]:4);
    writeln;
  end;
 
  for i := 1 to n do x[i] := i;
 
  max := - (maxlongint - 1);
  while nextpermutation do
  begin
    s := 0;
    for i := 1 to n do
      s := s + a[x[i], i];
    if max < s then
    begin
      T := x;
      max := s;
    end;
  end;
 
  writeln('Полученная матрица');
  for i := 1 to n do
  begin
    for j := 1 to n do write(a[T[i], j]:4);
    writeln;
  end;
end.

Вот результат работы (компилятор - FPC 2.6.2):

XML
1
2
3
4
5
6
7
8
9
Running "d:\programs\pascal\test_mx.exe"
Исходная матрица
   1   2   4
   6   1   5
   0   3   2
Полученная матрица
   6   1   5
   0   3   2
   1   2   4

Как ни странно, полученная матрица ровно так же ИДЕАЛЬНО совпадает с той, что тебе нужно было получить. Но ты, наверняка, как в прошлый раз сказал, что у меня все не так, так и в этот раз то же самое скажешь... Так что больше ничем помочь я тебе не могу (и не надо писать мне в ЛС)...

@MrSmmiT · 27.01.2014, 15:53 **[ТС]**

Сообщение от UI

Но ты, наверняка, как в прошлый раз сказал, что у меня все не так, так и в этот раз то же самое скажешь...

Прошу прощения, в той теме я не смог правильно объяснить что было нужно. Очень постараюсь избегать подобного. И извините что в лс написал.
А за ответ спасибо, то что нужно.

Новые блоги и статьи Все статьи Все блоги /
Перемещение выделенных строк ТЧ из одного документа в другой Maks 30.03.2026 Реализация из решения ниже выполнена на примере нетипового документа "ВыдачаОборудованияНаСпецтехнику" с единственной табличной частью "ОборудованиеИКомплектующие" разработанного в конфигурации КА2. . . .	Functional First Web Framework Suave DevAlt 30.03.2026 Sauve. IO Апнулись до NET10. Из зависимостей один пакет, работает одинаково хорошо как в режиме проекта так и в интерактивном режиме. из сложностей - чисто функциональный подход. Решил. . .	Автоматическое создание документа при проведении другого документа Maks 29.03.2026 Реализация из решения ниже выполнена на нетиповых документах, разработанных в конфигурации КА2. Есть нетиповой документ "ЗаявкаНаРемонтСпецтехники" и нетиповой документ "ПланированиеСпецтехники". В. . .	Настройка движения справочника по регистру сведений Maks 29.03.2026 Решение ниже реализовано на примере нетипового справочника "ТарифыМобильнойСвязи" разработанного в конфигурации КА2, с целью учета корпоративной мобильной связи в коммерческом предприятии. . . .
Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .