Сортировка столбцов в матрице

[WhistlerW]

Дана матрица 100 на 100(числа от 1 до 9). необходимо отсортировать элементы матрицы так, чтобы среднее значение каждого столбца было более-менее равным

пример
стартовая
1 1
2 3
2 5
3 5
срзнач: 1.5 срзнач 3.5

результат
1 1
2 2
3 3
5 5
срзнач 2.75 для обоих

[BaronTreep]

Ничево так задачка. Я сначала попробывал через минимальные числа, но щас сделал через случайные. Вобщем чем дальше крутить цикл тем больше будет соответствие средних, ну а если они перестали меняться значит всё.

const
  N = 5;
  M = 5;

type Array1 = array [1 .. N] of real;
type Array2 = array [1 .. N, 1 .. M] of real;

...

  Middle : Array1;
  Arr    : Array2;

...

{function MaxMal(A : Array2) : Real;
var
  i, k : word;
begin
  Result := A[1, 1];
  for i := 1 to N do
    for k := 1 to M do
       if (A[i, k] >= Result) then
          Result := A[i, k];
end;

function MinMal(A : Array2; var imin, kmin : word) : Real;
var
  i, k : word;
begin
  Result := A[1, 1];
  imin := 1;
  kmin := 1;
  for i := 1 to N do
    for k := 1 to M do
       if (A[i, k] <= Result) then begin
          Result := A[i, k];
          imin := i;
          kmin := k;
       end;
end;

procedure MinNth(nth : word; var imin, kmin : word);
var
  i, k, n : word;
  ArTmp   : Array2;
begin
  imin := 0;
  kmin := 0;
  ArTmp := Arr;
  for n := 1 to nth do begin
      MinMal(ArTmp, i, k);
      ArTmp[i, k] := MaxMal(ArTmp) + n;
  end;
  imin := i;
  kmin := k;
end; }

[BaronTreep]

procedure MiddleArr();
var
  i, k : word;
  Midd : real;
begin
  for k := 1 to M do begin
    Midd := 0;
    for i := 1 to N do
       Midd := Midd + Arr[i, k];
    Middle[k] := Midd /[color=green]// M;
  end;
end;

procedure Sort();
var
  i, k, nn : word;
  i2, k2   : word;
  tmp      : real;
begin
  randomize;
  for nn := 1 to 65000 do begin
      MiddleArr();
      {MinNth(n, i, k);}
      {MinNth(n + 1, i2, k2);}
      i := random(N) + 1;
      k := random(M) + 1;
      i2 := random(N) + 1;
      k2 := random(M) + 1;
      if Middle[k] < Middle[k2] then begin
         tmp := Arr[i2, k2];
         Arr[i2, k2] := Arr[i, k];
         Arr[i, k] := tmp;
      end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i, k : word;
  sArr : string;
begin
  for i := 1 to N do
    for k := 1 to M do
        Arr[i, k] := i + k;

  Sort();

  MiddleArr();
  for i := 1 to N do begin
    for k := 1 to M do begin
        str(Arr[i, k]:1:0, sArr);
        Memo1.Text := Memo1.Text + SArr + ', ';
    end;
    Memo1.Text := Memo1.Text + #13 + #10;
  end;
  Memo1.Text := Memo1.Text + #13 + #10;
  for i := 1 to N do begin
        str(Middle[i]:1:1, sArr);
        Memo1.Text := Memo1.Text +  sArr + ', ';
  end;
  Memo1.Text := Memo1.Text + #13 + #10;
end;

[WhistlerW]

Благодарю за ответ. К сожалению это решение мне не совсем подходит - задачка дана по предмету Исследование Операций, ваше решение препод просто не примет как не оптимальное
Я придумал другое, но оно тоже не особо

Вот кусок алгоритма отвечающий за перестановку:


Шаг 6: Вычисление сумм элементов каждого столбца
Шаг 7: Балансировка матрицы:
Шаг 7.1: Выбрать I-й и J-й столбцы где I не равно J . Если суммы элементов столбцов отличаются более чем на единицу или на разницу между минимальными элементами столбцов, перейти на шаг 7.2. Если суммы элементов всех столбцов равны или различаются не более чем на разницу между минимальными элементами столбцов, перейти на шаг 8, иначе повторить шаг 7.1 с другими столбцами.
Шаг 7.2: Для столбца с меньшей суммой элементов выбрать минимальный элемент, для второго – выбрать элемент, значение которого ближе всего к разнице между суммами двух столбцов, деленной надвое.
Шаг 7.3: Переставить элементы
Шаг 7.4: Обновить значение сумм столбцов
Шаг 7.5: Перейти на шаг 7.1
Шаг 8: Завершить сортировку

Если сможете предложить усовершенствование, буду очень благодарен. Можно даже без кода - чисто алгоритм, закодю сам.
Это решение препод назвал не слишком оптимальным и дал время на переделку до понедельника. Пока я не придумал что изменить.

Вопрос актуален до воскресного вечера