sub try '点按钮开始递归调用 if solution.Count=0 then set solution=gogo("",0,startBank) else if isFinish(solution) then succeed exit sub else set solution=aa(solution) end if end if show solution end sub
function gogo(K,T,L) '输入:K步骤序列 string '输入:T上步骤执行时间 int '输入:L可选择的人员名单 string '输出:返回后的结构体 Dictionary set scheme = CreateObject("Scripting.Dictionary") dim tempArr:tempArr=split(L)
n=n+1 for each i in tempArr for each j in tempArr if i>j then onceTime=maxTime(i,j) + T P=trim(K " " partner(i,j)) rBank=trim(otherBank(L) " " i " " j) lBank=otherBank(rBank) if not scheme.Exists(P) then scheme.Add P,Array(onceTime,lBank,rBank,0) end if end if next next set gogo=scheme end function
function aa(D) '输入:结构体 Dictionary '输出:返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary") for each K in D.Keys T=D.Item(K)(0) bool=D.Item(K)(3) ' alert K if cbool(bool) then L=D.Item(K)(1) link gogo(K,T,L),scheme else L=D.Item(K)(2) link back(K,T,L),scheme end if next set aa=scheme end function
'set D = CreateObject("Scripting.Dictionary") 'D.Exists(
sub link(D1,D2) '输入:D1结构体 Dictionary '输入返回:D2结构体 Dictionary for each K in D1.Keys if not D2.Exists(K) then D2.add K,D1.Item(K) next end sub
function back(K,T,L) '输入:K步骤序列 string '输入:T上步骤执行时间 int '输入:L可选择的人员名单 string '输出:返回后的结构体 Dictionary
set scheme = CreateObject("Scripting.Dictionary") dim tempArr:tempArr=split(L) for each i in tempArr onceTime=personTime(cint(i)) + T P=trim(K " " i) lBank= otherBank(L) " " i rBank= otherBank(lBank) scheme.Add P,Array(onceTime,lBank,rBank,1) next set back=scheme end function
function remove(L,i) '输入:L人员名单 string '输入:i被移出人的编号 int '输出:移出后的人员名单 string L=L " " L=replace(L,i " ","") remove=trim(L) end function
function otherBank(L) '输入:这岸的名单 string '输出:得到另外一个岸边的名单 string tempArr=split(L) LL=startBank for each i in tempArr LL=remove(LL,i) next otherBank=LL end function
function maxTime(x,y) '输入:x,y人的编号int '输出:得到两个人一次过河的最大时间int a=personTime(cint(x)) b=personTime(cint(y)) if a>b then maxTime=a else maxTime=b end function
function PtoMan(P) '输入:P单个方案 string '输出:由两个人名组合的方案 string dim tempStr dim bound:bound=ubound(personTime) for i=0 to bound for j=0 to bound if i>j and (partner(i,j)=P) then tempStr=i " " j exit for exit for end if next next PtoMan=tempStr end function
function PforRead(P) '输入:P有空格分隔的方案序列 string '输出:可读懂的方案序列 string tempArr=split(P) dim tempStr for i=0 to ubound(tempArr) if (i mod 2) =0 then tempStr =tempStr PtoMan(tempArr(i)) "过去 " else tempStr =tempStr tempArr(i) "回来 " end if next PforRead=tempStr end function
function partner(x,y) '输入两个数, 代表组合唯一值,存放到字符串里int '输出: a=cint(x) b=cint(y) partner=cstr(2^a +2^b) end function
sub show(D) '输入:D字典Dictionary '显示字典中的内容 dim i:i=1 re= "table border=1>" re=re "tr>td>行号/td>td>过河方案/td>td>花费时间/td>td>左岸状态/td>td>右岸状态/td>td>过河开关/td>/tr>" for each key in D.Keys re=re "tr>td>" i "/td>td title='" key "'>" PforRead(key) "/td>" for each a in D.Item(key) re=re "td>" a "/td>" next re=re "/tr>" i=i+1 next re=re "/table>" ppp.innerHTML=re
end sub
function D2Arr(D) '输入:D字典Dictionary '输出:时间结果数组,第一个元素设置为极小,不参与排序,array dim kArr:kArr=D.keys dim tempArr():redim tempArr(ubound(kArr)+1) tempArr(0)=0 for i=0 to D.count-1 tempArr(i+1)= D.Item(kArr(i))(0) next D2Arr=tempArr end function
sub sortA(Arr) '输入:Arr时间结果数组array '堆排序,复杂度n*log(n)/log(2),如果8个数就是24次,如果用冒泡是8^2=64次 dim n,i,L,ir,rArr,j n = ubound(Arr) L = int(n / 2)+1 ir = n do if L > 1 then L = L - 1 rArr = Arr(L) else rArr = Arr(ir) Arr(ir) = Arr(1) ir = ir - 1 if ir = 1 then Arr(1) = rArr exit sub end if end if i = L j = 2 * L while j = ir if j ir then if Arr(j) Arr(j + 1) then j = j + 1 end if if rArr Arr(j) then Arr(i) = Arr(j) i = j j = 2 * j else j = ir + 1 end if wend Arr(i) = rArr loop end sub
sub succeed() '成功后提示 dim tempArr:tempArr=D2Arr(solution) sortA tempArr alert "已经结束!最小值是:" tempArr(1) set Rows=ppp.getElementsByTagName("TR") for i=0 to Rows.length-1 if trim(Rows(i).cells(2).innerText) =cstr(tempArr(1)) then Rows(i).style.backgroundColor="red" end if next end sub
function isFinish(D) '输入:D返回后的结构体 Dictionary '输出:是否完成的状态bool dim re:re=false if D.Count>0 then dim tempArr:tempArr=D.Keys dim K:K=tempArr(0) if trim(D.Item(K)(1))="" then re=true end if isFinish=re end function /SCRIPT>