123

type
  matrix = array of array of integer;

procedure CreateMatrix(var pMatrix: matrix; count_row, count_col: integer);
var
  i, j: integer;
begin
  SetLength(pMatrix, count_row, count_col);
  For i:=0 To count_row-1 Do
      For j:=0 To count_col-1 Do
          pMatrix[i, j] := 0;
end;

procedure FillMatrix(var pMatrix: matrix; count_row, count_col: integer);
var
  i, j: integer;
begin
  Writeln(UTF8Decode('Заполнение количества запасов поставщиков: '));
  For i:=1 To count_row Do
    Begin
      Write(UTF8Decode('Количество запасов '), i, UTF8Decode('-ого поставщика = '));
      Readln(pMatrix[i, 0]);
    End;
  Writeln();
  For i:=1 To count_col Do
    Begin
      Write(UTF8Decode('Количество потребностей '), i, UTF8Decode('-ого потребителя = '));
      Readln(pMatrix[0, i]);
    End;
  Writeln();
  For i:=1 To count_row Do
    For j:=1 To count_col Do
      Begin
        Write(UTF8Decode('Введите стоимость перевозки между ') , i, UTF8Decode('-ым поставщиком и '), j, UTF8Decode('-ым потребителем = '));
        Readln(pMatrix[i, j]);
      End;
  Writeln();
end;

procedure ShowMatrix(pMatrix: matrix; count_row, count_col: integer);
var
  i, j: integer;
begin
  For i:=0 To count_row-1 Do
  Begin
    For j:=0 To count_col-1 Do
      Begin
        Write(pMatrix[i, j]:3);
      End;
    Writeln();
  End;
end;

function FillBasicPlan(var pMatrix, pMatrix2: matrix; count_row, count_col: integer) : integer;
var
  i, j, basic_plan, f_min, s_min, cord_max_i, cord_max_j, max, cord_min_i, cord_min_j, min: integer;
  isReady, isZero: boolean;
begin
  basic_plan := 0;
  isReady := false;

  While isReady = false Do
  begin
    For i := 1 To count_row-1 Do
    begin
      isZero := false;
      f_min := 0;
      s_min := 0;
      if pMatrix[i, 0] = 0 then
        isZero := true;
      if isZero = false then
      begin
        For j := 1 To count_col-1 Do
        begin
          if pMatrix[0, j] <> 0 then
          begin
            if f_min = 0 then
              f_min := pMatrix[i, j]
            else
              if s_min = 0 then
                s_min := pMatrix[i, j];
          end;
        end;
        if f_min > s_min then
        begin
          f_min := f_min + s_min;
          s_min := f_min - s_min;
          f_min := f_min - s_min;
        end;
        For j := 3 To count_col-1 Do
        begin
          if pMatrix[0, j] <> 0 then
          begin
            if (pMatrix[i, j] > f_min) and (pMatrix[i, j] < s_min) then
              s_min := pMatrix[i, j]
            else
            begin
              if pMatrix[i][j] <= f_min then
              begin
                s_min := f_min;
                              f_min := pMatrix[i, j];
              end;
            end;
          end;
        end;
        pMatrix[i, j + 1] := abs(s_min - f_min);
      end;
    end;
    //
    For j := 1 To count_col-1 Do
    begin
      isZero := false;
      f_min := 0;
      s_min := 0;
      if pMatrix[0, j] = 0 then
        isZero := true;
      if isZero = false then
      begin

        For i := 1 To count_row-1 Do
        begin
          if pMatrix[i, 0] <> 0 then
          begin
            if f_min = 0 then
            begin
              f_min := pMatrix[i, j];
            end
            else
              if s_min = 0 then
              begin
                s_min := pMatrix[i, j];
              end;
          end;
        end;
        if f_min > s_min then
        begin
          f_min := f_min + s_min;
          s_min := f_min - s_min;
          f_min := f_min - s_min;
        end;

        For i := 3 To count_row-1 Do
        begin
          if pMatrix[i, 0] <> 0 then
          begin
            if (pMatrix[i, j] > f_min) and (pMatrix[i, j] < s_min) then
              s_min := pMatrix[i, j]
            else
            begin
              if pMatrix[i][j] <= f_min then
              begin
                s_min := f_min;
                              f_min := pMatrix[i, j];
              end;
            end;
          end;
        end;
        pMatrix[i + 1, j] := abs(s_min - f_min);
      end;
    end;

    cord_max_i := count_row;
    cord_max_j := count_col;
    max := 0;
    For j := 1 To count_col-1 Do
    begin
      if pMatrix[0, j] <> 0 then
      begin
        if pMatrix[count_row, j] > max then
        begin
          max := pMatrix[count_row, j];
                    cord_max_i := count_row;
                    cord_max_j := j;
        end;
      end;
    end;
    For i := 1 To count_row-1 Do
    begin
      if pMatrix[i, 0] <> 0 then
      begin
        if pMatrix[i, count_col] > max then
        begin
          max := pMatrix[i, count_col];
                    cord_max_i := i;
                    cord_max_j := count_col;
        end;
      end;
    end;
    Write(UTF8Decode('Максимум = '), max, ' [', i, ', ', j, ']');

    cord_min_i := 0;
    cord_min_j := 0;
    min := MAXINT;

    if cord_max_i = count_row then
    begin
      Writeln(UTF8Decode(' Максимум в строке'));
      For i := 1 To count_row-1 Do
      begin
        if pMatrix[i, 0] <> 0 then
        begin
          if pMatrix[i, cord_max_j] < min then
          begin
            min := pMatrix[i, cord_max_j];
                        cord_min_i := i;
                        cord_min_j := cord_max_j;
          end;
        end;
      end;
    end
    else
    begin
      if cord_max_j = count_col then
      begin
        Writeln(UTF8Decode(' Максимум в столбце'));
        For j := 1 To count_col-1 Do
        begin
          if pMatrix[0, j] <> 0 then
          begin
            if pMatrix[cord_max_i, j] < min then
            begin
              min := pMatrix[cord_max_i, j];
              cord_min_i := cord_max_i;
              cord_min_j := j;
            end;
          end;
        end;
      end;
    end;

    Writeln(UTF8Decode('Минимум в матрице = '), min);
    Writeln(UTF8Decode('Координаты минимума: ['), cord_min_i, ', ', cord_min_j, ']');
    if pMatrix[0, cord_min_j] <= pMatrix[cord_min_i, 0] then
    begin
      pMatrix2[cord_min_i, cord_min_j] := pMatrix[cord_min_i, cord_min_j] * pMatrix[0, cord_min_j];
            pMatrix[cord_min_i, 0] := pMatrix[cord_min_i, 0] - pMatrix[0, cord_min_j];
            pMatrix[0][cord_min_j] := 0
    end
    else
    begin
      if pMatrix[0, cord_min_j] > pMatrix[cord_min_i, 0] then
      begin
        pMatrix2[cord_min_i, cord_min_j] := pMatrix[cord_min_i, cord_min_j] * pMatrix[cord_min_i, 0];
        pMatrix[0, cord_min_j] := pMatrix[0, cord_min_j] - pMatrix[cord_min_i, 0];
        pMatrix[cord_min_i, 0] := 0;
      end;
    end;

    basic_plan := basic_plan + pMatrix2[cord_min_i, cord_min_j];
    Readln();
    isReady := true;
    For j := 1 To count_col-1 Do
      if pMatrix[0, j] <> 0 then
        isReady := false;
    For i := 1 To count_row-1 Do
      if pMatrix[i, 0] <> 0 then
        isReady := false;
  end;
  FillBasicPlan := basic_plan;
end;

Var
  count_supplier, count_consumer: integer;
  max_row, max_col: integer;
  sum_basic_plan: integer;
  DeliveryMatrix, BasicPlan: matrix;
Begin
  Writeln(UTF8Decode('Введите количество поставщиков: '));
  Read(count_supplier);
  Writeln(UTF8Decode('Введите количество потребителей: '));
  Read(count_consumer);
  Writeln();
  max_row := count_supplier + 3;
  max_col := count_consumer + 3;
  CreateMatrix(DeliveryMatrix, max_row, max_col);
  //Заполняем матрицу поставок
  FillMatrix(DeliveryMatrix, count_supplier, count_consumer);
  //Вывод матрицы поставок
  Writeln(UTF8Decode('Матрица поставок сформирована'));
  ShowMatrix(DeliveryMatrix, max_row, max_col);
  Writeln();
  //Создание опорного плана
  CreateMatrix(BasicPlan, count_supplier + 1, count_consumer + 1);
  sum_basic_plan := FillBasicPlan(DeliveryMatrix, BasicPlan, count_supplier + 1, count_consumer + 1);
  //Вывод опорного плана
  ShowMatrix(DeliveryMatrix, max_row, max_col);
  Writeln(UTF8Decode('Опорный план построен'));
  ShowMatrix(BasicPlan, count_supplier + 1, count_consumer + 1);
  Writeln(UTF8Decode('Опорный план = '), sum_basic_plan);
  Readln();
End.