当前位置 博文首页 > 好玩的vbs特色代码第1/6页

    好玩的vbs特色代码第1/6页

    作者:admin 时间:2021-02-19 06:41

    用什么来表示组合?比如从5个数里面选n个数,你怎么用一个数字来表述你的选择结果?注意是一个数字。

    硬盘的权限就是一个例子,参考脚本手册FileSystem文件Attributes 属性部分:
    Normal 0 普通文件。不设置属性。 
    ReadOnly 1 只读文件。属性为读/写。 
    Hidden 2 隐藏文件。属性为读/写。 
    System 4 系统文件。属性为读/写。 
    Volume 8 磁盘驱动器卷标。属性为只读。 
    Directory 16 文件夹或目录。属性为只读。 
    Archive 32 文件在上次备份后已经修改。属性为读/写。 
    Alias 64 链接或者快捷方式。属性为只读。 
    Compressed 128 压缩文件。属性为只读。

    如果选择了其中任意几个数字相加,比如得到65,那么你选择的肯定是1和64的组合,vbs里面的And 运算符还对两个数值表达式中位置相同的位执行逐位比较,如果 1 and 65 得到的是1那么说明65可以表示你的选择里面含有1,如果是0则没有。

    还有一个的问题是:链表型的数据结构如何描述,一个表型的数据,可以根据行索引,可以方便增加删除行,并且增加数据前判断一行是否重复。而且代码不是特别多,速度不是特别慢,运行过程可以把数据显示出来供程序员调试?

    在vbs里面可以利用dictionary来模拟,Item项是一个一维数组。

    这两种个数据结构的原理我用到了一个游戏题目里:

     <style>
     body,td{font-size:12px;}
     table{border:1px solid lightblue;border-collapse:collapse;width:100%;}
     </style>

    四人欲过一座河,且只有一个氧气瓶(每次最多能容两人同时游过). <br/>
    甲单独过河需1分钟,乙需2分钟,丙需5分钟,丁需7分钟. 则四人全部通过的最短时间是多少. <br/>

     <button onclick="vbs:try">过河</button>
      <p ></p>
     <SCRIPT LANGUAGE="vbScript">
    '本题属于决策树类型问题
    '难点在于数据的描述上
    '决策树的数据关键是:初始状态,操作步骤,结束状态
    '每次递归的输入值--初始状态,是上次运算的结果--结束状态
    '因此经过反复推敲,决定用:岸边状态+操作步骤编码+时间结果+开关状态来描述


    '技巧:关于搭档方式的描述,采用2的n次方相加,实现用一个数来表示2个数搭配的目的
    '比如01搭档,那么表示方法就是2^0 + 2^1=3职能是01搭配才会产生,绝对不会是其他数字
    '见partner函数

    personTime =Array(1,2,5,7)'每个人花费时间
    startBank="0 1 2 3"'用空格分开表示河左岸的人的状态

    set solution = CreateObject("Scripting.Dictionary")' 

    '用一个结构体来描述数据,每行的格式如下:
    'solution.Add P,Array(onceTime,lBank,rBank,0) 

    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>
    123456下一页阅读全文
    js
下一篇:没有了