关于数论的代码 （转载）
1．求两数的最大公约数
function gcd(a,b:integer):integer;
begin
if b=0 then gcd:=a
else gcd:=gcd (b,a mod b);
end ;
2．求两数的最小公倍数
function lcm(a,b:integer):integer;
begin
if a<b then swap(a,b);
lcm:=a;
while lcm mod b>0 do inc(lcm,a);
end;
或者利用 最小公倍数=a*b/最大公约数
3．素数的求法
1.小范围内判断一个数是否为质数：
function prime (n: integer): Boolean;
var I: integer;
begin
for I:=2 to trunc(sqrt(n)) do
if n mod I=0 then begin
prime:=false; exit;
end;
prime:=true;
end;
2.判断longint范围内的数是否为素数（包含求50000以内的素数表）：
procedure getprime;
var
i,j:longint;
p:array[1..50000] of boolean;
begin
fillchar(p,sizeof(p),true);
p[1]:=false;
i:=2;
while i<50000 do begin
if p[i] then begin
j:=i*2;
while j<50000 do begin
p[j]:=false;
inc(j,i);
end;
end;
inc(i);
end;
l:=0;
for i:=1 to 50000 do
if p[i] then begin
inc(l);pr[l]:=i;
end;
end;{getprime}
begin
for i:=1 to pnum do
if sqr(p[i])<=x then
begin
if x mod p[i]=0 then
begin
IsPrime:=false;
exit;
end;
end
else
begin
IsPrime:=true;
exit;
end;
IsPrime:=true;
end;{prime}
3.利用随即函数判断longint范围内的数是否为素数
function f(a,b,n:longint):longint; //求a^b mod n
var d,t:int64;
begin
d:=1;t:=a;
while b>0 do
begin
if t=1 then
begin
f:=d;exit;
end;
if b mod 2 =1 then d:=d*t mod n;
b:=b div 2;
t:=t*t mod n;
end;
f:=d
end;
function judge(n:longint):boolean; //判断n是否为素数 n在longint范围内
var k:integer; bool:boolean; a:longint;
begin
randomize;
bool:=true;
for k:=1 to 3 do //适量调整k的大小
begin
a:=random(n-2)+1;
if (f(a,n-1,n) <> 1) then
begin
bool:=false;
exit; //不是 则退出该子程序使用break则只退出if循环而不退出子judge函数的运算过程
end;
end;
if bool then judge:=true //n 是素数
else judge:=false; //n 不是素数 ;
end;
4.求前n个素数:
program BasicMath_Prime;
const
maxn=1000;
var
pnum,n:longint;
p:array[1..maxn] of longint;
function IsPrime(x:longint):boolean;
var i:integer;
begin
for i:=1 to pnum do
if sqr(p[i])<=x then
begin
if x mod p[i]=0 then
begin
IsPrime:=false;
exit;
end;
end
else
begin
IsPrime:=true;
exit;
end;
IsPrime:=true;
end;
procedure main;
var x:longint;
begin
pnum:=0;
x:=1;
while(pnum<n) do
begin
inc(x);
if IsPrime(x) then
begin
inc(pnum);
p[pnum]:=x;
end;
end;
end;
procedure out;
var i,t:integer;
begin
for i:=1 to n do
begin
write(p[i]:5);t:=t+1;
if t mod 10=0 then writeln;
end;
end;
begin
readln(n);
main;
out;
end.
5.求不大于n的所有素数
program sushu3;
const maxn=10000;
var
i,k,n:integer;
a:array[1..maxn] of integer;
begin
readln(n);
for i:=1 to n do a[i]:=i;
a[1]:=0;
i:=2;
while i<n do
begin
k:=2*i;
while k<=n do
begin
a[k]:=0;
k:=k+i;
end;
i:=i+1;
while (a[i]=0) and (i<n) do i:=i+1;
end;
k:=0;
for i:=1 to n do
if a[i]<>0 then
begin
write(a[i]:5); k:=k+1;
if k mod 10 =0 then writeln;
end
end.
6.将整数分解质因数的积
program BasicMath_PolynomialFactors;
const
maxp=1000;
var
pnum,n:longint;
num,p:array[1..maxp] of longint;
procedure main;
var x:longint;
begin
fillchar(num,sizeof(num),0);
fillchar(p,sizeof(p),0);
pnum:=0;
x:=1;
while(n>1) do
begin
inc(x);
if n mod x=0 then
begin
inc(pnum);
p[pnum]:=x;
while(n mod x=0) do
begin
n:=n div x;
inc(num[pnum]);
end;
end;
end;
end;
procedure out;
var j,i:integer;
begin
for i:=1 to pnum do
for j:=1 to num[i] do
write(p[i]:5);
writeln;
end;
begin
main;
out;
end.
6 排列组合
(一) 排列数
[算法描述]
排列数公式
[源程序]
function A(m,n:integer):integer;
var
ans,i:integer;
begin
ans:=1;
for i:=1 to m do
begin
ans:=ans*n;
n:=n-1;
end;
A:=ans;
end;
(二) 组合数
[算法描述]
组合数公式
[源程序]
function C(m,n:integer):integer;
var
ans,i:integer;
begin
ans:=1;
for i:=1 to m do
begin
ans:=ans*n;
n:=n-1;
end;
for i:=1 to m do ans:=ans/i;
C:=ans;
end;
(三) 全排列算法
[算法描述]
1.1,2……N依次赋给a[1]至a[n],输出第一种排列;
2.构造下一种全排列,分四步完成:
(1) i的初值为1,在a[1]至a[n]中搜索找出相应的i,使i是a[k]>a[k-1]的k中最大的,即i=max{k|a[k]>a[k-1],k=2,3…n};
(2) 在a[x]至a[n]中搜索找出相应的j,使j是a[k]>a[i-1]的k中最大的,即j=max{k|a[k]>a[i-1],k=i,i+1…n};
(3) 交换a[i-1]与a[j]形成新的序列;
(4) 对新的序列从 a[i+1]……a[n]进行逆序处理,输出相应序列.
3.重复2直到i=1时结束
[源代码]:
program quanpailie;
const maxn=20;
type arrayt=array[1..maxn]of integer;
var i,n,temp:integer;
procedure inverse(var num:arrayt;x:integer); //对num[x]~num[n]作逆序处理
var
numt:arrayt;
i:integer;
begin
for i:=1 to n do
numt[i]:=num[i];
for i:=0 to n-x do
num[x+i]:=numt[n-i];
end;
procedure arrange(n:integer);
var
num:arrayt;
i,x,y:byte; temp:integer;
begin
num[0]:=0;
for i:=1 to n do
begin
num[i]:=i;
write(num[i],' ');
end;
writeln;
repeat
for i:=1 to n do
if num[i]>num[i-1] then x:=i;
for i:=x to n do
if num[i]>num[x-1] then y:=i;
if x>1 then
begin
temp:=num[x-1];num[x-1]:=num[y];num[y]:=temp;
inverse(num,x); //对num[x]~num[n]作逆序处理
for i:=1 to n do write(num[i],' '); //输出当前序列
writeln;
end;
until x=1;
end;
begin {main}
assign(input,'input.dat'); reset(input);
assign(output,'output.dat');rewrite(output);
readln(n);
arrange(n);
close(input);close(output);
end.
7 进制转换
(一) 十进制转N进制
[算法描述]
辗转相除法.
[源程序]
function int_to_n(x:cardinal; n:byte):string;
var
a:array[1..255] of byte;
ans:string;
count,i:byte;
begin
ans:='';
count:=0;
if x=0 then ans:='0';
while x>0 do
begin
count:=count+1;
a[count]:=x mod n;
x:=x div n;
end;
for i:=count downto 1 do
if a[i]<10 then ans:=ans+chr(ord('0')+a[i])
else ans:=ans+chr(ord('a')-10+a[i]);
int_to_n:=ans;
end;
(二) N进制转十进制
[算法描述]
加权.
[源程序]
function n_to_int(x:string; n:byte):cardinal;
var
a:array[1..255] of byte;
ans,y:cardinal;
count,i,j:byte;
begin
ans:=0;
for i:=1 to length(x) do
if x[i] in ['0'..'9'] then a[i]:=ord(x[i])-ord('0')
else a[i]:=ord(x[i])-ord('a')+10;
count:=0;
for i:=length(x) downto 1 do
begin
y:=1;
for j:=1 to count do y:=y*n;
count:=count+1;
ans:=ans+y*a[i];
end;
n_to_int:=ans;
end;
(三) 八进制数或十六进制数转换为二进制数，二进制数转换成八进制数和十六进制数的通用程序(仅在整数范围)。如：
输入一个数m : ABC
输入此数的进制n : 16
输出：
ABC(16)=101010111100(2)
又如输入一个数m : 101010111100
输入此数的进制n : 2
输出：
101010111100(2)=ABC(16)=5274(8)
【程序清单】
PROGRAM P12_5b;
CONST s0=['0'..'9','A'..'F'];
c:ARRAY [0..15] OF STRING[4]=('0000','0001','0010','0011','0100','0101',
'0110','0111','1000','1001','1010','1011','1100','1101','1110','1111');
c0:ARRAY [1..7] OF STRING=('1','10','11','100','101','110','111');
VAR i,j,k,n,l:Integer; f:Boolean;
s,s1,ss:STRING; ch:Char;
BEGIN
assign(input,'input.dat'); reset(input);
assign(output,'output.dat');rewrite(output);
ss:='0123456789ABCDEF';
Write('Input a string : '); Readln(s); {'输入一个数串}
REPEAT
Write('Input a number : '); Readln(n) {'输入一个此数串进制 }
UNTIL n IN [2,8,16];
l:=Length(s); i:=1; f:=True;
WHILE (i<=l) AND f DO BEGIN {'检测数串}
ch:=Upcase(s[i]); Write(ch);
IF n=16 THEN IF NOT(ch IN s0) THEN f:=False; {'如f为假输出出错信息}
IF n=8 THEN IF NOT(ch IN ['0'..'7']) THEN f:=False;
IF n=2 THEN IF NOT(ch IN ['0','1']) THEN f:=False;
i:=i+1;
END;
Write('(',n,') = ');
IF NOT f THEN BEGIN Writeln('Data Error !'); Readln; Exit END;
CASE n OF {'分情况处理}
2:BEGIN {'输入的是二进制数 }
i:=1; j:=l MOD 4; {'按每四位分，取余数j}
WHILE i<l DO BEGIN {'用当循环来处理}
s1:=Copy(s,i,j); {'取出子串}
IF j<4
THEN {'头一个子串因前面没有无用的0的，转换时分别处理 }
FOR k:=1 TO 7 DO IF s1=c0[k] THEN Write(k) ELSE
ELSE {'以后的子串每四位对应一个十六进制数}
FOR k:=0 TO 15 DO IF s1=c[k] THEN Write(ss[k+1]);
i:=i+j; j:=4; {'除头一个子串外，以后按每四位截取}
END; Write('(',16,') = '); {'十六进制数输出结束 }
i:=1; j:=l MOD 3; {'按每三位分, 取余数j }
WHILE i<l DO BEGIN
s1:=Copy(s,i,j);
IF j<3 {'头一个子串因前面没有无用的0，转换时分别处理 }
THEN FOR k:=1 TO 7 DO IF s1=c0[k] THEN Write(k) ELSE
ELSE FOR k:=0 TO 7 DO IF s1=Copy(c[k],2,4) THEN Write(ss[k+1]);
i:=i+j; j:=3; {'除头一个子串外，以后按每三位截取}
END; Writeln('(',8,')'); {'八进制数输出结束}
END;
8,16: {'输入的是八或十六进制数}
FOR i:=1 TO l DO BEGIN
ch:=Upcase(s[i]); j:=Ord(ch)-48; {'先转成大写，再转成对应的数}
IF ch IN ['A'..'F'] THEN j:=j-7;
IF i=1 {'头一个数转换成二进制数，前面无用的0不输出}
THEN IF ch IN ['1'..'7'] THEN Write(c0[j])
ELSE Write(c[j])
ELSE IF n=16 THEN Write(c[j]) {'转成十六进制数}
ELSE Write(Copy(c[j],2,4)) {'转成八进制数}
END
END;
IF n IN [8,16] THEN Writeln('(',2,')');
close(input);close(output);
END.
(四) 不同进制数之间实数转换的通用程序。
输入n进制的数m与要转换的p进制的输出。
如：
输入一个数m : ABC.CBA
输入此数的进制n : 16
输入要转换成的数的进制p : 2
输出：
ABC.ABC(16)=101010111100.11001011101(2)
【程序清单】
PROGRAM P12_5A;
TYPE ss=STRING[30];
VAR m,m1,a,s:ss;
m0,n,p,i,j,t,s1,x:Integer; mm,d:LongInt;
mr:Real;
PROCEDURE Zhuan(ch:Char); {过程—数字符转换成数}
BEGIN
j:=Ord(ch)-48; {数字符转换成数}
IF ch IN ['A'..'F'] THEN j:=j-7; {数字符转换成数}
IF (j<0) AND (j>=n) THEN {出界输出出错信息，程序终止}
BEGIN Writeln('Data errer !'); Readln; EXIT END;
END;
PROCEDURE Xiao(m:ss); {过程—小数部分的转换}
BEGIN
mr:=0; m0:=Length(m); t:=n; {初始化}
IF n=10 THEN Val(m,mr,t) ELSE {如是十进制数，就直接把数串转换成数}
FOR i:=2 TO m0 DO BEGIN {否则把m，先转换成十进制小数,m[1]是小数点}
Zhuan(m[i]); {调用字符转为数的过程}
mr:=mr+j/t; t:=t*n {按权一一展开，累加到mr中}
END;
m:='.'; {再把mr转换成p进制的数串}
WHILE mr>0.00001 DO BEGIN {精度要求5位小数}
mr:=mr*p; x:=Trunc(mr); {用乘p取整法，取出一位整数}
m:=m+s[x+1]; mr:=mr-x; {按顺序一一连入m中}
END;
Write(m) {输出p进制的数串m}
END;
BEGIN
s:='0123456789ABCDEF'; {s字符串用以对应数制用}
Write('Input m : '); Readln(m); {输入原数}
Write('Input n : '); Readln(n); {输入原数的进制}
Write('Input p : '); Readln(p); {输入要转换成的数的进制}
m0:=Length(m);
FOR i:=1 TO m0 DO m[i]:=Upcase(m[i]);{转成大写}
Write(m,'(',n,') = '); {输出要转换的原数及其进制}
x:=Pos('.',m); {找出小数点的位置。如没有小数点x为0}
IF x<>0 {如有小数部分，就把小数(m1)与整数(m)分离}
THEN BEGIN m1:=Copy(m,x,m0+1-x); m:=Copy(m,1,x-1) END;
t:=1; mm:=0; m0:=Length(m); {先做整数部分的转换}
IF n<>10 THEN {把数串m转换成十进制数mm}
FOR i:=m0 DOWNTO 1 DO BEGIN
Zhuan(m[i]); {调用字符转为数的过程}
mm:=mm+j*t; t:=t*n {按权一一展开，累加到mm中}
END
ELSE Val(m,mm,t); {如是十进制就直接把数串转成数}
IF p<>10 THEN BEGIN {再把mm转换成p进制的数串}
m:='';
WHILE mm>0 DO BEGIN {反序累加到m中}
m:=s[mm MOD p+1]+m; mm:=mm DIV p END;
END
ELSE Str(mm,m); {如mm是十进制数就直接转成数}
IF m<>'0' THEN Write(m); {先输出整数部分转换的结果}
IF x<>0 THEN Xiao(m1); {如有小数部分，就调用过程Xiao}
Writeln('(', p,')'); Readln; {最后输出要转换成的数制信息}
END.
