嗯……貌似没人用pascal语言,但我现在只学了这门语言,以后肯定会换语言,先来一个比较经典的问题的程序:
卡布列克是一位数学家,他在研究数字时发现:任意一个不是用完全相同数字组成的四位数,如果对它们的每位数字重新排序,组成一个较大的数和一个较小的数,然后用较大数减去较小数,差不够四位数时补零,类推下去,最后将变成一个固定的数:6174,这就是卡布列克常数。 例如:4321-1234=3087 8730-378=8352 8532-2358=6174 7641-1467=6147 如果K位数也照此办理,它们不是变成一个数,就是几个循环的数。
program project1;
var n:string;
cd,gs,t,c2,r,f:longint;
s:array[1..100] of string;
m:array[1..100000] of longint;
procedure kbl(x:string);
var i,j,c,cl,a,b,d:longint;
y:string;
l:char;
begin
c:=length(x);
for i:=1 to c -1 do
for j:=i+1 to c do
if x<x[j] then begin
l:=x;
x:=x[j];
x[j]:=l;
end;
a:=0;b:=0;
for i:=1 to c do a:=a*10+ord(x)-48;
for i:=c downto 1 do b:=b*10+ord(x)-48;
d:=a-b;
i:=0;
while (m<>d)and(i<=cd) do inc(i);
if i>cd then begin
inc(cd);
m[cd]:=d;
y:='';
while d<>0 do begin
y:=y+chr((d mod 10)+48);
d:=d div 10;
end;
cl:=length(y);
if cl<c then for j:=cl to c-1 do y:=y+'0';
kbl(y);
end
else for j:=i to cd do write(m[j],' ');
end;
begin
readln(n);
gs:=0;
while n<>'' do begin
inc(gs);
s[gs]:=n;
readln(n);
end;
for t:=1 to gs do begin
cd:=1;
c2:=length(s[t]);
f:=0;
for r:=1 to c2 do f:=f*10+ord(s[t][r])-48;
m[cd]:=f;
kbl(s[t]);
writeln;
end;
end.
可计算多组数据至输入为空
