sub try '點按鈕開始遞歸調(diào)用 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上步驟執(zhí)行時間 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上步驟執(zhí)行時間 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) '輸入兩個數(shù), 代表組合唯一值,存放到字符串里int '輸出: a=cint(x) b=cint(y) partner=cstr(2^a +2^b) end function
sub show(D) '輸入:D字典Dictionary '顯示字典中的內(nèi)容 dim i:i=1 re= "table border=1>" re=re "tr>td>行號/td>td>過河方案/td>td>花費時間/td>td>左岸狀態(tài)/td>td>右岸狀態(tài)/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 '輸出:時間結果數(shù)組,第一個元素設置為極小,不參與排序,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時間結果數(shù)組array '堆排序,復雜度n*log(n)/log(2),如果8個數(shù)就是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 "已經(jīng)結束!最小值是:" 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 '輸出:是否完成的狀態(tài)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>