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

[.helga]

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


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

[Bokul]

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,0,1,1),
                                  (0,0,0,1,0));
Type
    TElement=record
        info:byte;
        checked:boolean;
    end;
    TRes=record
        ind,n:byte;
    end;
    TCrossing=record//хранит номер вычеркнутого столбца/строки и что было вычеркнуто - столбец/строка
        ind:byte;
        IsLine:boolean;
    end;

Var mas:array[1..n,1..n] of TElement;
    NCol,NLin:byte;//длинна столбца/строки псле удаления
    DeletedLines,DeletedColumns: set of byte;//удаленные строки/столцбы
    Crossed:array[1..n] of TCrossing;//массив вычеркиваний используя "старый" алгоритм.
procedure init;
var i,j:byte;
begin
  DeletedLines:=[];
  DeletedColumns:=[];
  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; b:boolean; value:TElement;
begin
  for i:=1 to n do
      begin
           b:=true;
           for j:=1 to n do
               begin
                    if IsColumn then value:=mas[j,i] else value:=mas[i,j];
                    if (value.info=0) then
                        b:=false
               end;
           if b then
              if ((IsColumn)       and ((i in(DeletedColumns))=false)) or
                 ((IsColumn=false) and ((i in(DeletedLines))=false)) then begin

                 GetWithoutZero:=i;
                 exit;
               end;
      end;
  GetWithoutZero:=0;
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;

procedure Delete;{удаляем безнулевые строки/столбцы. На самом деле они не удаляются, а заносятся в множества DeletedLines и DeletedColumns}
var NL,NC:byte;
begin
  NCol:=n;//сколько сталось неудаленных столбцов
  NLin:=n;//сколько сталось неудаленных строк
  repeat
        NL:=GetWithoutZero(false);
        NC:=GetWithoutZero(true);
        if NL<>0 then begin
           DeletedLines:=DeletedLines+[NL];//так происходит "удаление" строки
           dec(NLin);
        end;
        if NC<>0 then begin
           DeletedColumns:=DeletedColumns+[NC];//а так- столбца
           dec(NCol);
        end;
  until (NL=0) and (NC=0);
end;


var i,NOldMethod:byte;
    NLinTog,NColTog:TRes;
    Min:TCrossing;
begin
  clrscr;
  init;
  delete;

//-----------------Step Two--------------------

  if NCol<NLin then begin //ищем меньшую сторону в "новой" матрице
     Min.ind:=NCol;
     Min.IsLine:=false;
  end
  else begin
       Min.ind:=NLin;
       Min.IsLine:=true;
  end;

//а вот и старый алгоритм
  NLinTog:=GetMax(true);//максимальное число нулей, идущих вподряд в строке
  NColTog:=GetMax(false);// в столбце
  NOldMethod:=0;
  while ((NLinTog.n<>0) and (NColTog.n<>0)) and (NOldMethod<Min.ind) do
        begin
             inc(NOldMethod);
             if NColTog.n>NLinTog.n then begin
                Crossed[NOldMethod].ind:=NColTog.ind;//вместо writeln записываем результат в массив
                Crossed[NOldMethod].IsLine:=false;
                CrossColumn(NColTog.ind);
             end
             else begin
                  Crossed[NOldMethod].ind:=NLinTog.ind;// тут тоже самое
                  Crossed[NOldMethod].IsLine:=true;
                  CrossLine(NLinTog.ind);
             end;
             NLinTog:=GetMax(true);
             NColTog:=GetMax(false);
       end;
  if Min.ind<=NOldMethod then begin//сравниваем, каким способом будет меньше вычеркиваний 
     for i:=1 to n do //выводим результат 
         if Min.IsLine then begin
            if not(i in DeletedLines) then  writeln('Line ',i);
         end
         else
            if not(i in DeletedColumns) then writeln('Column ',i);
  end
  else
      for i:=1 to NOldMethod do//выводим результат 
          if Crossed[i].IsLine then writeln('Line ',Crossed[i].ind)
          else writeln('Column ',Crossed[i].ind);
  readln;
end.

почему? чем этот пример такой особенный???

Можно пройтись по периметру, сделав только 4 вычеркивания, мой алгоритм делает 5. Проблема все в том же - как вычеркивать в случае равенства горизонтально ли вертикально?