1 Провести минимальное количество прямых через столбцы и строки матрицы таким образом, чтобы они проходили через все нули, содержащиеся в таблице 2 Найти наименьший из элементов, через которые не проходит ни одна прямая 3 Вычесть его из всех элементов, через которые не проходят прямые 4 Прибавить его ко всем элементам, лежащим на пересечении прямых 5 Элементы, через которые проходит только одна прямая, оставить неизменными
здесь можно вычеркнуть 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.
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.