题解 - Vijos

0

Psi LV 5 @ 2015-02-02 11:23:00

评测结果
编译成功

测试数据 #0: WrongAnswer, time = 0 ms, mem = 740 KiB, score = 0
测试数据 #1: WrongAnswer, time = 0 ms, mem = 740 KiB, score = 0
测试数据 #2: WrongAnswer, time = 0 ms, mem = 740 KiB, score = 0
测试数据 #3: WrongAnswer, time = 0 ms, mem = 744 KiB, score = 0
测试数据 #4: WrongAnswer, time = 0 ms, mem = 740 KiB, score = 0
测试数据 #5: WrongAnswer, time = 0 ms, mem = 744 KiB, score = 0
测试数据 #6: WrongAnswer, time = 0 ms, mem = 740 KiB, score = 0
测试数据 #7: Accepted, time = 0 ms, mem = 744 KiB, score = 10
测试数据 #8: WrongAnswer, time = 0 ms, mem = 744 KiB, score = 0
测试数据 #9: WrongAnswer, time = 15 ms, mem = 744 KiB, score = 0
WrongAnswer, time = 15 ms, mem = 744 KiB, score = 10
代码
begin
writeln('No solution possible');
end.

0

一方T行 LV 10 @ 2014-09-26 22:56:59

水题刘明
program p1337;
var a:array[1..12,1..12] of longint;
n,sum,i,j,k:longint;
cc:char;
b:array[1..5,1..5,1..5] of boolean;
c:array[1..5,1..2] of longint;
//
procedure print;
var i,j:longint;
begin
for i:=1 to sum do
begin
for j:=1 to sum do write(a[i,j]);
writeln;
end;
close(output);
halt;
end;
//
function fl:boolean;
var i,j:longint;
begin
for i:=1 to sum do
for j:=1 to sum do
if a[i,j]=0 then exit(false);
exit(true);
end;
//
function can(p1,p2,k:longint):boolean;
var i,j:longint;
begin
for i:=p1 to p1+c[k,1]-1 do
for j:=p2 to p2+c[k,2]-1 do
if (a[i,j]<>0) and (b[k,i-p1+1,j-p2+1]) then exit(false);
exit(true);
end;
//
procedure dfs(k:longint);
var i,j,i1,i2:longint;
begin
if k>n then
begin
if fl then print;
exit;
end;
for i:=1 to sum do
for j:=1 to sum do
if can(i,j,k) then
begin
for i1:=1 to c[k,1] do
for i2:=1 to c[k,2] do
if b[k,i1,i2] then a[i+i1-1,j+i2-1]:=k;
dfs(k+1);
for i1:=1 to c[k,1] do
for i2:=1 to c[k,2] do
if b[k,i1,i2] then a[i+i1-1,j+i2-1]:=0;
end;
end;
//
begin
readln(n);
for i:=1 to n do
begin
readln(c[i,1],c[i,2]);
for j:=1 to c[i,1] do
begin
for k:=1 to c[i,2] do
begin
read(cc);
if cc='1' then
begin
b[i,j,k]:=true;
inc(sum);
end
else b[i,j,k]:=false;
end;
readln;
end;
end;
sum:=round(sqrt(sum));
for i:=1 to 12 do
for j:=1 to 12 do
if (i>sum) or (j>sum) then a[i,j]:=10;
dfs(1);
write('No solution possible');
end.

0

一方T行 LV 10 @ 2014-09-26 22:55:00

第一个点好猥琐

0

徐宁 LV 3 @ 2012-10-11 15:14:11

type puzz=array[0..5,0..5]of byte;

var n,all,side:longint;

　　w,h:array[0..5]of longint;

　　s:array[0..5]of puzz;

　　v:array[0..5]of boolean;

　　map:puzz;

procedure cut(i:longint);

　　　　var z,j,k:longint;empty:boolean;

begin

　　 empty:=true;

　　 while empty do

　　　　begin

　　　　　　 for z:=1 to h[i] do

　　　　　　　　begin

　　　　　　　　　　 if s[i][z,w[i]]=1 then

　　　　　　　　　　　　begin

　　　　　　　　　　　　　　　　empty:=false;

　　　　　　　　　　　　　　　　break;

　　　　　　　　　　　　end;

　　　　　　　　end;

　　　　　　 if empty then dec(w[i]);

　　　　end;

　　 empty:=true;

　　 while empty do

　　　　begin

　　　　　　 for z:=1 to w[i] do

　　　　　　　　begin

　　　　　　　　　　 if s[i][h[i],z]=1 then

　　　　　　　　　　　　begin

　　　　　　　　　　　　　　 empty:=false;

　　　　　　　　　　　　　　 break;

　　　　　　　　　　　　end;

　　　　　　　　end;

　　　　　　 if empty then dec(h[i]);

　　　　end;

end;

procedure init;

　　　　 var k,i,j:longint;ch:char;

begin

　　 readln(n);

　　 all:=0;

　　 for i:=1 to n do

　　　　 begin

　　　　　　 readln(h[i],w[i]);

　　　　　　 for j:=1 to h[i] do

　　　　　　　　 begin

　　　　　　　　　　 for k:=1 to w[i] do

　　　　　　　　　　　　 begin

　　　　　　　　　　　　　　　　read(ch);

　　　　　　　　　　　　　　　　if ch='1' then s[i][j,k]:=1 else s[i][j,k]:=0;

　　　　　　　　　　　　　　　　if s[i][j,k]=1 then

　　　　　　　　　　　　　　　　 begin

　　　　　　　　　　　　　　　　　　　　inc(all);

　　　　　　　　　　　　　　　　 end;

　　　　　　　　　　　　 end;

　　　　　　　　　　 readln;

　　　　　　　　 end;

　　　　　　 cut(i);

　　　　 end;

end;

procedure clear(y,x,t:longint);

　　　　 var i,j:longint;pp:array[0..5,0..5]of byte;

begin

　　 for i:=1 to h[t] do

　　　　 for j:=1 to w[t] do

　　　　　　 begin

　　　　　　　　 if s[t]=1 then map:=0;

　　　　　　 end;

end;

procedure add(y,x,t:longint;var ok:boolean);

　　　　 var i,j:longint;pp:array[0..5,0..5]of byte;

begin

　　 if (x+w[t]-1>side)or(y+h[t]-1>side) then

　　　　begin

　　　　　　 ok:=false;

　　　　　　 exit;

　　　　end;

　　 for i:=1 to h[t] do

　　　　 for j:=1 to w[t] do

　　　　　　 if (s[t]=1) then

　　　　　　　　begin

　　　　　　　　　　 if (map=0) then

　　　　　　　　　　　　begin

　　　　　　　　　　　　　　 pp:=t;

　　　　　　　　　　　　end

　　　　　　　　　　 else

　　　　　　　　　　　　 begin

　　　　　　　　　　　　　　 ok:=false;

　　　　　　　　　　　　　　 exit;

　　　　　　　　　　　　 end;

　　　　　　　　end

　　　　　　 else

　　　　　　　　 begin

　　　　　　　　　　 pp:=map;

　　　　　　　　 end;

　　 for i:=1 to h[t] do

　　　　 for j:=1 to w[t] do

　　　　　　 begin

　　　　　　　　 map:=pp;

　　　　　　 end;

　　 ok:=true;

end;

procedure print;

　　　　 var i,j:longint;

begin

　　 for i:=1 to side do

　　　　 begin

　　　　 for j:=1 to side do

　　　　　　 begin

　　　　　　　　 write(map);

　　　　　　 end;

　　　　 writeln;

　　　　 end;

end;

procedure search(y,x,t:longint);

　　　　 var a,b,i:longint;ok:boolean;

begin

//　　 print;

//　　 writeln;

　　 if (t>n) then

　　　　begin

　　　　　　　　 print;

　　　　　　　　 halt;

　　　　end;

　　 if x>side then

　　　　begin

　　　　　　 inc(y);

　　　　　　 x:=1;

　　　　end;

　　 if map[y,x]=0 then

　　　　begin

　　　　　　 for i:=1 to n do if not(v[i]) then

　　　　　　　　 begin

　　　　　　　　　　 if s[i][1,1]=0 then

　　　　　　　　　　　　begin

　　　　　　　　　　　　　　 add(y,x,i,ok);

　　　　　　　　　　　　　　 if ok then

　　　　　　　　　　　　　　　　begin

　　　　　　　　　　　　　　　　　　 v[i]:=true;

　　　　　　　　　　　　　　　　　　 search(y,x,t+1);

　　　　　　　　　　　　　　　　　　 clear(y,x,i);

　　　　　　　　　　　　　　　　　　 v[i]:=false;

　　　　　　　　　　　　　　　　end;

　　　　　　　　　　　　end

　　　　　　　　　　 else

　　　　　　　　　　　　begin

　　　　　　　　　　　　　　 add(y,x,i,ok);

　　　　　　　　　　　　　　 if ok then

　　　　　　　　　　　　　　　　begin

　　　　　　　　　　　　　　　　　　 v[i]:=true;

　　　　　　　　　　　　　　　　　　 search(y,x+1,t+1);

　　　　　　　　　　　　　　　　　　 clear(y,x,i);

　　　　　　　　　　　　　　　　　　 v[i]:=false;

　　　　　　　　　　　　　　　　end;

　　　　　　　　　　　　end;

　　　　　　　　 end;

　　　　end

　　 else

　　　　begin

　　　　　　 for i:=1 to n do if not(v[i]) then

　　　　　　　　begin

　　　　　　　　　　 if s[i][1,1]=0 then

　　　　　　　　　　　　begin

　　　　　　　　　　　　　　 add(y,x,i,ok);

　　　　　　　　　　　　　　 if ok then

　　　　　　　　　　　　　　 begin

　　　　　　　　　　　　　　　　 v[i]:=true;

　　　　　　　　　　　　　　　　 search(y,x,t+1);

　　　　　　　　　　　　　　　　 clear(y,x,i);

　　　　　　　　　　　　　　　　 v[i]:=false;

　　　　　　　　　　　　　　 end;

　　　　　　　　　　　　end;

　　　　　　　　end;

　　　　　　 search(y,x+1,t);

　　　　end;

end;

procedure find;

　　　　 var o:real;

begin

　　 o:=sqrt(all);

　　 if oint(o) then

　　　　begin

　　　　　　　　 writeln('No solution possible');

　　　　　　　　 halt;

　　　　end;

　　 side:=trunc(sqrt(all));

　　 fillchar(v,sizeof(v),0);

　　 search(1,1,1);

　　　　 writeln('No solution possible');

　　　　 halt;

end;

begin

　　 init;

　　 find;

end.

0

fp_yfw LV 10 @ 2009-10-26 14:48:25

对付此题，裸搜足已~

0

527971925 LV 10 @ 2009-10-20 08:16:35

没想通为何如此猥琐的题通过率如此之高？？

---|---|---|---|---|---|---|---|---|---|---|

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

type puzz=array[0..5,0..5]of byte;

var n,all,side:longint;

w,h:array[0..5]of longint;

s:array[0..5]of puzz;

v:array[0..5]of boolean;

map:puzz;

procedure cut(i:longint);

var z,j,k:longint;empty:boolean;

begin

empty:=true;

while empty do

begin

for z:=1 to h[i] do

begin

if s[i][z,w[i]]=1 then

begin

empty:=false;

break;

end;

end;

if empty then dec(w[i]);

end;

empty:=true;

while empty do

begin

for z:=1 to w[i] do

begin

if s[i][h[i],z]=1 then

begin

empty:=false;

break;

end;

end;

if empty then dec(h[i]);

end;

end;

procedure init;

var k,i,j:longint;ch:char;

begin

readln(n);

all:=0;

for i:=1 to n do

begin

readln(h[i],w[i]);

for j:=1 to h[i] do

begin

for k:=1 to w[i] do

begin

read(ch);

if ch='1' then s[i][j,k]:=1 else s[i][j,k]:=0;

if s[i][j,k]=1 then

begin

inc(all);

end;

end;

readln;

end;

cut(i);

end;

end;

procedure clear(y,x,t:longint);

var i,j:longint;pp:array[0..5,0..5]of byte;

begin

for i:=1 to h[t] do

for j:=1 to w[t] do

begin

if s[t]=1 then map:=0;

end;

end;

procedure add(y,x,t:longint;var ok:boolean);

var i,j:longint;pp:array[0..5,0..5]of byte;

begin

if (x+w[t]-1>side)or(y+h[t]-1>side) then

begin

ok:=false;

exit;

end;

for i:=1 to h[t] do

for j:=1 to w[t] do

if (s[t]=1) then

begin

if (map=0) then

begin

pp:=t;

end

else

begin

ok:=false;

exit;

end;

end

else

begin

pp:=map;

end;

for i:=1 to h[t] do

for j:=1 to w[t] do

begin

map:=pp;

end;

ok:=true;

end;

procedure print;

var i,j:longint;

begin

for i:=1 to side do

begin

for j:=1 to side do

begin

write(map);

end;

writeln;

end;

end;

procedure search(y,x,t:longint);

var a,b,i:longint;ok:boolean;

begin

// print;

// writeln;

if (t>n) then

begin

print;

halt;

end;

if x>side then

begin

inc(y);

x:=1;

end;

if map[y,x]=0 then

begin

for i:=1 to n do if not(v[i]) then

begin

if s[i][1,1]=0 then

begin

add(y,x,i,ok);

if ok then

begin

v[i]:=true;

search(y,x,t+1);

clear(y,x,i);

v[i]:=false;

end;

end

else

begin

add(y,x,i,ok);

if ok then

begin

v[i]:=true;

search(y,x+1,t+1);

clear(y,x,i);

v[i]:=false;

end;

end;

end;

end

else

begin

for i:=1 to n do if not(v[i]) then

begin

if s[i][1,1]=0 then

begin

add(y,x,i,ok);

if ok then

begin

v[i]:=true;

search(y,x,t+1);

clear(y,x,i);

v[i]:=false;

end;

end;

end;

search(y,x+1,t);

end;

end;

procedure find;

var o:real;

begin

o:=sqrt(all);

if oint(o) then

begin

writeln('No solution possible');

halt;

end;

side:=trunc(sqrt(all));

fillchar(v,sizeof(v),0);

search(1,1,1);

writeln('No solution possible');

halt;

end;

begin

init;

find;

end.

0

hydralisk LV 10 @ 2009-09-21 11:57:17

第一组数据很可能像Bobby_Z说的这样:

1

2 2

10

00

过掉这个test_1估计没问题了.

0

NaTuReHugh LV 9 @ 2009-08-20 22:02:21

仔细！

0

azraelwzj LV 8 @ 2009-08-13 11:42:59

type

lx=record

　　x,y:integer;

　　dt:array[1..5,1..5] of word;

end;

var

a:array[1..5] of lx;

c:array[1..9,1..9] of word;

bc,n:integer;

Procedure Outp(t:integer);

var

i,j:integer;

begin

if t=-1 then Writeln('No solution possible')

　　　　 else

　　　　 If t=-2 then Writeln('1') else

　　　　 begin

　　　　　　 for i:=1 to bc do

　　　　　　 begin

　　　　　　　　 for j:=1 to bc do Write(c);

　　　　　　　　 Writeln;

　　　　　　 end;

　　　　 end;

end;

Procedure Init;

var

i,j,k,mj:integer;

ch:char;

begin

mj:=0;

read(n);

for i:=1 to n do

　　begin

　　 readln(a[i].x,a[i].y);

　　 for j:=1 to a[i].x do

　　 begin

　　　　for k:=1 to a[i].y do

　　　　 begin

　　　　　　read(ch);

　　　　　　if ch='1' then a[i].dt[j,k]:=1 else a[i].dt[j,k]:=0;

　　　　　　if a[i].dt[j,k]=1 then mj:=mj+1;

　　　　 end;

　　　　readln;

　　 end;

　　end;

bc:=trunc(sqrt(mj));

if bcsqrt(mj) then begin Outp(-1); halt; end;

if mj=1 then begin Outp(-2); halt; end;

end;

Function CanPut(x,y,w:integer):boolean;

var

i,j:integer;

begin

if (a[w].x+x-1)>bc then begin CanPut:=false; exit; end;

if (a[w].y+y-1)>bc then begin CanPut:=false; exit; end;

for i:=x to (a[w].x+x-1) do

　　for j:=y to (a[w].y+y-1) do

　　 begin

　　　　if a[w].dt=1 then

　　　　 if c0 then begin CanPut:=false; exit; end;

　　 end;

CanPut:=true;

end;

Procedure PutInMap(x,y,w:integer);

var

i,j:integer;

begin

for i:=x to (a[w].x+x-1) do

　　for j:=y to (a[w].y+y-1) do

　　　　if a[w].dt=1 then c:=w;

end;

Procedure dfs(b:integer);

var

i,j:integer;

temp:array[1..9,1..9] of word;

begin

if b>n then

　　begin Outp(b); halt; end;

for i:=1 to bc do

　　for j:=1 to bc do

　　　　if CanPut(i,j,b) then

　　　　 begin

　　　　　　temp:=c;

　　　　　　PutInMap(i,j,b);

　　　　　　dfs(b+1);

　　　　　　c:=temp;

　　　　 end;

end;

begin

Init;

dfs(1);

Outp(-1);

end.

0

木子日匀 LV 10 @ 2009-05-19 18:20:10

终于过了

0

猫猫 LV 9 @ 2009-05-08 12:52:56

标准程序，一次AC

type

lx=record

x,y:integer;

dt:array[1..5,1..5] of word;

end;

var

a:array[1..5] of lx;

c:array[1..9,1..9] of word;

bc,n:integer;

Procedure Outp(t:integer);

var

i,j:integer;

begin

if t=-1 then Writeln('No solution possible')

else

If t=-2 then Writeln('1') else

begin

for i:=1 to bc do

begin

for j:=1 to bc do Write(c);

Writeln;

end;

end;

end;

Procedure Init;

var

i,j,k,mj:integer;

ch:char;

begin

mj:=0;

read(n);

for i:=1 to n do

begin

readln(a[i].x,a[i].y);

for j:=1 to a[i].x do

begin

for k:=1 to a[i].y do

begin

read(ch);

if ch='1' then a[i].dt[j,k]:=1 else a[i].dt[j,k]:=0;

if a[i].dt[j,k]=1 then mj:=mj+1;

end;

readln;

end;

end;

bc:=trunc(sqrt(mj));

if bcsqrt(mj) then begin Outp(-1); halt; end;

if mj=1 then begin Outp(-2); halt; end;

end;

Function CanPut(x,y,w:integer):boolean;

var

i,j:integer;

begin

if (a[w].x+x-1)>bc then begin CanPut:=false; exit; end;

if (a[w].y+y-1)>bc then begin CanPut:=false; exit; end;

for i:=x to (a[w].x+x-1) do

for j:=y to (a[w].y+y-1) do

begin

if a[w].dt=1 then

if c0 then begin CanPut:=false; exit; end;

end;

CanPut:=true;

end;

Procedure PutInMap(x,y,w:integer);

var

i,j:integer;

begin

for i:=x to (a[w].x+x-1) do

for j:=y to (a[w].y+y-1) do

if a[w].dt=1 then c:=w;

end;

Procedure dfs(b:integer);

var

i,j:integer;

temp:array[1..9,1..9] of word;

begin

if b>n then

begin Outp(b); halt; end;

for i:=1 to bc do

for j:=1 to bc do

if CanPut(i,j,b) then

begin

temp:=c;

PutInMap(i,j,b);

dfs(b+1);

c:=temp;

end;

end;

begin

Init;

dfs(1);

Outp(-1);

end.

0

cgy4ever LV 10 @ 2009-02-24 19:02:27

搜索题.

注意细节

0

sdvsdv LV 10 @ 2009-01-10 11:45:11

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

注意细节啊!40..50..60..100!

0

LV.唱响 LV 8 @ 2008-10-15 20:34:03

很简单那的搜索

耐心做就OK

编译通过...

├ 测试数据 01：答案正确... 9ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：9ms

0

Bobby_Z LV 7 @ 2008-09-20 13:08:41

数据1可能有类似这样的形状

5 5

10000

00000

00000

00000

00000

对于每个形状还应该检查一下，删除全为0的行/列。好麻烦。。

0

daoshily LV 9 @ 2008-09-08 19:21:24

第一个点真是没办法....不知道是个什么毛病....只能特判

0

voyagec1 LV 7 @ 2008-09-06 10:24:51

大胆的搜吧,不要考虑很多剪支,数据就那么大撑足了也0S,注意一个小矩形的第一个被覆盖了不代表不能再放积木.把3个样例都过了就差不多可以过

0

llzzpp999 LV 8 @ 2008-08-14 09:42:07

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

数据好弱呀，秒杀.......

直接搜索，注意细节

0

mad LV 3 @ 2007-08-25 12:45:50

汗 n=1是特殊判断才过得

不知道为什么瓦

0

lovedreamF LV 3 @ 2007-08-12 10:57:41

NO solution possible

No solution possible

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

题解

26 条题解

拼图

信息

状态

开发

支持

题解

26 条题解

拼图

信息

状态

开发

支持

还没有账户？

登录