初一Free pascal语言题目

Question

题1、求Sn=a+aa+aaa+…+aa…a 之值，其中a是一个数字。例如：2+22+222+2222+22222（此时n=5）, n由键盘输入。

题2、打印100-999之间所有的“水仙花数”。“水仙花数”是一个三位数，其各位数立方和等于该数本身。

题3、有15个数按由小到大顺序存放在一个数组中，输入一个数，要求找出该数是数组中第几个元素的值。如果该数不在数组中，则打印出“NO”。

题4、如果矩阵A中存在这样的一个元素A[i,j]满足下列条件：A[i,j]是第i行中值最小的元素，且又是第j列中值最大的元素，则称之为该矩阵的一个马鞍点。编写一个程序计算出矩阵A的所有马鞍点，以及其位置。

题5、一辆以固定速度行驶的汽车，司机在上午10点看到里程表上的读数是一个对称数(即这个数从左向右读和从右向左读是完全一样的)，为95859。两小时后里程表上又出现了一个新的对称数。编写一个程序求该车的速度以及这新的对称数。

题6、纯粹素数是这样定义的：一个素数，去掉最高位，剩下的数仍为素数，再去掉剩下的数的最高位，余下的数还是素数。这样下去一直到最后剩下的个位数也还是素数。求出所有小于3000的四位的纯粹素数。

题7、已知一个正整数的个位数为7，将7移到该数的首位，其它数字顺序不变，则得到的新数恰好是原数的7倍，编程找出满足上述要求的最小自然数。

题8、求阶乘100！（将每一位都打印出来）

题9、把高精度减法写在记事本上。

题10、设有一个N*M方格的棋盘（ l＜＝ N＜＝ 100，1＜＝ M＜＝ 100）。
求出该棋盘中包含有多少个正方形、多少个长方形（不包括正方形）。
例如：当 N=2， M＝3时：

正方形的个数有8个：即边长为1的正方形有6个；
边长为2的正方形有2个。
长方形的个数有10个：
即2*1的长方形有4个：
1*2的长方形有3个：
3*1的长方形有2个：
3*2的长方形有1个：
程序要求：输入：N，M
输出：正方形的个数与长方形的个数
如上例：输入：2 3
输出：8，10

题11、分数变小数
写出一个程序，接受一个以N/D的形式输入的分数，其中N为分子，D为分母，输出它的小数形式。如果它的小数形式存在循环 节，要将其用括号括起来。例如：1/3=.00000...表示为.(3)，又如41/333=.123123123...表示为.(123)。
一些转化的例子：
1/3=.(3)
22/5=4.4
1/7=.(142857)
3/8=.375
45/46=.803(571428)
用上面的分数和11/59来测试你的程序。
运行举例：
ENTER N，D：1 7
1/7=.(142857)
本题中，0<=N<=65535，0<=D<=65535，设运算结果小数点后最多保留100位。

游戏题目：
由计算机“想”一个四位数，请人猜这个四位数是多少。人输入四位数字后，计算机首先判断这四位数字中有几位是猜对了，并且在对的数字中又有几位位置也是对的，将结果显示出来，给人以提示，请人再猜，直到人猜出计算机所想的四位数是多少为止。
例如：计算机“想”了一个“1234”请人猜，可能的提示如下：

人猜的整数 计算机判断有几个数字正确 有几个位置正确

1122 2 1
3344 2 1
3312 3 0
4123 4 0
1243 4 2
1234 4 4
如果你回答，请给我联系，Q：469262855

Answer 1

1:
var
n,i:byte;
a,s:longint;
begin
readln(a,n);s:=0;
for i:=1 to n do begin
s:=s+a;
a:=a*10+a mod 10;
end;
writeln(s);
readln;
end.

2:
var
a,b,c:byte;
begin
for a:=1 to 9 do
for b:=0 to 9 do
for c:=0 to 9 do
if a*a*a+b*b*b+c*c*c=a*100+b*10+c then
writeln(a,b,c);
readln;
end.

3:
begin
write('Input the array:');
for i:=1 to 15 do read(a[i]);readln;
{paixu}
for i:=1 to 14 do for j:=i+1 to 15 do if a[i]>a[j] then begin
n:=a[i];a[i]:=a[j];a[j]:=n;
end;
{paixu}
write('Input the data:');
readln(n);
for i:=1 to 15 do if a[i]=n then break;
if a[i]=n then while a[i]=n do begin
write(i,' '); i:=i+1;
end else write('NO');
readln;
end.

4:
var
a:array [1..100,1..100] of integer;
i,j,k:byte;
x,y:byte;
f:boolean;
n:word;
begin
write('Input x, y:');
readln(x,y);
writeln('Input data:');
for j:=1 to y do for i:=1 to x do read(a[i,j]);readln;
n:=1;
for i:=1 to x do for j:=1 to y do begin
f:=true;
for k:=1 to x do if a[k,j]<a[i,j] then f:=false;
for k:=1 to y do if a[i,k]>a[i,j] then f:=false;
if f then begin writeln(n:3,' : ',i:3,', ',j:3); n:=n+1; end;
end;
if n=1 then writeln('Not found!');
readln;
end.

5:
var
a:longint;
i:byte;
function dc(n:longint):boolean;
var i:byte;
a:string;
begin
dc:=true;
str(n,a);
for i:=1 to length(a) do if a[i]<>a[length(a)+1-i] then dc:=false;
end;
begin
a:=95860;
while not dc(a) do inc(a);
write(a);
readln;
end.

6:
var
a:array [0..3000] of boolean;
i,j:word;
begin
fillchar(a,sizeof(a),true);
a[0]:=false; a[1]:=false;
for i:=2 to 3000 do if a[i] then
for j:=2 to 3000 div i do a[i*j]:=false;
for i:=11 to 3000 do if a[i] then
if not a[i mod round(exp(ln(10)*(trunc(ln(i)/ln(10)))))] then a[i]:=false;
for i:=1000 to 3000 do if a[i] then write(i:8);
readln;
end.

后面懒得写了，有空再说。
之前写过一个猜数字，放在这里了：
program gn;
type int_1_4=array [1..4] of integer;
st_5=string[5];
var i,j,k:integer;
numn,numg:int_1_4;
ga,gb:array [1..8] of integer;
nun:array [1..8,1..4] of integer;
flag:boolean;
ch:char;
procedure init;
var r_g:integer;
begin
randomize;
for i:=1 to 4 do begin
r_g:=random(10-i);
numn[i]:=r_g;
end;
for k:=1 to 4 do
for i:=1 to 4 do
for j:=1 to i-1 do
if numn[i]=numn[j] then begin
numn[i]:=succ(numn[i]);
numn[i]:=numn[i] mod 10
end;
flag:=false;
writeln;writeln;
end;
function readnum(var num:int_1_4):boolean;
var st5:st_5;
function realnum(numl:st_5):boolean;
var flagl:boolean;
begin
flagl:=true;
if length(numl)<>4 then flagl:=false;
realnum:=flagl;
if not flagl then writeln('ERROR:length');
if flagl then begin
for i:=1 to 4 do
if not (numl[i] in ['0'..'9']) then
flagl:=false;
if not flagl then begin
realnum:=false;
writeln('ERROR:char');
end;
if flagl then begin
for i:=1 to 4 do
for j:=1 to i-1 do
if numl[i]=numl[j] then flagl:=false;
if not flagl then begin
writeln('ERROR:same');
realnum:=false;
end;
end;
end;
if not flagl then write('')
end;
procedure lr(st:st_5);
begin
if k<>1 then writeln;
for i:=1 to k-1 do begin
for j:=1 to 4 do write(nun[i,j]);
writeln(' ',ga[i],'A',gb[i],'B');
end;
write('Guess number:');
readln(st5);
end;
begin
lr(st5);
while not realnum(st5) do lr(st5);
for i:=1 to 4 do num[i]:=ord(st5[i])-48;
end;
procedure ab(n,g:int_1_4);
var a,b:integer;
begin
a:=0;b:=0;
for i:=1 to 4 do
for j:=1 to 4 do
if n[i]=g[j] then b:=b+1;
for i:=1 to 4 do
if n[i]=g[i] then begin
a:=a+1;
b:=b-1;
end;
if a=4 then begin
writeln('You are right! Congratulations!');
k:=8;
flag:=true;
end;
if (a<>4) and (k<>8) then for i:=1 to k do write(' ');
ga[k]:=a;gb[k]:=b;
for i:=1 to 4 do nun[k,i]:=g[i];
end;
begin
init;
for k:=1 to 8 do begin
readnum(numg);
ab(numn,numg);
end;
writeln;
if not flag then begin
writeln('Wrong!');
write('right answer is:');
for i:=1 to 4 do write(numn[i]);
writeln;
end;
readln;
end.
还有高精度计算，不过没有除法：
简单加法：
program db1_1;
function jia(n1,n2:string):string;
var
n3:string;
i:byte;
begin
n3:='';
{-1-}if length(n1)<length(n2)
then for i:=1 to length(n2)-length(n1) do insert('0',n1,1)
else for i:=1 to length(n1)-length(n2) do insert('0',n2,1);
{-2-}for i:=length(n1) downto 1 do insert(chr(ord(n1[i])+ord(n2[i])-48),n3,1);
{-3-}for i:=length(n1) downto 1 do
if n3[i]>'9' then begin
if i=1 then insert('1',n3,1)
else n3[i-1]:=succ(n3[i-1])
end;
{-4-}for i:=1 to length(n3) do if n3[i]>'9' then n3[i]:=chr(ord(n3[i])-10);
{-5-}jia:=n3;
end;
var
a,b:string;
begin
readln(a);readln(b);writeln(jia(a,b));readln;
end.
其它：
unit HP;
interface
type
HPN=record
n:string;{数字主体}
s:boolean;{符号，值为true时是正数}
d:integer;{点的位置}
end;
Function StrToHPN(s:string;var a:HPN):boolean;
{将字符串转换为高精度类型}
Function StrInput(s:string):string;
{输入，格式为字符串类型}
Procedure HPNInput(s:string;var a:HPN);
{输入，格式为高精度类型}
Function HPNToStr(a:HPN):string;
{将高精度类型转换为字符串}
Function HPNComp (a,b:HPN):shortint;
{高精度类型比较大小，返回值1为">",0为"=",-1为"<"}
Function StrComp (a,b:string):shortint;
{字符串类型比较大小，返回值1为">",0为"=",-1为"<"}
Procedure HPNEvaluate(a:HPN;var b:HPN);
{赋值，a给b}
Procedure HPNSwap (var a,b:HPN);
{交换a,b}
Procedure HPNPlus (a,b:HPN;var c:HPN);
{高精度类型加法}
Function StrPlus (a,b:string):string;
{字符串类型加法}
Procedure HPNMinus(a,b:HPN;var c:HPN);
{高精度类型减法，a被减数，b为减数}
Function StrMinus(a,b:string):string;
{字符串类型减法，a被减数，b为减数}
Function StringOfChar(c:Char;l:byte):String;
{返回包含一个字符重复指定次数的字符串}
Procedure HPNMultiplication(a,b:HPN;var c:HPN);
{高精度类型乘法}
Function StrMultiplication(a,b:string):string;
{字符串类型乘法}
Procedure HPNdivison(a,b:HPN;var c:HPN;u:byte);
implementation
Function StringOfChar;
var
i:byte;t:String;
begin
t:='';for i:=1 to l do t:=t+c;
StringOfChar:=t;
end;
Function StrToHPN;
var
i:byte;
begin
a.s:=s[1]<>'-';if s[1] in ['+','-'] then delete(s,1,1);
a.d:=pos('.',s)-1;
if a.d=-1 then a.d:=length(s);
delete(s,a.d+1,1);
StrToHPN:=true;
if length(s)=0 then StrToHPN:=false;
while (s[1]='0') and (s<>'') do begin
delete(s,1,1);
a.d:=a.d-1;
end;
for i:=length(s) downto 1 do
if s[i]='0' then delete(s,i,1) else break;
a.n:=s;
for i:=1 to length(a.n) do
if not (a.n[i] in ['0'..'9'])
then StrToHPN:=false;
end;
Procedure HPNInput;
var
t:string;
f:boolean;
begin
f:=false;
repeat
if f then writeln('Input Error!');
write(s);
readln(t);
f:=true;
until StrToHPN(t,a);
end;
function StrInput;
var
a:HPN;
begin
HPNInput(s,a);
StrInput:=HPNToStr(a)
end;
function HPNToStr;
var
i:integer;
s:string;
begin
s:='';
if not a.s then s:=s+'-';
if a.d<=0 then begin
s:=s+'0';
if a.n<>'' then begin
s:=s+'.';
s:=s+StringOfChar('0',a.d+2);
s:=s+a.n;
end;
end else begin
if a.d<=length(a.n) then s:=s+(copy(a.n,1,a.d));
if a.d<length(a.n) then begin
s:=s+'.';
s:=s+(copy(a.n,a.d+1,length(a.n)-a.d))
end;
if a.d>length(a.n) then begin
s:=s+(a.n);
s:=s+StringOfChar('0',a.d-length(a.n));
end;
end;
HPNToStr:=s;
end;
function HPNComp;
var
i,l:byte;
begin
if (a.n=b.n) and (a.s=b.s) and (a.d=b.d) then HPNComp:=0 else begin
if a.s<>b.s then HPNComp:=2*Ord(a.s)-1 else
if a.d<>b.d then HPNComp:=2*Ord((a.d>b.d)=a.s)-1
else begin
for i:=1 to l do if a.n[i]<>b.n[i] then break;
HPNComp:=2*Ord((a.n[i]>b.n[i])=a.s)-1;
end;
end;
end;
function StrComp;
var
m,n:HPN;
begin
StrToHPN(a,m);StrToHPN(b,n);
StrComp:=HPNComp(m,n)
end;
Procedure HPNEvaluate;
begin
b.n:=a.n;b.s:=a.s;b.d:=a.d;
end;
Procedure HPNSwap;
var
c:HPN;
begin
HPNEvaluate(a,c);
HPNEvaluate(b,a);
HPNEvaluate(c,b);
end;
procedure HPNPlus;
var
i,k:integer;
f:boolean;
s:string;
begin
if a.d<b.d then begin
a.n:=StringOfChar('0',b.d-a.d)+a.n;a.d:=b.d;
end else if a.d>b.d then begin
b.n:=StringOfChar('0',a.d-b.d)+b.n;b.d:=a.d;
end;
c.d:=a.d;
if length(a.n)<length(b.n)
then a.n:=a.n+StringOfChar('0',length(b.n)-length(a.n))
else b.n:=b.n+StringOfChar('0',length(a.n)-length(b.n));
k:=0;c.n:='';
if a.s=b.s then begin
c.s:=a.s;
for i:=length(a.n) downto 1 do begin
k:=k+ord(a.n[i])+ord(b.n[i])-96;
c.n:=chr(k mod 10+48)+c.n;
k:=k div 10
end;
if k<>0 then begin
c.n:=chr(k+48)+c.n;
c.d:=c.d+1
end;
end else begin
f:=a.s;a.s:=true;b.s:=true;
if HPNComp(a,b)=-1 then begin
f:=not f;
HPNSwap(a,b)
end;
c.s:=f;
for i:=length(a.n) downto 1 do begin
k:=ord(a.n[i])-ord(b.n[i])+k;
c.n:=chr(48+(k+10) mod 10)+c.n;
if k<0 then k:=-1 else k:=0
end
end;
s:=HPNToStr(c);
if not StrToHPN(s,c) then write('')
end;
function StrPlus;
var
m,n,c:HPN;
begin
StrToHPN(a,m);StrToHPN(b,n);
HPNPlus(m,n,c);
StrPlus:=HPNToStr(c)
end;
procedure HPNMinus;
begin
b.s:=not b.s;
HPNPlus(a,b,c)
end;
function StrMinus;
begin
if b[1]='-' then b:=copy(b,2,length(b)-1) else b:='-'+b;
StrMinus:=StrPlus(a,b)
end;
Procedure HPNMultiplication;
var
i,j:byte;
d:HPN;
begin
with c do begin
n:='0';d:=0;s:=true
end;
for i:=1 to length(a.n) do begin
for j:=1 to ord(a.n[i])-48 do begin
d:=b;d.d:=d.d+a.d-i;
HPNPlus(c,d,c);
end;
end;
end;
function StrMultiplication;
var
m,n,c:HPN;
begin
StrToHPN(a,m);StrToHPN(b,n);
HPNMultiplication(m,n,c);
StrMultiplication:=HPNToStr(c)
end;
procedure HPNdivison;
begin
end;
end.
可以将它保存成hp.pas然后再
uses hp;
var
a,b:string;
begin
a:=StrInput('Input First HPN:');
b:=StrInput('Input Second HPN:');
write(StrPlus(a,b));
write(StrMinus(a,b));
write(StrMultip(a,b));
writeln;
end.
在同一个文件夹保存、运行。

第10题：
正方形=n*m+(n-1)*(m-1)+...直到有一个为零
长方形=(n*(n-1)/2)*(m*(m-1)/2)-正方形

Answer 2

好难啊