pascal100练习题

Pascal练习题100道

1 题目：有1、2、3、4个数字，能组成多少个互不相同且无重复数字的三位数？都是多少？ var i,j,a,b,c:integer; begin

for i:=1 to 4 do for j:=1 to 4 do for a:=1 to 4 do for b:=1 to 4 do begin

if (i<>j) and (i<>a) and (i<>b) and (j<>a) and (j<>b) and (a<>b) then writeln(i,j,a,b); end; end.

2 题目：企业发放的奖金根据利润提成。利润(i)低于或等于10万元时，奖金可提10%；利润高于10万元，低于20万元时，低于10万元的部分按10%提成，高于10万元的部分，可可提成7.5%；20万到40万之间时，高于20万元的部分，可提成5%；40万到60万之间时高于40万元的部分，可提成3%；60万到100万之间时，高于60万元的部分，可提成1.5%，高于100万元时，超过100万元的部分按1%提成，从键盘输入当月利润i，求应发放奖金总数？ var

a:longint; s:real; begin readln(a);

if a<100000 then s:=a*0.1; if a>100000 then begin

if (a>100000) and (a<=200000) then s:= s + (a-100000)*0.075 + 100000*0.1;

if (a>200000) and (a<=400000) then s:=s+(a-200000)*0.05+100000*0.1+100000*0.075; if (a>400000) and (a<=600000) then s:=s+(a-400000)*0.03+100000*0.1+200000*0.05; if (a>600000) and (a<=1000000) then

s:=s+(a-600000)*0.015+100000*0.1+200000*0.05+200000*0.03; if (a>1000000) then

s:=s+(a-1000000)*0.01+100000*0.1+200000*0.05+200000*0.03+400000*0.015; end;

writeln(s:5:2); end.

3 题目：一个整数，它加上100后是一个完全平方数，再加上168又是一个完全平方数，请问该数是多少？ var i:longint; a,b:real; begin

for i:=1 to 1000000 do

begin

a:=sqrt(i+100); b:=sqrt(i+268);

if ((a*a)=(i+100)) and ((b*b)=(i+268)) then writeln(i); end; end.

4 题目：输入某年某月某日，判断这一天是这一年的第几天？ var a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a,b,c,d:integer; begin

read(a,b,c);

a1:=0;a2:=31;a3:=59;a4:=90;a5:=120;a6:=151;a7:=181;a8:=212;a9:=243;a10:=273;a11:=304;a12:=334;

if (b=1) then d:=a1 else if (b=2) then d:=a2 else if (b=3) then d:=a3 else if (b=4) then d:=a4 else if (b=5) then d:=a5 else if (b=6) then d:=a6 else if (b=7) then d:=a7 else if (b=8) then d:=a8 else if (b=9) then d:=a9 else if (b=10) then d:=a10 else if (b=11) then d:=a11 else if (b=12) then d:=a12; d:=d+c;

if (a mod 1000=0) and (c mod 400=0) and (b>3) then d:=d+1; if (a mod 1000<>0) and (c mod 4=0) and (b>3) then d:=d+1; writeln(d); end.

5 题目：输入三个整数x,y,z，请把这三个数由小到大输出。 var a,b,c,d:integer; begin

readln(a,b,c);

if a>b then begin d:=a;a:=b;b:=d; end; if a>c then begin d:=a;a:=c;c:=d; end; if b>c then begin d:=b;b:=c;c:=d; end; writeln(a,b,c); end.

6 题目：用*号输出字母c的图案。 begin

writeln(' ***');

writeln(' * '); writeln('* '); writeln('* '); writeln(' * '); writeln(' ***'); end.

7 题目：输出9*9口诀。 var i,j:integer; begin

for i:=1 to 9 do begin

for j:=1 to 9 do begin

write(j,'*',i,'=',j*i,' '); end; writeln; end; end.

8 题目：有一对兔子，从出生后第3个月起每个月都生一对兔子，小兔子长到第三个月后每个月又生一对兔子，假如兔子都不死，问每个月的兔子总数为多少？ var a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12:integer; begin

a1:=1;writeln(a1); a2:=1;writeln(a2); a3:=a1+a2;writeln(a3); a4:=a2+a3;writeln(a4); a5:=a3+a4;writeln(a5); a6:=a4+a5;writeln(a6); a7:=a5+a6;writeln(a7); a8:=a6+a7;writeln(a8); a9:=a7+a8;writeln(a9); a10:=a8+a9;writeln(a10); a11:=a9+a10;writeln(a11); a12:=a10+a11;writeln(a12); end.

9 题目：输出所有101-200之间的素数。 var n,i,a:integer; p:boolean; begin n:=200;

for a:=101 to n do

begin p:=true;

for i:=2 to trunc(sqrt(a))+1 do if a mod i=0 then begin p:=false; break end;

if p=true then write(a:4); end; end.

10 题目：打印出所有的“水仙花数”，所谓“水仙花数”是指一个三位数，其各位数字立方和等于该数本身。例如：153是一个“水仙花数”，因为153=1的三次方＋5的三次方＋3的三次方。

var a,b,c,i:integer; begin

for i:=100 to 999 do begin

a:=i div 100;

b:=(i div 10) mod 10; c:=i mod 10;

if a*a*a+b*b*b+c*c*c=i then writeln(i); end; end.

11 题目：将一个正整数分解质因数。例如：输入90,打印出90=1*2*3*3*5。 var n,i:integer; begin

write('please input the number:'); read(n);

write(n,'=',1); i:=1; repeat inc(i);

while n mod i=0 do begin

n:=n div i; write('*',i); end; until n=1; end.

12 题目：利用条件运算符的嵌套来完成此题：学习成绩>=90分的同学用a表示，60-89分之间的用b表示，60分以下的用c表示。

var a:integer; begin readln(a);

if a>=90 then writeln('a') else

if (a>=60) and (a<=89) then writeln('b') else writeln('c'); end.

13 题目：输入两个正整数m和n，求其最大公约数和最小公倍数。 var a,b,ans,c:longint;

function gcd(a,b:longint):longint; begin

if b=0 then gcd:=a

else gcd:=gcd(b,a mod b); end;

function lcm(a,b:longint):longint; begin

lcm:=a*b div gcd(a,b); end; begin read(a,b); c:=gcd(a,b); writeln(c); ans:=lcm(a,b); writeln(ans); end.

14 题目：输入一行字符，分别统计出其中英文字母、空格、数字和其它字符的个数。 var a:string;

b:array[1..200]of integer; t,i,z,h,f:integer; begin read(a); t:=length(a); for i:=1 to t do begin

b:=ord(a);

if (b>=65) and (b<=90) then z:=z+1 else if (b>=97) and (b<=122) then z:=z+1 else

if (b>=48) and (b<=57) then h:=h+1 else f:=f+1; end;

writeln(z,' ',h,' ',f); end.

15 题目：求s=a+aa+aaa+aaaa+aa...a的值，其中a是一个数字。例如2+22+222+2222+22222(此

时共有5个数相加)，几个数相加有键盘控制。 var a,s,b,i,z:longint; begin

readln(a,b); s:=a;

for i:=1 to b-1 do begin a:=a*11; z:=a; end; z:=z+s; writeln(z); end.

16 题目：一个数如果恰好等于它的因子之和，这个数就称为“完数”。例如6=1＋2＋3.编程找出1000以内的所有完数。 var

m,i,n,t:integer; begin

for n:=1 to 100 do begin

t:=0;

for i:=2 to n do if ((n mod i)=0) then t:=t+(n div i); if (t=n) then write(n,' '); end; end.

17 题目：一球从100米高度自由落下，每次落地后反跳回原高度的一半；再落下，求它在第10次落地时，共经过多少米？第10次反弹多高？ var a,i,b:integer; begin a:=100;

for i:=1 to 10 do begin

b:=a div 2; a:=a div 2; writeln(b); end; end.

18 题目：猴子吃桃问题：猴子第一天摘下若干个桃子，当即吃了一半，还不瘾，又多吃了一个第二天早上又将剩下的桃子吃掉一半，又多吃了一个。以后每天早上都吃了前一天剩下

的一半零一个。到第10天早上想再吃时，见只剩下一个桃子了。求第一天共摘了多少。 var i,x1,x2:integer; begin

for i:=1 to 10 do begin

x1:=(x2+1)*2; x2:=x1; end;

writeln(x2); end.

19 题目：两个乒乓球队进行比赛，各出三人。甲队为a,b,c三人，乙队为x,y,z三人。已抽签决定比赛名单。有人向队员打听比赛的名单。a说他不和x比，c说他不和x,z比，请编程序找出三队赛手的名单。 var

i,h,e:char; begin

for i:='x' to 'z' do

if (i<>'x') and (i<>'z') then begin writeln('c',i);h:=i; end; for i:='x' to 'z' do

if (i<>'x') and (i<>h) then begin writeln('a',i);e:=i; end; for i:='x' to 'z' do

if (i<>h) and (i<>e) then writeln('b',i); end.

20 题目：打印出如下图案（菱形） * *** ****** ******** ****** *** * begin

writeln('*'); writeln('***'); writeln('******'); writeln('********'); writeln('******'); writeln('***'); writeln('*'); end.

21 题目：有一分数序列：2/1，3/2，5/3，8/5，13/8，21/13...求出这个数列的前20项之和。

var a,b,c,t:real; i:integer; begin a:=2; b:=1;

for i:=1 to 20 do begin c:=c+a/b;

t:=a;a:=a+b;b:=t; end;

writeln(c); end.

22 题目：求1+2!+3!+...+20!的和 var i,j,a:longint; t,c:int64; begin

for i:=1 to 20 do begin t:=1;

for j:=1 to i do begin t:=t*j; end; c:=c+t; end; writeln(c); end.

23 题目：利用适当方法求5! 。 var a,j:longint; t,c:int64; begin t:=1;

for j:=1 to 5 do begin t:=t*j; end; c:=c+t; writeln(c); end.

24 题目：将输入5个字符，以相反顺序打印出来。 var a:array[1..5] of char;

i:integer; begin

for i:=1 to 5 do readln(a);

for i:=5 downto 1 do writeln(a); end.

25 题目：有5个人坐在一起，问第五个人多少岁？他说比第4个人大2岁。问第4个人岁数，他说比第3个人大2岁。问第三个人，又说比第2人大两岁。问第2个人，说比第一个人大两岁。最后问第一个人，他说是10岁。请问第五个人多大？ var a,i:longint; begin a:=10;

for i:=1 to 4 do a:=a+2; writeln(a); end.

26 题目：给一个不多于5位的正整数，要求：一、求它是几位数，二、逆序打印出各位数字。

var a,c,d1,d2,d3,d4,d5:longint; begin readln(a);

if a<10 then begin c:=1;writeln('1'); end else

if (a>=10) and (a<100) then begin c:=2;writeln('2'); end else if (a>=100) and (a<1000) then begin c:=3;writeln('3'); end else if (a>=1000) and (a<10000) then begin c:=4;writeln('4'); end else if a>=10000 then begin c:=5;writeln('5'); end; if c=5 then begin

d1:=a mod 10;a:=a div 10; d2:=a mod 10;a:=a div 10; d3:=a mod 10;a:=a div 10; d4:=a mod 10;a:=a div 10; d5:=a;

writeln(d1,d2,d3,d4,d5); end;

if c=4 then begin

d1:=a mod 10;a:=a div 10; d2:=a mod 10;a:=a div 10; d3:=a mod 10;a:=a div 10; d4:=a;

writeln(d1,d2,d3,d4); end;

if c=3 then begin

d1:=a mod 10;a:=a div 10; d2:=a mod 10;a:=a div 10; d3:=a;

writeln(d1,d2,d3); end;

if c=2 then begin

d1:=a mod 10;a:=a div 10; d2:=a;

writeln(d1,d2); end;

if c=1 then writeln(a); end.

27 题目：一个5位数，判断它是不是回文数。即12321是回文数，个位与万位相同，十位与千位相同。

var a,b1,b2,b3,b4,b5:longint; begin readln(a);

b1:=a mod 10;a:=a div 10; b2:=a mod 10;a:=a div 10; b3:=a mod 10;a:=a div 10; b4:=a mod 10;a:=a div 10; b5:=a;

if (b1=b5) and (b2=b4) then writeln('yes') else writeln('no'); end.

28 题目：请输入星期几的第一个字母来判断一下是星期几，如果第一个字母一样，则继续判断第二个字母…… var a,b,c:char; begin readln(a);

if (a='m') or (a='w') or (a='f') then begin

if a='m' then writeln('1') else if a='w' then writeln('3') else if a='f' then writeln('5'); end else begin

readln(b);

if (b='h') or (b='a') then begin

if b='h' then writeln('4') else if b='a' then writeln('6'); end else begin readln(c);

if (c='e') or (c='n') then begin

if c='e' then writeln('2') else if c='n' then writeln('7'); end; end; end; end.

29 题目：求100之内的素数 var n,i,a:integer; p:boolean; begin n:=100;

for a:=3 to n do begin p:=true;

for i:=2 to trunc(sqrt(a))+1 do if a mod i=0 then begin p:=false; break end;

if p=true then write(a:4); end; end.

30 题目：对10个数进行排序 插入排序 const n=10;

var a:array[1..n] of integer; i,j,k,t:integer; begin

write('Enter date:'); for i:= 1 to n do read(a); writeln;

for i:=2 to n do

begin

k:=a;j:=i-1;

while (k0) do begin a[j+1]:=a[j];j:=j-1 end; a[j+1]:=k; end;

write('output data:');

for i:= 1 to n do write(a:6); writeln; end.

冒泡排序 const n=10;

var a:array[1..n] of integer; i,j,k,t:integer; begin

write('Enter date:'); for i:= 1 to n do read(a); for i:=1 to n -1 do

for j:=n downto i+1 do if a[j-1]

begin t:=a[j-1];a[j-1]:=a[j];a[j]:=t end; write('output data:');

for i:= n downto 1 do write(a:6); writeln; end.

选择排序 const n=10;

var a:array[1..n] of integer; i,j,k,t:integer; begin

write('Enter date:'); for i:= 1 to n do read(a); writeln;

for i:=1 to n-1 do begin k:=i;

for j:=i+1 to n do

if a[j]i then

begin t:=a;a:=a[k];a[k]:=t;end; end;

write('output data:');

for i:= 1 to n do write(a:6); writeln;

end.

31 题目：某校0602班要进行篮球比赛，分成了3组，分别进行3轮比赛（每轮比赛的组与组之间，不能相同，且不能重复）请用编程写出。 var i,j,a,b,c:integer; begin

for i:=1 to 3 do begin

writeln('di',i,'luen'); for j:=1 to 3 do for a:=1 to 3 do for b:=1 to 3 do begin

if (j<>a) and (j<>b) and (a<>b) then writeln(j,a,b); end; end; end.

32 题目：有一个已经排好序的数组。现输入一个数，要求按原来的规律将它插入数组中。 const n=11;

var a:array[1..n] of integer; i,j,k,t:integer; begin

write('Enter date:'); for i:= 1 to n do read(a); writeln;

for i:=2 to n do begin

k:=a;j:=i-1;

while (k0) do begin a[j+1]:=a[j];j:=j-1 end; a[j+1]:=k; end;

write('output data:');

for i:= 1 to n do write(a:6); writeln; end.

33 题目：将一个数组逆序输出。 const n=10;

var i:integer; z:array[1..n] of integer; begin

for i:=1 to n do read(z);

writeln;

for i:=n downto 1 do write(z:6); end.

34 题目：取一个整数a从右端开始的4～7位。 var a:string; b:integer;

z,a1,a2,a3,a4:longint; begin readln(a); b:=length(a);

writeln(copy(a,4,4)); end.

35 题目：打印出杨辉三角形（要求打印出10行如下图） 程序分析： 1 1 1 1 2 1 1 3 3 1 1 4 6 4 1

1 5 10 10 5 1 const n=10; var i,j:integer;

f:array[1..1000,1..1000] of integer; begin

for i:=1 to n do begin for j:=1 to i do begin

if (j=1) or (j=i) then f:=1 else f:=f+f; write(f,' '); end; writeln; end; end.

36 题目：将一个数组的第一个数与最后一个数进行交换，输出结果。 const n=10;

var i,b,c:integer; a:array[1..n] of integer; begin

for i:=1 to n do readln(a); b:=a[n];

c:=a[1]; a:=b; a[n]:=c;

for i:=1 to n do writeln(a); end.

37 题目：有n个人围成一圈，顺序排号。从第一个人开始报数（从1到3报数），凡报到3的人退出圈子，问最后留下的是原来第几号的那位。 var a:array[1..100] of 0..1; m,n,i,s,p:integer; begin

write('input m,n:');readln(m,n); for i:=1 to m do a:=1; s:=0;p:=0; repeat i:=1;

while i

if s=n then begin

s:=0;a:=0;inc(p); writeln('NO.',p,' ',i); end; inc(i); end; until p=m; end.

38 题目：输入，输出5个学生的数据记录。 var z:array[1..5] of string; i:integer; begin

for i:=1 to 5 do readln(z);

for i:=1 to 5 do writeln(z); end.

39 题目：有n个整数，使其前面各数顺序向后移m个位置，最后m个数变成最前面的m个数。 var

a:array[1..10000] of integer; i,h,n,m:integer;

begin

readln(n,m); for i:=1 to n do read(a); h:=a[n-m]; a[n-m]:=a[m]; a[m]:=h;

for i:=1 to n do writeln(a); end.

40 题目：编写一个程序，输入n为偶数时，求1/2+1/4+...+1/n,当输入n为奇数时，求1/1+1/3+...+1/n。 var n,i,h:integer;d:real; begin readln(n);

if n mod 2=0 then begin

h:=n div 2; for i:=1 to h do d:=1/(i*2)+d; end;

if n mod 2<>0 then begin

h:=n div 2; for i:=1 to h do d:=1/(i*2+1)+d; end;

writeln(d); end.

41 题目：找到年龄最大的人，并输出。 var a:array[1..100] of integer; n,z,i:integer; begin readln(n);

for i:=1 to n do readln(a);

for i:=1 to n do if z

42 题目：字符串排序。

var a,b,c,d:string; begin readln(a); writeln; readln(b); writeln; readln(c); writeln;

if a>b then begin d:=a;a:=b;b:=d; end; if a>c then begin d:=a;a:=c;c:=d; end; if b>c then begin d:=b;b:=c;c:=d; end; writeln(a,' ',b,' ',c); end.

43 题目：海滩上有一堆桃子，五只猴子来分。第一只猴子把这堆桃子凭据分为五份，多了一个，这只猴子把多的一个扔入海中，拿走了一份。第二只猴子把剩下的桃子又平均分成五份，又多了一个，它同样把多的一个扔入海中，拿走了一份，第三、第四、第五只猴子都是这样做的，问海滩上原来最少有多少个桃子？ var a,i:integer; begin a:=1;

for i:=1 to 5 do a:=a*5+1; writeln(a); end.

44 题目：八进制转换为十进制。 var s1,n,i,sum,s:integer; a:array [1..10] of integer; begin

readln(s1); while s1>0 do begin n:=n+1;

a[n]:=s1 mod 10; s1:=s1 div 10; end; s:=1;

for i:=1 to n do begin

sum:=sum+a*s; s:=s*8; end;

writeln(sum);

end.

45 题目：求0—7所能组成的奇数个数。 var i,j,a,b,c,d,f,z,h:longint; begin

for i:=1 to 7 do for j:=0 to 7 do for a:=0 to 7 do for b:=0 to 7 do for c:=0 to 7 do for d:=0 to 7 do for f:=0 to 7 do begin

z:=i*1000000+j*100000+a*10000+b*1000+c*100+d*10+f; if z mod 2 <>0 then h:=h+1; end; writeln(h); end.

46 题目：判断一个素数能被几个9整除。 var a,b,n,c:longint; begin readln(n); b:=0;

while n mod 9=0 do begin

b:=b+1;n:=n div 9; end;

writeln(b); end.

47 题目：两个字符串连接程序。 var a,b:string; begin readln(a); writeln; readln(b); writeln;

a:=concat(a,b); writeln(a); end.

48 题目：某个公司采用公用电话传递数据，数据是四位的整数，在传递过程中是加密的，加密规则如下：每位数字都加上5,然后用和除以10的余数代替该数字，再将第一位和第四

位交换，第二位和第三位交换。 var a,a1,a2,a3,a4:integer; begin readln(a); a:=a+5555;

a1:=a mod 10;a:=a div 10; a2:=a mod 10;a:=a div 10; a3:=a mod 10;a:=a div 10; a4:=a mod 10; write(a4,a3,a2,a1) end.

49 题目：打印出以下图形 ***** ***** ***** begin

writeln('*****':8); writeln('*****':7); writeln('*****':6); end.

50 题目：打印出以下图形 # ## ### begin

writeln('#'); writeln('##'); writeln('###'); end.

51题目：输入一个四位数，以相反的顺序打印出来 var a,b,c,d,e:integer; begin readln(e);

a:=e mod 10;e:=e div 10; b:=e mod 10;e:=e div 10; c:=e mod 10;e:=e div 10; d:=e;

write(a,b,c,d); end.

52题目：输入一整形数字，编写程序判断是否大于10。 var a:integer; begin readln(a);

if a<10 then writeln('a<10'); if a>10 then writeln('a>10'); if a=10 then writeln('a=10'); end.

53题目：求100+97+……+10+7+4+1之和 var i,a:integer; begin

for i:=1 to 33 do a:=a+i*3+1; writeln(a); end.

54题目：某人想将一张面值为100元的人民币兑换成5元，1员，和0.5元面值的纸币,但要求零钱总数为100张,且每种面值纸币至少一张. var i,j,a:integer; begin

for i:=1 to 20 do for j:=1 to 100 do for a:=1 to 200 do

if (i+j+a=100) and (i*5+j*1+a*0.5=100) then writeln(i,' ',j,' ',a); end.

55题目：利用递归，编写一个求N！的程序。 var n:integer; x:longint;

function fct(t:longint):longint; begin if t=0 then fct:=1 else

fct:=t*fct(t-1); end; begin readln(n); x:=fct(n); writeln(x); end.

56（菲波纳契数列）题目：有一对雌雄兔子，假定两个月便可以繁殖雌雄各一对兔子。问n

各月后共有多少对兔子？（递归实现） var n:integer;

function fa(n:integer):integer; begin

if n<3 then fa:=1

else fa:=fa(n-1)+fa(n-2); end; begin

write('n=');readln(n);

writeln('The number of the rabbits:',fa(n)); end.

57（牛顿楼梯问题）题目：梯有N阶，上楼可以一步上一价，也可以一次上二阶。编一个程序，计算共有多少种不同的走法。（递归实现） var n:integer;

function s(n:integer):longint; begin

if (n=1)or(n=2) then s:=n else s:=s(n-1)+s(n-2); end; begin repeat

write('N=');readln(n); until n>0;

writeln('s=',s(n)); readln; end.

58题目：设计一个过程,计算圆的面积.在主程序中输入一个半径,然后调用过程,并输出圆的面积

var i:integer; a:real;

function f(t:integer):real; begin

f:=pi*(t*t); end; begin readln(i); a:=f(i);

writeln(a:10); end.

59题目：从键盘上输入一串英文字母，以#为结束标志，逆序输出 procedure ch;

var c:char; begin readln(c); if c<>'#' then ch; write(c); end; begin ch; end.

60题目:编程求出下式中N的最大值:2^2+4^2+6^2+...+n^6<1500. var c,a,d:longint; begin

while a<1500 do begin

a:=(2+c)*(2+c)+a; c:=c+2; d:=d+1; end;

writeln(d); end.

61题目:输入一个时间的秒数,分别将其转换成时,分,秒 var a,b,c:longint; begin readln(a); b:=0;c:=0;

if a>=3600 then begin

b:=a div 3600;a:=a mod 3600; end;

if a>=60 then begin

c:=a mod 60;a:=a mod 60; end;

writeln(b,' ',c,' ',a); end.

62题目:输入一个正方形的边长,输出它的面积和周长 var a:longint; begin readln(a); writeln(4*a);

writeln(a*a); end.

63题目:华氏转摄氏 var f,c:real; begin readln(f); f:=f-32; c:=f*5/9; writeln(c); end.

64题目:输入一个数,返回它的平方和立方 var a:longint; begin readln(a); writeln(a*a); writeln(a*a*a); end.

65题目:将字母'A','B','C','D'分别转换成1,2,3,4,其他的字符转换成5 var a:char; begin readln(a); case a of

'A' : writeln('1'); 'B' : writeln('2'); 'C' : writeln('3'); 'D' : writeln('4'); else writeln('5'); end; end.

66题目：输入十个学生的姓名，将他们用字典排序（快速排序） var i:longint;

a:array[1..10] of string;

procedure kuai(l, r: longint); var

i, j: longint; k,t:string; begin i := l; j := r;

k := a[(i+j) div 2];

repeat

while k < a do inc(i); while k > a[j] do dec(j); if i<= j then begin t := a; a := a[j]; a[j] := t; inc(i); dec(j); end; until i > j;

if i < r then kuai(i,r); if l < j then kuai(l,j); end;

begin

for i:=1 to 10 do readln(a); kuai(1,10);

for i:=1 to 10 do writeln(a); end.

67题目：读入10个数，输出偶数项，并打印它们之和，输出奇数项，并打印它们之和 var i,n,j,k,z,h:longint; a,b:array[1..10] of integer; begin j:=1;k:=1;

for i:=1 to 10 do begin readln(n);

if n mod 2=0 then begin a[j]:=n;j:=j+1; end else b[j]:=n;k:=k+1; end;

for i:=1 to 10 do begin z:=a+z; h:=b+h; end;

writeln(z); writeln(h); end.

68题目：使用快速排序,使N个数降序和升序分别排序 数据规模:n小于10000;

var i,n:longint;

a:array[1..10000] of longint; procedure kuai(l, r: longint); var

i,j,k,t: longint; begin i := l; j := r;

k := a[(i+j) div 2]; repeat

while k < a do inc(i); while k > a[j] do dec(j); if i<= j then begin t := a; a := a[j]; a[j] := t; inc(i); dec(j); end; until i > j;

if i < r then kuai(i,r); if l < j then kuai(l,j); end; begin readln(n);

for i:=1 to n do readln(a); kuai(1,n);

for i:=1 to n do writeln(a);

for i:=n downto 1 do writeln(a); end.

69题目：给出三角形的三个边长为a，b，c，求三角形的面积。 提示：根据海伦公式来计算三角形的面积： S＝ ；Area＝

var a,b,c,s,x,area:real; begin

write('Input a,b,c:');readln(a,b,c);

if (a>0) and (b>0) and (c>0) and (a+b>c)and(a+c>b)and(b+c>a) then begin s:=(a+b+c)/2; x:=s*(s-a)*(s-b)*(s-c);

if x>=0 Then begin area:=sqrt(x);writeln('Area=',area:8:5); end; end

else writeln('Input error!') end.

70题目：试编写一个根据用户键入的两个操作数和一个运算符，由计算机输出运算结果的程序。这里只考虑加（＋）、减（－）、乘（＊）、除（／）四种运算。 var x,y,n:real; o:char; begin

readln(x,y); readln(o); case o of '+':n:=x+y; '-':n:=x-y; '*':n:=x*y; '/':n:=x/y; end;

writeln(n:6:2); end.

71题目:编一个“念数字”的程序，它能让计算机完成以下工作：当你输入一个０至99之间的数后，计算机就会用汉字拼音印出这个数的念结束。 var x,a,b:integer;

procedure read1(n:integer); begin case n of

0:write('ling'); 1:write('yi'); 2:write('er'); 3:write('san'); 4:write('si'); 5:write('wu'); 6:write('liu'); 7:write('qi'); 8:write('ba'); 9:write('jiu'); end; end;

begin readln(x);

if (x>=0) and (x<=9) then read1(x); end.

72题目：编写一个堆上浮的程序

var ed,k,i:longint;

a:array[1..20] of integer; procedure heapup (i:longint); var

j,t:longint; begin

j:=i div 2;

while (a[j]

j:=i div 2; end; end; begin

readln(ed);

for i:=1 to ed do read(a); heapup(9);

for i:=1 to ed do write(a:4); end.

73题目：编写一个堆下沉的程序 var ed,k,i:longint;

a:array[1..20] of integer;

procedure heapdown(i:longint); var

j,x:longint; begin j:=i*2;

while j<=ed do begin

if (j

else j:=maxlongint; end; end;begin readln(ed);

for i:=1 to ed do read(a);

heapdown(1); for i:=1 to ed do write(a:4); end.

74题目：用堆的方式对数据进行排序 var ed,k,i,n,t,j:longint; a,b:array[1..20] of integer;

procedure heapdown(i:longint); var

j,x:longint; begin j:=i*2;

while j<=ed do begin

if (j

else j:=maxlongint; end; end;

begin

readln(ed); t:=ed;

for i:=1 to ed do read(a);

for i:= ed div 2 downto 1 do heapdown(i); for i:=1 to t do begin b:=a[1];

a[1]:=a[ed]; dec(ed);

heapdown(1); end;

for i:=1 to t do write(b:4); end.

75题目：建堆 var ed,k,i:longint;

a:array[1..20] of integer;

procedure heapdown(i:longint); var

j,x:longint; begin j:=i*2;

while j<=ed do begin

if (j

else j:=maxlongint; end; end;

begin

readln(ed);

for i:=1 to ed do read(a);

for i:= ed div 2 downto 1 do heapdown(i); for i:=1 to ed do write(a:4); end.

76题目：在原有堆中插入数据 var ed,k,i:longint;

a:array[1..20] of integer; procedure heapup (i:longint);

var

j,t:longint; begin

j:=i div 2;

while (a[j]

j:=i div 2; end; end;

begin

readln(ed);

for i:=1 to ed do read(a); readln(x); inc(ed); a[ed]:=x; heapup(ed); for i:=1 to ed do write(a:4); end.

77题目：从键盘输入4个数字a,b,c,d,编程输出由这4个数字组成的最大整数,和最小整数. var a:array[0..4] of 0..9; i,t,j:longint; begin

for i:=1 to 4 do read(a);

for i:=1 to 4 -1 do for j:=4 downto i+1 do if a[j-1]

begin t:=a[j-1];a[j-1]:=a[j];a[j]:=t end; if a[1]<>0 then begin

writeln(a[1],a[2],a[3],a[4]); end else begin

writeln(a[2],a[1],a[3],a[4]); end;

writeln(a[4],a[3],a[2],a[1]); end.

78题目：小猪喜欢吃苹果。猪妈妈想考考小猪，让小猪一次性的把最大的苹果选主来。你能帮帮小猪么？

说明：输入苹果数n和每个苹果的质量，打印最大的苹果质量和第一次出现的位置。 var max,n,i:longint;

a:array[0..10000] of longint; begin readln(n);

for i:=1 to n do begin read(a);

if a>max then max:=a; end;

for i:=1 to n do if a=max then begin

writeln(i); writeln(a); break; end; end.

79题目：现在你为班级编程实现统计“学生的学期积分”程序！规则如下：每人的基本分为100分，表扬一次加10分，批评一次扣5分，且批评次超过4次的扣40分。现在要求输入某学生的姓名、表扬次数、批评次数，程序运行输出学生的姓名和总等分！ var name:string; a,b,c,d:longint; begin

readln(name); readln(a,b); c:=100; c:=c+a*10;

if b>4 then c:=c+a*5 else c:=c-40; writeln(name,c:10); end.

80题目：某化肥厂1999年生产化肥3886万吨，该厂计划年增长率为10%，编程计算2005年生产多少吨化肥？ var n,i:integer; t:real; begin n:=2005; t:=3886;

for i:=2000 to n do

t:=t*1.1;

writeln(t*10000:5:5); end.

81题目：现有100元钱存入银行，一年期利息为8%，每年到期时，将本息取出重新存入，这样过n年后本息为多少？ var n,i:integer; m:real; begin read(n); m:=100;

for i:=1 to n do m:=m*1.08; writeln(m:5:2); end.

82题目：输入a,b两个变量，输出a*b,(a+b)*(a-b)； var a,b:integer; begin read(a,b);

writeln(a*b,' ',(a+b)*(a-b)); end.

83题目：国际象棋盘中，第1格中放1粒米，第2格中放2粒米，第3格中放4粒米，第4格中放8粒米，第5格中放16粒米......问：16个格子总共可以放多少粒米？ （第i个格子：2的（i-1)次方） const n=16; var x,p,i:longint; begin

write('x=');readln(x); p:=x;

for i:=1 to n-1 do p:=p*p; writeln(x,'^',n,'=',p); end.

84题目：随机生成100个一百以内的数 var

i:longint; begin

randomize;

for i:=1 to 100 do begin

write(random(100),' '); end; end.

85题目：任意输入三个字母，判定其在字母表中是否相邻 var

a:array [1..3]of char; procedure init; begin

read(a[1],a[2],a[3]); end;

procedure chck; var

i:array[1..3]of byte; x,y:integer; begin

i[1]:=ord(a[1]); i[2]:=ord(a[2]); i[3]:=ord(a[3]); for x:=1 to 3 do for y:=1 to 3 do

if abs(i[x]-i[y])=1 then begin

writeln('Yes'); halt; end;

writeln('No'); end; begin init; chck; end.

86题目：输出由1，2，3，4四个数字组成的四位数字，并统计它的个数。（注：允许四位数字中有相同的数字，如1111，1122，1212等）每行输出12个 var

i,j,k,l,sum:integer; begin sum:=0;

for i:=1 to 4 do for j:=1 to 4 do for k:=1 to 4 do for l:=1 to 4 do begin inc(sum);

if sum mod 12 =0 then writeln(i,j,k,l) else write(i,j,k,l,' '); end;

end.

87题目：输入一梯形的上底、下底、高, 求该梯形的面积。 var a,b,h,s:real; begin

write('Input a,b,h:'); readln(a,b,h); s:=(a+b)*h/2; write('s=',s:10:3); end.

88题目：计算1—1000之间能同时被3和5整除的整数的和。 var t,i:longint; begin

for i:=1 to 1000 do

if (i mod 3=0) or (i mod 5=0) then t:=t+i; writeln(t); end.

89题目：随机产生一些1—100之间的整数，直到产生的数为50为止,计算产生次数 var

a,b,c,t:longint; begin a:=0;

randomize; repeat

a:=random(100); t:=t+1; until a=50; writeln(t); end.

90题目：设计一个程序，输入三角形的三个边，判断它是何种类型的三角形（等边、等腰或一般三角形）？ var i,j,k:real; begin read(i,j,k);

if (i+j>k)and(i+k>j)and(j+k>i)and(i>0)and(j>0)and(k>0) then begin

if (i=j)or(i=k)or(j=k) then

if 3*i=i+j+k then writeln('Deng bian.') else writeln('Deng yao.') else writeln('Yi ban.'); end

else writeln('Not a triangle!'); end.

91题目：编写一个猜数字的程序，你想一个1000以内的自然数，程序运行后计算机给出它猜的数，你根据这个数键盘输入相应字符，告诉它大了（输入G）或小了（输入L）或对了（输入R），只要你都是用一个数作为标准并且输入正确，计算机10次以内肯定能猜出你所想的数。 var ch:char; n,x,y:longint; begin

n:=500;writeln(n);x:=1;y:=1000; readln(ch);

while ch<>'R' do begin if ch='G'

then begin y:=n-1;n:=(x+y)div 2; end else begin x:=n+1;n:=(x+y)div 2; end; writeln(n);readln(ch); end; end.

92题目：韩信点兵：相传韩信才智过人，从不直接点数自己军队的人数，只是让士兵三人一排、五人一排、七人一排变化对形，而他掠一眼对尾的人数就知道总人数了（从键盘中输入每次对尾的人数，输出总人数，假设人数在50-100人之间）。 var

i, a, b, c: integer; Begin

readln(a, b, c); for i:=50 to 100 do

if (i mod 3 = a)and(i mod 5 = b)and(i mod 7 = c)then begin writeln(i); halt; end; end.

93题目：警察局抓了a,b,c,d四名偷窃嫌疑犯，其中有一人是小偷。审问中a说：“我不是小偷。”b说：“c是小偷。”c说：“小偷肯定是d。”d说：“c冤枉人。”现在已经知道四人中三人说的是真话，一人说的是假话。问到底谁是小偷 var s,i:char; begin

for i:='a' to 'd' do begin

if ord(i<>'a')+ord(i='c')+ord(i='d')+ord(i<>'d')=3

then s:=i; end; write(s); end.

94题目：选票统计：有a,b,c,d四位候选人，n位投票人，统计时，a,b,c,d以外的字符为弃权。要求打印出候选人和所得票数。 var s,a,n,b,c,d:integer; t:char;

procedure p(g:char;h,j,k,l:integer;var y,u,i,o:integer); begin case g of

'a','A':y:=h+1; 'b','B':u:=j+1; 'c','C':i:=k+1; 'd','D':o:=l+1; end; end; begin

write('n='); readln(n); a:=0; b:=0; c:=0; d:=0;

for s:=1 to n do begin readln(t); p(t,a,b,c,d,a,b,c,d); end; writeln('a=',a,' b=',b,' c=',c,' d=',d); readln; end.

95题目：某仓库第一天有粮食100t，第二天又调进20t，第三天卖出库存的一半，第四天又调进库存的三倍的粮食，打印仓库每天的粮食库存。 var

x:integer; begin

x:=100; writeln('x1=',x); x:=x+20; writeln('x2=',x); x:=x div 2; writeln('x3=',x); x:=x+3*x; writeln('x4=',x); readln; end.

96题目：给出一个数N，知道这个N是2的M次方，怎样求出这个M？ var

n,m:longint; begin readln(n);

m:=0; repeat n:=n div 2; m:=m+1; until n=1; writeln(m); readln; end.

97题目：输入一个实型数A,用ROUND和TRUNC,打印原数,整数部分,小数部分,四舍五入后数. var a:real; begin readln(a); writeln(a);

writeln(trunc(a)); writeln(a-trunc(a)); writeln(round(a)); end.

98题目：有一个函数 -1(x<0) y= 0 (x=0) 1 (x>0) var

x,y:longint; begin readln(x);

if x<0 then y:=-1 else if x>0 then y:=1 else y:=0;

writeln('y=',y); end.

99题目：以知鸡和兔的总数量是H,鸡兔腿的总数量为F,求鸡和兔各多少只? var

h,f,c,r:integer; begin

readln(h,f);

c:=(4*h-f) div 2; r:=h-c; writeln(r); writeln(c); end.

100 2007NOIP普及组第一题 奖学金 题目： 描述:

某小学最近得到了一笔赞助，打算拿出其中一部分为学习成绩优秀的前5名学生发奖学金。期末，每个学生都有3门课的成绩:语文、数学、英语。先按总分从高到低排序，如果两个同学总分相同，再按语文成绩从高到低排序，如果两个同学总分和语文成绩都相同，那么规定学号小的同学 排在前面，这样，每个学生的排序是唯一确定的。

任务：先根据输入的3门课的成绩计算总分，然后按上述规则排序，最后按排名顺序输出前五名名学生的学号和总分。注意，在前5名同学中，每个人的奖学金都不相同，因此，你必须严格按上述规则排序。例如，在某个正确答案中，如果前两行的输出数据(每行输出两个数:学号、总分) 是: “7 279” “5 279 ”

这两行数据的含义是:总分最高的两个同学的学号依次是7号、5号。这两名同学的总分都是 279 (总分等于输入的语文、数学、英语三科成绩之和) ，但学号为7的学生语文成绩更高一些。如果你的前两名的输出数据是: “5 279” “7 279” 则按输出错误处理，不能得分。 输入格式:

输入包含n+1行:

第1行为一个正整数n，表示该校参加评选的学生人数。

第2到n+1行，每行有3个用空格隔开的数字，每个数字都在O到100之间z第1行的3个数 字依次表示学号为j-1的学生的语文、数学、英语的成绩。每个学生的学号按照输入顺序编号为l~n (恰好是输入数据的行号减1)。 所给的数据都是正确的，不必检验。 输出格式:

输出共有5行，每行是两个用空格隔开的正整数，依次表示前5名学生的学号和总分。 程序: type

chen=record hao:longint; yu:longint; shu:longint; ying:longint; z:longint; end; var

a:array[1..5000] of chen; t:chen;

n,i,j:longint; begin readln(n);

for i:=1 to n do begin a.hao:=i;

readln(a.yu,a.shu,a.ying); a.z:=a.yu+a.shu+a.ying; end;

for i:=1 to n -1 do for j:=n downto i+1 do if a[j-1].z

begin t:=a[j-1];a[j-1]:=a[j];a[j]:=t end; for i:=1 to n -1 do for j:=n downto i+1 do

if (a[j-1].z=a[j].z) and (a[j-1].yu

if (a[j-1].z=a[j].z) and (a[j-1].yu=a[j].yu) and (a[j-1].z

writeln(a.hao,' ',a.z); end.

本文来源：https://www.bwwdw.com/article/1gtr.html