pascal问题

分类: 电脑/网络 >>程序设源携计 >>其他编程语言

问题描述:

求01背包问题的程序以及分析

解析:

0/1背包

一个旅行者有一个最多能用m公斤的背包，现在有n件物品，它们的重量分别是W1，W2，...,Wn,它们的价值分别为C1,C2,...,Cn.若每种物品只有一件求旅行者能获得最大总此裂宽价值。

<1>分析说明:

显然这个题可用深度优先方法对每件物品进行枚举(选或不选用0,1控制).

程序简单,但是当n的值很大的时候不能满足时间要求，时间复杂度为O（2n）。按递归的思想我们可以把问题分解为子问题,使用递归函数

设 f(i，x)表示前i件物品，总重量不超过x的最优价值

则 f（i，x）=max(f(i－1，x-W[i])+C[i]，森亮f（i－1，x））

f（n，m）即为最优解，边界条件为f（0，x）＝0 ，f(i,0)=0

动态规划方法(顺推法)程序如下:

程序如下：

program knapsack02

const maxm=200maxn=30

type ar=array[1..maxn] of integer

var m,n,j,i:integer

c,w:ar

f:array[0..maxn,0..maxm] of integer

function max(x,y:integer):integer

begin

if x>y then max:=x else max:=y

end

begin

readln(m,n)

for i:= 1 to n do

readln(w[i],c[i])

for i:=1 to m do f(0,i):=0

for i:=1 to n do f(i,0):=0

for i:=1 to n do

for j:=1 to m do

begin

if j>=w[i] then f[i,j]:=max(f[i-1,j-w[i]]+c[i],f[i-1,j])

else f[i,j]:=f[i-1,j]

end

writeln(f[n,m])

end.

使用二维数组存储各子问题时方便，但当maxm较大时如maxn=2000时不能定义二维数组f,怎么办,其实可以用一维数组,但是上述中j:=1 to m 要改为j:=m downto 1,为什么?请大家自己解决。

4.1 原始递归法

先看完全背包问题

一个旅行者有一个最多能用m公斤的背包，现在兆并键有n种物品，每件的重量分别是W1，W2，...,Wn,

每件的价值分别为C1,C2,...,Cn.若的每种物品的件数足够多.

求旅行者能获得的最大总价值。

本问题的数学模型如下：

设 f(x)表示重量不超过x公斤的最大价值，

则 f(x）=max{f(x-i)+c[i]} 当x>=w[i] 1<=i<=n

可使用递归法解决问题程序如下:

program knapsack04

const maxm=200maxn=30

type ar=array[0..maxn] of integer

var m,n,j,i,t:integer

c,w:ar

function f(x:integer):integer

var i,t,m:integer

begin

if x=0 then f:=0 else

begin

t:=-1

for i:=1 to n do

begin

if x>=w[i] then m:=f(x-i)+c[i]

if m>t then t:=m

end

f:=t

end

end

begin

readln(m,n)

for i:= 1 to n do

readln(w[i],c[i])

writeln(f(m))

end.

说明:当m不大时,编程很简单,但当m较大时,容易超时.

4.2 改进的递归法

改进的的递归法的思想还是以空间换时间,这只要将递归函数计族巧蔽链算过程中的各个子函数的值保存起来,开辟一个

一维数组即可

程序如下:

program knapsack04

const maxm=2000maxn=30

type ar=array[0..maxn] of integer

var m,n,j,i,t:integer

c,w:ar

p:array[0..maxm] of integer

function f(x:integer):integer

var i,t,m:integer

begin

if p[x]<>-1 then f:=p[x]

else

begin

if x=0 then p[x]:=0 else

begin

t:=-1

for i:=1 to n do

begin

if x>=w[i] then m:=f(i-w[i])+c[i]

if m>t then t:=m

end

p[x]:=t

end

f:=p[x]

end

end

begin

readln(m,n)

for i:= 1 to n do

readln(w[i],c[i])

fillchar(p,sizeof(p),-1)

writeln(f(m))

end.

var t,m,i,j,a,b:integer s:array[0..1000] of integer

begin

assign(input,'medic.in')reset(input)

assign(output,'则中medic.out'野盯弯颂闷)rewrite(output)

readln(t,m)fillchar(s,sizeof(s),0)

for i:=1 to m do

begin

readln(a,b)

for j:=t-a downto 0 do if s[j]+b>s[j+a] then s[j+a]:=s[j]+b

end

writeln(s[t])

end.

---