free pascal

Question

2、1267*1267=1605289，表明等式右边是一个七位的完全平方数，而这七个数字互不相同。编程求出所有这样的七位数。
3、一个素数,去掉最高位,剩下的数仍是素数;再去掉剩下的数的最高位,余留下来的数还是素数,这样的素数叫纯粹素数。求所有三位数的纯粹素数。
4、自然数4,9,16,25等叫做完全平方数,因为22 =4, 32 =9, 42 =16,52 =25, 当某一对自然数相加和相减, 有时可各得出一个完全平方数。
例如: 8与17这对自然数： 17+8=25 17—8= 9
试编程,找出所有小于100的自然数对,当加和减该数对时，可各得出一个完全平方数。
5、求数字的乘积根。正整数的数字乘积这样规定：这个正整数中非零数字的乘积。例如整数999的数字乘积为9*9*9，得到729；729的数字乘积为7*2*9，得到126；126的数字乘积为1*2*6，得到12；12从数字乘积为1*2，得到2。如此反复取数字的乘积，直至得到一位数字为止。999的数字乘积根是2。编程输入一个长度不超过100位数字的正整数，打印出计算数字乘积根的每一步结果。输出格式如下：
（N=3486784401）
3486784401
516096
1620
12
2
6、 有一组13个齿轮互相啮合,各齿轮啮合的齿数依次分别为6,8,9,10,12,14,15,16,18, 20,21,22,24, 问在转动过程中同时啮合的各齿到下次再同时啮合时,各齿轮分别转过了多少圈?
7、节目主持人准备从N名学生中挑选一名幸运观众，因为大家都想争当幸运观众，老师只好采取这样的办法：全体同学排成一列，由前面往后面依顺序报数1，2，1，2，…，报单数的同学退出队伍，余下的同学向前靠拢后再重新由前往后1，2，1，2，…报数，报单数者退出队伍，如此下去最后剩下一人为幸运观众。编程找出幸运观众在原队列中站在什么位置上？（N由键盘输入，N < 255）。
8、输入50个学生的某门课程的成绩，打印出低于平均分的同学号数与成绩。
9、国际象棋盘中，第1格放1粒米，第2格放2粒米，第3格放4粒米，第4格放8粒米，第5格放16粒米。。。，问：16个格子总共可以放多少粒米？
10、输入一个不大于32767的正整数N，将它转换成一个二进制数，例如：
输入：100
输出：1100100
11、猴子选大王：有N只猴子围成一圈，每只猴子各一个从1到N中的依次编号，打算从中选出一个大王；经过协商，决定出选大王的规则：从第一个开始循环报数，数到M的猴子出圈，最后剩下来的就是大王。要求：从键盘输入N、M，编程计算哪一个编号的猴子成为大王
样例：
输入：7 3
输出：4
输入：5 2
输出：3
待解：
输入：999 15
输出：？

Answer 1

习题5.1
1.裴波那契数列：数列1、1、2、3、5、8、13、21…称为裴波那契数列，它的特点是：数列的第一项是1，第二项也是1，从第三项起，每项等于前两项之和。编程输入一个正整数N，求出数列的第N项是多少？（N不超过30）。
program Project1;
VAR
a:array[1..30] of longint;{建立一个1-30的数组}
i,n:longint;{设置两个变量}
begin
readln(n);{输入数组中第几个数(不超过30)}
a[1]:=1;{第一个数为1}
a[2]:=1;{第二个数也为1}
for i:=3 to n do{从第三个数开始到N（30）做循环(i为1-30中任意一数)}
begin
a[i]:=a[i-1]+a[i-2];{i等于i前面一个数加前面第二数的和}
end;
write(a[n]);{打印输入的数}
readln;
readln;
end.

2.下面的竖式是乘法运算，式中P表示为一位的素数，编程输出此乘法竖式的所有可能方案。

3.节目主持人准备从N名学生中挑选一名幸运观众，因为大家都想争当幸运观众，老师只好采取这样的办法：全体同学排成一列，由前面往后面依顺序报数1，2，1，2，…，报单数的同学退出队伍，余下的同学向前靠拢后再重新由前往后1，2，1，2，…报数，报单数者退出队伍，如此下去最后剩下一人为幸运观众。编程找出幸运观众在原队列中站在什么位置上？（N由键盘输入，N < 255）。
program Project1;
var
a:array[1..225] of boolean; {建立一个1-225的数组}
n,i,j,b,c:longint;{ b为个数，c为现在所加到的数，i为数量}
begin
read(n); {输入总数(不超过225)}
fillchar(a,sizeof(a),true);{把所有值都赋为真值}
repeat
i:=0;
b:=0;
while i<n do
begin
inc(i);{累加i}
if a[i]=true then begin inc(j); c:=i; if j mod 2<>0 then begin a[i]:=false; end; inc(b);end;
{如果i为真，则累加j。（J为1）C和i交换变量。如果j除以2不等于0，则这些数都赋予假值。累加b}
end;
until b=1;{直到b为1}
writeln(c);{打印c}
readln;
readln;
end.

4. 1267*1267=1605289，表明等式右边是一个七位的完全平方数，而这七个数字互不相同。编程求出所有这样的七位数。

program ex1;
const a:array[0..9]of string=('0','1','2','3','4','5','6','7','8','9');
var i,j,l:longint; s:string;
begin
for i:=1000 to 3162 do
begin
l:=0;
str(i*i,s);
for j:=0 to 9 do
if pos(a[j],s)>0 then inc(l);
if l=7 then write(i*i:8);
end;
readln;
readln;
end.
5. 校女子100米短跑决赛成绩如下表，请编程打印前八名运动员的名次、运动员号和成绩。（从第一名至第八名按名次排列）
运动员号 017 168 088 105 058 123 142 055 113 136 020 032 089 010
成绩(秒) 12.3 12.6 13.0 11.8 12.1 13.1 12.0 11.9 11.6 12.4 12.9 13.2 12.2 11.4
program Project1;
const
n:longint=14;
VAR
a:array[1..14] of real;
b:array[1..14] of longint;
c:array[1..14] of string;
i,j:longint;
t:real;
s:string;
begin
for i:=1 to n do
read(b[i]);
readln;
for i:=1 to n do
read(a[i]);
for i:=1 to n do
str(b[i],c[i]);
for i:=1 to n-1 do
for j:=1 to n-i do
begin
if a[j]<a[j+1] then begin
t:=a[j]; a[j]:=a[j+1]; a[j+1]:=t;
s:=c[j]; c[j]:=c[j+1]; c[j+1]:=s;
end;
end;
for i:=1 to 8 do
writeln(i,' ',c[i],' ',a[i]:0:1);
readln;
readln;
end.
6. 求数字的乘积根。正整数的数字乘积这样规定：这个正整数中非零数字的乘积。例如整数999的数字乘积为9*9*9，得到729；729的数字乘积为7*2*9，得到126；126的数字乘积为1*2*6，得到12；12从数字乘积为1*2，得到2。如此反复取数字的乘积，直至得到一位数字为止。999的数字乘积根是2。编程输入一个长度不超过100位数字的正整数，打印出计算数字乘积根的每一步结果。输出格式如下：
（N=3486784401）
3486784401
516096
1620
12
2

rogram ex2;
var i,j,l:longint; s:string;
begin
readln(s);
writeln(s);
while length(s)<>1 do
begin
l:=1;
for i:=1 to length(s) do
begin
val(s[i],j);
if j<>0 then
l:=l*j;

end;
writeln(l);
str(l,s);
end;
readln;
readln;
end.

7. 有一组13个齿轮互相啮合,各齿轮啮合的齿数依次分别为6,8,9,10,12,14,15,16,18, 20,21,22,24, 问在转动过程中同时啮合的各齿到下次再同时啮合时,各齿轮分别转过了多少圈?
program Project1;
const
a:array[1..13] of longint=(6,8,9,10,12,14,15,16,18,20,21,22,24);
var
b,i,j:longint;
begin
repeat
j:=0;
inc(b);
for i:=1 to 13 do
if b mod a[i]=0 then inc(j);
until j=13;
for i:=1 to 13 do
writeln(b div a[i]);
readln;
readln;
end.

8. 集合M的元素的定义如下:
(1) 数1属于M;
(2) 若X属于M, 则A=2X+1, B=3X+1, C=5X+1, 也属于M;
(3) 再没有别的数属于M。(M={1,3,4,6,7,9,10,13,15,16...，如果M中的元素是按递增次序排列的,求出其中的第201,202和203个元素。

program ex3;
var i,j,t:longint; a:array[1..210]of longint;
begin
a[1]:=1;
i:=1;
j:=1;
while j<203 do
begin
a[j+1]:=a[i]*2+1;
a[j+2]:=a[i]*3+1;
a[j+3]:=a[i]*5+1;
inc(j,3);
inc(i);
end;
for i:=1 to 203 -1 do
for j:=203 downto i+1 do
if a[j-1]>a[j] then
begin t:=a[j-1];a[j-1]:=a[j];a[j]:=t end;
write(a[201],' ',a[202],' ',a[203]);
readln;
readln;
end.
9. 一个素数,去掉最高位,剩下的数仍是素数;再去掉剩下的数的最高位,余留下来的数还是素数,这样的素数叫纯粹素数。求所有三位数的纯粹素数。
var
a:array[1..999]of boolean;
i,j,b:longint;
procedure t1(var c:longint);
var
i,j,l:longint;
b:array[1..10]of longint;
begin
i:=c;l:=0;
while i>0 do
begin
b[l+1]:=i mod 10;
i:=i div 10;
inc(l);
end;
c:=0;i:=1;
for j:=l downto 2 do
begin
inc(c,b[j]*i);
i:=i*10;
end;
end;
begin
for i:=1 to 999 do
begin
a[i]:=true;
for j:=2 to trunc(sqrt(i))+1 do
if i mod j=0 then begin a[i]:=false; break; end;
if i=2 then a[i]:=true;
end;
for i:=100 to 999 do
begin
b:=i;
while (b<>0)and(a[b]) do t1(b);
if b=0 then writeln(i);
end;
readln;
readln;
end.
10. 自然数4,9,16,25等叫做完全平方数,因为22 =4, 32 =9, 42 =16,52 =25, 当某一对自然数相加和相减, 有时可各得出一个完全平方数。
例如: 8与17这对自然数： 17+8=25 17—8= 9
试编程,找出所有小于100的自然数对,当加和减该数对时，可各得出一个完全平方数。
program ex4;
var i,j:longint; a:array[1..200]of boolean;
begin
for i:=1 to 200 do
a[i]:=false;
for i:=1 to 14 do
a[i*i]:=true;
for i:=0 to 100 do
for j:=i to 100 do
begin
if a[i+j] and a[abs(i-j)] then writeln(i,',',j);
end;
readln;
readln;
end.

Answer 2

第一个题目：
program e3;
var x,y:longint;
a:array[1..7]of integer;
i,j,t:integer;
begin
for x:=1000 to 3162 do
begin
t:=0;
y:=x*x;
a[1]:=y div 1000000;
a[2]:=(y-a[1]*1000000) div 100000;
a[3]:=(y-a[1]*1000000-a[2]*100000) div 10000;
a[4]:=(y-a[1]*1000000-a[2]*100000-a[3]*10000) div 1000;
a[7]:=y mod 10;
a[6]:=((y mod 100)-a[7]) div 10;
a[5]:=((y mod 1000)-a[7]-a[6]*10) div 100;

for i:=1 to 6 do
begin
for j:=(i+1) to 7 do
if (a[i]=a[j]) then begin t:=1; break; end;
if (t=1) then break;
end;
if (t=0) then
writeln(y);
end;
readln;
end.

Answer 3

第一题：
var i,j,k:longint;
begin
for i:=1000000 to 9999999 do
if string(sqrt(i))=string(trunc(sqrt(i))) do writeln(i);
end.

第二题：
var i:integer;
function ok(a:integer):boolean;
var i:integer;
begin
for i:=2 to trunc(sqrt(a)) do
if a mod i=0 then exit(false);
ok:=true;
end;
begin
for i:=100 to 999 do
if ok(i) and ok(i mod 100) and ok(i mod 10) then writeln(i);
end.

第三题：
var i,j:integer;
begin
for i:=1 to 100 do
for j:=i to 100 do
if (string(sqrt(i+j)=string(trunc(sqrt(i+j))))and
(string(sqrt(j-i))=string(trunc(sqrt(j-i)))) then
writeln(i,'-',j);
end.

后面几道题我明天再补，我把你的题目重新编了序号，你应该看的懂。

Answer 4

第⑨题
program
var
a,b,c,d:longinr;
begin
a:=1;
d:=0;
for c:=1 to 15 do
begin
b:=a*2;
d:=d+b;
a:=b;
end;
d:=d+1;(加上第一格的1)
writeln(d);
end.