数学建模算法合集之《动态规划的特点及其应用》(5)

write(Put[i]);

if i

writeln;

close(output);

end;

begin assign(input,'flower.inp');

assign(output,'flower.out'); ReadIn; Work;

Print; end.

5. 例3“街道问题”的扩展，找两条不重叠的最短路径

program N_Street; const

MaxSize=90; {地图的最大尺寸} type var

Row,Col :byte; {地图的行数和列数} Best,B1 :TPlanarArr; {动态规划中本阶段和上阶段的最优指标函数} Street :array [0..1] of TPlanarArr; {地图中横向和纵向的边}

{读入}

TPlanarArr=array [1..MaxSize,1..MaxSize] of integer;

procedure ReadIn; var i,j :byte; begin reset(input);

readln(Row,Col); for i:=1 to Row do

begin for j:=1 to Col-1 do read(Street[0,i,j]); readln; end;

for j:=1 to Col do begin

for i:=1 to Row-1 do

read(Street[1,i,j]); readln;

end;

close(input);

第 21 页 共 29页

end;

procedure Work; {规划过程，和文章中不同，这里是逆序求解} var k, {阶段}

s1,s2, {状态（二维）} u1,u2, {决策（二维）}

t1,t2, {由s和t导出的上阶段的状态（二维）} m, {本阶段的状态总数} m1,m2

:byte; {Row和Col当中较小的数和较大的数}

e1,e2 :integer; {u1,u2对应的两条边长}

function GetET(s,u:byte; var e:integer; var t:byte):boolean; {求e,t} begin GetET:=false;

if (k>=Row) and (s=1) and (u=1) or (k>=Col) and (s=m) and (u=0) then exit; {判断越界} GetET:=true;

if k

e:=Street[u,k+1-s,s];

t:=s+1-u; end

else begin e:=Street[u,Row+1-s,k-Row+s]; t:=s-u; end;

end; begin if Row

then begin m1:=Row; m2:=Col; end

else begin

m1:=Col; m2:=Row; end;

Best[1,1]:=0;

for k:=Row+Col-2 downto 1 do {逆序求解} begin

if k

else if k>m2 then m:=Row+Col-k else m:=m1;

第 22 页 共 29页

B1:=Best;

for s1:=1 to m do for s2:=1 to m do begin Best[s1,s2]:=$7000; {初始化为一个较大的数}

for u1:=0 to 1 do

if GetET(s1,u1,e1,t1) then

for u2:=0 to 1 do if ((s1<>s2) or (u1<>u2)) and

GetET(s2,u2,e2,t2) and

(B1[t1,t2]+e1+e2

Best[s1,s2]:=B1[t1,t2]+e1+e2; {更新最优解}

end;

end;

end;

begin assign(input,'input.txt'); assign(output,'output.txt');

ReadIn; Work;

rewrite(output); writeln(Best[1,1]); close(output); end.

6. 例4“mod 4最优路径问题”的源程序

program BestPath_mod4; const MaxN=100; {点数上限} MaxE=100; {两点之间的边数上限} var N

E

:byte; {点数}

:array [1..MaxN,0..MaxE] of integer; {E[i,0]第i点到第i+1点之间的边数}

{E[i,j]第i点到第i+1点之间的第j条边长}

Best :array [1..MaxN,0..3] of boolean; {Best[k,s]从第1点到第k点长度mod 4的值为s的路径是否存在}

{读入}

procedure ReadIn; var

i,j :byte; reset(input); readln(N); begin

第 23 页 共 29页

for i:=1 to N-1 do begin read(E[i,0]); for j:=1 to E[i,0] do read(E[i,j]);

readln; end;

close(input); end;

procedure Work; {主递推过程} var k,s,u begin

:byte; {阶段、状态、决策}

fillchar(Best,sizeof(Best),false); Best[1,0]:=true; {边界条件} for k:=2 to N do for s:=0 to 3 do for u:=1 to E[k-1,0] do

Best[k,s]:=Best[k,s] or Best[k-1,($10000+s-E[k-1,u]) mod 4];

{加上10000(h)为防止出现负数}

end;

procedure Print; {这里只输出最优路径mod 4的值，路径就不输出了} var i begin

:byte;

for i:=0 to 3 do if Best[N,i] then break; rewrite(output); writeln(i);

close(output); end;

begin

assign(input,'input.txt'); assign(output,'output.txt'); ReadIn; Work; Print;

end.

7. 例5“钉子与小球”的源程序

{$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}

第 24 页 共 29页

{$M 65520,0,655360}

program Ball; var N,M :byte; Nail :array [1..50,1..50] of byte;

procedure ReadIn; var

i,j :byte;

:char;

c begin

Poss :array [0..50,0..50] of comp;

reset(input); readln(N,M);

for i:=1 to N do for j:=1 to i do

begin repeat read(c);

until c in ['*','.']; if c='*'

then Nail[i,j]:=1 else Nail[i,j]:=0; end;

close(input);

end;

procedure Work; var i,j :byte;

begin fillchar(Poss,sizeof(Poss),0);

Poss[0,0]:=1; for i:=1 to N do

Poss[0,0]:=Poss[0,0]*2; for i:=0 to N-1 do

for j:=0 to i do

if Nail[i+1,j+1]=0

then Poss[i+2,j+1]:=Poss[i+2,j+1]+Poss[i,j] else begin

Poss[i+1,j]:=Poss[i+1,j]+Poss[i,j]/2; Poss[i+1,j+1]:=Poss[i+1,j+1]+Poss[i,j]/2; end;

end;

第 25 页 共 29页