欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页  >  IT编程

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

程序员文章站 2022-03-06 23:48:22
用什么来表示组合?比如从5个数里面选n个数,你怎么用一个数字来表述你的选择结果?注意是一个数字。 硬盘的权限就是一个例子,参考脚本手册filesystem文件attribu...
用什么来表示组合?比如从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 id="ppp"></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>
1