Форум DL

Мой профиль

Здравствуйте, у меня не работает программа.
"Разрезание листа"521 условия: Долинский М.С. тесты: Судиловский К.Н.

Из листа клетчатой бумаги размером М*N клеток удалили некоторые клетки. На сколько кусков распадется оставшаяся часть листа? (1<=M,N<=100)

Пример.

Если из шахматной доски удалить все клетки одного цвета,то оставшаяся часть распадется на 32 куска.

Формат входного файла:

M N
K ( Кол-во удаленных клеток )
I1 J1 ... Ik Jk ( Положение удаленной клетки )
Пример ввода:

3 3
4
1 2 2 1 2 3 3 2
Пример вывода:

5
program p1;
var
Que : array[1..999,1..999] of longint;
Marked : array [1..100,1..100] of boolean;
QueBegin, QueEnd,
i,j,Sx,Sy,Ex,Ey,
StepNumber,n,k,m : longint;
x,y : integer;

procedure Get(var x,y:integer);
begin
x := Que[QueBegin,1];
y := Que[QueBegin,3];
Inc(QueBegin);
end;

procedure Put(x,y:integer);
begin
Inc(QueEnd);
Que[QueEnd,1] := x;
Que[QueEnd,10] := y;
Marked[x,y]:=true;
end;

procedure StartProcess;
var i,j,x,y : longint;
StartCell : string;
begin
readln(m,n);
for i:=1 to m do
for j:=1 to n do
Marked[i,j]:=false;
readln(k);
for i:=1 to k do
begin
readln(x,y);
Marked[x,y]:=true;
end;
QueBegin:=1;
QueEnd:=0;
end;

procedure PutAll(x,y:integer);
type
King = array [1..4,1..2] of integer;
const
Steps : King = ( ( 0,-1),
( 0, 1),
(-1, 0),
( 1, 0) );
var
i, CurrentX, CurrentY : longint;
begin
i:=0;
while (i<4) do
begin
inc(i);
CurrentX := x+steps[i,1] ;
CurrentY := y+steps[i,2] ;
if (CurrentX>0) and (CurrentX<=n) and
(CurrentY>0) and (CurrentY<=m) and
not Marked[CurrentX,CurrentY]
then Put(CurrentX,CurrentY);
end;
end;

function Found(var x,y:integer):boolean;
var
i,j : integer;
begin
for i:=1 to m do
for j:=1 to n do
if not Marked[i,j]
then begin x:=i; y:=j; Found:=true; exit; end;
Found := false;
end;
begin
assign(input,'input.txt');reset(input);
assign(output,'output.txt');rewrite(output);

StartProcess;
StepNumber:=0;
while (Found(x,y)) do
begin
Put(x,y);
Inc(StepNumber);
while QueBegin<=QueEnd do
begin
Get(x,y);
PutAll(x,y);
end;
end;
if k=0 then writeln('1') else
writeln(StepNumber);
close(input);close(output)
end.

когда задаю 32 на 32 то она выводит Ошибка:1000 выход за границы в ABC, а в турбо просто говорит ввести и зависает.
Помогите пожалуйста.

Мой профиль

1. Надо использовать тег code=pascal, тогда текст будет выглядеть на форуме получше, вот так:

program p1;
var
  Que : array[1..999,1..999] of longint;
  Marked : array [1..100,1..100] of boolean;
  QueBegin,  QueEnd,
  i,j,Sx,Sy,Ex,Ey,
  StepNumber,n,k,m  : longint;
  x,y           : integer;

procedure Get(var x,y:integer);
    begin
      x          := Que[QueBegin,1];
      y          := Que[QueBegin,3];
      Inc(QueBegin);
    end;


    procedure Put(x,y:integer);
    begin
      Inc(QueEnd);
      Que[QueEnd,1] := x;
      Que[QueEnd,10] := y;
      Marked[x,y]:=true;
    end;






         procedure StartProcess;
       var i,j,x,y       : longint;
           StartCell : string;
         begin
          readln(m,n);
            for i:=1 to m do
              for j:=1 to n do
               Marked[i,j]:=false;
               readln(k);
               for i:=1 to k do
               begin
               readln(x,y);
               Marked[x,y]:=true;
               end;
                 QueBegin:=1;
                 QueEnd:=0;
         end;
         
         
procedure PutAll(x,y:integer);
    type
        King   = array [1..4,1..2] of integer;
    const
        Steps : King   = ( ( 0,-1),
                           ( 0, 1),
                           (-1, 0),
                           ( 1, 0) );
    var
        i, CurrentX, CurrentY  :  longint;
    begin
        i:=0;
        while (i<4) do
            begin
                inc(i);
                CurrentX := x+steps[i,1] ;
                CurrentY := y+steps[i,2] ;
                if (CurrentX>0) and (CurrentX<=n) and
                   (CurrentY>0) and (CurrentY<=m) and
                   not Marked[CurrentX,CurrentY]
                   then Put(CurrentX,CurrentY);
        end;
    end;
    
      function Found(var x,y:integer):boolean;
    var
        i,j : integer;
    begin
        for i:=1 to m do
           for j:=1 to n do
               if not Marked[i,j]
                  then begin x:=i; y:=j; Found:=true; exit; end;
        Found := false;
    end;
begin
assign(input,'input.txt');reset(input);
assign(output,'output.txt');rewrite(output);

    StartProcess;
    StepNumber:=0;
    while (Found(x,y)) do
        begin
           Put(x,y);
           Inc(StepNumber);
           while QueBegin<=QueEnd do
                begin
                    Get(x,y);
                    PutAll(x,y);
               end;
        end;
        if k=0 then writeln('1') else
    writeln(StepNumber);
          close(input);close(output)
end.

2. Надо писать текст структурированно, чтобы было проще его читать и понимать.
В обучении к двум предыдущим задачам на очередь тебе пытались "вдолбить", как это делать,
но ты проигнорировала эти рекомендации.

3. Две предыдущие задачи ты сдала не сама, а с тетрадками и подсказками.
То есть, на самом деле, ты их не умеешь решать, и в таком случае НЕЛЬЗЯ двигаться дальше.
Надо научиться решать первые две задачи ИЗ ГОЛОВЫ, никуда не подсматривая,
тогда у тебя появится ФУНДАМЕНТ для решения последующих задач.
А у тебя сейчас "ЖИЖА" вместо фундамента.

3. Вот фрагмент твоего кода, который хорошо иллюстрирует пункт 3.

 
  procedure Get(var x,y:integer);
    begin
      x          := Que[QueBegin,1];
      y          := Que[QueBegin,3];
      Inc(QueBegin);
    end;


    procedure Put(x,y:integer);
    begin
      Inc(QueEnd);
      Que[QueEnd,1] := x;
      Que[QueEnd,10] := y;
      Marked[x,y]:=true;
    end;

Мой профиль

Здравствуйте, Михаил Семенович.
Я просто копировала и вставляла код решения задачи на форум, поэтому она вставилась в некрасивом виде. Я не знаю как использовать тег code=pascal. Подскажите, пожалуйста как

Мой профиль

В коде решения, которое отправляла на проверку, которое не проходит 4-й тест, я уже исправила 10 на 2 в Put и 3 на 2 в Get. Я понимаю, что в процедурах 1 это x и 2 это y, а 3 это номер хода

Мой профиль

Здравствуйте, Михаил Семенович.
Я к Вам опять с задачей Разрезание листа. Я выучила написание всех процедур и главной программы и могу набирать без тетрадки. Я разобралась с каждой строчкой процедур в этой задачи. На сайте она не проходит 4-й тест. Когда я тестирую ее в Паскаль ABC, то она работает как в 4-м тесте на сайте и выдает ответ 2. А в Турбо при тестировании на количество клеток =100 и при вводе матрицы 100 на 100 дает ответ 1. Помогите, пожалуйста, с задачей. Где я решаю неверно?

program p1;
var
  Que             : array [1..22000,1..2] of longint;
  Marked          : array [1..1000,1..1000] of boolean;
  x,y,n,m,k,s,
  StepNumber,
  QueBegin,QueEnd : longint;
  
  procedure Put(x,y:longint);
    begin
      Inc(QueEnd);
      Que[QueEnd,1] := x;
      Que[QueEnd,2] := y;
      Marked[x,y]:=true;
    end;
    
procedure Get(var x,y:longint);
    begin
      x          := Que[QueBegin,1];
      y          := Que[QueBegin,2];
      Inc(QueBegin);
    end;
    
      function Found(var x,y:longint): boolean;
        var
          i,j : longint;
        begin
          for i:=1 to n do
            for j:=1 to m do
               if not Marked[i,j]
                  then begin x:=i; y:=j; Found:=true; exit; end;
        Found := false;
    end;

procedure PutAll(x,y:longint);
    type
        King = array [1..4,1..2] of longint;
    const
        Steps : King   = ( ( 0,-1),
                           ( 0, 1),
                           (-1, 0),
                           ( 1, 0) );
    var
        i, CurrentX, CurrentY,d1,d2  :  longint;
    begin
        i:=0;
        while (i<4) do
            begin
                inc(i);
                CurrentX := x+Steps[i,1] ;
                CurrentY := y+Steps[i,2] ;
                if (CurrentX>0) and (CurrentX<=n) and
                   (CurrentY>0) and (CurrentY<=m) and
                   (not Marked[CurrentX,CurrentY])
                   then Put(CurrentX,CurrentY);
        end;
    end;
    
         procedure StartProcess;
           var i,j,x,y  : longint;
           begin
             read(n,m,k);
             for i:=1 to n do
               for j:=1 to m do
                  Marked[i,j]:=false;
             for i:=1 to k do
               begin
                 readln(x,y);
                 if (x>0)and(x<=n) and
                    (y>0)and(y<=m)
                    then Marked[x,y]:=true;
                {if x=y then s:=s+1;}
               end;
              QueBegin:=1;
              QueEnd:=0;
         end;


begin
assign(input,'input.txt');reset(input);
assign(output,'output.txt');rewrite(output);
    StartProcess;
    StepNumber:=0;
    while Found(x,y) do
        begin
           Inc(StepNumber);
           Put(x,y);
           while QueBegin<=QueEnd do
                begin
                    Get(x,y);
                    PutAll(x,y);
                end;
        end;
    writeln(StepNumber);
    close(input);close(output);
end.

Мой профиль

Спасибо

Мой профиль

Ксения Шарикова:

Здравствуйте, Михаил Семенович.
Я просто копировала и вставляла код решения задачи на форум, поэтому она вставилась в некрасивом виде. Я не знаю как использовать тег code=pascal. Подскажите, пожалуйста как

После слова code написать =pascal

Я сделал это в твоём сообщении, где последняя версия программы - можешь кликнуть "правка" и посмотреть.

Мой профиль

Ксения Шарикова:

Здравствуйте, Михаил Семенович.
Я к Вам опять с задачей Разрезание листа. Я выучила написание всех процедур и главной программы и могу набирать без тетрадки. Я разобралась с каждой строчкой процедур в этой задачи. На сайте она не проходит 4-й тест. Когда я тестирую ее в Паскаль ABC, то она работает как в 4-м тесте на сайте и выдает ответ 2. А в Турбо при тестировании на количество клеток =100 и при вводе матрицы 100 на 100 дает ответ 1. Помогите, пожалуйста, с задачей. Где я решаю неверно?
         procedure StartProcess;
           var i,j,x,y  : longint;
           begin
             read(n,m,k);
             for i:=1 to n do
               for j:=1 to m do
                  Marked[i,j]:=false;
             for i:=1 to k do
               begin
                 readln(x,y);

По условию задачи координаты вырезанных клеток в строчку вводятся, а ты пишешь readln (а надо read).
Только тебе нужно научиться САМОЙ
- не делать такие ошибки
- а если всё-таки сделала, находить.

Мой профиль

Спасибо.
Я очень стараюсь учиться. Только еще мало знаю.
Спасибо за помощь.