IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

> реализуемо ли
.helga
сообщение 1.01.2007 22:55
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 26
Пол: Женский

Репутация: -  1  +


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


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


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Bokul
сообщение 3.01.2007 20:43
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +



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


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
.helga   реализуемо ли   1.01.2007 22:55
мисс_граффити   Реализуемо. Скажи, у тебя есть идеи, каким алгорит...   1.01.2007 23:35
.helga   эмм.. нужно вычеркивать сначала те столбцы или стр...   2.01.2007 0:05
мисс_граффити   в принципе, думала примерно так же. единственное у...   2.01.2007 0:44
.helga   о, пришла бредовая мысля! :) а что, если ...   2.01.2007 1:07
Bokul   Вот мое решение: Пойдём от обратного: какое макси...   2.01.2007 4:21
.helga   а если безнулевых строк/столбцов не окажется? 1 ...   2.01.2007 4:39
Bokul   Ты не поняла шутки с random-ом - если безнулевых с...   2.01.2007 4:47
.helga   ну да. если в моем примере проводить только горизо...   2.01.2007 4:50
Bokul   .helga, почему ты так хочешь усложнить все? Хва...   2.01.2007 5:02
.helga   не хватит! потому что при некоторых примерах о...   2.01.2007 5:18
Bokul   Что требуется? Найти минимальное количество зач...   2.01.2007 5:27
.helga   Но зачеркивать-то с умом нужно) Чтобы остались эле...   2.01.2007 5:33
Bokul   :wacko: .helga, покажи как ты с умом зачеркнёшь вс...   2.01.2007 5:35
.helga   насчет тех примеров: зачеркну. сначала вычеркиваем...   2.01.2007 5:42
Bokul   Нет мой алгоритм и для такого не годится: 1111 110...   2.01.2007 6:05
.helga   хм. тогда кроме вычеркивания строк/столбцов с макс...   2.01.2007 6:16
Bokul   А полный код можешь привести?   2.01.2007 6:18
.helga   отредактировала чуток предыдущее. спать все-таки и...   2.01.2007 6:22
Bokul   Тот который будет компилироваться..   2.01.2007 6:28
.helga   на недо-паскале: program z; uses crt; var mart: ...   2.01.2007 6:51
Bokul   Конечно у тебя рекурсия вечная (до переполнения ст...   2.01.2007 6:56
.helga   а вот этот кусок for i:=1 to m do for ii:=1 to m...   2.01.2007 6:59
Bokul   Ты тестила свой код? Правильные результаты дает? ...   2.01.2007 7:56
volvo   2 Bokul: Copy+Paste - не наш метод... Убираем 2 фу...   2.01.2007 10:20
мисс_граффити   А как ты отличаешь элементы, расположенные на пер...   2.01.2007 12:37
Bokul   :yes2: :no1: Я сам сначала хотел сделать и...   2.01.2007 18:15
мисс_граффити   Везет тебе.... :) А вот автору темы нужно: А к...   2.01.2007 19:02
Bokul   Попробуй сделать - поймешь. :) [/quote] Мож...   2.01.2007 19:10
мисс_граффити   Попробовала. Сделала. Не поняла :( Файлик прицепл...   2.01.2007 23:00
Bokul   И не всегда правильно.. :( Ну сохраним. Вмес...   2.01.2007 23:12
мисс_граффити   А зачем нам их хранить? Надо подумать, как пост...   2.01.2007 23:27
Bokul   Ты права. Просто люблю все делать поэтапно.. ...   2.01.2007 23:38
мисс_граффити   ой... в смысле, вот так: n=5; ar:array[1..n,1...   2.01.2007 23:40
Bokul   :blink: Да. Проблема в том что в случае ког...   2.01.2007 23:47
мисс_граффити   я вот про этот вариант: n=5; ar:array[1..n,1....   2.01.2007 23:57
.helga   2 мисс_граффити основы алгоритмизации и программир...   3.01.2007 0:07
Bokul   :yes2: Положится на судьбу и воспользоватьс...   3.01.2007 0:23
мисс_граффити   к сожалению, внесенные изменения не в полной мере ...   3.01.2007 0:35
Bokul   :mega_chok: const n=5; ar:array[1..n,1...   3.01.2007 0:37
мисс_граффити   Идея такая: если безнулевых столбцов/строк больше,...   3.01.2007 0:44
Bokul   :no1: Я допустил ошибку: ...   3.01.2007 1:01
мисс_граффити   :) вроде как непринципиально... Я про немножко др...   3.01.2007 1:14
Bokul   :no1: 0 0 1 1 1 1 1 0 1 1 1 1 0 1 1 1 1 0 1 1 1 ...   3.01.2007 1:21
Bokul   Переделать старый алгоритм("то есть ищем, где...   3.01.2007 1:40
Bokul   Блин, написал код и для этого алгоритма, но он тож...   3.01.2007 8:43
мисс_граффити   почему? чем этот пример такой особенный??? покажеш...   3.01.2007 15:13
Bokul   uses crt; const n=5; ar:array[1..n,1..n...   3.01.2007 20:43
мисс_граффити   рассматиривать отдельно?... поскольку "развил...   3.01.2007 23:22
.helga   уже нет, мне изменили постановку задачи, теперь не...   3.01.2007 23:50
Malice   Проще всего сделать перебором, вот так, например: ...   4.01.2007 10:19
Bokul   Malice, можешь сделать небольшое пояснение алгорит...   4.01.2007 11:01
Malice   Malice, можешь сделать небольшое пояснение алгори...   4.01.2007 12:06


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 10.07.2025 15:38
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"