(信息学奥赛辅导)程序设计试题汇编(答案)

程序设计试题及答案
（备注：试题难度评价采取五★级评价体系，分基础、容易、一般、稍难、难五个等级，其中的一、二、三★级都属于程序设计的基础试题级别，同学们稍加思考均有能力求得正确解答，对于四★级试题属于程序设计试题基础级别的思考题，五★级难度试题在此没有涉及，在程序设计高级试题中另行讲解。对于基础和容易两个级别的程序设计试题，若能够给出语句分类（如If条件语句、条件语句嵌套、循环语句、多重循环语句等）的将尽量给出。若属于13大类别的将尽量标注。）
程序设计试题几大分类：
素数类问题（求素数的几种算法）：
数据排序问题（数据排序的几种方法）：
最大公约数和最小公倍数问题（几种算法）：
公式求解类问题（如求圆周率π、自然常数e、解方程等等）：
编号相反处理问题：
约瑟夫问题（或猴子选大王问题、密码问题）：
回文数问题：
高精度数值计算问题：
数值计算问题：
进制相互转换问题：
字符串倒置问题：
排列与组合类问题：
因子、质因子（质因数）类相关问题：
答案部分：
（程序设计的源程序没有统一的标准答案，实现程序的算法也是多种多样，但结果是唯一的，算法也有优劣之分，一个程序的优劣，关键在于是否找到了好的算法，以下程序和算法不一定就是最佳算法和最佳程序，只能仅供参考，希望同学们能够对某些程序提出更好的算法来改进程序）
（经常碰到的判断是否为素数、是否为回文数、求两个数的最大公约数、求两个数的最小公倍数等问题的子函数源程序，请务必记住！）
①判断是否为素数，若是素数则返回true，若不是素数则返回false：
fun_ction prime(x:longint):boolean;
var
j,y:longint;
begin
prime:=true;
if x<2 then prime:=false;
y:=trunc(sqrt(x));
for j:=2 to y do
if (x mod j = 0) then
begin prime:=false; exit; end;
end;
备注：1～100之间所有的素数：2、3、5、7、11、13、17、19、23、29、31、37、41、43、47、53、59、61、67、71、73、79、83、89、97。（共25个）
②判断是否为回文数，若是回文数则返回true，若不是回文数则返回false：
fun_ction huiwen(n:longint):boolean;
var
m,i,j:longint;
a:array[1..10] of integer;
begin
if n<0 then begin huiwen:=false; exit; end;
m:=n; i:=0; huiwen:=true;
repeat
i:=i+1;
a[i]:=m mod 10;
m:=m div 10;
until m=0;
for j:=1 to (i div 2) do
if a[j]<>a[i-j+1] then
begin huiwen:=false; exit; end;
end;
③求最大公约数子函数，返回两个正整数的最大公约数，采用辗转相除法算法；
fun_ction gcd(a,b:longint):longint;
begin
if b=0 then gcd:=a
else gcd:=gcd(b,a mod b);
end;
④求最小公倍数：lcm=a*b div gcd(a,b);
（以下程序设计试题来自《奥赛经典（语言篇）》）
基本语句与程序结构
例题部分：
求梯形的面积。（梯形面积公式：）
（★，测试数据①
求一元二次方程ax2＋bx＋C＝0的两个实根。（求根公式：）
（★，测试数据a＝1，b＝－5，c＝6；答案：x1＝2、x2＝3）
输入一个三位的自然数，然后把这个数的百位与个位对调，输出对调后的结果。 （★）
输入三个数a、b、c，首先判断这三个数能否构成三角形，若能，则求出三角形的面积。
（提示：海伦公式，其中，a、b、c为边长）
（★，If条件语句，测试数据a＝5，b＝6，c＝7；答案：14.7）
从键盘读入三个数，按从大到小的顺序把它们打印出来。（★，If条件语句）
输入三角形的三边，判断它是否是直角三角形。
（★，If条件语句，测试数据①3、4、5；②4、5、6；答案①Yes；②No）
编写一个根据用户键入的两个操作数和一个运算符，由计算机输出运算结果的程序。（★★★）
输入一个年号，判断它是否为闰年。
（★，If条件语句，测试数据①1900；②2000；③2008；答案：①No；②Yes；③Yes）
编程计算S＝1＋2＋3＋…＋100。（★，循环语句， 答案：5050）
相关练习：（1）； （2）；
（3）； （4）；
（相关练习答案：（1）5.19（保留2为小数）；（2）338350；（3）2550；（4）1717）
根据公式，计算圆周率的π值。
（★★，循环语句，测试数据n＝10000；答案：3.1414971639）
program e;
var
i:longint;
s:real;
begin
writeln; s:=0;
for i:=1 to 10000 do s:=s+1/(i*i);
writeln(sqrt(6*s));
end.
计算n!。（n!＝1×2×3×…×n，取n＝10）
（★★，循环语句，10！＝3628800）
已知一对兔子，每个月可以生一对小兔，而小兔过一个月后也可生一对小兔。即兔子的对数是：第一个月1对，第二个月2对，第三个月3对，第四个月5对，……，假设兔子的生育期是12个月，并且不死，问一年后，这对兔子有多少对活着的后代？（Fibonacci数列问题）
（★★，循环语句， 1、2、3、5、8、13、21、34、55、89、144、233；答案233）
求两个整数a与b的最大公约数和最小公倍数。
（★，循环语句、If条件语句，测试数据16和24，最大公约数8，最小公倍数48）
利用格利高公式求π。，直到最后一项的值小于10－6为止。
（★★★，循环语句） （答案：3.1415946569E+00）
program e2_32;
var
n,fh:longint;
s,t,p:real;
begin
writeln; n:=1; s:=0; t:=1; fh:=1;
while (abs(t)>=1e-6) do
begin t:=fh/n; s:=s+t; n:=n+2; fh:=-fh; end;
p:=4*s;
writeln('pi=',p);
end.
相关练习：利用公式，求π。
（计算前10000项时，答案为3.1415426536）
program e;
var
i,a,b:longint;
x,s:real;
begin
writeln; s:=0;
for i:=1 to 10000 do begin a:=(4*i-3); b:=(4*i-1); s:=s+1/(a*b); end;
writeln(8*s);
end.
求100～999中的水仙花数。（若三位数ABC，ABC＝A3＋B3＋C3，则称ABC为水仙花数。例如153，13＋53＋33＝153，则153是水仙花数。） （★★，循环语句）
（答案：153、370、371、407）
program e12;
var
i,a,b,c:integer;
begin
writeln;
for i:=100 to 999 do
begin
a:=i div 100;
b:=(i mod 100) div 10;
c:=i mod 10;
if i=a*a*a+b*b*b+c*c*c then write(i:8);
end;
end.
试编写能够打印输出如下图形的程序。 （★★，循环语句）
AAAAAAAAA
AAAAAAA
AAAAA
AAA
A
program e;
const n=5;
var
i,j:integer;
begin
writeln;
for i:=1 to n do
begin
write('':i);
for j:=1 to (n-i)*2+1 do write('A');
writeln;
end;
end.
四个学生上地理课，回答我国四大淡水湖大小时这样说： （★★★）
甲：“最大洞庭湖，最小洪泽湖，鄱阳湖第三。”
乙：“最大洪泽湖，最小洞庭湖，鄱阳湖第二，太湖第三。”
丙：“最小洪泽湖，洞庭湖第三。”
丁：“最大鄱阳湖，最小太湖，洪泽湖第二，洞庭湖第三。”
对于每个湖的大小，每个学生仅答对一个，请编程确定四个湖的大小。

习题部分：
已知三角形的两边a、b和夹角jc的值，求第三边（已知条件由键盘输入）。 （★）
（提示：余角公式）
（测试数据：输入a＝3、b＝4、jc＝90； 输出5）
program e2_5;
var
a,b,c,jc:real;
begin
writeln('input a,b,jc:'); readln(a,b,jc);
c:=sqrt(a*a+b*b-2*a*b*cos(pi*jc/180));
writeln(c:8:2);
end.
编写程序把一个四位整数3581颠倒成1853。 （★）
program e;
const n=3581;
var
a,b,c,d:integer;
begin
writeln;
a:=n mod 10;
b:=(n div 10) mod 10;
c:=(n div 100) mod 10;
d:=n div 1000;
writeln(a,b,c,d);
end.
相关练习：任意输入一个正整数，颠倒输出该数。
program e;
var
n:longint;
begin
writeln; writeln('input a integer number:'); readln(n);
repeat
write(n mod 10); n:=n div 10;
until n=0;
end.
输入a、b、c三个数，打印出最大者。 （★，If条件语句）
program e;
var
a,b,c:real;
begin
writeln('input three number for a,b,c:');
readln(a,b,c);
if (a>b)and(a>c) then writeln(a);
else if (b>a)and(b>c) then writeln(b);
else writeln(c);
end.
从键盘读入两个数，比较其大小，把大数置于x，小数置于y。请设计实现该功能的程序。
（★，If条件语句）（程序略）
输入三个数，判断以这三个数为边能否组成一个三角形。若不能，则给出适当信息；若能，则进一步判断它们构的是锐角三角形、直角三角形还是钝角三角形，并输出其特征（等边、等腰、直角、一般）、求其面积。 （★★，If条件语句）
（算法分析：对于判断是锐角、直角、还是钝角三角形，只需判断最大边的平方与其余两边的平方和的大小比较即可，小于则为锐角、等于则为直角、大于则为钝角。）
（测试数据：①1、2、3；②3、4、5；③）4、4、7；④5、5、5；答案：①No；②直角、面积6.00；③钝角、等腰、面积6.78；④锐角、等边、面积10.83）
program e;
var
a,b,c,t,s,d,ja,jb,jc:real;
begin
writeln('input three number for a,b,c:');
readln(a,b,c);
if a if a if (a begin
if (a*a else if(a*a=b*b+c*c) then writeln('zhi jiao san jiao xing.')
else writeln('dun jiao san jiao xing.');
if (a=b)and(b=c)and(c=a) then writeln('deng bian san jiao xing.')
else if ((a=b)and(b<>c))or((a=c)and(c<>b))or((b=c)and(c<>a)) then
writeln('deng yao san jiao xing.')
else if (a*a<>b*b+c*c) then writeln('yi ban san jiao xing.');
d:=(a+b+c)/2; s:=sqrt(d*(d-a)*(d-b)*(d-c)); writeln('s=',s:0:2);
end
else writeln('NO!');
end.
设我国目前的人口为11亿，且每年的增长率为1.5％。问多少年后，我国的人口会翻一番？（★） （答案：47）
program e2_22;
var
i:integer;
s:real;
begin
writeln; s:=11; i:=0;
while s<22 do
begin s:=s*(1.015); inc(i); end;
writeln(i);
end.
Fibonacci数列问题：数列的头两个数分别是0和1，从第三个数开始，每个数皆为它的前两个数之和，即：0，1，1，2，3，5，…，输出该数列的第50个数。 （★★，循环语句）
（答案：7778742049）
program e;
{$N+,E+}
var
i:integer;
x,y,z:extended;
begin
writeln; x:=0; y:=1; write(x:20:0,y:20:0);
for i:=3 to 50 do
begin z:=x+y; write(z:20:0); x:=y; y:=z; end;
end.
编写程序求出下式中n的最大值：22＋42＋62＋…＋n2<1500。 （★★，循环语句）
（答案：18）
program e2_24;
var
n,s:integer;
begin
writeln;
s:=0; n:=0;
while s<1500 do
begin inc(n,2); inc(s,n*n); end;
writeln(n-2);
end.
把一元的钞票换成一分、二分和五分的硬币（每种至少一枚），问有多少种兑换方法？（★★）（答案：461）
program e2_29;
var
i,j,k,ans:integer;
begin
ans:=0;
for k:=1 to 19 do
for j:=1 to 47 do
for i:=1 to 93 do
if (k*5+j*2+i)=100 then inc(ans);
writeln(ans);
end.
编写程序求最小正整数m、n（0（★★★★）
（算法：这类数字很大且有效数字位数很多（超出最多有效位数extended数据类型有效数字18位）的数字问题，一定要另辟蹊径寻找突破口，注意到此题只要求最后三位数字相同，则我最多保留最后四位有效数字即可进行判断。还请记住这样一个事实，如1989×1989＝3956121，3956121×1989＝7868724669，最后四位数字是“4669”，而我把3956121取其最后的四位数“6121”与1989相乘即6121×1989=12174669，最后四位数字也是“4669”，没有破坏最后四位有效数字的值，因此可以通过这种方法来编写此程序。）
（答案：m＝51； n＝1）；
program e;
var
m,n,i,j:integer;
x,y,a,b:longint;
begin
writeln;
for m:=2 to 60 do
for n:=1 to m-1 do
begin
x:=1; y:=1;
for i:=1 to m do begin x:=x mod 10000; x:=x*1989; a:=x mod 1000; end;
for j:=1 to n do begin y:=y mod 10000; y:=y*1989; b:=y mod 1000; end;
if a=b then writeln('m=',m,' n=',n);
end;
end.
编写程序提示用户输入一系列整数，用0作结束标志，统计其中有多少个正数。 （★）
program e;
var
count,x:integer;
begin
writeln; writeln('input integer number(0--end):'); count:=0;
repeat
read(x);
if x>0 then inc(count);
until(x=0);
writeln('count=',count);
end.
求自然常数的值。（提示：0！＝1，1！＝1） （★★）
直到第50项；（2）直到最后一项小于10－5。
（答案：（1）2.71828182845905E+0000； （2）2.71828152557319E+0000）
（备注：第2小问程序略，只须将更改语句“until (1/s)<1E-5;”即可求的解答）
program e2_35;
{$N+}
var
i,count:integer;
e,s:extended;
begin
e:=1; count:=0;
repeat
inc(count); s:=1;
for i:=1 to count do s:=s*i;
e:=e+1/s;
until count=50;
writeln(e);
end.
三齐王点兵的故事。相传三齐王韩信才智过人，从不直接清点自己军队的人数，只是让士兵先后以三人一排、五人一排、七人一排地变换队形，而他每次只掠一眼队伍的排尾就知道总人数了（不超过100人）。输入三次排尾的人数，输出总人数。 （★★）
program e2_36;
var
a,b,c,i:integer;
begin
writeln('shu ru p3(0~2),p5(0~4),p7(0~6) de wei shu:');
readln(a,b,c);
for i:=100 downto 1 do
if (i mod 3=a)and(i mod 5=b)and(i mod 7=c) then writeln(i);
if i=1 then writeln('No answer!');
end.
编写程序，计算N！以十进制数形式表示的数中最右的非零数字，并找出在它右边有几个零。例如12！＝1×2×3×…×12＝479001600。因此12！的右边有2个零。 （★★★）
（提示：碰到5、52、53、54…才会出现末尾是零，所以1000！末尾零的个数为：
（1000 div 5）＋（1000 div 52）＋（1000 div 53）＋（1000 div 54）＝249）
（下面的程序没采用上面的算法，采取另一种算法实现了这一程序，显然上面的算法效率高）
（程序算法：只需提供末尾几位有效数字即可，我采取提供四位有效数字相乘）
program I_11;
var
s:longint;
i,d:integer;
begin
writeln;
d:=0; s:=1;
for i:=1 to 1000 do
begin
s:=s*i;
if (s mod 1000 =0) then begin s:=s div 1000; d:=d+3; end;
if (s mod 100 = 0) then begin s:=s div 100; d:=d+2; end;
if (s mod 10 = 0) then begin s:=s div 10; d:=d+1; end;
s:=s mod 10000;
end;
writeln; write(d);
end.
编写程序，输出“字母塔”。以此类推共26层。 A （★★）
ABA
ABCBA
……………
program e2_40;
var
i,j:integer;
begin
writeln;
for i:=1 to 26 do
begin
for j:=1 to 26-i do write(' ');
for j:=1 to i do write(chr(64+j));
for j:=i-1 downto 1 do write(chr(64+j));
writeln;
end;
end.
第4章 数组类型
例题部分：
输入10个整数，把这10个数按从小到大的顺序排列。 （★★）
（冒泡法排序和选择法排序两种方法）
冒泡法排序：
program e1;
const n=10;
var
a:array[1..10] of integer;
i,j,t:integer;
begin
writeln('input ',n,' integer number:');
for i:=1 to n do read(a[i]);
for i:=1 to n-1 do
for j:=1 to n-i do
if a[j]>a[j+1] then begin t:=a[j]; a[j]:=a[j+1]; a[j+1]:=t; end;
for i:=1 to n do write(a[i]:5);
end.
折半查找。（二分法查找） （★★）
旅馆里有一百个房间，从1到100编了号。第一个服务员把所有的房间门都打开了，第二个服务员把所有编号是2的倍数的房间“相反处理”，第三个服务员把所有编号是3的倍数的房间作“相反处理”，……，以后每个服务员都是如此。问第100个服务员来过后，哪几扇门是打开的。（所谓“相反处理”是：原来开着的门关上，原来关上的门打开。） （★★）
（提示：对于任何一个编号，例如8，它的因子只有1、2、4、8，并且成对出现，当此数的因子数为偶数个时将被关上，当此数的因子数为奇数个时才会被打开。考虑到因子成对出现的情况，因此只有平方数的因子是奇数个的，所以门被打开的只能是平方数的房间，如1，4等）
编写程序把任意十进制整数转换成二进制整数。 （★★）
所谓“幻方”，是一个行、列为奇数的方阵，把1～n2这n2个不同的数放入方阵中，使方阵的每行、每列和每个对角线上的元素的和全部相等。下面给出幻方的一种排列方法：
先把1放在第一行的中间位置；
下一个数放在上一个数的右上方；
若右上方已超出方阵的第一行，则下一个数放在下一列的最后一行上；
若右上方已超出方阵的最后一列，则下一个数放在上一行的第一列上；
若右上方已经有数，或右上方已超出方阵的第一行最后一列，则下一个数放在上一个数的正下方。
编写程序，对输入小于15的n，打印出相应的幻方。 （★★★）
在一个字符数组LET中形成由A开始的连续26个大写字母构成的字串，并将其倒置后仍放在LET中。
随机输入一个长度不超过255的字符串，将其倒置后输出。
随机输入一些国家的英文名字，以end作为输入结束标志，按字母顺序排序后输出。
求n个字符串的最长公共子串，n<20，字符长度不超过255。
例如n＝3，由键盘依次输入三个字符串为：
what is local bus?
Name some local bus.
Local bus is high speed I/O bus close to the processor.
则最长公共子串为“local bus”。
文本的整版。编写一个程序，从键盘以任意的方法输入句子，然后打印出来。打印时每行宽度必须为n个字符。如果一行的最后一个单词超出了本行n个字符的范围，则应把它移到下一行去。输入一个句子测试你的程序。
习题部分：
输入n个整数，请找出最小数所在的位置，并把它与第一个数对调。 （★）
program e4_2;
var
a:array[1..10]of integer;
i,t,y:integer;
begin
writeln('input ten integer number:');
for i:=1 to 10 do read(a[i]);
t:=a[1];
for i:=2 to 10 do if a[i] for i:=1 to 10 do
if a[i]=t then begin writeln('the min number is ',i,'th'); a[i]:=a[1]; a[1]:=t; end;
for i:=1 to 10 do write(a[i]:8);
end.
用边排序边合并的方法把两个有序数列合并为一个新的有序数列，不得先合并再重新排序。
（★★）
（测试数据：这里a组数据共8个：1 1 3 6 6 7 9 10； b组数据共5个：0 1 2 3 4）
program e4_3;
var
a:array[1..8] of integer;
b:array[1..5] of integer;
c:array[1..13] of integer;
i,j,k,m,n:integer;
begin
writeln('input 8 integer number of square arrayA:');
for i:=1 to 8 do read(a[i]);
writeln('input 5 integer number of square arrayB:');
for i:=1 to 5 do read(b[i]);
j:=1; k:=1; m:=a[j]; n:=b[k];
for i:=1 to 13 do
begin
if m begin
c[i]:=m; inc(j); m:=a[j];
if j=9 then m:=maxint;
end
else
begin
c[i]:=n; inc(k); n:=b[k];
if k=6 then n:=maxint;
end;
end;
for i:=1 to 13 do write(c[i]:4);
end.
将一个数插入到有序的数列中，插入后数列仍然有序。 （★★）
（测试数据：有序数组为1 1 3 6 6 7 9 10； 待插入数为5）
program e4_4;
var
i,j,n:integer;
flag:boolean;
a:array[1..9] of integer;
begin
writeln('input 8 integer square number:');
for i:=1 to 8 do read(a[i]);
writeln('input a integer number to insert:');
readln(n);
flag:=false; i:=1;
repeat
if a[i]>n then flag:=true else inc(i);
until flag=true;
for j:=9 downto i+1 do a[j]:=a[j-1];
a[i]:=n;
for i:=1 to 9 do write(a[i]:4);
end.
有N个无序的数存放在A数组中，请将后面相同的数删成只剩下一个，并输出经过删除后的数列。 （★★）
（测试数据：数列为1 3 5 3 7 5 3 1； 答案：1 3 5 7）
program e4_5;
var
a:array[1..8] of integer;
i,j,n:integer;
begin
writeln('input 8 integer number:');
for i:=1 to 8 do read(a[i]);
for i:=2 to 8 do
for j:=1 to i-1 do if a[i]=a[j] then a[i]:=maxint;
for i:=1 to 8 do
if a[i]<>maxint then write(a[i]:4);
end.
有N个人排队到R个相同的水龙头去打水，他们装满各自水桶的时间T1、T2、…、TN为整数且互不相等，应如何安排他们打水的顺序才能使他们花费的总时间最少？（花费的总时间等于每个花费时间的总和）
求一个五阶方阵中某个元素的位置：它在行上是最小的，在列上也是最小的，如果没有请输出“NO FIND！”。 （★★★）
（分析：整个矩阵中的最小值，当然也是所在行和所在列的最小值，因此肯定能找到这样的数）测试数据： 答案：2、1、3、6
11
4
2
7
8
5
9
23
1
25
3
22
21
18
15
17
16
24
12
6
13
10
19
20
14
program e;
var
i,j,x,y:integer;
minx:integer;
a:array[1..5,1..5] of integer;
begin
writeln; writeln('input number(5*5):');
for i:=1 to 5 do
for j:=1 to 5 do
read(a[i,j]);
for i:=1 to 5 do
begin
minx:=a[i,1]; x:=i; y:=1;
for j:=1 to 5 do
if a[i,j] for j:=1 to 5 do
if a[j,y] if j=5 then writeln('the number is ',minx,'[',x,']','[',y,']');
end;
end.
第5章 过程与函数
例题部分：
编程求：1！＋3！＋5！＋7！＋9！＋11！。
求数字的乘积根。一个正整数的数字的乘积N的定义是：这个整数中非零数字的乘积。例如，整数999的数字乘积为9×9×9，即729。729的数字乘积为7×2×9，即126。126的数字乘积为1×2×6，即12。12的数字乘积为1×2，即2。一个正整数的数字乘积根N是这样得到的：反复取该整数的数字乘积，直到得到一位数字为止。例如，在上面的例子中数字的乘积根是2。编写一个程序，输入一个正整数（长度不超过200位数字），输出计算其数字乘积根的每一步结果。
汉诺（Hanoi）塔问题。设有n个大小不等的中空圆盘，按照从小到大（尺寸和序号）的顺序叠套在立柱A上。另有两根立柱B和C，如图所示。问题要求把全部圆盘从A柱（源柱）移到C柱（目标柱）。移动过程中可借助B柱（中间柱）。移动时有如下要求：
一次只能移动一个圆盘；
不允许把大盘放在小盘上边；
可使用任意一根立柱暂存圆盘。
把一个十进制整数转化为K进制数（K≤10）。
八皇后问题：把八个皇后摆在8×8国际象棋棋盘格子内，使它们互不捕获对方。换言之，在任何一行、一列或一条对角线上，仅能放置一个皇后。这一问题是由19世纪著名数学家高斯（Gauss）于1850年首先提出的。（答案共有92种解答）
已知：切比雪夫多项式如下： （提示：运用递归函数计算）

对给定的不同的正整数，它是一些阶数不同的多项式，编程计算第n个多项式的值。
习题部分：
编写一递归函数说明，用以计算组合数C（M，N）。（即）
两个人玩井字游戏，在井字进分的九个空位上轮流画O或*，谁最先使自己的三个O或三个*在一条直线上，谁就赢了。编写程序检查每一步是否走得正确，并告诉谁是胜利者。
第6章 集合与记录类型
例题部分：
七段数码管问题。
任意给出一个正整数N，找一个正整数M，使得N*M的值的数字由0、1、…、C（C≤9）组成，且这些数字至少出现一次。编写程序在整数范围内找出满足条件的最小M。若没有给出信息，则输出“No find！”。
例如：C＝3、N＝65时，M＝48，65×48＝3210；
C＝8、N＝125时，“No find！”。
（以下程序设计试题来自《计算机二级考试复习指南》）
数列称为e数列， （★★）
每一个e（n）（n＝1，2，…）称为e数。求［1，30000］之内：
最大的e数；（2）e数的数目。
（该数列前面几项为1、1、3、11、53、……； 答案：①16687； ②8）
program e;
var
a,b,c,n:longint;
begin
writeln; n:=3; a:=1; b:=1;
repeat
c:=(n-2)*a+(n-1)*b; a:=b; b:=c; inc(n);
until c>30000;
writeln('maxe=',a,' count=',n-2);
end.
计算并输出：之值（精确到小数点后第5位）。 （★）
（答案：0.99900）
program e;
var
i:integer;
s,n:real;
begin
writeln; s:=0;
for i:=1 to 1000 do begin n:=i; s:=s+1/(n*(n+1)); end;
writeln(s:0:5);
end.
已知，求： （★★）
F（50）；（2）F（0）＋F（1）＋……＋F（50）。
（答案：①212101； ②－97262）
program e;
var
i,a,b,c,d,s:longint;
begin
writeln; a:=1; b:=1; c:=1; s:=3;
for i:=3 to 50 do
begin d:=a-2*b+c; s:=s+d; a:=b; b:=c; c:=d; write(d:8); end;
writeln; writeln('s=',s);
end.
求满足：A·B＝716699并且A＋B最小两个条件的A和B。 （★★★）
（答案：A＝563； B＝1273）
program e;
var
a,x,s,mina,minb:longint;
begin
writeln; s:=716699; x:=trunc(sqrt(716699));
for a:=1 to x do
if (716699 mod a=0)and(a+(716699 div a) begin s:=a+(716699 div a); mina:=a; minb:=(716699 div a); end;
writeln('A=',mina,' B=',minb);
end.
一自然数平方的末几位与该数相同时，称此数为自同构数。例如，由于52＝25，则称5为自同构数。求出［1，700］以内的：（1）最大的自同构数；（2）自同构数数目。 （★★）
（答案：①625 ②）7）
program e;
var
i,count:longint;
begin
writeln; count:=0;
for i:=1 to 9 do
if (i*i-i) mod 10=0 then inc(count);
for i:=10 to 99 do
if (i*i-i) mod 100=0 then inc(count);
for i:=100 to 700 do
if (i*i-i) mod 1000=0 then begin inc(count); write(i:8); end;
writeln; writeln('count=',count);
end.
若某不含数字0的三位正整数，其平方数至少有三位同样的数字，则称该三位数为三重数。例如，由于：5112＝261121（有三位1），所以511为三重数。求出： （★★★★）
（1）按升序排列第10个三重数；（2）按升序排列前10个三重数之和；
（答案：（1）258； （2）1826）
program e1;
var
i,j,k,a,b,c,x,n,count,s:longint;
aa:array[1..5]of integer;
begin
writeln;
s:=0; count:=0;
for i:=111 to 316 do
begin
a:=i div 100; b:=(i div 10) mod 10; c:=i mod 10;
if ((a<>0)and(b<>0)and(c<>0)) then
begin
x:=i*i;
aa[1]:=x div 10000;
aa[2]:=(x div 1000) mod 10;
aa[3]:=(x div 100) mod 10;
aa[4]:=(x div 10) mod 10;
aa[5]:=x mod 10;
for j:=1 to 3 do
begin
n:=1;
for k:=j+1 to 5 do
if aa[j]=aa[k] then n:=n+1;
if n>2 then begin writeln(i:8,x:8); s:=s+i; count:=count+1; break; end;
end;
end;
if count=10 then break;
end;
writeln(s:8);
end.
满足下列两个条件：（a）千位数字与百位数字相同（非0），十位数字与个位数字相同；（b）是某两位数的平方。的四位正整数称为四位平方数。例如，由于：7744＝882，则称7744为四位平方数。求出：（1）所有四位平方数的数目；（2）所有四位平方数之和。 （★★）
（分析：最小四位数1000是31.6的平方，最大的四位数9999是99.9的平方）
（答案：①1； ②7744）
program e;
var
i,x,count,s:longint;
begin
writeln; count:=0; s:=0;
for i:=32 to 99 do
begin
x:=i*i;
if ((x div 1000)=((x div 100) mod 10))and(((x div 10) mod 10)=(x mod 10)) then
begin inc(count); s:=s+x; end;
end;
writeln('count=',count,' s=',s);
end.
其平方等于某两个正整数平方之和的正整数称为弦数。例如，由于32＋42＝52，因此5为弦数。求［121，130］之间：（1）弦数数目；（2）最小的弦数；（3）最大的弦数。 （★★★）
(分析：设a2＋b2＝c2，且a（答案：①4； ②122； ③130）
program e;
var
i,j,k,x,count:longint;
begin
writeln; count:=0;
for i:=121 to 130 do
begin
x:=trunc(sqrt(i*i/2));
for j:=1 to x do
begin
k:=trunc(sqrt(i*i-j*j));
if (i*i=j*j+k*k) then
begin inc(count); writeln(i,'*',i,'=',j,'*',j,'+',k,'*',k); break; end;
end;
end;
writeln('count=',count);
end.
求满足以下三个条件：（a）X2＋Y2＋Z2＝512；（b）X＋Y＋Z之值最大；（c）X最小。的一组X、Y、Z的值。 （★★★★）
（答案：X＝22； Y＝31； Z＝34）
program e1;
var
x,y,z,n,m,maxs,minx,xx,yy,zz:integer;
begin
writeln;
n:=trunc(sqrt(51*51/3)); m:=trunc(sqrt((51*51-1*1)/2));
maxs:=0; minx:=51;
for x:=n downto 1 do
for y:=x to m do
begin
z:=trunc(sqrt(51*51-x*x-y*y));
if (z>y)and(x*x+y*y+z*z=51*51) then
if ((x+y+z>maxs)or((x+y+z)=maxs)) then
begin
maxs:=x+y+z; xx:=x; yy:=y; zz:=z;
end;
end;
writeln('x=',xx,' y=',yy,' z=',zz);
end.
计算（精度10－4）（a=0.1、x=1.0）。 （★）
（答案：0.0295）
program e;
var
y,a,x:real;
begin
writeln; a:=0.1; x:=1.0;
y:=(exp(a*x)-exp(-a*x))/2*sin(x+a)+a*ln((x+a)/2);
writeln(y:0:4);
end.
倒勾股数是满足下列公式：（设A>B>C）的一组（3个）整数（A、B、C），例如（156，65，60）是倒勾股数，因为。问： （★★）
（1）A、B、C之和小于100的倒勾股数有多少组？
（2）满足（1）的诸组中，A、B、C之和最小的是哪组？
（提示：把公式转化为A2B2＝C2（A2＋B2））
（答案：①2； ②a＝20， b＝15， c＝12）
program e;
var
a,b,c,count,mins,mina,minb,minc:longint;
begin
writeln; count:=0; mins:=100;
for c:=1 to 33 do
for b:=c+1 to 49 do
for a:=b+1 to 97 do
if (a*a*b*b=c*c*(a*a+b*b))and(a+b+c<100) then
begin
inc(count);
if (a+b+c end;
writeln('count=',count,' a=',mina,' b=',minb,' c=',minc);
end.
设有十进制数字a、b、c、d、e，求在满足下列式子：abcd×e=dcba（a非0，e非0非1）的四位数abcd中，求满足条件的最小的abcd和与之对应的e。 （★★）
（答案：1089； 9）
program e1;
var
a,b,c,d,e,x,y:longint;
begin
writeln;
for a:=1 to 9 do
for b:=0 to 9 do
for c:=0 to 9 do
for d:=0 to 9 do
for e:=2 to 9 do
begin
x:=a*1000+b*100+c*10+d; y:=d*1000+c*100+b*10+a;
if (x*e=y) then begin writeln(x:8,e:8); exit; end;
end;
end.
求方程：在区间（0，1）内的解，精度为10－4。 （★★）
（答案：0.3473）
program e;
var
x:real;
begin
writeln; x:=0.0001;
repeat
if (abs(x*x*x-3*x+1)<1e-4) then writeln(x:0:4);
x:=x+0.0001;
until x>=1;
end.
按递增顺序产生序列M中最小的80个数。M定义如下：数1属于M；若x属于M，则y=2x+1，z=3x+1也属于M，并求： （★★★★）
该序列第50个元素之值；（2）该序列前50个元素之和。
（答案：（1）172； （2）3853）
program e;
var
i,j,k,t,p,n:longint;
a:array[1..100] of longint;
begin
writeln;
p:=1; a[p]:=1; n:=1;
while p<50 do
begin
a[n+1]:=2*a[p]+1;
a[n+2]:=3*a[p]+1;
n:=n+2;
for i:=1 to n-1 do
for j:=1 to n-i do
if a[j]>a[j+1] then
begin t:=a[j]; a[j]:=a[j+1]; a[j+1]:=t; end;
p:=p+1;
end;
writeln(a[p]:8);
end.
在n个一连串的方格内填写字母A或B，但相邻两格内不能都填B。求所有可能的填写方案数。例如，当n＝3，可能的方案有AAA、AAB、ABA、BAA、BAB等5种。试求：（1）当n＝15时，所有可能的方案数是多少？（2）当n＝10时，包含有8个字母A的方案数共有多少？（★★★）
（提示：此题可以采用进制转换来解决。考虑到只包含了A与B两个字母，我们可以用二进制的0和1来代替，所以当全部是A时最小，此数为0，当全部是B时最大为2 n－1，我们让变量从0～2 n－1循环，然后将此数转换为相应的二进制数存储在数组中即可进行判断了。）
（答案：（1）1597； （2）36）
program e;
var
n,m,s,i,j,count:longint;
flag:boolean;
a:array[1..100] of integer;
begin
writeln('input n:');
readln(n);
s:=1; count:=0;
for i:=1 to n do s:=s*2;
for i:=0 to s-1 do
begin
m:=i;
for j:=1 to n do
begin
a[j]:=m mod 2;
m:=m div 2;
end;
flag:=true;
for j:=1 to n-1 do
if (a[j]=1)and(a[j+1]=1) then
begin flag:=false; break; end;
if flag=true then count:=count+1;
end;
writeln(count);
end.
program e;
var
n,m,s,i,j,count,na:longint;
flag:boolean;
a:array[1..100] of integer;
begin
writeln('input n:');
readln(n);
s:=1; count:=0;
for i:=1 to n do s:=s*2;
for i:=0 to s-1 do
begin
m:=i;
for j:=1 to n do
begin
a[j]:=m mod 2;
m:=m div 2;
end;
flag:=true;
for j:=1 to n-1 do
if (a[j]=1)and(a[j+1]=1) then
begin flag:=false; break; end;
na:=0;
for j:=1 to n do
if a[j]=0 then
na:=na+1;
if (flag=true)and(na=8) then count:=count+1;
end;
writeln(count);
end.
给定自然数1到n的集合和自然数m（m>n），求各元素之和等于m的子集。（设n=20，m＝48）。（1）共有多少个符合上述条件的子集？（2）符合上述条件且子集元素数目为5的子集有多少？
（★★★）
（提示：集合的元素不能重复，此题可分3～9个元素类别集合讨论，下面给出第2问的源程序）
（答案：①1674； ②488）
program e1;
const
m=48;
var
a,b,c,d,e,f,g,count:integer;
begin
writeln; count:=0;
for a:=1 to trunc(m/5) do
for b:=a+1 to trunc((m-1)/4) do
for c:=b+1 to trunc((m-1-2)/3) do
for d:=c+1 to trunc((m-1-2-3)/2) do
for e:=d+1 to 20 do
if (a+b+c+d+e=m) then inc(count);
writeln('count5=',count);
end.
（以下程序设计试题来自《全国青少年信息学奥林匹克联赛――培训习题与解答（中学）》）
计算1×2＋3×4＋5×6＋……＋49×50的值。 （★）
（答案：21450）
program e;
var
i,x,s:longint;
begin
writeln; s:=0; x:=0;
for i:=1 to 25 do begin x:=x+2; s:=s+x*(x-1); end;
writeln(s);
end.
给定一串整数数列，求出所有的递增和递减子序列的数目。例如数列7、2、6、9、8、3、5、2、1可分为（7，2）、（2，6，9）、（9，8，3）、（3，5）、（5，2，1）五个子序列，答案就是5。我们称2、9、3、5为转折元素。 （★★★）
program e;
var
a:array[1..9] of integer;
i,j,k,n:integer;
begin
writeln('input 9 number');
for i:=1 to 9 do read(a[i]);
n:=1;
for i:=2 to 9-1 do
if ((a[i]a[i-1])and(a[i]>a[i+1])) then
n:=n+1;
writeln(n:8);
end.
将1～9这9个数字分成三组（每个数字只能使用一次），分别组成三个三位数，且这三个三位数的值构成1：2：3的比例，试求出所有满足条件的三个三位数。 （★★★）
（分析：注意下面源程序所采用的算法，非常好）
（答案：（192、384、576）、（219、438、657）、（273、546、819）、（327、654、981））
program e;
var
a:array[0..9] of integer;
i,g,s,b,k,t:integer;
begin
writeln;
for i:=100 to 333 do
begin
for k:=0 to 9 do a[k]:=0;
k:=i;
g:=k mod 10; s:=(k div 10) mod 10; b:=k div 100; a[g]:=1; a[s]:=1; a[b]:=1;
k:=2*i;
g:=k mod 10; s:=(k div 10) mod 10; b:=k div 100; a[g]:=1; a[s]:=1; a[b]:=1;
k:=3*i;
g:=k mod 10; s:=(k div 10) mod 10; b:=k div 100; a[g]:=1; a[s]:=1; a[b]:=1;
t:=0;
for k:=1 to 9 do t:=t+a[k];
if t=9 then writeln(i:4,i*2:4,i*3:4);
end;
end.
回文算术：任给一个三位数abc，算出abc与cba之和。若该和数不是回文数（回文数的定义是从左读和从右读一样，如5、121、1221等），再按上述方法求和。以此类推，直到得到回文形式的和数或者和数的位数已经超过15位时中止计算。 （★★★）
(分析：注意此题中处理回文数判断的方法和处理数组高精度加法的方法)
program e;
var
a,b:array[1..20] of integer;
x,i,m:integer;
hw:boolean;
begin
writeln; write('abc='); readln(x);
for i:=1 to 15 do a[i]:=0;
a[1]:=x mod 10; a[2]:=(x div 10) mod 10; a[3]:=x div 100;
m:=3; hw:=false;
while (hw=false)and(m<15) do
begin
for i:=1 to m do b[i]:=a[m-i+1];
i:=1;
while (i<=m)and(a[i]=b[i]) do i:=i+1;
if i>m then hw:=true
else
begin
for i:=m downto 1 do write(a[i]);
write('+');
for i:=m downto 1 do write(b[i]);
write('=');
for i:=1 to m do
begin a[i]:=a[i]+b[i]; a[i+1]:=a[i+1]+a[i] div 10; a[i]:=a[i] mod 10; end;
if a[m+1]>0 then m:=m+1;
for i:=m downto 1 do write(a[i]);
writeln;
end;
end;
if hw then writeln('success!') else writeln('Fail!');
end.
求一个n×n数阵中的马鞍数，输出它的位置。所谓马鞍数，是指在行上最小而在列上最大的数。
（★★）
（测试数据：（矩阵1） （矩阵2）
15
4
14
25
7
11
4
2
7
8
11
9
23
16
8
5
9
23
1
25
22
3
21
18
5
3
22
21
18
15
17
1
24
12
6
17
16
24
12
6
13
10
19
20
2
13
10
19
20
14
program e;
const n=5;
var
i,j,min,x,y:integer;
flag:boolean;
a:array[1..n,1..n] of integer;
begin
writeln; writeln('input ',n,'*',n,' integer number:');
for i:=1 to n do
for j:=1 to n do
read(a[i,j]);
flag:=false;
for i:=1 to n do
begin
min:=a[i,1]; x:=i; y:=1;
for j:=1 to n do
if a[i,j] for j:=1 to n do
if a[j,y]>a[x,y] then break;
if (j=n)and(a[x,y]>a[n,y]) then begin write(a[x,y],'(',x,',',y,')'); flag:=true; end;
end;
if flag=false then writeln('No find!');
end.
数学黑洞6174。已知：一个任意的四位正整数（全相同的除外，如1111）。将数字重新组合成一个最大的数和最小的数相减，重复这个过程，最多七步，必得6174。即：7641－1467＝6174。将永远出不来。
求证：所有四位数数字（全相同的除外），均能得到6174。输出掉进黑洞的步数。 （★★★）
program e18;
var
a:array[1..4] of integer;
i,j,d,k:integer;
begin
writeln('input a si wei shu:');
read(d);
if (d mod 1111<>0) then
while d<>6174 do
begin
a[1]:=d div 1000; a[2]:=(d mod 1000) div 100;
a[3]:=(d mod 100) div 10; a[4]:=d mod 10;
for i:=1 to 4 do
for j:=i+1 to 4 do
if a[i] begin
k:=a[i]; a[i]:=a[j]; a[j]:=k;
end;
d:=1000*a[1]+100*a[2]+10*a[3]+a[4]-1000*a[4]-100*a[3]-10*a[2]-a[1];
writeln(1000*a[1]+100*a[2]+10*a[3]+a[4],'-',1000*a[4]+100*a[3]+10*a[2]+a[1],'=',d);
end;
end.
（以下程序设计试题来自《青少年信息学竞赛题库》）
输入10个正整数，计算它们的和，平方和。 （★）
program I_1;
var
i,s,d,p:integer;
begin
writeln('input ten positive number:');
s:=0; p:=0;
for i:=1 to 10 do
begin
read(d);
s:=s+d; p:=p+d*d;
end;
writeln;
write(s:8,p:8);
end.
统计1——999中能被3整除，且至少有一位数字是5的数。 （★）
（答案：91）
program I_4;
var
i,s:integer;
begin
writeln; s:=0;
for i:=1 to 999 do
begin
if(i mod 3 = 0) and ((i mod 10 = 5) or ((i div 10) mod 10 =5) or ((i div 100)=5))
then begin write(i:8); s:=s+1; end;
end;
writeln; write(s:8);
end.
从键盘输入一个20～50之间的整数，统计出边长为整数，周长为输入数的不等边三角形的个数。
（测试数据：输入27， 输出18） （★★）
program I_9;
var
x,y,z,k,s:integer;
begin
writeln; writeln('input a integer number(20 k:=0;
for x:=1 to (s div 3) do
for y:=x to ((s-x) div 2) do
begin
z:=s-x-y;
if (x+y)>z then
begin
writeln(x:4,y:4,z:4); k:=k+1;
end;
end;
if (s mod 3)=0 then k:=k-1;
write(k);
end.
一个整数的立方可以表示为两个整数的平方差，如19853=19711052-19691202。编程：输入一个整数N，自动将其写成N3=X2-Y2。 （★★★）
（提示：N3=X2-Y2=(X＋Y)(X－Y)，所以必有（X－Y）＝N，（X＋Y）＝N2。）
（测试数据：N＝2004； 答案20043＝20090102－20070062）
program I_13;
var
n,x,y:longint;
begin
writeln; read(n);
for y:=1 to maxlongint do
begin
x:=y+n;
if (n*n=x+y) then begin writeln(n,'︿3=',x,'︿2-',y,'︿2'); exit; end;
end;
end.
任意给定平面上三个点A（X1，Y1），B（X2，Y2），C（X3，Y3），试判断这三个点能否构成三角形。能则求出它的面积。 （★★）
（测试数据：
program I_16;
var
x1,y1,x2,y2,x3,y3,a,b,c,d,e,k:real;
begin
writeln; write('input X1,Y1 X2,Y2 X3,Y3:');
read(x1,y1,x2,y2,x3,y3);
a:=sqrt((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2));
b:=sqrt((x2-x3)*(x2-x3)+(y2-y3)*(y2-y3));
c:=sqrt((x3-x1)*(x3-x1)+(y3-y1)*(y3-y1));
if a if a if a begin d:=(a+b+c)/2; e:=sqrt(d*(d-a)*(d-b)*(d-c)); write('area=',e:8:3); end
else write('bu neng gou cheng san jiao xing');
end.
59=32+52+52=12+32+72，即59可以分别等于两组不同的自然数（每组各3个数）的二次幂之和，请找出10个最小的具有这种特性的数。 （★★★）
（分析：注意此程序中Goto语句的用法）
（答案：（27、1、1、5、3、3、3）（33、1、4、4、2、2、5）（38、1、1、6、2、3、5）等）
program e;
label 1;
var
m,a,b,c,n,a1,b1,c1,count:integer;
begin
writeln; count:=0; m:=0;
1:repeat
begin
inc(m);
if count>=10 then exit;
n:=0;
for a:=1 to trunc(sqrt(m/3)) do
for b:=a to trunc(sqrt((m-a*a)/2)) do
for c:=b to trunc(sqrt(m-a*a-b*b)) do
if (a*a+b*b+c*c>m) then goto 1
else if (a*a+b*b+c*c=m) then
begin
inc(n);
if n=1 then begin a1:=a; b1:=b; c1:=c; end
else if n=2 then
begin
inc(count);
writeln(m:4,a1:4,b1:4,c1:4,a:4,b:4,c:4);
goto 1;
end;
end;
end;
until count>=10;
end.
每一个素数的倒数都可以化为一个循环小数，例如：1/7可以化为0.（142857），1/13可化为
0.（076923）。编程把17的倒数化为循环小数。 （★★）
（答案：0.(0588235294117647)）
program I_25;
var
a,b,c,i,j,k:integer;
e:array[1..200] of integer;
yes:boolean;
begin
writeln;
a:=1; b:=17;
for i:=1 to 200 do
begin
c:=a*10 div b;
a:=10*a mod b;
e[i]:=c;
end;
for i:=1 to 200 do
for j:=i+1 to 200 do
if (e[i]=e[j]) then
begin
yes:=true;
for k:=1 to j-i do
if e[i]<>e[j] then yes:=false;
if yes=true then
begin
for k:=i to j-1 do
write(e[k]);
halt;
end;
end;
end.
求数列1、5、17、53、161、。。。前20项的和。（提示： An=2+3×An-1） （★★）
（答案：3486784380）
program I_29;
var
an,am,s:real;
i:integer;
begin
writeln; am:=1; s:=1; write(am:20:0);
for i:=2 to 20 do
begin
an:=am*3+2; s:=s+an; am:=an; write(am:20:0);
end;
writeln; write('totle:',s:0:0);
end.
编一程序实现：由键盘输入年月日后，计算机能打印出该日期是星期几。 （★★）
（提示：首先算出这一年的元旦是星期几。算法如下：①输入年份year；②根据下面公式计算：
d＝year＋（（year－1）div 4）－（（year－1）div 100）＋（（year－1）div 400）
d＝d mod 7；那么d＝0则表示为Sunday、d＝1则表示为Monday、……依此类推。
③输入月份month和日期day，计算该日期是这个年份中的第几天（x）；
④计算（x＋d－1）mod 7，得到星期几。
注意月份中的二月是28天还是29天，需看年份是否为闰年，闰年定义为：年份能被400整除的是闰年，或者年份能被4整除但不能被100整除的是闰年，其它年份均不为闰年。闰年的计算方法如下：若（（year mod 4＝0）and（year mod 100<>0））or（year mod 400＝0）则为闰年。）
program e;
const
yd:set of 1..12=[1,3,5,7,8,10,12]; {月大的月份}
yx:set of 1..12=[4,6,9,11]; {月小的月份}
a:array[1..12] of integer=(0,31,59,90,120,151,181,212,243,273,304,334);
{a数组存放第i个月份的前i-1个月的天数}
{因为这12个月的天数分别为31,28,31,30,31,30,31,31,30,31,30,31，故前i-1个月的天数为不断叠加}
s:array[0..6] of string=
('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
var
year,m,day,d,x:integer;
r,flag:boolean;
begin
writeln('input year:'); readln(year);
if (year mod 400=0)or((year mod 4=0)and(year mod 100<>0)) then r:=true else r:=false;
repeat
writeln('input month:'); readln(m);
until (m in [1..12]);
flag:=false;
repeat
writeln('input day:'); readln(day);
if (m in yd)and(day in [1..31]) then flag:=true
else if (m in yx)and(day in [1..30]) then flag:=true
else if (m=2)and(r=true)and(day in [1..29]) then flag:=true
else if (m=2)and(r=false)and(day in [1..28]) then flag:=true;
until flag=true;
d:=year+((year-1) div 4)-((year-1) div 100)+((year-1) div 400); {按公式计算d}
d:=d mod 7; {得到元旦为星期几}
x:=a[m]+day; {x表示该天是该年的第几天}
if (m>2)and(r=true) then x:=x+1; {如果月份大于二月且该年为闰年，那么天数需要多加一天}
x:=(x-1+d) mod 7; {x-1表示在元旦的基础上，该天是第多少天}
writeln('Today is ',s[x]);
end.
编程实现：键盘输入年月，计算机能打印出该月的月历，如输入2004、6，则输出： （★★★）
SUM
MON
TUE
WED
THU
FRI
SAT
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
program e;
const
yd:set of 1..12=[1,3,5,7,8,10,12]; {月大的月份}
yx:set of 1..12=[4,6,9,11]; {月小的月份}
a:array[1..12] of integer=(0,31,59,90,120,151,181,212,243,273,304,334);
var
year,m,day,d,x,i:integer;
r:boolean;
begin
writeln('input year:'); readln(year);
if (year mod 400=0)or((year mod 4=0)and(year mod 100<>0)) then r:=true else r:=false;
repeat
writeln('input month:'); readln(m);
until (m in [1..12]);
if m in yd then day:=31
else if m in yx then day:=30
else if (m=2)and(r=true) then day:=29
else day:=28;
d:=year+((year-1) div 4)-((year-1) div 100)+((year-1) div 400); {按公式计算d}
d:=d mod 7; {得到元旦为星期几}
x:=a[m]; {x表示该月是的前m-1个月的天数}
if (m>2)and(r=true) then x:=x+1; {如果月份大于二月且该年为闰年，那么天数需要多加一天}
x:=(x-1+d) mod 7; {x-1表示在元旦的基础上，该天是第多少天，x表示上个月最后一天是星期几}
writeln('SUM':4,'MON':4,'TUE':4,'WED':4,'THU':4,'FRI':4,'SAT':4);
for i:=0 to x do write('':4); {上个月占用的星期用空格输出}
for i:=1 to day do
begin
if (i+x) mod 7=0 then writeln;
write(i:4);
end;
end.
写出两个1，然后在它们中间插入2，成121；下一步是在上面数中每两个相邻的和数为3的数之间插入3，成为13231；再下一步又在上面数中任意两个相邻的和数为4的数中插入4，成为1432341；由键盘输入N，求出用上面方式构造出来的序列，其最后插入的数是N。假设这个序列不超过1000项，给出N=9时的运算结果。
把所有3的方幂及不相等的3的方幂的和排列成递增序列：1、3、4、9、10、12、13、。。。这个序列的第300项是多少？(6840)
两个1，两个2，两个3，这6个数可组成6位数312132。这个数有如下特点：两个1之间隔一位，两个2之间隔两位，两个3之间隔3位。231213也是一个符合条件的6位数。用数字1、2、3、4、5、6、7、8各两个，可以组成类似的16位数，请找出10个这样的16位数。
对于所有的数字不完全相同的三位数（不够三位数的前面补零也当成是三位数）。我们定出如下计算规则：用这个三位数的三个数字可组成的最大数减去可组成的最小数，则得到一个新的三位数；对新的三位数还按照上面的规则继续算下去，最后会发现，我们陷入一个死循环里，或者说是跌入了一个数的黑洞里。用具体例子说明。比如从三位数123开始，计算如下321-123=198；981-189=792；972-279=693；963-369=594；954-459=495；954-459=495；…. 从其他的任何三位数开始，最终也都会停止在495，我们把495叫做三位数的黑洞。类似地也存在着一个由一个数组成的四位数的黑洞。请编程序把它找出来。（6174）
（答案：与前面的数学黑洞问题相似，故此程序略）
11，323，74947，63144136这样的数叫回文数，它们的特点是最高位、最低位的数相同，次高位，次低位相同，….其中11是个更特殊的回文数，它的平方121、立方1331也是回文数。这是最小的一个具有这种性质的回文数。请编程，找出三次方小于999999999的具有上述性质的所有回文数。
（答案：1、2、11、101、111） （★★）
program e;
var
i:longint;
fun_ction huiwen(x:longint):boolean;
var
a,b:array[1..100] of integer;
m,n,y:longint;
hw:boolean;
begin
if x<1 then begin huiwen:=false; exit; end;
for m:=1 to 100 do a[m]:=0;
y:=x; m:=0;
repeat
inc(m); a[m]:=y mod 10; y:=y div 10;
until y=0;
for n:=1 to m do b[n]:=a[m+1-n];
n:=1;
while (n<=m)and(a[n]=b[n]) do inc(n);
if n=m+1 then huiwen:=true else huiwen:=false;
end;
{=============main=============}
begin
writeln;
for i:=1 to 999 do
if (huiwen(i)=true)and(huiwen(i*i)=true)and(huiwen(i*i*i)=true) then write(i:8);
end.
请编写程序，以简单算术表达式作为输入，构造对应的无括号表达式（无括号表达式的运算符写在运算对象的后面）。如：输入：A*（B-C）+D，应输出ABC-*D+；输入：（A+B）/C-D*E，应输出AB+C/DE*-。
键盘输入一个只含加、减、乘、除四则运算和括号的数学表达式，编程求出该表达式的值并输出结果。
一只公鸡值５元，一只母鸡值３元，３只小鸡值１元，现用一百元要买一百只鸡，问有什么方案？
（答案：（0、25、75），（4、18、78），（8、11、81），（12、4、84）） （★★）
program e;
var
i,j,k:integer;
begin
writeln;
for i:=1 to 20 do
for j:=1 to 33 do
begin
k:=100-i-j;
if (k mod 3=0)and(5*i+3*j+(k div 3)=100) then
writeln(i:8,j:8,k:8);
end;
end.
（来自其它试题）
某超市为了促销，规定：购物不足50元的按原价付款，超过50不足100的超过部分按九折付款，超过100元的，超过部分按八折付款。编一程序完成超市的自动计费的工作。 （★）
program e;
var
n,money:real;
begin
writeln; writeln('input the money number:'); readln(n); money:=0;
if n<=50 then money:=n
else if (n>50)and(n<=100) then money:=50+(n-50)*0.9
else money:=50+(100-50)*0.9+(n-100)*0.8;
writeln('money=',money:0:2);
end.
输入四个整数，排出名次后输出这四个数。如输入75、99、67、98。则输出： （★★★）
75——3、99——1、67——4、98——2。
相关练习：任意输入N个整数，排出名次后输出这N个数。
program e;
var
a:array[1..4] of integer;
i,j,m:integer;
begin
writeln;
for i:=1 to 4 do read(a[i]);
for i:=1 to 4 do
begin
m:=1; write(a[i],'--');
for j:=1 to 4 do
if a[j]>a[i] then inc(m);
write(m,' ');
end;
end.
任意输入一个正整数（（测试数据：35829083； 答案：38）
program e;
var
n,s:longint;
begin
writeln; writeln('input n:'); readln(n);
s:=0;
while n>0 do
begin s:=s+(n mod 10); n:=n div 10; end;
writeln(s);
end.
1981年，李氏兄弟三人核对自己的年龄。老三说，第一，我们三兄弟之间年龄之差是相等的；第二，去年我们三兄弟的年龄数恰好都等于各自出生年份中各数之和的2倍。你能根据这两点提示，编程计算出这兄弟三人的年龄和出生年月吗？ （★★）
（分析：假定这三兄弟均在1900年后出生）
（答案：1981年时，老大43岁1938年出生、老二37岁1944年出生、老三31岁1950年出生）
program e;
var
a,b,c:integer;
begin
writeln;
for a:=1 to 100 do
for b:=a+1 to 100 do
for c:=b+1 to 100 do
if (c-b=b-a) then
if((a-1)=2*(10+((1981-a)mod 10)+(((1981-a)div 10)mod 10))) then
if ((b-1)=2*(10+((1981-b)mod 10)+(((1981-b)div 10)mod 10))) then
if ((c-1)=2*(10+((1981-c)mod 10)+(((1981-c)div 10)mod 10))) then
writeln(a:4,b:4,c:4);
end.
将1～9这9个数字分成三组，每组3个数字，每个数字只能且必须使用一次，并且每组中的3个数字组成的三位数又要是完全平方数。请编程找出这样的数。 （★★）
（分析：注意下面程序所采取的方法与前面类似问题的算法一样，非常好。答案：361、529、784）
program e;
var
i,j,k,g,s,b,t,n:integer;
a:array[0..9] of integer;
begin
writeln;
for i:=11 to 31 do
for j:=i to 31 do
for k:=j to 31 do
begin
for n:=0 to 9 do a[n]:=0;
g:=i*i mod 10; s:=(i*i div 10) mod 10; b:=i*i div 100; a[g]:=1; a[s]:=1; a[b]:=1;
g:=j*j mod 10; s:=(j*j div 10) mod 10; b:=j*j div 100; a[g]:=1; a[s]:=1; a[b]:=1;
g:=k*k mod 10; s:=(k*k div 10) mod 10; b:=k*k div 100; a[g]:=1; a[s]:=1; a[b]:=1;
t:=0;
for n:=1 to 9 do t:=t+a[n];
if t=9 then writeln(i*i:8,j*j:8,k*k:8);
end;
end.
素数类问题程序设计试题
（备注：除第1题写出判断素数子函数外，其余各题的判断素数子函数均相同，故省略，但同学们在编程的时候不能省，否则程序将无法运行。）
编程求正整数M与N（Mprogram e;
var
i,m,n:integer;
fun_ction prime(x:longint):boolean;
var
j,y:longint;
flag:boolean;
begin
y:=trunc(sqrt(x));
flag:=true;
for j:=2 to y do
if (x mod j = 0) then begin flag:=false; break; end;
if x<2 then flag:=false;
if flag=true then prime:=true else prime:=false;
end;
begin
writeln; writeln('input two integer number for m and n (m for i:=m to n do
if prime(i)=true then write(i:4);
end.
验证歌德巴赫猜想：任何一个充分大的偶数N（N≥4），都可以用两个素数之和表示。例如：4＝2＋2，6＝3＋3，8＝3＋5，98＝17＋79。 （★★，循环语句）
歌德巴赫猜想之一是任何大于5的奇数都可表示为3个素数之和。请用10个大于5的奇数验证这一论断。奇数用随机函数产生，把验证编写为过程，打印出每个数和组成该数的三个素数。（★★）
编写程序，判断任何一个大于2的整数是素数还是合数。 （★★）
（素数算法：只需判断到这个数开平方的整数为止即可，如判断25，则只需判断从2～5即可）
（测试数据：2147483647； 答案：Yes）（源程序略）
一个自然数是素数，且它的数字位置经过任意对换后仍为素数，则称为绝对素数，例如13。试找出所有两位数的绝对素数。 （★★）
（答案：11、13、17、31、37、71、73、79、97）（源程序略）
用筛选法求素数。 （★★★）
若两素数之差为2，则称该两素数为双胞胎数。求出［2，300］之内： （★★）
（1）最大的一对双胞胎数；（2）有多少对双胞胎数。
（答案：①281和283； ②19）（源程序略）
若两个自然连续数乘积减1后是素数，则称此两个自然连续数为友数对，该素数称为友素数。例如，由于2×3－1＝5，因此，2与3是友数对，5是友素数。求［2，99］之间： （★★）
（1）友数对的数目；（2）所有友素数之和。
（答案：①48； ②128044）（源程序略）
梅森尼数是指能使2n－1为素数的数n。求［1，21］范围内： （★★）
（1）有多少个梅森尼数？（2）最大的梅森尼数？
（答案：①7； ②19）
program e6_9;
var
i,count:longint;
begin
writeln; count:=0;
for i:=1 to 21 do
if prime(trunc(exp(i*ln(2))-1))=true then begin inc(count); write(i:8); end;
writeln; writeln('count=',count);
end.
一个素数（设为p）依次从低位去掉一位，二位，…，若所得的各数仍都是素数，则称数p为超级素数。例如239即是超级素数。试求［100，9999］之内： （★★）
（1）超级素数的个数；（2）最大的超级素数。
（答案：①30； ②7393）
program e6_9;
var
i,count:integer;
begin
writeln;
for i:=100 to 999 do
if (prime(i))and(prime(i div 10))and(prime(i div 100)) then inc(count);
for i:=1000 to 9999 do
if (prime(i))and(prime(i div 10))and(prime(i div 100))and(prime(i div 1000)) then
begin inc(count); write(i:8); end;
writeln; writeln('count=',count);
end.
求1000~1200以内的所有纯素数。纯粹素数是这样定义的：一个素数，去掉最高位，剩下的数仍为素数，再去掉剩下的数的最高位，余下的数还是素数。这样下去一直到最后剩下的个位数也还是素数。（纯素数不同于超级素数，注意二者的区别） （★★）
（答案：1013、1097、1103）
program I_14;
var
x:integer;
begin
writeln;
for x:=1000 to 1200 do
if prime(x)=true then
if prime(x mod 1000)=true then
if prime(x mod 100)=true then
if prime(x mod 10)=true then write(x:8);
end.
一个合数，去掉最低位，剩下的数仍是合数，再去掉剩下的数的最低位，余留下来的数还是合数，这样反复，一直到最后公剩下的一位数仍是合数；我们把这样的数称为纯粹合数。求100～500之间所有纯粹合数的个数。 （★★）
（答案：58）
program I_18;
var
i,s:integer;
begin
writeln; s:=0;
for i:=100 to 500 do
if (prime(i)=false) and (prime(i div 10)=false) and (prime(i div 100)=false) and ((i div 100)<>1)
then begin write(i:8); inc(s); end;
writeln; writeln(s);
end.
试找出5个小于160而成等差数列的素数。 （★★）
（答案：5、11、17、23、29；或5、17、29、41、53）
program I_28;
var
i,d:integer;
begin
writeln;
for i:=2 to 160 do
for d:=1 to 26 do
if prime(i)=true then
if prime(i+d)=true then
if prime(i+2*d)=true then
if prime(i+3*d)=true then
if prime(i+4*d)=true then writeln(i:4,i+d:4,i+2*d:4,i+3*d:4,i+4*d:4)
end.
如果两个素数之和的一半仍然是一个素数，则这三个素数可以组成一个等差素数组，如（3+7）/2=5，则（3，5，7）为一个等差素数组，编程求100以内的所有等差素数组。 （★★）
（答案：共46组）
program e6_9;
var
d,i:longint;
begin
writeln;
for i:=2 to 100 do
for d:=2 to 100 do
begin
if ((i+2*d)<100)and(prime(i)=true)and(prime(i+d)=true)and(prime(i+2*d)=true) then
write(i:8,i+d:8,i+2*d:8,'':16);
end;
end.
某自然数n的所有素数因子的平方和等于n，（n<100），请找出二个这样的自然数n。 （★★）
（答案：4、9、25、49）
program e6_9;
var
i,j,s:integer;
begin
writeln;
for i:=2 to 100 do
begin
s:=0;
for j:=2 to i do
if (i mod j=0)and(prime(j)=true) then s:=s+j*j;
if s=i then write(i:8);
end;
end.
因子、质因子类问题程序设计试题
任意输入一个正整数，输出它的质因子乘积形式。如100＝2×2×5×5。 （★★）
program e2_25;
var
i,n:integer;
begin
writeln; writeln('input a integer number:');
readln(n); write(n,'=');
while n>1 do
begin
for i:=2 to n do
if n mod i=0 then
begin
n:=n div i; write(i); dec(i);
if n>1 then write('*') else exit;
end;
end;
end.
求2～1000中的完数。（因子（除开它本身）之和等于它本身的数称为完数，例如28的因子是1、2、4、7、14，并且1＋2＋4＋7＋14＝28，所以28是完数。）（完数又称完全数）（★★）
（答案：6、28、496）
program e2_27;
var
i,j,n,s:integer;
begin
writeln;
for i:=2 to 1000 do
begin
n:=i; s:=0;
for j:=1 to n div 2 do
if n mod j=0 then
s:=s+j;
if s=n then write(n:8);
end;
end.
整数36的质因子共有4个，它们是2，2，3，3，求整数716539的： （★★）
（1）质因子个数；（2）最小质因子；（3）最大质因子。
（答案：①3； ②83； ③97）
program e;
var
i,x,n:longint;
begin
writeln; n:=0; x:=716539; write(x,'=');
while (x>1) do
begin
for i:=2 to x do
if (x mod i=0) then
begin
write(i); x:=x div i; inc(n); dec(i);
if x>1 then write('*');
end;
end;
writeln; writeln('n=',n);
end.
若某整数N的所有因子之和等于N的倍数，则称N为多因子完备数。例如，28是多因子完备数。因为：1＋2＋4＋7＋14＋28＝56＝28×2。试求［1，700］之内： （★★）
（1）有多少个多因子完备数？（2）最大的一个多因子完备数是？
（答案：①6； ②672）
program e;
var
i,j,n,count:integer;
begin
writeln; count:=0;
for i:=1 to 700 do
begin
n:=0;
for j:=1 to i do
if (i mod j=0) then n:=n+j;
if (n mod i=0) then begin inc(count); write(i:8); end;
end;
writeln; writeln('count=',count);
end.
已知24有8个因子，而24正好被8整除。求［1，100］之间： （★★）
（1）有多少个整数能被其因子的个数整除？（2）其中最大的整数是？
（答案：①16； ②96）
program e;
var
i,j,n,count:integer;
begin
writeln; count:=0;
for i:=1 to 100 do
begin
n:=0;
for j:=1 to i do
if (i mod j=0) then inc(n);
if (i mod n=0) then begin write(i:8); inc(count); end;
end;
writeln; writeln('count=',count);
end.
寻求并输出3000以内的亲密数对。亲密数对的定义为：若正整数A的所有因子（不包括A）之和为B，B的所有因子（不包括B）之和为A，且A≠B，则称A与B为亲密数对。 （★★）
（答案：［220，284］、［1184，1210］、［2620，2924］）
program e;
var
i:integer;
fun_ction qinmi(n:integer):integer;
var
j,s:integer;
begin
s:=0;
for j:=1 to n-1 do if (n mod j=0) then s:=s+j;
qimi:=s;
end;
begin
writeln;
for i:=2 to 3000 do
if (qinmi(i)<3000)and(qinmi(qinmi(i))=i)and(i<>qinmi(i)) then
writeln(i:8,qinmi(i):8);
end.
一个自然数，若它的素因数至少是两重的（相同的素因数至少个数为二个，如：36=2*2*3*3），则称该数为"漂亮数"。若相邻的两个自然数都是"漂亮数"，就称它们为"孪生漂亮数"，例如8和9就是一对"孪生漂亮数"。编程再找出一对"孪生漂亮数"。 （★★★）
（分析：素因素至少是两重的则说明这个数至少能被素因素的平方整除，注意此程序退出语句用法）
（答案：288和289、675和676）
program e;
var
i:longint;
fun_ction piaoliang(x:longint):boolean;
var
a,y:longint;
flag:boolean;
begin
flag:=true; y:=x;
if y<4 then begin flag:=false; exit; end;
while y>1 do
begin
for a:=2 to y do
begin
if (y mod (a*a)<>0)and(a*a>y) then begin piaoliang:=false; exit; end
else if (y mod (a*a)=0) then
repeat
y:=y div a;
until (y mod a<>0);
if a>y then break;
end;
end;
if flag=true then piaoliang:=true else piaoliang:=false;
end;
begin
writeln; i:=8;
repeat
inc(i);
if (piaoliang(i)=true)and(piaoliang(i+1)=true) then
begin writeln(i:8,i+1:8); exit; end;
until(i>1000);
end.
6的因子有1、2、3、6，它们的和1+2+3+6与原数6的比值等于2，比6小的数的这个比值都小于2，比6大的数一直到12，才有（1+2+3+4+6+12）/12=2.33，比值超过2。 编程序，给出120以内最大比值的统计表，即从6开始计算此值，得到更大的此值就输出，再得到新的更大比值则再输出，一直到120，输出格 式为： （★★）
6 12 。。。
2 2.33 。。。(其中比值精确到小数点后第二位)
（答案： 6 12 24 36 48 60 120
2.00 2.33 2.50 2.53 2.58 2.80 3.00 )
program e;
var
i,j,k,s:integer;
a:array[1..120] of integer;
b:array[1..120] of real;
begin
writeln; a[1]:=6; b[1]:=2; k:=1;
for i:=6 to 120 do
begin
s:=0;
for j:=1 to i do
if (i mod j=0) then s:=s+j;
if (s/i)>b[k] then begin inc(k); a[k]:=i; b[k]:=s/i; end;
end;
for i:=1 to k do write(a[i]:8);
writeln;
for i:=1 to k do write(b[i]:8:2);
end.
约瑟夫类问题程序设计试题
约瑟夫问题：N个人围成一圈，从第一个人开始报数，数到M的人出圈；再由下一个人开始报数，数到M的人出圈；……，输出依次出圈的人的编号。N、M由键盘输入。（★★★）
（测试数据N＝8，M＝3； 答案：3、6、1、5、2、8、4、7）
program e;
var
m,n,i,count,x:integer;
a:array[1..1000] of integer;
begin
writeln; writeln('input integer number for n(people number):'); readln(n); x:=0;
writeln('input integer number for m:'); readln(m);
for i:=1 to n do a[i]:=1;
x:=0; count:=0; i:=0;
repeat
inc(i); if i=n+1 then i:=1;
if a[i]=1 then inc(count);
if count=m then begin count:=0; write(i,' '); a[i]:=0; inc(x); end;
until(x=n);
end.
n只猴子选大王，选举办法如下：从头到尾1、2、3报数，凡报3的退出；余下的从尾到头1、2、3报数，凡报3的退出；余下的又从头到尾报数，还是报3的退出；依此类推，当剩下两只猴子时，取这时报数报1的为王。若想当猴王，请问当初应占据什么位置？（★★★★）
（算法分析：开始选举之前用n个数组存放数1，当报数为3的倍数时，更改存放的数为0（0表示淘汰出局），直到最后只有两个1为止）
（测试数据：N＝8； 答案：4）
program e4_7;
var
a:array[1..1000] of integer;
i,n,b,count:integer;
begin
writeln; write('input N:');
read(n);
for i:=1 to n do a[i]:=1;
count:=n;
while count>1 do
begin
if count=2 then
begin
for i:=1 to n do
if a[i]=1 then begin write(i); exit; end;
end
else
begin
b:=0;
for i:=1 to n do
begin
if a[i]=1 then inc(b);
if (b mod 3=0)and(b>0) then begin a[i]:=0; dec(count); b:=0; end;
end;
end;
if count=2 then
begin
for i:=n downto 1 do
if a[i]=1 then begin write(i); exit; end;
end
else
begin
b:=0;
for i:=n downto 1 do
begin
if a[i]=1 then inc(b);
if (b mod 3=0)and(b>0) then begin a[i]:=0; dec(count); b:=0; end;
end;
end;
end;
end.
围绕着山顶有10个洞，一只狐狸和一只兔子住在各自的洞里。狐狸总想吃掉兔子。一天，兔子对狐狸说：“你想吃我有一个条件，先把洞从1～10编上号，你从10号洞出发，先到1号洞找我；第二次隔一个洞找我，第三次隔2个洞找我，以后依此类推，此数不限。若能找到我，你就可以饱餐一顿。不过在没有找到我以前不能停下来。”狐狸满口答应就开始找了，它从早到晚进了1000次洞，累得昏了过去也没找到兔子。问兔子躲在几号洞？ （★★）
（答案：2、4、7、9）
program e4_8;
var
a:array[1..10] of integer;
i,n:longint;
begin
writeln;
for i:=1 to 10 do a[i]:=1;
n:=0;
for i:=1 to 1000 do
begin
n:=n+i;
if n mod 10=0 then a[10]:=0 else a[n mod 10]:=0;
end;
for i:=1 to 10 do
if a[i]=1 then write(i:8);
end.
有2N个学生去春游，其中男女各半。为了增加乐趣，他们玩一个出圈游戏，游戏的规则是：所有的学生围成一个圈，顺时针从1到2N编号，从1号开始以1到M（M≥1）循环报数，报到M的人退出，当有N－1个人出圈后，只剩下一个女生了，于是改变游戏规则从刚才的下一个人开始仍以1到M反向（与原来的方向相反）报数，报到M的人退出，恰好最后一个出圈的是女生。问当初他们是怎样排列的，同时按他们出圈的先后顺序输出各自的编号。以“O”表示男生，“*”表示女生。
编号为1、2、3、…、N的N个人按顺时针方向围坐一圈，每人持有一个密码（正整数）。从指定编号为1的人开始，按顺时针方向自1开始顺序报数，报到指定数M时停止报数，报M的人出列，并将他的密码作为新的M值，从他在顺时针方向的下一个人开始，重新从1报数，依此类推，直至所有的人全部出列为止。请设计一个程序求出出列的顺序，其中N≤30，M及密码值从键盘输入。
高精度算法程序设计试题
（在下面的高精度算法程序设计试题中，均采用子过程进行输入、输出和加、减、乘等操作，其中的输出和输出操作通用，特别需仔细体会加、减、乘子过程的算法描述。）
从键盘输入两个位数不超过100位的正整数A和B，求A＋B的值。
program e;
var
a,b,c:array[0..1000] of byte;
s1,s2:string;
procedure shuru;
var
i,j,code:integer;
flag:boolean;
begin
repeat
writeln('input A:'); readln(s1); flag:=true;
a[0]:=length(s1);
for i:=1 to a[0] do
if (ord(s1[i])<48)or(ord(s1[i])>57) then flag:=false;
until flag=true;
for i:=1 to a[0] do val(s1[a[0]-i+1],a[i],code);
repeat
writeln('input B:'); readln(s2); flag:=true;
b[0]:=length(s2);
for i:=1 to b[0] do
if (ord(s2[i])<48)or(ord(s2[i])>57) then flag:=false;
until flag=true;
for i:=1 to b[0] do val(s2[b[0]-i+1],b[i],code);
end;
procedure jia;
var
i,t:integer;
begin
if a[0]>b[0] then t:=a[0] else t:=b[0];
for i:=1 to t do
begin
c[i]:=c[i]+(a[i]+b[i]);
if c[i]>=10 then begin inc(c[i+1]); c[i]:=c[i] mod 10; end;
end
end;
procedure shuchu;
var
i:integer;
begin
while c[c[0]]=0 do dec(c[0]);
for i:=c[0] downto 1 do write(c[i]);
end;
{============main=========}
begin
writeln;
shuru;
jia;
shuchu;
end.
从键盘输入两个位数不超过100位的正整数A和B，求A－B的值。
program e;
var
a,b,c:array[0..1000] of byte;
s1,s2:string;
procedure shuru;
var
i,j,code:integer;
flag:boolean;
begin
repeat
writeln('input A:'); readln(s1); flag:=true;
a[0]:=length(s1);
for i:=1 to a[0] do
if (ord(s1[i])<48)or(ord(s1[i])>57) then flag:=false;
until flag=true;
for i:=1 to a[0] do val(s1[a[0]-i+1],a[i],code);
repeat
writeln('input B:'); readln(s2); flag:=true;
b[0]:=length(s2);
for i:=1 to b[0] do
if (ord(s2[i])<48)or(ord(s2[i])>57) then flag:=false;
until flag=true;
for i:=1 to b[0] do val(s2[b[0]-i+1],b[i],code);
end;
procedure jian;
var
i:integer;
begin
if (a[0]>b[0])or((a[0]=b[0])and(s1>s2)) then
for i:=1 to a[0] do
begin
if a[i]-b[i]<0 then begin a[i+1]:=a[i+1]-1; a[i]:=a[i]+10; end;
c[i]:=a[i]-b[i];
end
else
begin
write('-');
for i:=1 to b[0] do
begin
if b[i]-a[i]<0 then begin b[i+1]:=b[i+1]-1; b[i]:=b[i]+10; end;
c[i]:=b[i]-a[i];
end;
end;
end;
procedure shuchu;
var
i:integer;
begin
while c[c[0]]=0 do dec(c[0]);
for i:=c[0] downto 1 do write(c[i]);
end;
{============main=========}
begin
writeln;
shuru;
jian;
shuchu;
end.
从键盘输入两个位数不超过100位的正整数A和B，求A*B的值。
program e;
var
a,b,c:array[0..1000] of byte;
s1,s2:string;
procedure shuru;
var
i,j,code:integer;
flag:boolean;
begin
repeat
writeln('input A:'); readln(s1); flag:=true;
a[0]:=length(s1);
for i:=1 to a[0] do
if (ord(s1[i])<48)or(ord(s1[i])>57) then flag:=false;
until flag=true;
for i:=1 to a[0] do val(s1[a[0]-i+1],a[i],code);
repeat
writeln('input B:'); readln(s2); flag:=true;
b[0]:=length(s2);
for i:=1 to b[0] do
if (ord(s2[i])<48)or(ord(s2[i])>57) then flag:=false;
until flag=true;
for i:=1 to b[0] do val(s2[b[0]-i+1],b[i],code);
end;
procedure cheng;
var
i,j,k:integer;
begin
for i:=1 to a[0] do
for j:=1 to b[0] do
begin
c[i+j-1]:=c[i+j-1]+(a[i]*b[j] mod 10);
c[i+j]:=c[i+j]+(a[i]*b[j] div 10)+(c[i+j-1] div 10);
c[i+j-1]:=c[i+j-1] mod 10;
end;
end;
procedure shuchu;
var
i:integer;
begin
while c[c[0]]=0 do dec(c[0]);
for i:=c[0] downto 1 do write(c[i]);
end;
{============main=========}
begin
writeln;
shuru;
cheng;
shuchu;
end.
输入两个正整数A和B，其中A、B都小于32767，求A／B的值。要求计算结果精确到小数点后N（1≤N≤200）位。（★★★）
（测试数据： ①输入A＝1，B＝1997，N＝25； 答案：0.0005007511266900350525788
②输入A＝19997，B＝197，N=15； 答案：101.507614213197969）
program I_23;
var
a,b,c,n,i:integer;
begin
writeln; writeln('input A,B and N:'); readln(a,b,n);
write(a,'/',b,'='); write(a div b); write('.'); a:=a mod b;
for i:=1 to n do
begin c:=a*10 div b; a:=10*a mod b; write(c); end;
end.
设计一个程序，当键入一个正整数N（1≤N≤100）时，输出N！的精确表示法。
（测试数据：25！＝15511210043330985984000000；）
program e;
var
a,b,c:array[0..1000] of byte;
n,i,j,k:integer;
procedure cheng;
var
i,j,k:integer;
begin
for i:=1 to a[0] do
for j:=1 to b[0] do
begin
c[i+j-1]:=c[i+j-1]+(a[i]*b[j] mod 10);
c[i+j]:=c[i+j]+(a[i]*b[j] div 10)+(c[i+j-1] div 10);
c[i+j-1]:=c[i+j-1] mod 10;
end;
end;
procedure shuchu;
var
i:integer;
begin
while c[c[0]]=0 do dec(c[0]);
for i:=c[0] downto 1 do write(c[i]);
end;
{============main=========}
begin
writeln; writeln('input n(<=100):'); readln(n); c[1]:=1;
for i:=1 to n do
begin
j:=1000;
while c[j]=0 do dec(j);
a[0]:=j;
for k:=j downto 1 do begin a[k]:=c[k]; c[k]:=0; end;
b[1]:=i mod 10; b[2]:=(i div 10) mod 10; b[3]:=(i div 100) mod 10;
b[0]:=3;
cheng;
end;
write(n,'!='); shuchu;
end.
编程计算Xn，其中X、n的值由键盘输入（必须为正整数并且X<50、n<10）。
（测试数据：X＝49，n＝9； 答案：1628413597910449）
program e;
var
a,b,c:array[0..1000] of byte;
x,n,i,j,k:integer;
procedure cheng;
var
i,j,k:integer;
begin
for i:=1 to a[0] do
for j:=1 to b[0] do
begin
c[i+j-1]:=c[i+j-1]+(a[i]*b[j] mod 10);
c[i+j]:=c[i+j]+(a[i]*b[j] div 10)+(c[i+j-1] div 10);
c[i+j-1]:=c[i+j-1] mod 10;
end;
end;
procedure shuchu;
var
i:integer;
begin
while c[c[0]]=0 do dec(c[0]);
for i:=c[0] downto 1 do write(c[i]);
end;
{============main=========}
begin
writeln; writeln('input x(<50) and n(<10):'); readln(x,n); c[1]:=1;
for i:=1 to n do
begin
j:=1000;
while c[j]=0 do dec(j);
a[0]:=j;
for k:=j downto 1 do begin a[k]:=c[k]; c[k]:=0; end;
b[1]:=x mod 10; b[2]:=(x div 10) mod 10; b[3]:=(x div 100) mod 10;
b[0]:=3;
cheng;
end;
write(x,'︿',n,'='); shuchu;
end.
求789789…789（共29组789）除以79的商和余数。
（答案：余数8 商：999733911126316189607328847835176949100重复一次9997339）
program e;
const w=3*29; m=79;
var
a,b:array[0..w] of integer;
x,i,j:integer;
begin
writeln;