Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Игроки-2

Автор: xxx000 15.04.2010 2:33

Ввод из: Стандартный ввод Время выполнения на одном тесте: 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 классе. што умеем, то и делаем

Автор: Client 15.04.2010 2:59

a:array [0..1200,0..1200] of integer;
вот ошибка, на ТР не будет работать
Да и зачем настолько большая матрица?

Автор: volvo 15.04.2010 13:00

Цитата
вот ошибка, на ТР не будет работать
Абсолютно по этой же причине не будет работать и на FPC: 1220 * 1200 * 4 (каждый Integer) = 5760000 байт. А это 5625 Кб. Ограничение в 2000 Кб используемой памяти явно превышено.

Автор: xxx000 16.04.2010 1:16

и что делать

Автор: volvo 16.04.2010 1:30

Подумать над заданным выше вопросом:

Цитата
зачем настолько большая матрица?


У тебя неверно вычисляется Z... Как только ты введешь значение N большее, чем 2, ты в этом убедишься - допустим, ввел N = 3. Чему будет равно Z по-твоему алгоритму? 8. Это неверно. Программа ожидает не 2n, а 2*n строк и столбцов. Отсюда, при максимальном N = 10 необходимый размер матрицы равен не 210 = 1024, как ты предполагал, а всего 2*10 = 20. Опиши матрицу 20*20, ее должно хватить...

Автор: xxx000 16.04.2010 1:51

volvo
тут неправильно показано, это степень.
и я сдаю на FP

Автор: volvo 16.04.2010 1:54

В таком случае будь добр исправить первый пост, и показать его ПРАВИЛЬНО. А то решать "то, не знаю, что" - как-то не очень интересно.

Автор: xxx000 16.04.2010 1:56

я не знаю как поднять n.


Вроде исправил, помогите пожалуйста ...

Автор: xxx000 16.04.2010 2:26

помогите пожалуйста

Автор: Client 16.04.2010 2:43

Цитата
я не знаю как поднять n.
т.е. возвести число в степень?

Автор: xxx000 16.04.2010 2:44

ну в условии БЫЛО 2n, а надо 2 в n

Client, пожалуйста помогите решить

Автор: Client 16.04.2010 2:53

var
x, n, i : integer;
k: longint;
begin
readln(x);
readln(n);
k:=1;
for i:=1 to n do k:= k * x;
writeln(k);
readln
end
Вот, например, возводит х в степень n.
или
writeln( exp(ln( x ) * n):0:3 );

Автор: xxx000 16.04.2010 2:55

Client, я знаю как возводить в степень, я не знаю как её сделать (задачу), что бы памяти было не > 2000 Кб

Автор: Client 16.04.2010 2:59

спрошу еще раз: зачем массив 1200*1200 ? кто столько значений будет вводить? даже если программно заполнить массив, то все равно нет смысла.
А что сделать - описать массив поменьше, причем намного поменьше. 100*100 или 200*200 будет предостаточно.
Что еще не понятно?

Автор: volvo 16.04.2010 3:19

Цитата
зачем массив 1200*1200 ? кто столько значений будет вводить?
Программа получит файл, который ей надо обработать. Что, Онлайн-серверы не знаешь как работают? smile.gif

Цитата
Вот, например, возводит х в степень n.
или
writeln( exp(ln( x ) * n):0:3 );
А там надо не Xn, а 2n, все проще:
z := 1 shl n;


Цитата
я не знаю как её сделать (задачу), что бы памяти было не > 2000 Кб
Вот смотрю я на твой код, и вижу, что у тебя в каждый момент времени (давай скажем по-другому, на каждой итерации цикла по строкам матрицы) используется только три строки из всей матрицы: Текущая (с индексом i), предыдущая (с индексом i-1), и следующая (с индексом i+1)... А почему бы тебе не отказаться от идеи читать СРАЗУ все в массив? Читай построчно. Обработал очередную строку - сдвинул их на 1 (то, что было текущей - стало предыдущей, то, что было следующей - стало текущей), прочитал новую строку из файла. Так тебе понадобится всего 3*1024*4 байта = меньше 15К

Автор: Client 16.04.2010 3:52

Цитата
Программа получит файл, который ей надо обработать
Да, это так, но... smile.gif все таки это слишком
Цитата
Что, Онлайн-серверы не знаешь как работают?
Неа. Расскажешь? smile.gif (или в новой теме?)

Автор: xxx000 17.04.2010 0:57

volvo а как читать по три строки, НЕ из ФАЙЛА

Автор: volvo 17.04.2010 3:32

А я не предлагал читать не из файла. Я предлагал читать порциями, а не все сразу. Вот код, аналогичный твоему:

var
a: array[0 .. 2, 0 .. 1024] of integer;
d:array [1..350] of integer;

n,z,c,i,j,x,y,b:longint;
begin
readln(n);
z := 1 shl n;
readln(x,y);
for j := 1 to z do
read(a[1, j]);


for i:=1 to z do begin

if i <> z then
for j := 1 to z do read(a[2, j])
else
for j := 1 to z do a[2, j] := 0;


for j:=1 to z do begin
if (a[1, j] = 0) and (x <> i) and (y <> j) then begin
writeln('Wrong Answer'); halt;
end
else begin
c := a[1, j];
if (c > 0) and (a[1, j+1] = c) then begin
if (a[2, j] = c) then inc(d[c], 3)
else
if (a[0, j] = c) then inc(d[c], 3);
end;

if (c > 0) and (a[1, j-1] = c) then begin
if (a[2, j] = c) then inc(d[c], 3)
else
if (a[0, j] = c) then inc(d[c], 3);
end;

end;
end;

a[0] := a[1];
a[1] := a[2];
end;

for i:=1 to 341 do if d[i]>3 then
begin
writeln('Wrong Answer');
halt;
end;
writeln('Accepted');
end.


А теперь посмотри, сколько памяти требует твой, а сколько - мой.

Автор: xxx000 18.04.2010 0:35

volvo конечно спасибо, но
fpc Неверный ответ на тесте 10 88 1072
я и массив D больше делал,но всё равно
fpc Неверный ответ на тесте 10 88 1072

вот ещё одно из моих решений

var
a,b:array [-5..1025] of longint;
z,x,y,i,j,f,k,l,o,p,n,m,q,w:longint;
begin

readln(m);
n:=1;
for i:=1 to m 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 (y=1)and(a[x]<>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;
for j:=1 to n do
begin

if (a[j]>0) then
begin
if (a[j]=a[j+1])and((a[j]=b[j])or(a[j]=b[j+1])) then
begin
inc(o,2);
inc(p,3);
if (b[j]=a[j]) then b[j]:=-1 else
if (b[j+1]=a[j]) then b[j+1]:=-1;
end else
if (a[j]=b[j])and((a[j]=b[j+1])or(a[j]=b[j-1])) then
begin
inc(o);
inc(p,3);
b[j]:=-1;
if a[j]=b[j+1] then b[j+1]:=-1 else
if a[j]=b[j-1] then b[j-1]:=-1;
end;
end else
if (a[j]=0)and(q=0)and(((x=1)and(w=0))or(x=i))and(y=j) then
begin
inc(o);
end else
if a[j]=-1 then inc(o);
end;

if (o=n)or((o=n-1)and(i-1=y)) then o:=0 else
begin
writeln('Wrong Answer');
halt;
end;

inc(w);
for j:=1 to n do a[j]:=b[j];
end;
if (((n*n)-p)<>1) then
begin
writeln('Wrong Answer');
halt;
end;

writeln('Accepted');
end.

, но оно не проходит 4 тест, то есть выводит Wrong Answer, а нада Accepted

Автор: volvo 18.04.2010 13:46

Что-то твой сервер не то делает... Во-первых, я добавил чуть-чуть размер массива, чтобы не было даже теоретической возможности выхода за его пределы (при любых корректных значениях N). Во-вторых, добавил проверку, которой у тебя изначально не было, что не все числа идут по порядку: скажем, число 1 пропущено, и заполнение начинается с двойки - твой код (первый) это не ловил, и мог выдать неверный ответ при таком стечении обстоятельств.

Также я добавил в код проверку на особый случай - введено N = 0, значит X и Y должны быть равны 1, и считанное число должно быть нулем.

В конце каждой итерации была добавлена проверка на то, что элемент d[ c ] стал больше 3, это означает мгновенный выход из программы, дальше искать нечего.

После всего этого он мне заявляет, что тест №13 не пройден? Извини, я стесняюсь спросить, а с каких пор в онлайн-тестировании ВООБЩЕ больше 10 тестов, тем более, начиная от 0? Где-то в правилах пользования этой системой написано вообще, СКОЛЬКО тестов он будет гонять? Где-то можно посмотреть сами тесты? На usaco, например, как только твоя программа тест не прошла - тебе показываются входные данные. Откуда я знаю, что там передается в программу? Вслепую? Уволь, я гаданием на кофейной гуще не занимаюсь.

Автор: volvo 18.04.2010 14:17

Нет, ребята, я просто в шоке. Нашел еще одно уязвимое место - какое говорить не буду, чтоб не лишать вас удовольствия найти его самостоятельно. Исправил. Что вы думаете? Прошло? Ага, 13-тый тест прошло... На 18-ом застопорилось. В общем, я как-то больше и не хочу этой задачей заниматься... Строка с надписью "неверный ответ на тесте №65536" добьет меня окончательно...

Автор: volvo 18.04.2010 16:46

yahoo!.gif
Я-таки добил эту задачку... Зачли наконец-то...

xxx000, я в результате сдал чуть-чуть подправленный код из 18-го поста. Составитель тестов был хитрый, видимо. Но... Все-же я его "раскусил"...

Автор: xxx000 18.04.2010 23:19

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 раза