pascal.txt

pascal基本算法及优化(如数论问题单纯背包问题等)

基本算法（用 PASCAL 描述）  
［作者：sortmail    转贴自：Delphibbs.com    点击数：462    更新时间：2005-1-22    文章录入：aleyn］ 
 
基本算法（用 PASCAL 描述）

1.数论算法 
求两数的最大公约数 
function gcd(a,b:integer):integer; 
begin 
if b=0 then gcd:=a 
else gcd:=gcd (b,a mod B); 
end;  

求两数的最小公倍数 
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.小范围内判断一个数是否为质数： 
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; 

B.判断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} 

function prime(x:longint):integer; 
var i:integer; 
begin 
prime:=false; 
for i:=1 to l do 
if pr[i] >=x then break 
else if x mod pr[i]=0 then exit; 
prime:=true; 
end;{prime} 

2． 

3． 


4.求最小生成树 
A.Prim算法： 
procedure prim(v0:integer); 
var 
lowcost,closest:array[1..maxn] of integer; 
i,j,k,min:integer; 
begin 
for i:=1 to n do begin 
lowcost[i]:=cost[v0,i]; 
closest[i]:=v0; 
end; 
for i:=1 to n-1 do begin 
{寻找离生成树最近的未加入顶点k} 
min:=maxlongint; 
for j:=1 to n do 
if (lowcost[j]< min) and (lowcost[j]< >0) then begin 
min:=lowcost[j]; 
k:=j; 
end; 
lowcost[k]:=0; {将顶点k加入生成树} 
{生成树中增加一条新的边k到closest[k]} 
{修正各点的lowcost和closest值} 
for j:=1 to n do 
if cost[k,j]< lwocost[j] then begin 
lowcost[j]:=cost[k,j]; 
closest[j]:=k; 
end; 
end; 
end;{prim} 

B.Kruskal算法：(贪心) 
按权值递增顺序删去图中的边，若不形成回路则将此边加入最小生成树。 
function find(v:integer):integer; {返回顶点v所在的集合} 
var i:integer; 
begin 
i:=1; 
while (i< =n) and (not v in vset[i]) do inc(i); 
if i< =n then find:=i else find:=0; 
end; 

procedure kruskal; 
var 
tot,i,j:integer; 
begin 
for i:=1 to n do vset[i]:=[i];{初始化定义n个集合，第I个集合包含一个元素I} 
p:=n-1; q:=1; tot:=0; {p为尚待加入的边数，q为边集指针} 
sort; 
{对所有边按权值递增排序，存于e[I]中，e[I].v1与e[I].v2为边I所连接的两个顶点的序号，e[I].len为第I条边的长度} 
while p >0 do begin 
i:=find(e[q].v1);j:=find(e[q].v2); 
if i< >j then begin 
inc(tot,e[q].len); 
vset[i]:=vset[i]+vset[j];vset[j]:=[]; 
dec(p); 
end; 
inc(q); 
end; 
writeln(tot); 
end; 


5.最短路径 
A.标号法求解单源点最短路径： 
var 
a:array[1..maxn,1..maxn] of integer; 
b:array[1..maxn] of integer; {b[i]指顶点i到源点的最短路径} 
mark:array[1..maxn] of boolean; 

procedure bhf; 
var 
best,best_j:integer; 
begin 
fillchar(mark,sizeof(mark),false); 
mark[1]:=true; b[1]:=0;{1为源点} 
repeat 
best:=0; 
for i:=1 to n do 
If mark[i] then {对每一个已计算出最短路径的点} 
for j:=1 to n do 
if (not mark[j]) and (a[i,j] >0) then 
if (best=0) or (b[i]+a[i,j]< best) then begin 
best:=b[i]+a[i,j]; best_j:=j; 
end; 
if best >0 then begin 
b[best_j]:=best；mark[best_j]:=true; 
end; 
until best=0; 
end;{bhf} 

B.Floyed算法求解所有顶点对之间的最短路径： 
procedure floyed; 
begin 
for I:=1 to n do 
for j:=1 to n do 
if a[I,j] >0 then p[I,j]:=I else p[I,j]:=0; {p[I,j]表示I到j的最短路径上j的前驱结点} 
for k:=1 to n do {枚举中间结点} 
for i:=1 to n do 
for j:=1 to n do 
if a[i,k]+a[j,k]< a[i,j] then begin 
a[i,j]:=a[i,k]+a[k,j]; 
p[I,j]:=p[k,j]; 
end; 
end; 

C. Dijkstra 算法： 
类似标号法，本质为贪心算法。 
var 
a:array[1..maxn,1..maxn] of integer; 
b,pre:array[1..maxn] of integer; {pre[i]指最短路径上I的前驱结点} 
mark:array[1..maxn] of boolean; 
procedure dijkstra(v0:integer); 
begin 
fillchar(mark,sizeof(mark),false); 
for i:=1 to n do begin 
d[i]:=a[v0,i]; 
if d[i]< >0 then pre[i]:=v0 else pre[i]:=0; 
end; 
mark[v0]:=true; 
repeat {每循环一次加入一个离1集合最近的结点并调整其他结点的参数} 
min:=maxint; u:=0; {u记录离1集合最近的结点} 
for i:=1 to n do 
if (not mark[i]) and (d[i]< min) then begin 
u:=i; min:=d[i]; 
end; 
if u< >0 then begin 
mark[u]:=true; 
for i:=1 to n do 
if (not mark[i]) and (a[u,i]+d[u]< d[i]) then begin 
d[i]:=a[u,i]+d[u]; 
pre[i]:=u; 
end; 
end; 
until u=0; 
end; 

D.计算图的传递闭包 
Procedure Longlink; 
Var 
T:array[1..maxn,1..maxn] of boolean; 
Begin 
Fillchar(t,sizeof(t),false); 
For k:=1 to n do 
For I:=1 to n do 
For j:=1 to n do T[I,j]:=t[I,j] or (t[I,k] and t[k,j]); 
End; 


6.0-1背包问题（部分背包问题可有贪心法求解：计算Pi/Wi) 
数据结构： 
w[i]:第i个背包的重量； 
p[i]:第i个背包的价值； 
(1)0-1背包： 每个背包只能使用一次或有限次(可转化为一次)： 
A.求最多可放入的重量。 
NOIP2001 装箱问题 
有一个箱子容量为v(正整数，o≤v≤20000)，同时有n个物品(o≤n≤30)，每个物品有一个体积 (正整数)。要求从 n 个物品中，任取若千个装入箱内，使箱子的剩余空间为最小。 
l 搜索方法 
procedure search(k,v:integer); {搜索第k个物品，剩余空间为v} 
var i,j:integer; 
begin 
if v< best then best:=v; 
if v-(s[n]-s[k-1]) >=best then exit; {s[n]为前n个物品的重量和} 
if k< =n then begin 
if v >w[k] then search(k+1,v-w[k]); 
search(k+1,v); 
end; 
end; 

l DP 
F[I,j]为前i个物品中选择若干个放入使其体积正好为j的标志，为布尔型。 
实现:将最优化问题转化为判定性问题 
F[I,j]=f[i-1,j-w[i]] (w[I]< =j< =v) 边界：f[0,0]:=true. 
For I:=1 to n do 
For j:=w[I] to v do F[I,j]:=f[I-1,j-w[I]]; 
优化：当前状态只与前一阶段状态有关，可降至一维。 
F[0]:=true; 
For I:=1 to n do begin 
F1:=f; 
For j:=w[I] to v do 
If f[j-w[I]] then f1[j]:=true; 
F:=f1; 
End; 

B.求可以放入的最大价值。 
F[I,j]= 


C.求恰好装满的情况数。 

　

(2)每个背包可使用任意次： 
A.求最多可放入的重量。 
状态转移方程为 
f[I,j]=max{f[i-w[j] 

　


B.求可以放入的最大价值。 
USACO 1.2 Score Inflation 
进行一次竞赛，总时间T固定，有若干种可选择的题目，每种题目可选入的数量不限，每种题目有一个ti（解答此题所需的时间）和一个si（解答此题所得的分数），现要选择若干题目，使解这些题的总时间在T以内的前提下，所得的总分最大，求最大的得分。 
*易想到： 
f[i,j] = max { f [i- k*w[j], j-1] + k*v[j] } (0< =k< = i div w[j]) 
其中f[i,j]表示容量为i时取前j种背包所能达到的最大值。 
*优化： 
Begin 
FillChar(problem,SizeOf(problem),0); 
Assign(Input,'inflate.in'); 
Reset(Input); 
Readln(M,N); 
For i:=1 To N Do 
With problem[i] Do 
Readln(point,time); 
Close(Input); 

FillChar(f,SizeOf(f),0); 
For i:=1 To M Do 
For j:=1 To N Do 
If i-problem[j].time >=0 Then 
Begin 
t:=problem[j].point+f[i-problem[j].time]; 
If t >f[i] Then f[i]:=t; 
End; 

Assign(Output,'inflate.out'); 
Rewrite(Output); 
Writeln(f[M]); 
Close(Output); 
End. 
C.求恰好装满的情况数。 
Ahoi2001 Problem2 
求自然数n本质不同的质数和的表达式的数目。 
思路一，生成每个质数的系数的排列，在一一测试，这是通法。 
procedure try(dep:integer); 
var i,j:integer; 
begin 
cal; {此过程计算当前系数的计算结果，now为结果} 
if now >n then exit; {剪枝} 
if dep=l+1 then begin {生成所有系数} 
cal; 
if now=n then inc(tot); 
exit; 
end; 
for i:=0 to n div pr[dep] do begin 
xs[dep]:=i; 
try(dep+1); 
xs[dep]:=0; 
end; 
end; 

思路二，递归搜索效率较高 
procedure try(dep,rest:integer); 
var i,j,x:integer; 
begin 
if (rest< =0) or (dep=l+1) then begin 
if rest=0 then inc(tot); 
exit; 
end; 
for i:=0 to rest div pr[dep] do 
try(dep+1,rest-pr[dep]*i); 
end; 

思路三：可使用动态规划求解 
USACO1.2 money system 
V个物品，背包容量为n，求放法总数。 
转移方程： 

Procedure update; 
var j,k:integer; 
begin 
c:=a; 
for j:=0 to n do 
if a[j] >0 then 
for k:=1 to n div now do 
if j+now*k< =n then inc(c[j+now*k],a[j]); 
a:=c; 
end; 
{main} 
begin 
read(now); {读入第一个物品的重量} 
i:=0; {a[i]为背包容量为i时的放法总数} 
while i< =n do begin 
a[i]:=1; inc(i,now); end; {定义第一个物品重的整数倍的重量a值为1，作为初值} 
for i:=2 to v do 
begin 
read(now); 
update; {动态更新} 
end; 
writeln(a[n]);

7.排序算法 
A.快速排序： 
procedure sort(l,r:integer); 
var i,j,mid:integer; 
begin 
i:=l;j:=r; mid:=a[(l+r) div 2]; {将当前序列在中间位置的数定义为中间数} 
repeat 
while a[i]< mid do inc(i); {在左半部分寻找比中间数大的数} 
while mid< a[j] do dec(j);{在右半部分寻找比中间数小的数} 
if i< =j then begin {若找到一组与排序目标不一致的数对则交换它们} 
swap(a[i],a[j]); 
inc(i);dec(j); {继续找} 
end; 
until i >j; 
if l< j then sort(l,j); {若未到两个数的边界，则递归搜索左右区间} 
if i< r then sort(i,r);