路桥中学信息学竞赛第三次测试参考程序

1、路中信息学竞赛第三次测试参考程序（时间：2007年12月2日星期日：下午1:304:30）再次感谢为本次次考试出题的所有同学：丁磊、陈牡军、夏自远、王少聪，这次题型总体感觉题型新颖、来源于平时练习及改编，质量较高。仍然希望能将好传统延续下去。本次出题同学对照表：丁 磊：高一（3）oi3_1oi3_2oi3_3陈牡军：高一（4）oi3_4oi3_5oi3_6oi3_7夏自远：高一（4）oi3_8oi3_9oi3_10王少聪：高一（5）oi3_11oi3_12下面是我的程序代码，仅供参考，欢迎交流！program oi3_1; 【参考程序】如何分析本题是关键！是道好题var a,b:byte;pr

2、ocedure pull(a,b:byte);var t,a2,b2:byte;begin b2:=13-b; a2:=a-b2; writeln('A:',a,'->',' B:',b:2,'=:',a2); if a2=15 then begin writeln('OK');exit; end else begin if a2>13 then begin writeln('A:',a2,'->',' B:',0:2,'=:',a2

3、-13); a2:=a2-13; end; pull(a,a2); end;end;begin writeln('A:',17,'->','B:',13,'=:?'); a:=17; b:=0; pull(a,b);gram oi3_2; 【参考程序】var i,m,n:longint;function gbs(m,n:longint):longint;var t:longint;begin if m<n then begin t:=m; m:=n; n:=t; end; t:=m; while t mo

4、d n<>0 do inc(t,m); gbs:=t;end;begin read(m); for i:=2 to 5 do begin read(n); m:=gbs(m,n); end; writeln(m);gram oi3_3; 【参考程序】此题做法与oi3_9有相通之处var 为避免思路重复，本题我借用了字串处理，希望大家熟习！ n,d:longint;function check(n,d:longint):boolean;var flag1,flag2:boolean; m,t,len:longint; s1:string; ch:char;begin f

5、lag1:=true; flag2:=false; m:=n; str(n,s1); len:=length(s1); while m>0 do begin t:=m mod 10; delete(s1,len,1); dec(len); if pos(chr(t+48),s1)>0 then begin flag1:=false; break; end; if m mod 10=d then flag2:=true; m:=m div 10; end; if flag1 and flag2 then check:=true else check:=false;end;begin

6、readln(n,d); writeln(check(n,d);gram oi3_4; 【参考程序】var i,j,k,m:longint; flag1,flag2:boolean;function sushu(m:longint):boolean;var i,t:longint; flag:boolean;begin flag:=true; t:=trunc(sqrt(m); for i:=2 to t do begin if m mod i=0 then begin flag:=false; break; end; end; sushu:=flag;end;begin for

7、 i:=3 to 50 do begin m:=2*i; k:=m div 2; for j:=2 to k do begin if sushu(j)and(sushu(m-j)then begin writeln(m:4,'=',j:4,'+',m-j:4); break; end; end; end;gram no3_5; 【参考程序】这道题不错，考思路，要清晰就好做了！var m,i,j,num:longint;function szh(m:longint):longint;var s:longint;begin s:=0; while m&

8、gt;0 do begin s:=s+m mod 10; m:=m div 10; end; szh:=s;end;function hs(m:longint):boolean;var i,t:longint; flag:boolean;begin t:=trunc(sqrt(m); flag:=false; for i:=2 to t do if m mod i=0 then begin flag:=true; break; end; hs:=flag;end;function zyz(m:longint):longint;var i,j,k,s:longint;begin j:=2; s:

9、=0; repeat while m mod j=0 do begin inc(s,szh(j); m:=m div j; end; inc(j); until j>m; zyz:=s;end;begin num:=0; for i:=4 to 500 do begin if hs(i) then begin if szh(i)=zyz(i) then begin inc(num); write(i:4); if num mod 5=0 then writeln; end; end; end;gram oi3_6; 【参考程序】var n:longint; x:real;f

10、unction fxn(x:real;n:longint):real;begin if n=1 then fxn:=1 else fxn:=x*fxn(x,n-1);end;begin readln(x,n); writeln(fxn(x,n):0:2);gram oi3_7; 【参考程序】var i,j,k,n:longint;procedure sini;var i:longint; sin1,cos1,sini,cosi:real;begin sin1:=0.000290888; cos1:=sqrt(1-sin1*sin1); sini:=sin1; cosi:=cos1

11、; for i:=2 to 5400 do begin if i mod 2=0 then writeln; sini:=sin1*cosi+cos1*sini; write(sini:0:10,' '); cosi:=sqrt(1-sini*sini); end;end;begin sini;gram oi3_8; 【参考程序】var n,num,i:longint;function hesu(m:longint):boolean;begin if (m mod 2=0)or(m mod 3=0)or(m mod 5=0) then hesu:=true els

12、e hesu:=false;end;begin readln(n); i:=6; num:=1; if n>=num then write(4,' '); while num<n do begin if hesu(i) then begin inc(num); write(i,' '); end; inc(i); end; writeln;gram oi3_9; 【参考程序】var n:longint;function f(m:longint):boolean;begin if m div 10>0 then f(m div 10

13、); if (m mod 10)=(n mod 10)then n:=n div 10 else begin f:=false; exit; end; f:=true;end;begin readln(n); writeln(f(n);gram oi3_10; 【参考程序】直接找归律是一种高效办法，是一道好题var n:longint;procedure f(n:longint);var i,j,k,t,stp,stp2:longint;begin j:=1; stp:=2; for i:=1 to n do begin inc(j,i-1); k:=0; t:=j; stp2:

14、=stp; repeat write(t:4); inc(k); inc(t,stp2); inc(stp2); until k>n-i; writeln; inc(stp); end;end;begin readln(n); f(n);gram oi3_11; 【参考程序】本题没有画图，可分为两角与夹边或对边分别处理var 不过情况差别不大，简单画图可能就知道了，能考点数学，很好！ a,b,c,m,m1,s,s1:real;begin readln(a,b,m); c:=180-a-b; a:=a*pi/180; c:=c*pi/180; b:=b*pi/180; m1:

15、=m*sin(a)/sin(c); s:=1/2*m*m1*sin(b); writeln(s:10:2);gram oi3_12; 【参考程序】var n,i,j,num:longint;function hs(m:longint):boolean;var i,t:longint; flag:boolean;begin t:=trunc(sqrt(m); flag:=false; for i:=2 to t do if m mod i=0 then begin flag:=true; break; end; hs:=flag;end;begin readln(n); num:=

16、0; j:=4; repeat if hs(j) then inc(num) else num:=0; inc(j); until num>=n; for i:=j-n to j-1 do write(i:8);gram oi3bc_1; 【参考程序】var n,a,b,c,num:longint;procedure move(n,a,b,c:longint);begin inc(num); if n=1 then writeln(a,'->',c) else begin move(n-1,a,c,b); writeln(a,'->',c); move(n-1,b,a,c); end;end;begin num:=0; readln(n); move(n,1,2,3); writeln(num); 2