Игроки-2, нужно оптимизировать Опции

[xxx000]

Ввод из: Стандартный ввод Время выполнения на одном тесте: 1 с
Вывод в: Стандартный вывод Ограничение памяти программы на одном тесте: 2000 кб


После долгих и мучительных попыток Власу с помощью программистов из ТРТУ удалось, наконец, замостить уголками доску размера 2nx2n без произвольной клетки. Однако Еник вовсе не уверен, что предложенное Власом и программистами решение верно. Он просит вас написать программу, проверяющую правильность мощения.
Напоминаем, что на месте вырезанной клетки должен стоять 0. Остальные клетки должны содержать числа от 1 до (2 в n степени*2 в n степени-1)/3 соответственно принадлежности клетки определенному уголку. Уголки не должны перекрываться и не должно быть непокрытых клеток (кроме вырезанной, естественно).
Входные данные: В первой строке – число n (0&ltn&lt10). Во второй строке - координаты вырезанной клетки. Далее 2 в n степени строк по 2 в n степени чисел в каждой через пробел – схема замощения доски.
Выходные данные: вывести «Accepted», если предложенная схема замощения является верной, или «Wrong Answer», если нарушено одно из правил замощения.

Пример входных данных:
2
1 1
0 1 2 2
1 1 3 2
4 3 3 5
4 4 5 5
Пример выходных данных:
Accepted

---------------------------------------

var
 a:array [0..1200,0..1200] of integer;
 d:array [1..350] of integer;
 n,z,c,i,j,x,y,b:longint;
begin
 readln(n);
 z:=1;
 for i:=1 to n do z:=z*2;
 readln(x,y);
 for i:=1 to z do
  for j:=1 to z do read(a[i,j]);
 
 for i:=1 to z do
 begin
  for j:=1 to z do
  begin
   if (a[i,j]=0)and(x<>i)and(y<>j) then
   begin
    writeln('Wrong Answer');
    halt;
   end else
   begin
    c:=a[i,j];
    if (c>0)and(a[i,j+1]=c) then
   begin
     if (a[i+1,j]=c) then inc(d[c],3) else
      if (a[i-1,j]=c) then inc(d[c],3);
   end;
    if (c>0)and(a[i,j-1]=c) then
   begin
     if (a[i+1,j]=c) then inc(d[c],3) else
      if (a[i-1,j]=c) then inc(d[c],3);
   end;
   end;
  end;
 end;
 for i:=1 to 341 do if d[i]>3 then
 begin
  writeln('Wrong Answer');
  halt;
 end;
 writeln('Accepted');
end.
 

--------------------------------------------

система пишет, что превышен лимит памяти, помогите!!


--------------------------------------------

и ещё это задача с 7-й олимпиады ФАВТ, нам её училка задала, а мы тока в 8 классе. што умеем, то и делаем

Сообщение отредактировано: xxx000 - 15.04.2010 21:58

[xxx000]

http://contester.tsure.ru/ - все вопросы к ней
вот мой код который прошёл все тесты

 var
 a,b:array[1..1025] of longint;
 d:array[-1..350000] of integer;
 f,c,j,i,k,l,n,m,o,p,w,q,z,x,y:longint;
begin
 readln(z);
 n:=1;
 for i:=1 to z do n:=n*2;
 readln(x,y);
 f:=(n*n-1) div 3;
 for i:=1 to n do
 begin
  read(a[i]);
  if a[i]>f then
  begin
   writeln('Wrong Answer');
   halt;
  end;
 end;
 if (x=1)and(a[y]<>0) then
 begin
  writeln('Wrong Answer');
  halt;
 end;

 for i:=2 to n do
 begin
  for j:=1 to n do
  begin
   read(b[j]);
   if b[j]>f then
   begin
    writeln('Wrong Answer');
    halt;
   end;
  end;
  if (x=i)and(b[y]<>0) then
  begin
   writeln('Wrong Answer');
   halt;
  end;

  for j:=1 to n do
  begin
   inc(d[a[j]]);
   if (a[j]=-1) then inc(o);
   if (a[j]>0)and(a[j+1]=a[j])and((b[j]=a[j])or(b[j+1]=a[j])) then
   begin
    inc(d[a[j]],2);
    inc(o);
    inc(p);
    if (b[j]=a[j]) then b[j]:=-1 else
     if b[j+1]=a[j] then b[j+1]:=-1;
    a[j]:=-1;
    a[j+1]:=-1;
   end;
   if (a[j]>0)and(a[j]=b[j])and((a[j]=b[j+1])or(a[j]=b[j-1])) then
   begin
    inc(d[a[j]],2);
    inc(o);
    if (b[j+1]=a[j]) then b[j+1]:=-1 else
     if (b[j-1]=a[j]) then b[j-1]:=-1;
    inc(p);
    a[j]:=-1;
    b[j]:=-1;
   end;
   if (a[j]=0)and(q=1) then
   begin
    writeln('Wrong Answer');
    halt;
   end;
   if (a[j]=0) then
   begin
    inc(o);
    inc(q);
    a[j]:=-1;
   end;
  end;

  for j:=1 to n do a[j]:=b[j];
 end;
{ for i:=1 to n do
 begin
  if (a[j]<>-1)or((a[j]<>0)and(y=n)and(x=j)) then
  begin
   writeln('Wrong Answer');
   halt;
  end;
 end;
} for i:=1 to 350000 do
  if d[i]>3 then
  begin
   writeln('Wrong Answer');
   halt;
  end;
  if n*n-(p*3)<>1 then
  begin
   writeln('Wrong Answer');
   halt;
  end;
 writeln('Accepted');
end.

volvo я где ты сдавал????
и кстати я её сдал со 140 раза

Сообщение отредактировано: xxx000 - 18.04.2010 19:25