【VB教学】第十六节 穷举法

http://hi.baidu.com/mfs666/blog/item/658f0a24339fcb34c895591f.html

 

 

一些小的数学方法，也是要会写的。

program maths;
const maxn=100000;
var
i,j,a,b,c,m,n,ct:longint;
p,pt:array[0..maxn] of longint;//存储素数表和质因数表
d:array[0..maxn] of longint ;
f:array[0..maxn] of boolean;
r:array[0..32] of longint;//进制转换时每一位的权
ks:array[0..32] of char;//进制转换时所用的进制数串

function GCD(x,y:longint): longint;//辗转相除法求最大公约数
Var n:longint;
begin
   While x mod y<>0 do begin//当不能整除时
     n:=x; x:=y; y:=n   mod   y//第二个数作为第一个数，余数作为第二个数
   end;
   GCD:=y;
end;

function acm(x,y:longint):longint;//最小公倍数算法，依赖于最大公约数算法
begin
   acm:=x*y div gcd(x,y);
end;

function pe(x:longint):boolean;//判断是否为质数，试除法
var
   i,t:longint;
begin
   t:=trunc(sqrt(x));//试除时除到开根号即可
   for i:=2 to t do
    if x mod i=0 then begin
     pe:=false;
     exit;
    end;
   pe:=true;
end;

procedure shai(x:longint);//筛法求质数表
var
   i,j,t:longint;
   f:array[0..maxn] of boolean;
begin
   fillchar(f,sizeof(f),true);
   t:=trunc(sqrt(x));//同样只处理到根号下
   c:=0;
   for i:=2 to t do
     if f[i] then//如果不是已知的合数
      for j:=2 to (x div i) do//枚举另一个对范围有意义乘数，设为合数
       f[i*j]:=false;
   for i:=2 to x do
    if f[i] then begin
      inc(c);
      p[c]:=i;
    end;
end;

procedure fzy(x:longint);//分解质因数，试除法，依赖筛法所求的质数表
var
   t,j:longint;
begin
t:=x;
shai(x);//筛出小于等于该数的质数
ct:=0;
while t>1 do//如果没有被除尽（变成1）
   for j:=1 to c do//枚举质数
     while t mod p[j]=0 do begin//如果能整除就多次除至出尽
      inc(ct);
      pt[ct]:=p[j];
      t:=t div p[j];
     end;
end;

procedure print(x:longint);//生成排列组合的辅助输出过程
var i:longint;
begin
for i:=1 to x do
   write(d[i]);
writeln;
end;

procedure pl(x,m,n:longint);//字典序生成排列，类似深搜
var i:longint;
begin
for i:=1 to n do//对于本深度，枚举每个数字，如果之前没有使用过，则可以使用
   if f[i] then
    begin
     d[x]:=i; f[i]:=false;
     if x=m then print(m) else pl(x+1,m,n);//如果到达所取的组合深度，则输出，否则处理下一个深度
     f[i]:=true;//回溯
   end;
end;

procedure zh(x,m,n:longint);//组合生成，类似深搜
var i:longint;
begin
for i:=d[x-1]+1 to n-(m-x) do begin//对于每一位，枚举上一位所使用的加1到总数减还剩下的深度的数字
   d[x]:=i;
   if x=m then print(m) else zh(x+1,m,n);
end
end;

function exgcd(a,b:longint;var x,y:longint):longint;//扩展欧几里得算法，不懂，死记。。。
var
t:longint;
begin
if b=0 then begin
   exgcd:=a;
   x:=1;
   y:=0;
end else begin
   exgcd:=exgcd(b,a mod b,x,y);
   t:=x;
   x:=y;
   y:=t-(a div b)*y;
end;
end;

procedure equation(a,b,c:longint;var x0,y0:longint);//依赖于扩展欧几里得算法，求不定方程的一个整数解，即将扩展所求的整数根等倍扩大
var d,x,y:longint;
begin
d:=exgcd(a,b,x,y);
if c mod d>0 then begin
   writeln('no answer');
   halt;
end else begin
x0:=x*(c div d);
y0:=y*(c div d);
end;
end;

function o2t(x:string):longint;//进制转换，其他进制到十进制，按位乘权

var
i,t:longint;
begin
o2t:=0;
for i:=length(x) downto 1 do begin
   if not (x[i] in ['0'..'9']) then
    t:=ord(x[i])-55
   else
    val(x[i],t);
   inc(o2t,t*r[length(x)+1-i]);
end;
end;

function t2o(x,j:longint):string;//十进制到其他进制，整除至商为0
var
i.t,m:longint;

begin
t2o:='';
while t<>0 do begin
    m:=t mod j;
    t2o:=t2o+ks[m];
    t:=t div j;
end;
end;

{procedure gauss;//高斯消元，靠的可能性小，暂时未完成
var
begin

end;
}

begin
   {readln(a,b);
   writeln(gcd(a,b));
   writeln(acm(a,b));
   shai(1000);
   for i:=1 to c do
    writeln(p[i]);
   fillchar(b,sizeof(f),true);
   fillchar(a,sizeof(d),0);
   pl(1,m,n);
   zh(1,m,n);}
   {readln(a);
   fzy(a);
   for i:=1 to ct do
    writeln(pt[i]);}

end.