1 Провести минимальное количество прямых через столбцы и строки матрицы таким образом, чтобы они проходили через все нули, содержащиеся в таблице 2 Найти наименьший из элементов, через которые не проходит ни одна прямая 3 Вычесть его из всех элементов, через которые не проходят прямые 4 Прибавить его ко всем элементам, лежащим на пересечении прямых 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.
чувствую, что здесь косяков ой как много.. особенно с тем, что я пыталась оформить рекурсией..
да, я не писала вводы-выводы матрицы, но это ведь не суть.
Конечно у тебя рекурсия вечная (до переполнения стека точно не остановится).
Сообщение отредактировано: Bokul -
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
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.
Цитата
причем в поле info храним собственно значение (цифру), а в checked - информацию о зачеркнутости (0 - не зачеркнуто, 1 - зачеркнуто, 2 - находится на пересечении).
Хватит только 1 и 0, по-этому использую boolean.
Цитата
1) создаем дополнительный массив, в который записываем номера вычеркнутых строк и столбцов.
Этого не достаточно, надо хранить информацию о каждом элементе.
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
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;
А как ты отличаешь элементы, расположенные на пересечении зачеркнутых строки и столбца?
Цитата
Этого не достаточно, надо хранить информацию о каждом элементе.
Тогда это сведется к первому варианту Нет, информации о строках и столбцах достаточно. Кстати, пожалуй, ее удобнее хранить не в массивах, а в множествах.
--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует. На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
Нет, информации о строках и столбцах достаточно. Кстати, пожалуй, ее удобнее хранить не в массивах, а в множествах.
Я сам сначала хотел сделать именно через два множества - множество зачеркнутых столбцов(CrossedColumns) и еще одно для строк(CrossedLines). Но что делать когда надо зачеркнуть строку 2 в таком случае? 110 010 111 Добавляешь в CrossedLines 2, но 0, стоящий на пересечении 3-ого столбца и 2-ой строки будет перечеркнутым только как строка - он не занесен в CrossedColumns и поэтому будет учитываться в следующим подсчете в третьем слобце.
Цитата
А как ты отличаешь элементы, расположенные на пересечении зачеркнутых строки и столбца?
Нигде, эта информация мне не надо.
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
4 Прибавить его ко всем элементам, лежащим на пересечении прямых
Цитата
Добавляешь в CrossedLines 2, но 0, стоящий на пересечении 3-ого столбца и 2-ой строки будет перечеркнутым только как строка - он не занесен в CrossedColumns и поэтому будет учитываться в следующим подсчете в третьем слобце.
А кто тебе мешает проверять на перечеркнутость для как строки? (тьфу... не по-русски сказала). ну то есть
for j:=1 to n do for i:=1 to n do if not(i in CrossedLines) then...
Не понимаю сути проблемы.
Цитата
Copy+Paste - не наш метод...
А откуда тогда взялось:
if (value.info=0) and (value.checked=false) then
Сообщение отредактировано: мисс_граффити -
--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует. На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
4 Прибавить его ко всем элементам, лежащим на пересечении прямых
Можно обойтись только знанием проведенных прямых.
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
Попробовала. Сделала. Не поняла Файлик прицепляю - вроде работает. Правда, не всегда совсем "с умом"..._______1.PAS ( 1.4 килобайт )
Кол-во скачиваний: 498 .
Цитата
Можно обойтись только знанием проведенных прямых.
Можно. Но ведь мы их не храним... А храним инфу по каждому числу отдельно...
--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует. На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
Можно. Но ведь мы их не храним... А храним инфу по каждому числу отдельно...
Ну сохраним. Вместо вывода на экран номеров столбцов и строк сохраняем их в множества.
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
Ну сохраним. Вместо вывода на экран номеров столбцов и строк сохраняем их в множества.
А зачем нам их хранить?
Цитата
И не всегда правильно..
Надо подумать, как поступать, если максимальное количество нулей по строкам равно максимальному по столбцам... А вообще твой вариант транспонированную матрицу:
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 Вы по какому предмету эти транспортные задачи мучаете?
--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует. На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
здесь можно вычеркнуть 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.
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
к сожалению, внесенные изменения не в полной мере решают проблему:
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));
меняем нижнюю левую единицу на ноль и мучаемся в поисках нового алгоритма..
Цитата
может, еще считать количество безнулевых строк и столбцов?
Да надо совмещать, щас подумаю..
--------------------
Лао-Цзы : Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.