реализуемо ли Опции

[.helga]

Реализуемо ли это в Делфи??


1 Провести минимальное количество прямых через столбцы и строки матрицы таким образом, чтобы они проходили через все нули, содержащиеся в таблице
2 Найти наименьший из элементов, через которые не проходит ни одна прямая
3 Вычесть его из всех элементов, через которые не проходят прямые
4 Прибавить его ко всем элементам, лежащим на пересечении прямых
5 Элементы, через которые проходит только одна прямая, оставить неизменными

[Bokul]

здесь можно вычеркнуть 4 столбца. А у тебя вычеркивается 2 столбца и 3 строки, так?

А я - всегда вертикальную... Но что с этим делать - не придумала.

Положится на судьбу и воспользоваться random-ом

Жду твой вариант...

Добавил функцию, которая ищет количество безнулевых строк/столбцов в зависимости от передаваемого флага: true для столбца.
Также улучшил (имхо) читабельность главного цикла.

uses crt;
const
     n=5;
     ar:array[1..n,1..n] of byte=((0,1,0,1,0),
                                  (1,0,1,1,1),
                                  (1,0,0,1,0),
                                  (0,1,1,1,1),
                                  (1,0,0,1,0));
Type
    TElement=record
        info:byte;
        checked:boolean;
    end;
    TRes=record
        ind,n:byte;
    end;
Var mas:array[1..n,1..n] of TElement;

procedure init;
var i,j:byte;
begin
  for i:=1 to n do
      for j:=1 to n do
          begin
               mas[i,j].info:=ar[i,j];
               mas[i,j].checked:=false;
          end;
end;

function GetMax(isLine: boolean):TRes;
var i,j,max:byte;
    res:TRes;
    value: TElement;
begin
  max:=0;
  res.n:=0;
  res.ind:=0;
  for i:=1 to n do
      begin
           for j:=1 to n do begin
               if  isLine then value := mas[i, j] else value := mas[j, i];
               if  (value.info=0) and (value.checked=false) then inc(max);
           end;
           if max>res.n then
              begin
                   res.n:=max;
                   res.ind:=i;
              end;
           max:=0;
      end;
  GetMax:=res;
end;

function GetWithoutZero(IsColumn:boolean):byte;//<--Новая!!!
var i,j:byte; res:byte; b:boolean; value:TElement;
begin
  res:=0;
  for i:=1 to n do
      begin
           b:=false;
           for j:=1 to n do
               begin
                    if IsColumn then value:=mas[j,i] else value:=mas[i,j];
                    if (value.info=0) and (value.checked=false) then
                       b:=true
               end;
           if not(b) then
              inc(res);
      end;
  GetWithoutZero:=res;
end;



procedure CrossColumn(num:byte);
var i:byte;
begin
  for i:=1 to n do
      mas[i,num].checked:=true;
end;

procedure CrossLine(num:byte);
var i:byte;
begin
  for i:=1 to n do
      mas[num,i].checked:=true;
end;

var NColumn,NLine:TRes; WriteColumn:boolean;
begin
  clrscr;
  init;
  NColumn:=GetMax(false);
  NLine:=GetMax(true);
  while (NColumn.n<>0) and (NLine.n<>0) do
        begin
             if NColumn.n>NLine.n then
                WriteColumn:=true;
             if NColumn.n<NLine.n then
                WriteColumn:=false;

             if NColumn.n=NLine.n then
                 if GetWithoutZero(true)>GetWithoutZero(false) then
                    WriteColumn:=true
                 else
                     WriteColumn:=true;
             if WriteColumn then begin
                writeln('Column ',NColumn.ind);
                CrossColumn(NColumn.ind);
             end
             else begin
                 writeln('Line ',NLine.ind);
                 CrossLine(NLine.ind);
             end;
             NColumn:=GetMax(false);
             NLine:=GetMax(true);
        end;
readln;
end.