NoiP2003提高组复赛试题分析_天津南开中学滕伟.doc

我看了李学武教授写的《关于NOIP复赛的若干问题的思考》一文，有很大触动，深刻感受到天津市信息学奥赛基础薄弱。我从事奥赛培训工作十三年，培训的学生在全国取得了一些好成绩，一块国际银牌，四块全国奥赛金牌，三块银牌，十块铜牌。我认为我有责任将我的培训工作介绍给同人和其他学校的同学，来推动天津市奥赛的发展。下面是我写的今年分区联赛高中组复赛的解题分析，供大家参考，并恳切希望能与“OIER”交流共勉。

天津南开中学滕伟（ 邮编：300100，电子邮箱：fnoi2003@ 或 tjnkzx2000@ ）
第一题：神经网络
【试题分析】
一、题意分析
1、任务描述：从输入层开始，各节点按照传递公式，一层一层向下传递。输出输出层中信号大于零的节点编号和信号大小。（节点编号由小到大）如果没有满足条件的编号则输出NULL。
信号传递公式：

公式中的Wji（可能为负值）表示连接j号神经元和i号神经元的边的权值。当Ci大于0时，该神经元处于兴奋状态，否则就处于平静状态。当神经元处于兴奋状态时，下一秒它会向其它神经元传递信号，信号的强度为Ci。
2、输入：
两个整数n（1≤n≤20）和p。n表示节点的个数；p表示有向边的条数。
下面n行表示1-n号节点的状态和阈值。
下面p行表示有向边及其权值。
3、输出：
输出输出层状态大于零的神经元编号和状态，并且按照编号有小到大顺序输出！
若输出层的神经元最后状态小于等于0，则输出NULL。
二、问题分析
1、题目中给出每层神经元只向下一层的神经元输出信息，只从上一层神经元接受信息。所以不必进行拓扑排序，一层一层的向下传递信号即可。输出最后一层中信号大于零的节点编号。
2、可以建立一个队列，将输入层节点入队。
3、取队首节点出队，寻找此节点有向边，如果有有向边：
1）则记录此节点不是输出层；
2）再判断此节点信号大于零则向下传递信号，将指向的节点入队（防止重复入队）。再出队再传递，直至全部出队。
注意：1）输入层可以是输出层。2）信号传递公式中只减一次U[i]。
【程序清单】
下面是我校学生肖天同学写的程序。
{NOIP 2003 Problem 1 by Xiao Tian}
{Test 1..5 : All right}
Program network;
Const
InName='network.in';
OutName='network.out';
MM=100;
Var
InFile,OutFile:Text;
C,U:Array[1..MM] Of LongInt;
Map:Array[1..MM,1..MM] Of LongInt;
Flag:Array[1..MM,1..MM] Of Boolean;
IsOut:Array[1..MM] Of Boolean;
Queue:Array[1..MM] Of LongInt;
N,P,i,Int1,Int2,Head,Rear:LongInt;
IsInQueue:Array[1..MM] Of Boolean;
IsNull:Boolean;
Begin
Assign(InFile,InName);
Reset(InFile);
ReadLn(InFile,N,P);
For i:=1 To N Do ReadLn(InFile,C[i],U[i]);
FillChar(Flag,SizeOf(Flag),False);
For i:=1 To P Do Begin
Read(InFile,Int1,Int2);
ReadLn(InFile,Map[Int1,Int2]);
Flag[Int1,Int2]:=True;
End;
Close(InFile);

FillChar(IsOut,SizeOf(IsOut),True);
FillChar(IsInQueue,SizeOf(IsInQueue),False);
Head:=1; Rear:=1;
For i:=1 To N Do Begin
If C[i]>0 Then Begin
Queue[Rear]:=i;
Inc(Rear);
IsInQueue[i]:=True;
End
Else C[i]:=-U[i];
End;
While Head<Rear Do Begin
For i:=1 To N Do
If Flag[Queue[Head],i] Then Begin
If C[Queue[Head]]>0 Then Begin
Inc(C[i],Map[Queue[Head],i]*C[Queue[Head]]);
If Not IsInQueue[i] Then Begin
Queue[Rear]:=i;
Inc(Rear);
IsInQueue[i]:=True;
End;
End;
IsOut[Queue[Head]]:=False;
End;
Inc(Head);
End;

Assign(OutFile,OutName);
Rewrite(OutFile);
IsNull:=True;
For i:=1 To N Do
If IsOut[i] Then
If C[i]>0 Then Begin
WriteLn(OutFile,i,' ',C[i]);
IsNull:=False;
End;
If IsNull Then WriteLn(OutFile,'NULL');
Close(OutFile);
End.
第二题：侦探推理
【试题分析】
一、题意分析
1、任务描述：M个人参加游戏，每人提供一句或多句证言，共P句证言。其中N个人始终说假话，其余的人始终说真话。请你通过证言判断出谁是罪犯。
证言形式如下：
证词内容
证词含义
I am guilty.
我是罪犯
I am not guilty.
我不是罪犯
XXX is guilty.
XXX是罪犯（XXX表示某个同学的名字）
XXX is not guilty.
XXX不是罪犯
Today is XXX.
今天是XXX（XXX表示星期几，是Monday Tuesday Wednesday
Thursday Friday Saturday Sunday其中之一）
证词中出现的其它话，都不列入逻辑推理的内容。
2、输入：
第一行有三个整数，M（1≤M≤20）、N（1≤N≤M）和P（1≤P≤100）：M是参加游戏的明明的同学数，N是其中始终说谎的人数，P是证人的综述。
接下来M行，每行是明明的一个同学的名字（英文字母组成，没有空格，全部大写）。
往后有P行，每行开始是某个同学的名字，紧跟着一个冒号和一个空格，后面是一句证词，符合前表中所列格式，证词每行不会好过250个字符。
输入中不会出现连续的两个空格，而且每行开头和结尾也没有空格。
3、输出：
如果你的程序能确定谁是罪犯，则输出他的名字；
如果程序判断出不止一个人可能是罪犯，则输出Cannot Determine；
如果程序判断出没有人可能成为罪犯，则输出Impossible。
二、问题分析
1、根据题意可知可以利用枚举法完成。枚举罪犯和今天是星期几。满足N个人始终说谎话和M-N个人始终说真话的条件，就可以确定罪犯。
2、首先利用字符串操作将证言转化成计算机可表示的信息。
1）定义Guilty:Array[1..MM,1..MM] Of Integer;{-1..1}
FillChar(Guilty,SizeOf(Guilty),0) 初值为0
Guilty[i,j]=-1：表示第i个人说第j个人不是罪犯
Guilty[i,j]= 1：表示第i个人说第j个人是罪犯
其中包含Guilty[i,i]即第i个人说自己是不是罪犯
注意：Guilty不可以自相矛盾。
2）定义WhatDay:Array[1..MM,1..7] Of Boolean;
FillChar(WhatDay,SizeOf(WhatDay),False)
WhatDay[i,j]:=True :表示第i个人说过j是星期几
3、枚举罪犯和星期几，判断每句证言是真是假，统计说真假证言的人数。注意：有可能某人又说过真话，又说过假话。
4、根据题目要求输出罪犯编号或Cannot Determine或Impossible。
【程序清单】
下面是我校学生肖天同学写的程序。
{NOIP 2003 Problem 2 by Xiao Tian}
{Test 0..9 : All right}
{Algorithm : Enumerate the guilty and what day it is today.
then we can determine whether each sentence is true or not.}
Program logic;
Const
InName='logic.in';
OutName='logic.out';
MM=20;
DayState:Array[1..7] Of String
=('is Monday. #'
,'is Tuesday. #'
,'is Wednesday. #'
,'is Thursday. #'
,'is Friday. #'
,'is Saturday. #'
,'is Sunday. #');
cImpossible=-1;
cCannotDetermine=-2;
Var
InFile,OutFile:Text;
M,N,P:Integer;
Name:Array[1..MM] Of String;
Guilty:Array[1..MM,1..MM] Of Integer;{-1..1}
WhatDay:Array[1..MM,1..7] Of Boolean;
i,j:Integer;
IsGuilty:Array[1..MM] Of Boolean;
Ans,AnsC:Integer;
Procedure Print(ID:Integer);
Begin
Assign(OutFile,OutName);
Rewrite(OutFile);
If ID=cImpossible Then
WriteLn(OutFile,'Impossible')
Else If ID=cCannotDetermine Then
WriteLn(OutFile,'Cannot Determine')
Else WriteLn(OutFile,Name[ID]);
Close(OutFile);
Halt;
End;
Procedure SetGuilty(CurID,NextID,NewValue:Integer);
Begin
If Guilty[CurID,NextID]=0 Then
Guilty[CurID,NextID]:=NewValue
Else If Guilty[CurID,NextID]<>NewValue Then
Print(cImpossible);
End;
Procedure ReadStatement;
Var
i,j,CurID,NextID:Integer;
CurStr,CurName:String;
Begin
For i:=1 To P Do Begin
ReadLn(InFile,CurStr);
CurStr:=CurStr+' #';
CurName:=Copy(CurStr,1,Pos(':',CurStr)-1);
CurStr:=Copy(CurStr,Pos(':',CurStr)+2,255);
CurID:=0;
For j:=1 To M Do
If CurName=Name[j] Then Begin
CurID:=j;
Break;
End;
If CurID=0 Then Continue;
If CurStr='I am guilty. #' Then
SetGuilty(CurID,CurID,1)
Else If CurStr='I am not guilty. #' Then
SetGuilty(CurID,CurID,-1)
Else Begin
CurName:=Copy(CurStr,1,Pos(' ',CurStr)-1);
CurStr:=Copy(CurStr,Pos(' ',CurStr)+1,255);
If CurName='Today' Then Begin
For j:=1 To 7 Do
If CurStr=DayState[j] Then Begin
WhatDay[CurID,j]:=True;
Break;
End;
End
Else Begin
NextID:=0;
For j:=1 To M Do
If CurName=Name[j] Then Begin
NextID:=j;
Break;
End;
If NextID=0 Then Continue;
If CurStr='is guilty. #' Then
SetGuilty(CurID,NextID,1)
Else If CurStr='is not guilty. #' Then
SetGuilty(CurID,NextID,-1);
End;
End;
End;
End;
Function Check(CurGuilty,CurDay:Integer):Boolean;
Var
SayT,SayF:Array[1..MM] Of Boolean;
i,j,TCount,FCount:Integer;
Begin
FillChar(SayT,SizeOf(SayT),False);
FillChar(SayF,SizeOf(SayF),False);
For i:=1 To M Do Begin
If Guilty[i,CurGuilty]=1 Then
SayT[i]:=True
Else If Guilty[i,CurGuilty]=-1 Then
SayF[i]:=True;
End;
For i:=1 To M Do
For j:=1 To M Do
If j<>CurGuilty Then Begin
If Guilty[i,j]=1 Then
SayF[i]:=True
Else If Guilty[i,j]=-1 Then
SayT[i]:=True;
End;
For i:=1 To M Do
If WhatDay[i,CurDay] Then SayT[i]:=True;
For i:=1 To M Do
For j:=1 To 7 Do
If j<>CurDay Then
If WhatDay[i,j] Then SayF[i]:=True;
For i:=1 To M Do
If SayT[i] And SayF[i] Then Begin
Check:=False;
Exit;
End;
TCount:=0; FCount:=0;
For i:=1 To M Do Begin
If SayT[i] Then Inc(TCount);
If SayF[i] Then Inc(FCount);
End;
If (FCount>N) Or (M-TCount<N) Then Begin
Check:=False;
Exit;
End;
Check:=True;
End;
Begin
Assign(InFile,InName);
Reset(InFile);
ReadLn(InFile,M,N,P);
For i:=1 To M Do ReadLn(InFile,Name[i]);
FillChar(Guilty,SizeOf(Guilty),0);
FillChar(WhatDay,SizeOf(WhatDay),False);
ReadStatement;
Close(InFile);

FillChar(IsGuilty,SizeOf(IsGuilty),False);
For i:=1 To M Do
For j:=1 To 7 Do
IsGuilty[i]:=IsGuilty[i] Or Check(i,j);

AnsC:=0;
For i:=1 To M Do
If IsGuilty[i] Then Begin
Inc(AnsC);
Ans:=i;
End;
If AnsC=0 Then
Print(cImpossible)
Else If AnsC>1 Then
Print(cCannotDetermine)
Else Print(Ans);
End.
第三题：加分二叉树

【试题分析】
一、题意分析
1、任务描述：在中序遍历为（1,2,3,…,n）的各种二叉树中，选出加分最高的一棵二叉树，输出最高加分和对此二叉树的前序遍历。
加分规则：任意棵子树subtree（也包含tree本身）的加分计算方法如下：
subtree的左子树的加分*subtree的右子树的加分+subtree的根的分数
若某个子树为空，规定其加分为1，叶子的加分就是叶节点本身的分数，不考虑它的空子树。
2、输入：节点数和每个节点的分值。（n<30、分值<100）
3、输出：最高加分，和此树的前序遍历。（结果不会超过4,000,000,000）保险可利用double类型。
二、问题分析
1、因为给出中序遍历（1,2,3,…,n），所以可以以每个节点作根。当根为i时，则将序列分为三部分1至（i-1）为左子树，i为根，（i+1）至n为右子树。根据上面分析可断定此题可利用动态规划解决。
2、根据加分规则：转移方程如下：
f(i,j)表示编号为i到编号为j的中序遍历的二叉树的最高加分。

f(1,n)即为所求最高加分。记录最高加分结果的划分就是前序遍历的结果。
可以利用备忘录形式或递推形式完成。
【程序清单】
下面是我校学生薛原同学写的程序。
{NOIPG2003第三题（2003年11月29日）
加分树
}
program tree;
var a:array[1..30] of longint;
max:array[1..30,1..30] of longint;
way:array[1..30,1..30] of integer;
n:integer;
f:text;
procedure init;
var f:text;
fn:string;
i:integer;
begin
readln(fn);
assign(f,fn);reset(f);
readln(f,n);
for i:=1 to n do read(f,a[i]);
fillchar(max,sizeof(max),0);
close(f);
end;
procedure try(x,y:integer);
var i:integer;
begin
if x>y then begin max[x,y]:=1;exit;end;
if x=y then begin max[x,y]:=a[x];exit;end;
for i:=x to y do
begin
if max[x,i-1]=0 then try(x,i-1);
if max[i+1,y]=0 then try(i+1,y);
if max[x,y]<max[x,i-1]*max[i+1,y]+a[i] then
begin
max[x,y]:=max[x,i-1]*max[i+1,y]+a[i];
way[x,y]:=i;
end;
end;
end;
procedure output(x,y:integer);
begin
write(f,way[x,y],' ');
if x=way[x,y]-1 then write(f,x,' ')
else if x<way[x,y]-1 then output(x,way[x,y]-1);
if way[x,y]+1=y then write(f,y,' ')
else if way[x,y]+1<y then output(way[x,y]+1,y);
end;
begin
init;
try(1,n);
assign(f,'tree.out');rewrite(f);
writeln(f,max[1,n]);
output(1,n);
close(f);
end.
第四题：传染病控制
【试题分析】
一、题意分析
1、任务描述：在一棵树中，每层任意砍掉一条边，使包含根结点的树的结点数最少。
2、输入：
输入的第一行是两个整数n（1≤n≤300）和p，接下来p行，每一行有两个整数i和j，表示节点i和j间有边相连（即，第i人和第j人之间有传播途径相连）。其中节点1是已经被感染的患者。
3、输出：
只有一行，输出总共被感染的人数（即包含1号结点的树的结点数）。
二、问题分析
1、首先利用宽度搜索求出树的深度和每层的宽度，并记录每个结点的根结点编号。
2、再利用搜索，每层去掉一条边，记录感染人数。比较求出最少感染人数。
3、优化：
1）在搜索过程中可以利用剪枝加快搜索效率。目前我没有找到有效的剪枝方法，如游客一发信给我，谢谢。
2）杨博海同学利用随机方法求解，效果不错。即每层随机去掉一条边统计结点数，随即10000次输出最少感染人数。
【程序清单】
下面是我校学生杨博海同学写的程序。
Program Epidemic;
Var
root,list,short,s:array[1..300] of LongInt;
e:array[1..600,0..1] of LongInt;
a,b,c,n,m,t,best:LongInt;
Procedure bfs;
Var
a,k:LongInt;
Begin
For a:=1 to n Do short[a]:=n;
short[1]:=0;
k:=1;
list[1]:=1;
s[1]:=1;
For a:=1 to n Do Begin
For b:=1 to m*2 Do
If (short[e[b][0]]>short[e[b][1]]+1) and (short[e[b][1]]=a-1) Then Begin
root[e[b][0]]:=e[b][1];
short[e[b][0]]:=short[e[b][1]]+1;
Inc(k);
list[k]:=e[b][0];
End;
If s[a]=k Then Break;
s[a+1]:=k;
End;
t:=a;
End;
Procedure calc;
Var
a,b,k,num:LongInt;
flag:array[1..300] of Boolean;
step:array[1..300] of LongInt;
Begin
flag[1]:=true;
num:=1;
For a:=2 to t Do Begin
k:=0;
For b:=s[a-1]+1 to s[a] Do Begin
flag[list[b]]:=flag[root[list[b]]];
If flag[list[b]] Then Begin
Inc(num);
Inc(k);
step[k]:=list[b];
End;
End;
If k>0 Then Begin
flag[step[random(k)+1]]:=false;
Dec(num);
End;
End;
If best>num Then best:=num;
End;
Begin
Randomize;
Assign(input,'epidemic.in0');
Reset(input);
ReadLn(n,m);
For a:=1 to m Do Begin
Read(e[a*2-1][0],e[a*2-1][1]);
e[a*2][0]:=e[a*2-1][1];
e[a*2][1]:=e[a*2-1][0];
End;
Close(input);
bfs;
best:=n;
For a:=1 to 100000 Do calc;
WriteLn(best);
End.