NOIP2008普及组题解
[i=s] 本帖最后由 zhiheng3 于 2008-11-21 09:12 PM 编辑 [/i]这次普及组题目虽然称不上很难，但都比较难懂，第四题也是比较麻烦。正在练习写解题报告，不足之处也请大家指出，代码附在附件中，已经经过测试
第一题：很水的送分题，可能对于刚刚接触OI的选手来说，处理字符串是一个难点，不妨用整体读入，用st-'0'[fly]的方法即可求出该位数字（C++写法，PASCAL有些忘记见谅，希望有人能够补充上）。最后注意'X'即可获得满分
第二题：贪心。该题的难点是读懂题意，其实只需记录将第几行第几列隔开可以阻止多少对学生说话，最后进行两次排序（一次为了求出可以阻止最多对数说话的行或列，一次为了按顺序输出），输出即可。注意行尾不能有空格
第三题：动态规划or记忆化搜索，我的代码是用记忆化搜索写的，动态规划方程为：f[j]=f[i+1][j-1]+f[i-1][j-1]（i表示当前球在人的号码，j表示经多少次传回小蛮手中，注意边界条件及i的循环性即可。用记忆化搜索则需要注意无解情况，避免死循环
第四题：比较繁琐的一道题，但其实只要分析清楚题意，还是很容易解出的。
第一步：将基本图形存到数组中
第二步：算出每个立方体左上角的坐标
第三步：按从后向前，从下向上，从左向右的顺序依次覆盖输出数组，最后数组内存的即为最后答案（覆盖前将数组初始化为'.'）
PASCAL代码已经贴出，感谢oimaster提供代码
请大家加入OI交流群74762057，有很多NOI，IOI，集训队大牛加入此群
如果有不正确或不明确的地方，欢迎大家予以指正。欢迎大家加我的QQ：409137693，如果是初学者我愿意帮忙，如果是大牛就请允许我讨教~~~~~~ 完整题目贴一下好吗? 不好意思，卷子被老师收走了，等我上网找一下再发布 ...............网上找不到啊.............. 那现在没有办法，不好意思，过两天应该会有人发布的 希望能有人贴一下PASCAL的代码，毕竟PASCAL还是多数 不错，看一下自己的方法有哪些不足 希望大家都多提一点自己的想法，给更多的人思路，毕竟大牛都是从初学者过来的 [i=s] 本帖最后由 oimaster 于 2008-11-19 08:34 PM 编辑 [/i]
第三题还可以这样做：
每一种传法就是一串长度为m的01串，因为往左传和往右传可以抵消，所以0和1个数差应该是n的倍数才能传回原点。穷举0的个数a，得到1的个数b（m-a），验证abs（a-b）是否是n的倍数，如果是，就在总数上加C(m,a)。
程序：[code] program ball(input,output);
var
n,m,a,b:integer;
total:longint;
f:array[0..30,0..30] of longint;
function c(n,r:integer):longint;
begin
if r>n then exit(0);
if r=0 then exit(1);
if f[n,r]<>0 then exit(f[n,r]);
c:=c(n-1,r)+c(n-1,r-1);
f[n,r]:=c;
end;
begin
assign(input,'ball.in');
reset(input);
readln(n,m);
close(input);
fillchar(f,sizeof(f),0);
total:=0;
for a:=0 to m do
begin
b:=m-a;
if (b-a) mod n=0 then
total:=total+c(m,a);
end;
assign(output,'ball.out');
rewrite(output);
writeln(total);
close(output);
end.
[/code] 有pascal的么？ 9楼的代码一会我测试一下，想法很好
LS的，我有时间会把我的程序翻译成PASCAL，不过速度会有点慢，很长时间不用了~~ var
n,m,i,j:longint;
f:array [0..30,0..30] of longint;
begin
assign(input,'ball.in');
reset(input);
assign(output,'ball.out');
rewrite(output);
read(n,m);
fillchar(f,sizeof(f),0);
f[0,1]:=1;
for i:=1 to m do
begin
f[i,1]:=f[i-1,n]+f[i-1,2];
for j:=2 to n-1 do f[i,j]:=f[i-1,j-1]+f[i-1,j+1];
f[i,n]:=f[i-1,n-1]+f[i-1,1]
end;
writeln(f[m,1]);
close(input);
close(output)
end. 谢谢楼主了!
第一题就因为没看题挂了…… 第一题
[code]program isbn(input,output);
var
i,code,t,sum,n:longint;
str:string;
begin
assign(input,'isbn.in');
reset(input);
readln(str);
close(input);
val(str[1],t,code);
sum:=t;
for i:=3 to 5 do
begin
val(str[i],t,code);
sum:=sum+(i-1)*t;
end;
for i:=7 to 11 do
begin
val(str[i],t,code);
sum:=sum+(i-2)*t;
end;
n:=sum mod 11;
assign(output,'isbn.out');
rewrite(output);
if n<10 then
if ord(str[13])=n+48 then
writeln('Right')
else
begin
str[13]:=chr(n+48);
writeln(str);
end
else
if str[13]='X' then
writeln('Right')
else
begin
str[13]:='X';
writeln(str);
end;
close(output);
end.
[/code] [i=s] 本帖最后由 oimaster 于 2008-11-19 08:33 PM 编辑 [/i]
第二题：[code]program seat(input,output);
var
hang,lie:array[1..1000] of longint;
ans:array[1..2,1..1000] of boolean;
m,n,k,l,d:longint;
function min(a,b:longint):longint;
begin
if a<b then exit(a) else exit(b);
end;
procedure init;
var
i,x,y,p,q:longint;
begin
fillchar(lie,sizeof(lie),0);
fillchar(hang,sizeof(hang),0);
assign(input,'seat.in');
reset(input);
readln(m,n,k,l,d);
for i:=1 to d do
begin
readln(x,y,p,q);
if x=p then
inc(lie[min(y,q)])
else
inc(hang[min(x,p)]);
end;
close(input);
end;
procedure work;
var
i,j,max,no:longint;
begin
fillchar(ans,sizeof(ans),false);
for i:=1 to k do
begin
max:=0;
no:=0;
for j:=1 to m-1 do
if (not ans[1,j]) and (hang[j]>=max) then
begin
max:=hang[j];
no:=j;
end;
ans[1,no]:=true;
end;
for i:=1 to l do
begin
max:=0;
no:=0;
for j:=1 to n-1 do
if (not ans[2,j]) and (lie[j]>=max) then
begin
max:=lie[j];
no:=j;
end;
ans[2,no]:=true;
end;
end;
procedure print;
var
temp:array[1..1000] of integer;
i,total:longint;
begin
assign(output,'seat.out');
rewrite(output);
total:=0;
for i:=1 to m-1 do
if ans[1,i] then
begin
inc(total);
temp[total]:=i;
end;
for i:=1 to total do
if i<total then
write(temp,' ')
else
writeln(temp);
total:=0;
for i:=1 to n-1 do
if ans[2,i] then
begin
inc(total);
temp[total]:=i;
end;
for i:=1 to total do
if i<total then
write(temp,' ')
else
writeln(temp);
close(output);
end;
begin
init;
work;
print;
end.
[/code] 呵呵，谢谢LS以及LS的LS的LS贴出的代码，我会整理到一起做为附件供大家下载，欢迎大家加入OI交流群74762057，我正准备邀请各位IOI，NOI各位大牛加入 第四题：
[code]program drawing(input,output);
const
t:array[1..6,1..7] of char
=(('.','.','+','-','-','-','+'),
('.','/',' ',' ',' ','/','|'),
('+','-','-','-','+',' ','|'),
('|',' ',' ',' ','|',' ','+'),
('|',' ',' ',' ','|','/','.'),
('+','-','-','-','+','.','.'));
var
ans:array[1..500,1..500] of char;
a:array[1..50,1..50] of integer;
m,n:integer;
procedure init;
var
i,j:integer;
begin
assign(input,'drawing.in');
reset(input);
readln(m,n);
for i:=1 to m do
for j:=1 to n do
read(a[i,j]);
close(input);
end;
procedure work;
var
i,j,k,t1,t2,x,y:integer;
begin
fillchar(ans,sizeof(ans),46);
for i:=1 to m do
for j:=1 to n do
for k:=1 to a[i,j] do
begin
t1:=495-(m-i)*2-(k-1)*3;
t2:=4*j-3+(m-i)*2;
for x:=1 to 6 do
for y:=1 to 7 do
if t[x,y]<>'.' then ans[t1+x-1,t2+y-1]:=t[x,y];
end;
end;
procedure print;
var
i,h,sum,j:integer;
begin
h:=1;
while true do
begin
sum:=0;
for i:=1 to 500 do
if ans[h,i]='.' then inc(sum);
if sum<500 then break;
inc(h);
end;
assign(output,'drawing.out');
rewrite(output);
for i:=h to 500 do
begin
for j:=1 to 4*n+2*m+1 do
write(ans[i,j]);
writeln;
end;
close(output);
end;
begin
init;
work;
print;
end.
[/code] 那个~~~LS的朋友，先谢谢，然后请你看一下第二题我不能编译，修改一下，我这里Free Pascal不好用，谢谢，其他3题均通过测试，准确无误 PASCAL代码已经贴出，感谢oimaster提供代码 倒霉呀
我如果再细心一点就是吉林省的第一名了
感谢大家给的第三题的解题报告
页:
[1]
2