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


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

Реализуемо.
Скажи, у тебя есть идеи, каким алгоритмом надо пользоваться, чтобы минимизировать количество прямых? (Вне связи с языком реализации - как бы ты действовала, если бы тебе дали таблицу с числами и попросили провести такие прямые?)

эмм.. нужно вычеркивать сначала те столбцы или строки, в которых сод. наибольшее кол-во нулей. написать это труднее, чем сказать. у меня получается что-то вроде этого:

max:=0;
counter:=0;

for i:=1 to m do
begin
for ii:=1 to m do
if matr[i,ii]=0 then
inc(counter);
if counter>max then
begin
max:=counter;
b:=ii; {запоминаем строку}
counter:=0;
end;
end;

это для строк. то же самое для столбцов с сохранением макс., но тут непонятно, как запоминать теперь уже столбец, чтобы не було путаницы, когда придется "вычеркивать"..

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

Очень много лишних проходов.
Может быть, имеет смысл потратить некоторое количество памяти и, посчитав количество нулей в каждой строке и столбце, записать их отдельно? а потом по мере вычеркивания корректировать?

Цикл заканчивается, когда не осталось невычеркнутых нулей. То есть, если идем вторым путем, массив обнулился. Если первым - можно хранить кол-во оставшихся нулей в отдельной переменной.

следующий вопрос: как проверять, вычеркнуто ли то или иное число?
у меня есть 2 идеи:
1) создаем дополнительный массив, в который записываем номера вычеркнутых строк и столбцов.
2) исходный массив объявляем не так:

matr: array[1..m,1..m] of integer;

а так:

type
element=record
info,checked: integer;
end;
var matr: array[1..m,1..m] of element;

причем в поле info храним собственно значение (цифру), а в checked - информацию о зачеркнутости (0 - не зачеркнуто, 1 - зачеркнуто, 2 - находится на пересечении).

мне кажется, со вторым будет несколько проще работать.
как считаешь?

в общем, попробуй...
если что получится - выкладывай. если нет - напиши об этом...

о, пришла бредовая мысля!

а что, если "зачеркнутые значения" в процессе зачеркивания умножить, напр, на те же 100. у меня ограничение по вводу меньше трех цифр, так что тогда будет сразу видно, что мы "зачеркивали", + довольно легко найдутся пересечения. и поиску мин. значений это не будет мешать.

потом:
if a[i,ii]<100 then a[i,ii]:=a[i,ii]-min;

затем ищем пересечения:
if a[i,ii]>=10000 then a[i,ii]:=a[i,ii]/10000+min

а остальные: двойной вложенный цикл
if a[i,ii]>=100 then a[i,ii]:=a[i,ii]/100.

будет оно правильно работать? а вот с этим поиском строк/столбцов с макс. кол-вом нулей я все равно туплю..

Вот мое решение:
Пойдём от обратного: какое максимальное число n линий нужно провести, чтобы вычеркнуть все нули с квадратной матрицы (потом легко можно перейти к общему случаю)? Ответ прост - число линий будет отвечать размерности матрицы (количеству столбцов или строк). Тогда когда же мы сможем получить выигрыш (число вычеркиваний будет меньшим чем n)? Ответ тоже прост - только в том случае, когда на каком-нибудь столбце или строке вообще не будет нулей.
Алгоритм таковой: находим все "безнулевые" строки и столбцы, одновременно считая их количество(NColumn, NLine). Сравниваем NColumn и NLine, если NLine больше проводим горизонтальные линии через все строки, не помечены как "безнулевые", если же NColumn - тоже самое, только вертикальные линии. В случае равенства - запускаем random з 2.. - направление не имеет значения.

а если безнулевых строк/столбцов не окажется?

1 1 1 0
1 0 1 1
0 0 1 1
1 1 0 1

хорошо, пусть в этом случае будет равенство. 0=0, => рандом. но рандом на то и рандом, что никак не угадать, что он начеркает. может оказаться, что вычеркнуться все элементы матрицы, как в таком, например, случае. а можно (нужно!) вычеркнуть минимальным кол-вом линий, чтобы эл-ты остались.

напрмер так;
1 - 1 -
1 - 1 -
- - - -
- - - -

пс. матрица и так квадратная. забыла уточнить в теме.

Ты не поняла шутки с random-ом - если безнулевых строк/столбцов не будет, то все-равно, проведём ли мы 4 вертикальных или 4 горизонтальных линий. Его мы используем чтобы узнать проводить горизонтальные или вертикальные линии. Ты можешь вообще не использовать random, тогда в случае равенства всегда проводить, например, только горизонтальные линии, хотя с тем же успехом можешь использовать только вертикальные.

ну да. если в моем примере проводить только горизонтальные линии, то все эл-ты зачеркнуться.
или ты предлагаешь делать это рекурсивно (по одному зачеркиванию за раз) и по ходу дела уже анализировать ситуацию?

.helga, почему ты так хочешь усложнить все? Хватит того, что я описал в 6 посте.


Сделай еще примеры, пройдись по ним с моим алгоритмом, если найдешь ситуацию, когда он дает не минимальное число зачеркиваний - повышу рейтинг..

не хватит! потому что при некоторых примерах оно не выполняется. как в том, что я привела. или в матрице, трансп. из этой:

1 0 1 1
1 0 0 1
0 1 1 1
1 1 1 0

хоть вычеркивай только вертикальные, хоть только горизонтальные, будет совсем не то, что требуется. таких примеров можно привести кучу (таких - когда нет ненулевых строк/столбцов=> алгоритм не работает).

алгоритм должен подходить по все возможные варианты, за исключением парочки, что можно описать в else. вот

если есть безнулевые строки или столбцы, все работает, но если нету.. вот тут-то и прокол.
дело в том, в этой задаче предыдущие два этапа как раз такие, что безнулевых строк/столбцов как раз не окажется.. (до этого находятся максы и мины в каждых строках/столбцах и вычитаются из всех эл-тов строки/столбца).

имхо, проще было бы каждый раз искать строку/столбец с наиб. кол-вом нулей и вычеркивать его..

Что требуется? Найти минимальное количество зачеркиваний, правильно? Какой ответ даст мой алгоритм для твоего случая? Ответ-четыре. Неужели ты видишь как сделать меньше?

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

0 1 1 1
0 1 1 1
1 1 0 1
1 0 0 0

м?) можно зачеркнуть тремя линиями. а по твоему алгоритму он 4 сделает.

.helga, покажи как ты с умом зачеркнёшь все нули в твоем примере.


Так бы сразу, действительно мой алгоритм - не правильный.

насчет тех примеров:
зачеркну. сначала вычеркиваем столбец/строку с максимальным кол-вом нулей, а потом, когда появляются ненулевые строки/столбцы, можно рассуждать по твоему алгоритму.
проблема в том, что его можно применять только при наличии этих самых безнулевых столбцов.

Нет мой алгоритм и для такого не годится:
1111
1101
1101
1000
он даст 3, хотя можно обойтись и двумя линиями.

хм. тогда кроме вычеркивания строк/столбцов с максимальным кол-вом нулей, я решений не вижу..
вот так?

max_a, max_b, counter, i, ii, m: integer;

begin
max_b:=0;
counter:=0;

for i:=1 to m do
 begin
  for ii:=1 to m do
   if matr[i,ii]=0 then
    inc(counter);
   if counter>max_b then
    begin
     max_b:=counter;
     b:=ii; {запоминаем строку}
     counter:=0;
    end;
 end;

max_a:=0;

for ii:=1 to m do
 begin
  for i:=1 to m do
   if matr[i,ii]=0 then
    inc(counter);
   if counter>max_a then
    begin
     max_a:=counter;
     a:=i; {запоминаем столбец}
     counter:=0;
    end;
 end;

if max_a<max_b then 
 begin
  for i:=1 to m do
   if matr[i,b]=0 then matr[i,b]:=matr[i,b]*100;
 end
else
 begin
  for ii:=1 to m do
   if matr[a,ii]=0 then matr[a,ii]:=matr[a,ii]*100;  
  end;
end;

выполнять пока есть нули.
чет как-то громоздко получилось..

А полный код можешь привести?

отредактировала чуток предыдущее. спать все-таки иногда надо, прокалываюсь на мелочах)

полный код - это код всех 5 шагов? или только "вычеркивания"?

Тот который будет компилироваться..

на недо-паскале:

program z;
uses crt;
var
mart: array [1..100, 1.. 100] of integer;
i,ii,m:integer;

procedure lines;
var
max_a, max_b, counter: integer;

begin

for i:=1 to m do
 for ii:=1 to m do 
  if matr[i,ii]=0 then
   inc(counter);
if counter=0 then break
else

max_b:=0;
counter:=0;

{максимальное кол-во нулей по строкам}
for i:=1 to m do
 begin
  for ii:=1 to m do
   if matr[i,ii]=0 then
    inc(counter);
   if counter>max_b then
    begin
     max_b:=counter;
     b:=ii; {запоминаем строку}
     counter:=0;
    end;
 end;

max_a:=0;
{максимальное кол-во нулей по столбцам}
for ii:=1 to m do
 begin
  for i:=1 to m do
   if matr[i,ii]=0 then
    inc(counter);
   if counter>max_a then
    begin
     max_a:=counter;
     a:=i; {запоминаем столбец}
     counter:=0;
    end;
 end;

{
  если максимально кол-во нулей по строкам больше максимального
  кол-ва нулей по столбцам, "вычеркиваем" строку и наоборот
}
if max_a<max_b then 
 begin
  for i:=1 to m do
   if matr[i,b]=0 then matr[i,b]:=matr[i,b]*100;
 end
else
 begin
  for ii:=1 to m do
   if matr[a,ii]=0 then matr[a,ii]:=matr[a,ii]*100;  
  end;

lines; 
end;


procedure steps;
var
min: integer;

begin
{поиск минимального элемента}
min:=100;
for i:=1 to m do
 for ii:=1 to m do
  if matr[i,ii]<min then
  min:=matr[i,ii];

{вычитаем минимальный элемент из незачеркнутых элементов матрицы}
for i:=1 to m do
 for ii:=1 to m do
  if a[i,ii]<100 then a[i,ii]:=a[i,ii]-min;

{прибавляем минимальный элемент к элементам, находящимся на пересечении прямых}
for i:=1 to m do
 for ii:=1 to m do
  if a[i,ii]>=10000 then a[i,ii]:=a[i,ii]/10000+min

{возвращаем "зачеркнутым" посредством умножения на 100 элементам их исходное значение}
for i:=1 to m do
 for ii:=1 to m do
  if a[i,ii]>=100 then a[i,ii]:=a[i,ii]/100.
end;

begin
lines;
steps;
end.
 

чувствую, что здесь косяков ой как много.. особенно с тем, что я пыталась оформить рекурсией..

да, я не писала вводы-выводы матрицы, но это ведь не суть.

Конечно у тебя рекурсия вечная (до переполнения стека точно не остановится).

а вот этот кусок

for i:=1 to m do
 for ii:=1 to m do 
  if matr[i,ii]=0 then
   inc(counter);
if counter=0 then break

разве не считается?

Ты тестила свой код? Правильные результаты дает?

Вот моя реализация алгоритма мисс_граффити:

uses crt;
const
     n=4;
     ar:array[1..n,1..n] of byte=((0,1,1,0),
                                  (2,1,0,1),
                                  (3,1,0,1),
                                  (4,0,0,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 GetMaxColumn:TRes;//находим столбик с максимальным количеством нулей
var i,j,max:byte;
    res:TRes;
begin
  max:=0;
  res.n:=0;
  res.ind:=0;
  for i:=1 to n do
      begin
           for j:=1 to n do
               if  (mas[j,i].info=0) and (mas[j,i].checked=false) then
                   inc(max);
           if max>res.n then
              begin
                   res.n:=max;
                   res.ind:=i;
              end;
           max:=0;
      end;
  GetMaxColumn:=res;
end;

function GetMaxLine:TRes;//находим строку с максимальным количеством нулей
var i,j,max:byte;
    res:TRes;
begin
  max:=0;
  res.n:=0;
  res.ind:=0;
  for i:=1 to n do
      begin
           for j:=1 to n do
               if (mas[i,j].info=0) and (mas[i,j].checked=false) then
                   inc(max);
           if max>res.n then
              begin
                   res.n:=max;
                   res.ind:=i;
              end;
           max:=0;
         end;
  GetMaxLine:=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;
begin
  clrscr;
  init;
  repeat//повторяем
        NColumn:=GetMaxColumn;
        NLine:=GetMaxLine;
        if (NColumn.n<>0) and (NLine.n<>0) then
           if NColumn.n>NLine.n then //если количество нулей больше в столбце
              begin
                   writeln('Column ',NColumn.ind);
                   CrossColumn(NColumn.ind);//то зачеркиваем его
              end
           else// в противоположном случае
               begin
                    writeln('Line ',NLine.ind);
                    CrossLine(NLine.ind);// зачеркиваем линию
               end;
  until (NColumn.n=0) and (NLine.n=0);//пока не зачеркнем все нули
readln;
end.

Хватит только 1 и 0, по-этому использую boolean.

Этого не достаточно, надо хранить информацию о каждом элементе.

2 Bokul: Copy+Paste - не наш метод... Убираем 2 функции (GetMaxLine/GetMaxColumn), заменяем их на одну:

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;

Вся разница - в способе вызова:

...
  repeat
        NColumn:=GetMax(false);
        NLine:=GetMax(true);
        ...

А как ты отличаешь элементы, расположенные на пересечении зачеркнутых строки и столбца?


Тогда это сведется к первому варианту
Нет, информации о строках и столбцах достаточно. Кстати, пожалуй, ее удобнее хранить не в массивах, а в множествах.

Я сам сначала хотел сделать именно через два множества - множество зачеркнутых столбцов(CrossedColumns) и еще одно для строк(CrossedLines). Но что делать когда надо зачеркнуть строку 2 в таком случае?
110
010
111
Добавляешь в CrossedLines 2, но 0, стоящий на пересечении 3-ого столбца и 2-ой строки будет перечеркнутым только как строка - он не занесен в CrossedColumns и поэтому будет учитываться в следующим подсчете в третьем слобце.

Нигде, эта информация мне не надо.

Везет тебе.... А вот автору темы нужно:



А кто тебе мешает проверять на перечеркнутость для как строки? (тьфу... не по-русски сказала). ну то есть

for j:=1 to n do
  for i:=1 to n do
    if not(i in CrossedLines) then...

Не понимаю сути проблемы.


А откуда тогда взялось:

if  (value.info=0) and (value.checked=false) then

Попробуй сделать - поймешь.

Можно обойтись только знанием проведенных прямых.

Попробовала. Сделала. Не поняла
Файлик прицепляю - вроде работает. Правда, не всегда совсем "с умом"...Нажмите для просмотра прикрепленного файла.


Можно. Но ведь мы их не храним... А храним инфу по каждому числу отдельно...

И не всегда правильно..
Нажмите для просмотра прикрепленного файла

Ну сохраним. Вместо вывода на экран номеров столбцов и строк сохраняем их в множества.

А зачем нам их хранить?


Надо подумать, как поступать, если максимальное количество нулей по строкам равно максимальному по столбцам...
А вообще твой вариант транспонированную матрицу:

n=5;
     ar:array[1..n,1..n] of byte=((0,1,1,1,0),
                                  (1,0,0,1,1),
                                  (1,0,1,1,0),
                                  (0,1,0,1,1),
                                  (1,0,1,1,0));

тоже не слишком весело обрабатывает. так что проблема общая.

Ты права. Просто люблю все делать поэтапно..

Почему же, моя даже не задумывалась:

Column 2
Column 5
Line 4
Line 1
Line 2

ой...
в смысле, вот так:

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));

ну первый вариант тоже некорректно обрабатывается

5 линий. А можно обойтись 4...

Да. Проблема в том что в случае когда максимальные количества нулей в строке и столбце равняются, я всегда провожу горизонтальную линию, хотя это надо делать 'с умом' - совместить мой неправильный алгоритм с этим. Сейчас сделаю.

я вот про этот вариант:

n=5;
     ar:array[1..n,1..n] of byte=((0,1,1,1,0),
                                  (1,0,0,1,1),
                                  (1,0,1,1,0),
                                  (0,1,0,1,1),
                                  (1,0,1,1,0));

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


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

2 .helga
Вы по какому предмету эти транспортные задачи мучаете?

2 мисс_граффити
основы алгоритмизации и программирования. курсовой пишу.
с этим вот этапом вышла проблемка.

Положится на судьбу и воспользоваться 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.

к сожалению, внесенные изменения не в полной мере решают проблему:

const
     n=5;
     ar:array[1..n,1..n] of byte=((0,1,0,1,0),
                                  (1,1,1,1,1),
                                  (1,0,0,1,0),
                                  (1,1,1,1,1),
                                  (1,0,0,1,0));

можно обойтись вычеркиванием трех строк, а программка предлагает 4 столбца...
может, еще считать количество безнулевых строк и столбцов?

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),
                                  (0,0,0,1,0));

меняем нижнюю левую единицу на ноль и мучаемся в поисках нового алгоритма..


Да надо совмещать, щас подумаю..

Идея такая: если безнулевых столбцов/строк больше, накладываем запрет на вычеркивание строк/столбцов соответственно. Если поровну (частный случай - ни одного) - идем по старому алгоритму.
Что скажешь?

Я допустил ошибку:

             
             if NColumn.n=NLine.n then
                 if GetWithoutZero(true)>GetWithoutZero(false) then
                    WriteColumn:=true
                 else
                     WriteColumn:=true;//<---!надо заменить на false!
             if WriteColumn then begin

Хотя с моим вариантом он не справляется все-равно .

Почти тоже самое в моей последнем варианте - только вместо запрета разрешение..

А если еще потом окажется, что максимальное количество нулей в строке и столбце одинаковое? Как линию проводить, горизонтально или вертикально?

вроде как непринципиально...

Я про немножко другой алгоритм... у тебя идет проверка на кол-во ненулевых только при NColumn.n=NLine.n.
А я предлагаю делать так:
1) Смотрим на ненулевые строки и столбцы.
2) Если строк больше, вычеркиваем только строки с нулями.
3) Если столбцов больше, вычеркиваем только столбцы с нулями.
4) Если поровну (как вариант - полное отсутствие) - идем по старому алгоритму... то есть ищем, где у нас больше нулей и т.д.

0 0 1 1 1
1 1 0 1 1
1 1 0 1 1
1 1 0 1 1
1 1 1 1 1

У меня есть идейка, сейчас попробую додумать..

Переделать старый алгоритм("то есть ищем, где у нас больше нулей и т.д") на роботу не только с квадратными матрицами. Но изменения будут касаться не только сменой границ счетчиков (з двух n-ов станет до m и до n), но и добавлением условия - если полученное число вычеркиваний меньше меньшей стороны матрицы - делаем их, в противном случае проводим линии перпендикулярно меньшей стороне.

Тогда в квадратной матрицы, в случае существования безнулевых строчек/столбцов, мы их удаляем и передаем полученную матрицу обновлённому "старому" алгоритму, описанному выше.

Например:

(0,1,0,1,0),
(1,0,1,1,1),
(1,0,0,1,0),
(0,1,1,1,1),
(0,0,0,1,0));

1-ый шаг

(0,1,0,0),
(1,0,1,1),
(1,0,0,0),
(0,1,1,1),
(0,0,0,0));

2-ой шаг

(Количество вычеркиваний согласно "старому" алгоритму=5) > (меньшей стороны 4), по тому проводим четыре вертикальных линии.

Ну как?

Блин, написал код и для этого алгоритма, но он тоже не правильный - задыхается на таком примере:

1 0 0 0 1
1 1 1 1 0
0 1 1 1 0
0 1 1 1 1
1 0 0 0 1

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

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. Проблема все в том же - как вычеркивать в случае равенства горизонтально ли вертикально?

рассматиривать отдельно?...
поскольку "развилок" может получиться много (особенно на больших массивах), это проблематично.

helga, а тебе непременно венгерский метод нужен?

уже нет, мне изменили постановку задачи, теперь немного другая тема.

но все равно интересно, как это сделать можно )