第一题，数字统计，很water的题目，要是有人傻乎乎的用桶排，我也没办法，直接上代码。
View Code
1 Program Count(Input,Output);
2 Type
3 Numbertype = Array[0..200000] Of Longint;
4 Var
5 N1,I1,S : Longint;
6 A : Numbertype;
7 Procedure Swap(Var A1,A2: Longint);
8 Var
9 T:Longint;
10 Begin
11 T:=A1;
12 A1:=A2;
13 A2:=T;
14 End;
15 Procedure Csort(L,R:Longint;Var A:Numbertype);
16 Var
17 H,E:Longint;
18 Begin
19 For E:=L+1 To R Do
20 Begin
21 A[0]:=A[E];
22 H:=E-1;
23 While A[H]>A[0] Do
24 Begin
25 A[H+1]:=A[H];
26 H:=H-1;
27 End;
28 A[H+1]:=A[0];
29 End;
30 End;
31 Procedure Quick(P,Q:Longint;Var A:Numbertype);
32 Var
33 I,J,M:Longint;
34 Begin
35 If Q-P<=16 Then
36 Csort(P,Q,A)
37 Else
38 Begin
39 I:=P;
40 J:=Q;
41 M:=A[(I+J)Div 2];
42 If (A[I]<M)And(A[J]<A[I]) Then
43 Swap(A[I],A[(I+J)Div 2])
44 Else
45 Begin
46 If (A[J]<M)And(A[I]<A[J]) Then
47 Swap(A[J],A[(I+J)Div 2])
48 Else
49 If A[I]>A[J] Then
50 Swap(A[I],A[J]);
51 End;
52 M:=A[(I+J)Div 2];
53 Repeat
54 While A[I]<M Do
55 Inc(I);
56 While A[J]>M Do
57 Dec(J);
58 If I<=J Then
59 Begin
60 Swap(A[I],A[J]);
61 Inc(I);
62 Dec(J);
63 End;
64 Until I>J;
65 If P<J Then Quick(P,J,A);
66 If I<Q Then Quick(I,Q,A);
67 End;
68 End;
69 Begin
70 Assign(Input,'Count.In');Reset(Input);
71 Assign(Output,'Count.Ans');Rewrite(Output);
72 Readln(N1);
73 For I1:=1 To N1 Do
74 Readln(A[I1]);
75 Quick(1,N1,A);
76 S:=1;
77 For I1:=1 To N1 Do
78 Begin
79 If A[I1]=A[I1+1] Then
80 Begin
81 S:=S+1;
82 Continue;
83 End
84 Else
85 Begin
86 Writeln(A[I1],'',S);
87 S:=1;
88 End;
89 End;
90 Close(Input);
91 Close(Output);
92 End.
第二题，字符串展开，比较黑人的一道题，注意考虑所有情况,这里仅列出本人觉得易出错的点：
1.-出现在行首或行尾。
2.序列反转问题的处理。
第一次做为了简便，我把答案保存在ANS里，最后一起输出，这题阴人的地方就在这里，保存后再输出会超某些东西（时间或空间），最后改了一下，边处理边 输出，才A掉这道题。提供两个代码供大家比较参考。
View Code
1 {保存了答案一起输出，80分}
2 Program Expand(Input,Output);
3 Var
4 S : ansistring;
5 Make : Array[0..500] Of Boolean;
6 P1,P2,P3 : Integer;
7 Ans : ansistring;
8 Procedure Init;
9 Begin
10 Readln(P1,P2,P3);
11 Readln(S);
12 End; { Init }
13 procedure swap(var aa,bb :char );
14 var
15 tt : char;
16 begin
17 tt:=aa;
18 aa:=bb;
19 bb:=tt;
20 end; { swap }
21 Procedure Main;
22 Var
23 Now,Start : Longint;
24 I,J : Longint;
25 ch : char;
26 Begin
27 Fillchar(Make,Sizeof(Make),False);
28 Now:=1;
29 While Now<=Length(S) Do
30 Begin
31 If S[Now]<>'-' Then
32 Begin
33 Ans:=Ans+S[Now];
34 inc(now);
35 Continue;
36 End;
37 If S[Now]='-' Then
38 Begin
39 If ((S[Now-1] In ['a'..'z'])And(S[Now+1] In ['a'..'z']))Or((S[Now-1] In ['0'..'9'])And(S[Now+1] In ['0'..'9'])) Then
40 Begin
41 if s[now-1]>=s[now+1] then
42 begin
43 ans:=ans+s[now]+s[now+1];
44 inc(now,2);
45 continue;
46 end;
47 For Ch:=Succ(S[Now-1]) To Pred(S[Now+1]) Do
48 For I:=1 To P2 Do
49 Begin
50 Ans:=Ans+Ch;
51 Make[Length(Ans)]:=True;
52 End;
53 ans:=ans+s[now+1];
54 Inc(Now,2);
55 Continue;
56 End
57 Else
58 Begin
59 Ans:=Ans+S[Now];
60 Inc(Now);
61 Continue;
62 End;
63 End;
64 End;
65 for i:=1 to length(ans) do
66 begin
67 if make[i] then
68 case p1 of
69 1 : continue;
70 2 : ans[i]:=upcase(ans[i]);
71 3 : ans[i]:='*';
72 end; { case }
73 end;
74 if p3=1 then
75 exit;
76 now:=1;
77 while now<=length(ans) do
78 begin
79 if not make[now] then
80 begin
81 inc(now);
82 continue;
83 end;
84 start:=now;
85 while make[now] do
86 inc(now);
87 dec(now);
88 for i:=start to now do
89 begin
90 if make[i] then
91 begin
92 swap(ans[i],ans[now-i+start]);
93 make[now-i+start]:=false;
94 end
95 else
96 break;
97 end;
98 end;
99 End; { Main }
100 Begin
101 assign(input,'expand.in');reset(input);
102 assign(output,'expand.out');rewrite(output);
103 Init;
104 Main;
105 Writeln(Ans);
106 close(input);
107 close(output);
108 End.
View Code
1 {边处理边输出 AC}
2 Program Expand(Input,Output);
3 Var
4 S,Ans : Ansistring;
5 P1,P2,P3 : Integer;
6 Procedure Init;
7 Begin
8 Readln(P1,P2,P3);
9 Readln(S);
10 End; { Init }
11 Procedure Main;
12 Var
13 Now : Longint;
14 I : Longint;
15 Ch : Char;
16 Begin
17 Now:=1;
18 While Now<=Length(S) Do
19 Begin
20 If S[Now]<>'-' Then
21 Begin
22 Write(S[Now]);
23 Inc(Now);
24 Continue;
25 End;
26 If S[Now]='-' Then
27 Begin
28 If ((S[Now-1] In ['a'..'z'])And(S[Now+1] In ['a'..'z']))Or((S[Now-1] In ['0'..'9'])And(S[Now+1] In ['0'..'9'])) Then
29 Begin
30 If S[Now-1]>=S[Now+1] Then
31 Begin
32 Write(S[Now]+S[Now+1]);
33 Inc(Now,2);
34 Continue;
35 End;
36 Ans:='';
37 If P3=1 Then
38 Begin
39 For Ch:=Succ(S[Now-1]) To Pred(S[Now+1]) Do
40 For I:=1 To P2 Do
41 Case P1 Of
42 1 : Ans:=Ans+Ch;
43 2 : Ans:=Ans+Upcase(Ch);
44 3 : Ans:=Ans+'*';
45 End; { Case }
46 Write(Ans,S[Now+1]);
47 Inc(Now,2);
48 End
49 Else
50 Begin
51 For Ch:=Pred(S[Now+1]) Downto Succ(S[Now-1]) Do
52 For I:=1 To P2 Do
53 Case P1 Of
54 1 : Ans:=Ans+Ch;
55 2 : Ans:=Ans+Upcase(Ch);
56 3 : Ans:=Ans+'*';
57 End; { Case }
58 Write(Ans,S[Now+1]);
59 Inc(Now,2);
60 End;
61 End
62 Else
63 Begin
64 Write(S[Now]);
65 Inc(Now);
66 Continue;
67 End;
68 End;
69 End;
70 End; { Main }
71 Begin
72 Init;
73 Main;
74 End.
第三题，矩阵取数游戏，在之前一直被我归为比较恶心的题目，是因为它DP时还要加高精度，以前一直是朴素代码（40分），今天下定了决心，终于打掉了它，
动规方程还是要说一下，每行独立这一点大家都看出来了，对于每一行，用f[i,j]表示还剩下i到j这段区间的数没有取，则
f[i,j]=max{f[i-1,j]+a[i-1]*2^(m-j+i-1),f[i,j+1]+a[j+1]*2^(m-j+i-1)},该行的最大值要从所有的f[i,i-1]，f[i+1,i]里面取得，这里很容易出错，因为要把所有的数取完，所以答案是f[i,i]可以推出的状态，显然是f[i,i-1]和f[i+1,i]，而f[i+1,i]=f[(i+1),(i+1)-1],所以只要取所有f[i,i-1]里的最大值就行了。
下面是朴素的AC的代码
View Code
1 program game(input,output);
2 var
3 a : array[0..80,0..80] of qword;
4 f : array[0..80,0..80] of qword;
5 prefixes : array[0..16] of qword;
6 n,m : longint;
7 ans,tmpans,tmp1,tmp2 : qword;
8 procedure init;
9 var
10 i,j : longint;
11 begin
12 readln(n,m);
13 for i:=1 to n do
14 for j:=1 to m do
15 read(a[i,j]);
16 prefixes[0]:=1;
17 for i:=1 to 16 do
18 prefixes[i]:=prefixes[i-1]*2;
19 end; { init }
20 procedure main;
21 var
22 i,j,k : longint;
23 begin
24 ans:=0;
25 tmpans:=0;
26 for k:=1 to n do
27 begin
28 fillchar(f,sizeof(f),0);
29 for i:=1 to m do
30 for j:=m downto 1 do
31 // if i<=j then
32 begin
33 tmp1:=f[i-1,j]+a[k,i-1]*prefixes[m-j+i-1];
34 tmp2:=f[i,j+1]+a[k,j+1]*prefixes[m-j+i-1];
35 if tmp1>tmp2 then
36 f[i,j]:=tmp1
37 else
38 f[i,j]:=tmp2;
39 end;
40 for i:=1 to m do
41 if f[i,i-1]>tmpans then
42 tmpans:=f[i,i-1];
43 ans:=ans+tmpans;
44 tmpans:=0;
45 end;
46 end; { main }
47 procedure print;
48 begin
49 writeln(ans);
50 end; { print }
51 begin
52 assign(input,'game.in');reset(input);
53 assign(output,'game.out');rewrite(output);
54 init;
55 main;
56 print;
57 close(input);
58 close(output);
59 end.
View Code
1 ｛压8位高精度｝
2 Program Game(Input,Output);
3 Type
4 Numbertype = Array[0..5] Of Int64;
5 Var
6 skip : numbertype;
7 Prefixes : Array[0..80] Of Numbertype;
8 Two : Numbertype;
9 F : Array[0..81,0..81] Of Numbertype;
10 A : Array[0..81,0..81] Of Numbertype;
11 N,M : Longint;
12 Tmp1,Tmp2,Tmpans,Ans : Numbertype;
13 Procedure Init;
14 Var
15 I,J : Longint;
16 Begin
17 fillchar(skip,sizeof(skip),0);
18 Readln(N,M);
19 For I:=1 To N Do
20 For J:=1 To M Do
21 Begin
22 A[I,J][0]:=1;
23 Read(A[I,J][1]);
24 End;
25 Fillchar(Two,Sizeof(Two),0);
26 Two[0]:=1;
27 Two[1]:=2;
28 End; { Init }
29 Function Multiply(X,Y :Numbertype ):Numbertype;
30 Var
31 I,J : Longint;
32 Begin
33 Fillchar(Multiply,Sizeof(Multiply),0);
34 For I:=1 To X[0] Do
35 For J:=1 To Y[0] Do
36 Begin
37 Inc(Multiply[I+J-1],X[I]*Y[J]);
38 Inc(Multiply[I+J],Multiply[I+J-1] Div 100000000);
39 Multiply[I+J-1]:=Multiply[I+J-1] Mod 100000000;
40 End;
41 If Multiply[X[0]+Y[0]]>0 Then
42 Multiply[0]:=X[0]+Y[0]
43 Else
44 Multiply[0]:=X[0]+Y[0]-1;
45 End; { Multiply }
46 Function Plus(X,Y :Numbertype ):Numbertype;
47 Var
48 I,Len : Longint;
49 Begin
50 Fillchar(Plus,Sizeof(Plus),0);
51 If X[0]>Y[0] Then
52 Len:=X[0]
53 Else
54 Len:=Y[0];
55 For I:=1 To Len Do
56 Begin
57 Plus[I]:=Plus[I]+X[I]+Y[I];
58 Plus[I+1]:=Plus[I] Div 100000000;
59 Plus[I]:=Plus[I] Mod 100000000;
60 End;
61 If Plus[Len+1]<>0 Then
62 Plus[0]:=Len+1
63 Else
64 Plus[0]:=Len;
65 End; { Plus }
66 Function Binary(X :Numbertype ):Numbertype;
67 Var
68 I : Longint;
69 Begin
70 Fillchar(Binary,Sizeof(Binary),0);
71 Binary:=X;
72 For I:=X[0] Downto 2 Do
73 Begin
74 Binary[I-1]:=Binary[I-1]+(Binary[I] Mod 2)*10;
75 Binary[I]:=Binary[I] Div 2;
76 End;
77 Binary[1]:=Binary[1] Div 2;
78 Binary[0]:=X[0];
79 While (Binary[Binary[0]]=0)And(Binary[0]>0) Do
80 Dec(Binary[0]);
81 End; { Binary }
82 Function Power(X,Y: Numbertype ):Numbertype;
83 Begin
84 Fillchar(Power,Sizeof(Power),0);
85 If Y[0]=0 Then
86 Begin
87 Power[0]:=1;
88 Power[1]:=1;
89 End;
90 If (Y[0]=1)And(Y[1]=1) Then
91 Exit(X);
92 If (Y[0]=1)And(Y[1]=2) Then
93 Exit(Multiply(X,X));
94 Power:=Power(X,Binary(Y));
95 Power:=Multiply(Power,Power);
96 If Odd(Y[1]) Then
97 Power:=Multiply(Power,X);
98 End; { Power }
99 Function Max(Aa,Bb :Numbertype ):Numbertype;
100 Var
101 I : Longint;
102 Begin
103 If Aa[0]>Bb[0] Then
104 Exit(Aa);
105 If Bb[0]>Aa[0] Then
106 Exit(Bb);
107 For I:=Aa[0] Downto 1 Do
108 If Aa[I]>Bb[I] Then
109 Exit(Aa)
110 Else
111 If Bb[I]>Aa[I] Then
112 Exit(Bb);
113 Exit(Aa);
114 End; { Max }
115 Function Change(S: Ansistring ):Numbertype;
116 Var
117 I : Longint;
118 Begin
119 Fillchar(Change,Sizeof(Change),0);
120 Change[0]:=Length(S);
121 For I:=1 To Change[0] Do
122 Change[I]:=Ord(S[Change[0]-I+1])-48;
123 End; { Change }
124 Procedure Previous();
125 Var
126 I : Longint;
127 Begin
128 Prefixes[0][0]:=1;
129 Prefixes[0][1]:=1;
130 For I:=1 To 80 Do
131 Prefixes[I]:=Multiply(Prefixes[I-1],Two);
132 End; { Previous }
133 Procedure Main;
134 Var
135 I,J,K : Longint;
136 Begin
137 For K:=1 To N Do
138 Begin
139 Fillchar(F,Sizeof(F),0);
140 For I:=1 To M Do
141 For J:=M Downto 1 Do
142 Begin
143 Tmp1:=Plus(F[I-1,j],Multiply(A[K,i-1],Prefixes[m-j+i-1]));
144 Tmp2:=Plus(F[I,J+1],Multiply(A[K,j+1],Prefixes[m-j+i-1]));
145 F[I,J]:=Max(Tmp1,Tmp2);
146 End;
147 Fillchar(Tmpans,Sizeof(Tmpans),0);
148 For I:=1 To M Do
149 Tmpans:=Max(F[I,I-1],tmpans);
150 Ans:=Plus(Ans,Tmpans);
151 End;
152 End; { Main }
153 Procedure Print(X: Numbertype );
154 Var
155 I : Longint;
156 Begin
157 Write(X[X[0]]);
158 For I:=X[0]-1 Downto 1 Do
159 Begin
160 Write(X[I] Div 10000000);
161 Write((X[I] Div 1000000) Mod 10);
162 Write((X[I] Div 100000) Mod 10);
163 Write((X[I] Div 10000) Mod 10);
164 Write((X[I] Div 1000) Mod 10);
165 Write((X[I] Div 100) Mod 10);
166 Write((X[I] Div 10) Mod 10);
167 Write((X[I] Mod 10));
168 End;
169 End; { Print }
170 Begin
171 Assign(Input,'game.in');Reset(Input);
172 Assign(Output,'game.out');Rewrite(Output);
173 Init;
174 Previous;
175 Main;
176 Print(Ans);
177 Close(Input);
178 Close(Output);
179 End.
第四题，树网的核，这事实上是一道考察最短路和枚举的算法，合理的话n^4都不会超时，，最简单的思想，先一遍佛洛依德算法，保存最短路长度，在用四重循环枚举直径起点，直径终点，核的起点，核的终点。更新解即可。
View Code
1 (*该题主要考察最短路算法和枚举算法
2 *首先必须明确，偏心距一定是直径端点到核的距离，否则该直径不是最长边，与它是直径相矛盾
3 *不要看数据范围感觉要超时，要知道这道题目的算法复杂度不可能太低，即使感觉超时，也要敢于使用，得十分算十分
4 *由上面的几句话得到算法主流程:floyd求最短路，枚举直径，判断某段路径是否在直径上，求偏心距即可*)
5 Program Core(Input,Output);
6 Var
7 Dist : Array[0..301,0..301] Of Longint;
8 N,S,Ecc,Length : Longint;
9 Procedure Init;
10 Var
11 I,X,Y,W : Longint;
12 Begin
13 Fillchar(Dist,Sizeof(Dist),21);
14 Readln(N,S);
15 For I:=1 To N Do
16 Dist[I,I]:=0;
17 For I:=1 To N-1 Do
18 Begin
19 Readln(X,Y,W);
20 Dist[X,Y]:=W;
21 Dist[Y,X]:=W;
22 End;
23 End; { Init }
24 Procedure Floyd;{先用Floyd暴力求出各个点间的距离，以备后用，注意，不会超时}
25 Var
26 I,J,K : Longint;
27 Begin
28 For K:=1 To N Do
29 For I:=1 To N Do
30 If (I<>K) Then
31 For J:=1 To N Do
32 If (J<>K)And(I<>J) Then
33 If Dist[I,K]+Dist[K,J]<Dist[I,J] Then
34 Dist[I,J]:=Dist[I,K]+Dist[K,J];
35 End; { Floyd }
36 Function Min(Aa,Bb :Longint ):Longint;
37 Begin
38 If Aa<Bb Then
39 Exit(Aa);
40 Exit(Bb);
41 End; { Min }
42 Function Max(Aa,Bb :Longint ):Longint;
43 Begin
44 If Aa>Bb Then
45 Exit(Aa);
46 Exit(Bb);
47 End; { Max }
48 Procedure Main;
49 Var
50 Mid1,Mid2,I,J : Longint;
51 Start,Endd : Longint;
52 Tmpecc : Longint;
53 Begin
54 Length:=0;
55 For I:=1 To N Do
56 For J:=1 To N Do
57 If Dist[I,J]>Length Then {先用两重循环求得直径长度}
58 Length:=Dist[I,J];
59 Ecc:=$fffff;
60 For Start:=1 To N-1 Do {枚举直径起点}
61 For Endd:=Start+1 To N Do {枚举直径终点}
62 If Dist[Start,Endd]=Length Then {判断是否是直径}
63 For Mid1:=1 To N Do
64 If Dist[Start,Mid1]+Dist[Mid1,Endd]=Length Then {枚举直径上的路径起点}
65 For Mid2:=1 To N Do {枚举直径上的路径终点}
66 If (Dist[Start,Mid2]+Dist[Mid2,Endd]=Length)And(Dist[Mid1,Mid2]<=S) Then {该路径可以作为核}
67 Begin
68 Tmpecc:=Max(Min(Dist[Mid1,Start],Dist[Mid2,Start]),Min(Dist[Mid1,Endd],Dist[Mid2,Endd]));
69 If Tmpecc<Ecc Then
70 Ecc:=Tmpecc;
71 End;
72 End; { Main }
73 Procedure Print;
74 Begin
75 Writeln(Ecc);
76 End; { Print }
77 Begin
78 Assign(Input,'Core.In');Reset(Input);
79 Assign(Output,'Core.Out');Rewrite(Output);
80 Init;
81 Floyd;
82 Main;
83 Print;
84 Close(Input);
85 Close(Output);
86 End.