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

[.helga]

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

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]

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

Сообщение отредактировано: Bokul - 2.01.2007 6:57

[.helga]

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

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

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

[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) создаем дополнительный массив, в который записываем номера вычеркнутых строк и столбцов.

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

[volvo]

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

[мисс_граффити]

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

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

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

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

[Bokul]

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

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

Я сам сначала хотел сделать именно через два множества - множество зачеркнутых столбцов(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

Сообщение отредактировано: мисс_граффити - 2.01.2007 19:03

[Bokul]

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

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

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

4 Прибавить его ко всем элементам, лежащим на пересечении прямых

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

[мисс_граффити]

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

Попробовала. Сделала. Не поняла
Файлик прицепляю - вроде работает. Правда, не всегда совсем "с умом"...  _______1.PAS ( 1.4 килобайт ) Кол-во скачиваний: 362
.

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

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

[Bokul]

Правда, не всегда совсем "с умом"...

И не всегда правильно..

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

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

[мисс_граффити]

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

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

И не всегда правильно..

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

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

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

[Bokul]

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

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

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

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

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...


Сообщение отредактировано: мисс_граффити - 2.01.2007 23:41

[Bokul]

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

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
Вы по какому предмету эти транспортные задачи мучаете?

[.helga]

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

[Bokul]

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

[Bokul]

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

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

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

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