绍兴市第八届pascal编程比赛题目及答案

如题所述

第1个回答  2012-04-14
第一题:

program c1;

var
K: Byte;
n: Longint;
Sn: Extended;

begin
Readln(K);
Sn := 0; n := 0;
Repeat
Inc(n);
Sn := Sn + 1 / n;
Until Sn > k;
Writeln(n);
end.

第二题:

program c2;

const
MaxN = 20;

var
N, M, i: Byte;
ans, s: Longint;
x: array[1 .. MaxN] of Longint;
f: array[1 .. 10000] of Byte;
p: array[1 .. 1229] of Integer;

procedure Get_Prime;
var
i, j, s: Integer;
begin
s := 0;
f[1] := 0;
for i := 2 to 10000 do f[i] := 1;
for i := 2 to 10000 do
if f[i] = 1 then
begin
Inc(s); p[s] := i;
j := 2 * i;
while j <= 10000 do begin f[j] := 0; Inc(j, i) end;
end
end;

procedure Work(S: Longint);
var
i: Integer;
begin
if S <= 10000 then Inc(ans, f[S])
else
begin
i := 1;
while sqr(longint(p[i])) <= S do
begin
if S mod p[i] = 0 then Exit;
Inc(i)
end;
Inc(ans)
end
end;

procedure Search(d, pre: Byte);
var
i: Byte;
begin
for i := pre + 1 to N - (M - d) do
begin
Inc(S, x[i]);
if d = M then Work(S)
else Search(d + 1, i);
Dec(S, x[i])
end
end;

begin
Readln(N, M);
for i := 1 to N do Read(x[i]);
ans := 0; S := 0;
Get_Prime;
Search(1, 0);
Writeln(ans)
end.

第三题:

program c3;

const
MaxLen = 30;

var
Len, M: Byte;
a: array[1 .. MaxLen] of Byte;
f: array[0 .. 9] of Byte;
g: array[0 .. 9, 0 .. 9] of Boolean;

procedure Init;
var
i: Byte;
St: String;
begin
Readln(st);
Len := 0; M := 0;
i := 1;
while st[i] in ['0' .. '9'] do
begin Inc(Len); a[Len] := Ord(st[i]) - 48; Inc(i) end;
Repeat
if st[i] in ['0' .. '9'] then M := M * 10 + Ord(st[i]) - 48;
Inc(i)
Until i > Length(st)
end;

procedure Main;
var
i, j, k: Byte;
begin
Fillchar(g, Sizeof(g), False);
for k := 1 to M do
begin
Readln(i, j);
g[i, j] := True
end;
for k := 0 to 9 do
for i := 0 to 9 do
for j := 0 to 9 do
g[i, j] := g[i, j] or (g[i, k] and g[k, j]);
Fillchar(f, Sizeof(f), 0);
for i := 0 to 9 do g[i, i] := True;
for i := 0 to 9 do
for j := 0 to 9 do
Inc(f[i], Ord(g[i, j]))
end;

procedure Show;
var
i, j, k, g: Byte;
ans: Array[1 .. MaxLen] of Byte;
begin
Fillchar(ans, Sizeof(ans), 0);
ans[1] := 1;
for k := 1 to Len do
begin
g := 0;
for i := 1 to MaxLen do
begin
ans[i] := ans[i] * f[a[k]] + g;
g := ans[i] div 10;
ans[i] := ans[i] mod 10
end
end;
j := MaxLen;
While ans[j] = 0 do Dec(j);
for i := j downto 1 do Write(ans[i]);
Writeln
end;

begin
Init;
Main;
Show
end.

第四题:
program c4;

const
dx: array[1 .. 8] of Shortint = (-2, -1, 1, 2, 2, 1, -1, -2);
dy: array[1 .. 8] of Shortint = (1, 2, 2, 1, -1, -2, -2, -1);

var
n, m, x, y, i, j: Byte;
g: array[0 .. 20, 0 .. 20] of Byte;
f: array[0 .. 20, 0 .. 20] of Comp;

begin
Readln(n, m, x, y);
Fillchar(g, Sizeof(g), 0);
g[x, y] := 1;
for i := 1 to 8 do
if (x + dx[i] >= 0) and (x + dx[i] <= n) and
(y + dy[i] >= 0) and (y + dy[i] <= m) then
g[x + dx[i], y + dy[i]] := 1;
f[0, 0] := 1;
for i := 1 to n do
if g[i, 0] = 0 then f[i, 0] := f[i - 1, 0];
for i := 1 to m do
if g[0, i] = 0 then f[0, i] := f[0, i - 1];
for i := 1 to n do
for j := 1 to m do
if g[i, j] = 0 then f[i, j] := f[i - 1, j] + f[i, j - 1];
Writeln(f[n, m]: 0: 0)
end.

解题报告:
题一: 级数求和

[问题描述]:
已知:Sn=1+1/2+1/3+…+1/n。显然对于任意一个整数K,当n足够大的时候,Sn大于K。现给出一个整数K(1<=K<=15),要求计算出一个最小的n,使得Sn>K

[问题分析]:
这道题目非常简单,题目的意思已经把该题的算法描述得再清楚不过了,初始时Sn=0,n=0,然后每次循环nçn+1,SnçSn+1/n,,直到Sn大于K,最后输出K。另外实型(Real是最慢的,建议用Extended)的运算速度不是很快,而K为1~15之间的整数,所以最后可以交一张表(常量数组),以达到最好的效果

题二: 选数

[问题描述]:
已知n(1<=n<=20)个整数x1,x2,…,xn(1<=xi<=5000000),以及一个整数k(k<n)。从n个整数中任选k个整数相加,可分别得到一系列的和。现在,要求你计算出和为素数共有多少种。

[问题分析]:
本题动态规划无从下手,也无数学公式可寻,看来只能搜索(组合的生成算法),其实1<=n<=20这个约束条件也暗示我们本题搜索是有希望的,组合的生成可用简单的DFS来实现,既搜索这k个整数在原数列中的位置,由于组合不同于排列,与这k个数的排列顺序无关,所以我们可以令a[I]<a[I+1](a[I]表示第I个数在原数列中的位置),这个组合生成算法的复杂度大约为C(n,k),下面给出递归搜索算法的框架:

Proc Search(dep) Beginfor i <- a[dep - 1] + 1 to N - (M - dep) do1:a[dep] <- i2:S <- S + x[i]3:if dep < k then Search(dep + 1) else 判断素数4:S <- S - x[i] End

接下来的问题就是判断素数,判断一个整数P(P>1)是否为素数最简单的方法就是看是否存在一个素数a(a<=sqrt(P))是P的约数,如果不存在,该数就为素数,由于在此题中1<=xi<=5000000,n<=20,所以要判断的数P不会超过100000000,sqrt(p)<=10000,因此,为了加快速度,我们可以用筛选法将2…10000之间的素数保存到一个数组里(共1229个),这样速度估计将提高5~6倍。

特别注意:本题是要求使和为素数的情况有多少种,并不是求有多少种素数,比赛时就有很多同学胡乱判重而丢了12分;还有1不是素数,在判素数时要对1做特殊处理。

题三: 产生数

[问题描述]:
给出一个整数n(n<10^30)和k个变换规则(k<=15)。
规则:
1个数字可以变换成另一个数字
规则的右部不能为零。
问题:
给出一个整数n和k个规则
求出:
经过任意次的变换(0次或多次),能产生出多少个不同的整数。

[问题分析]:
认真分析题目之后发现,本题搜索显然是不行的,而且对于只需计数而不需求具体方案的题目,一般都不会用搜索解决,其实本题不难看出,可以用乘法原理直接进行计数,用Fi表示数字i包括本身可以变成的数字总个数(这里的变成可以是直接变成也可以是间接变成,比如3->5,5->7,那么3->7),那么对于一个数a(用数组存,长度为n),根据乘法原理它能产生出F[a[1]]*F[a[2]]*F[a[3]]*…F[a[n]]个不同整数,相信这一点大家不难理解。那么现在的关键就是如何求Fi,由于这些变换规则都是反应的数字与数字之间的关系,这很容易让我们想到用图来表示这种关系:

1: 建立一个有向图G,初始化g[i, j] ß False
2: 如果数字i能直接变成数字j,那么g[i, j] ß True

容易知如果数字i能变成数字j,那么i到j必须存在路径,否则i是不可能变成j的,这样一来,Fi的求解就显得非常简单了,求一个顶点v包括本身能到达的顶点数的方法相当多,可以用BFS,DFS,Dijkstra,Floyd,这里介绍一种类似Floyd的有向图的传递闭包算法,该算法实现简单 ,在解决这类问题时比Floyd效率更高,所谓有向图的传递闭包就是指可达性矩阵A=[a[i, j]],其中
a[i, j] = True 从i到j存在通路
a[i, j] = False 从i到j不存在通路

所以有向图传递闭包算法只需将floyd算法中的算术运算符操作‘+’用相应的逻辑运算符‘and’和’or’代替就可以了,其算法如下:
for k ß 1 to n do
for i ß 1 to n do
for j ß 1 to n do
a[i, j] = a[i, j] or (a[i, k] and a[k, j])

最后值得注意的是当n很大时输出可能会超过Comp类型的范围,所以要使用高精度乘法,由于高精度算法是信息学竞赛中的基础,这里就不在详述。

题四: 过河卒

[问题描述]:
棋盘上A点有一个过河卒,需要走到目标B点。卒行走的规则:可以向下、或者向右。
同时在棋盘上C点有一个对方的马,该马所在的点和所有跳跃一步可达的点称为对方马的控制点。
棋盘用坐标表示,A点(0,0)、B点(n, m) (n,m为不超过20的整数),同样马的位置坐标是需要给出的。现在要求你计算出卒从A点能够到达B点的路径的条数

[问题分析]:
这是一道老得不能再老的题目了,很多书上都有类似的题目,NOIp97普及组的最后一题就和本题几乎一模一样。有些同学由于没见过与之类似的题目,在比赛时用了搜索,当n到14,15左右就会超时,其实,本题稍加分析,就能发现:要到达棋盘上的一个点,只能从左边过来或是从上面下来,所以根据加法原理,到达某一点的路径数目,等于到达其相邻上,左两点的路径数目之和,因此我们可以使用逐列(或逐行)递推的方法来求出从起始顶点到重点的路径数目,即使有障碍(我们将马的控制点称为障碍),这一方法也完全适用,只要将到达该点的路径数目置为0即可,用F[i,j]表示到达点(i,j)的路径数目,g[i,j]表示点(i, j)有无障碍,递推方程如下:
F[0,0] = 1
F[i,j] = 0 { g[x,y] = 1 }
F[i,0] = F[i-1,0] {i > 0, g[x,y] = 0}
F[0,j] = F[0,j-1] {j > 0, g[x,y] = 0}
F[i,j] = F[i-1,j] + F[i,j-1] {i > 0, j > 0, g[x, y] = 0}
本题与第三题一样,也要考虑精度问题,当n,m都很大时,可能会超过MaxLongInt,所以要使用Comp类型计数(Comp类型已经足够了,即使n=20,m=20,没有任何障碍的情况下的结果也只有14,5位的样子)。