标题: [技术讨论] [已解决]VBS 数组元素循环移动如何优化? [打印本页]
作者: yu2n 时间: 2015-8-7 21:01 标题: [已解决]VBS 数组元素循环移动如何优化?
本帖最后由 yu2n 于 2015-8-8 14:03 编辑
计划使用一个固定长度的数组循环复写来记录日志,写了一个ArrayShift函数,此函数并无问题,但是此函数使用了两个数组,如何缩减为一个?求优化…- 'ArrayShift.vbs
- Dim arrStr, sInfo
- arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
- sInfo = "原字符串:" & Join(arrStr, ",") & vbCrLf
- sInfo = sInfo & "偏移+2:" & Join(ArrayShift(arrStr, 2), ",") & vbCrLf
- sInfo = sInfo & "偏移-2:" & Join(ArrayShift(arrStr, -2), ",") & vbCrLf
- sInfo = sInfo & "偏移+10086:" & Join(ArrayShift(arrStr, 10086), ",") & vbCrLf
- sInfo = sInfo & "偏移-10086:" & Join(ArrayShift(arrStr, -10086), ",") & vbCrLf
- MsgBox sInfo
-
- Function ArrayShift(ByVal arrStr, ByVal nShift)
- Dim arr, nLength, i, s1, s, nOffSet
- arr = arrStr
- nLength = UBound(arrStr)
- For i = 0 To nLength Step 1
- nOffSet = ((i + nShift) Mod (nLength + 1))
- If nOffSet >= 0 Then
- arr(i) = arrStr(nOffSet)
- ElseIf nOffSet < 0 Then
- nOffSet = (nLength + 1) + nOffSet
- arr(i) = arrStr(nOffSet)
- End If
- Next
- ArrayShift = arr
- End Function
复制代码
示例结果如下:- 原字符串:0,1,2,3,4,5,6,7,8,9
- 偏移+2:2,3,4,5,6,7,8,9,0,1
- 偏移-2:8,9,0,1,2,3,4,5,6,7
- 偏移+10086:6,7,8,9,0,1,2,3,4,5
- 偏移-10086:4,5,6,7,8,9,0,1,2,3
复制代码
作者: CrLf 时间: 2015-8-7 21:12
用一个临时变量不行吗
作者: yu2n 时间: 2015-8-7 23:28
回复 2# CrLf
我尝试另写了一个,直接用 ByRef 操作原参数数组,就不用重复一个数组,但是思路不对,没有成功。
作者: aa77dd@163.com 时间: 2015-8-7 23:39
本帖最后由 aa77dd@163.com 于 2015-8-8 00:15 编辑
只适用于元素全是 1 位数的- Dim arrStr
- arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
-
- offs = -10086
-
- slen = len(join(arrStr, ""))
-
- msgbox "原字符串:" & Join(arrStr, ",") & vbCrLf _
- & "偏移" & offs & ":" & _
- join(split(mid(join(arrStr, ";") & ";" & join(arrStr, ";"), 2*(1 + (offs mod slen + slen) mod slen)-1, 2*slen-1), ";"), ",")
复制代码
通用的
算法在时间和空间消耗上是矛盾的, 以时间换空间:- 'ArrShift.vbs
- Dim arrStr, sInfo
- arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
- sInfo = "原字符串:" & Join(arrStr, ",") & vbCrLf
- sInfo = sInfo & "偏移+2:" & Join(ArrShift(arrStr, 2), ",") & vbCrLf
- sInfo = sInfo & "偏移-2:" & Join(ArrShift(arrStr, -2), ",") & vbCrLf
- sInfo = sInfo & "偏移+10086:" & Join(ArrShift(arrStr, 10086), ",") & vbCrLf
- sInfo = sInfo & "偏移-10086:" & Join(ArrShift(arrStr, -10086), ",") & vbCrLf
- MsgBox sInfo
-
- Function ArrShift(ByVal arrStr, ByVal nShift)
- Dim i, t, a_len, tmp
-
- a_len = UBound(arrStr) + 1
- rem nShift 去符号
- nShift = (nShift mod a_len + a_len)
-
- for t = 1 to nShift step 1
- tmp = arrStr(0)
- For i = 0 To UBound(arrStr) - 1 Step 1
- arrStr(i) = arrStr( i + 1 )
- next
- arrStr(UBound(arrStr)) = tmp
- next
-
- ArrShift = arrStr
- End Function
复制代码
作者: CrLf 时间: 2015-8-8 01:25
目前有另一种思路,利用单个临时变量循环置换,写了个雏形,但还有些问题没想明白
作者: aa77dd@163.com 时间: 2015-8-8 02:56
回复 5# CrLf
数组索引:
0 1 2 3 4 5
shift = 2
不能 一次性 闭环遍历:
0,2,4,0
数组索引:
0 1 2 3 4 5 6
shift = 2 可以 一次性 闭环遍历:
0,2,4,6,1,3,5,0
shift = 3 可以 一次性 闭环遍历:
0,3,6,2,5,1,4,0
数组索引:
0 1 2 3 4 5 6 7 0=8 1=9
shift = 3 可以 一次性 闭环遍历
0,3,6,1,4,7,2,5,0
数组索引:
0 1 2 3 4 5 6 7 8 0=9
shift = 3 不能 一次性 闭环遍历
0,3,6,0
设 shift > 1
数组长度为 length
情形 A.
length mod shift == 0 不能 一次性 闭环遍历
情形 B.
(length + 1) mod shift == 0 <==> length mod shift == shift - 1 可以 一次性 闭环遍历
还有另外的情形需要迭代深入研究
情形 A 时, 需要额外的代码
可以用 shift ( 链头: 0 .. shift-1 ) 轮置换链:
例如:
数组索引:
0 1 2 3 4 5 6 7 8 0=9
shift = 3 不能 一次性 闭环遍历, 但 用 3 轮置换链即可完成:
0,3,6,0
1,4,7,1
2,5,8,2
每轮置换链闭环时, 才能释放临时变量. 否则将需要更多临时变量保存链头信息.
作者: CrLf 时间: 2015-8-8 05:39
本帖最后由 CrLf 于 2015-8-8 15:59 编辑
回复 6# aa77dd@163.com
是这个思路,例:- 'ArrayShift.vbs
- Dim arrStr, sInfo
-
- arrStr = Split("0,1,2,3,4,5,6,7,8,9,10,11,12", ",")
-
- sInfo = "原字符串:" & Join(arrStr, ",") & vbCrLf
-
- For i = -20 To 20
- sInfo = sInfo & "偏移+" & i & ":" & Join(ArrayShift(arrStr, i), ",") & vbCrLf
- Next
-
- WSH.Echo sInfo
-
- Function ArrayShift(ByVal arrStr, ByVal nShift)
- Dim arr, nLength, i, s1, s, nOffSet, [起始]
-
- nLength = UBound(arrStr) + 1
- nShift = (nShift Mod nLength + nLength) Mod nLength
-
- For [起始] = 0 To [func最大公约数](nLength,nShift) - 1
- i = (([起始] + nShift) Mod (nLength))
- tmpStr = arrStr(i)
-
- Do While i <> [起始]
- nOffSet = ((i + nShift) Mod (nLength))
- arrStr(i) = arrStr(nOffSet)
- i = nOffSet
- Loop
-
- arrStr(nOffSet) = tmpStr
- Next
-
- ArrayShift = arrStr
- End Function
-
- Function [func最大公约数](ByVal a,ByVal b)
- Dim c
-
- If b=0 Then a=0
-
- Do While b <> 0
- c = a Mod b
- a = b
- b = c
- Loop
-
- [func最大公约数] = a
- End Function
复制代码
代码逻辑:闭环遍历置换,头尾相衔,回到原点时 +1 继续,一直循环到次数不小于元素个数
如此可实现单表无冗余置换,时间复杂度和空间复杂度比较均衡
事实上顶楼是三数组,因为还要算上函数返回值,如果不想设置临时变量,可以直接使用返回值进行映射,省得最后还要传递一次变量
其实我想说的是,楼主还是投奔 JS 党吧...非 VBS 不娶的话,用 wsf 或者 hta 纳个妾也好啊
作者: yu2n 时间: 2015-8-8 09:59
本帖最后由 yu2n 于 2015-8-8 11:28 编辑
回复 7# CrLf
好长…逻辑很好。
最大公约数那个有点看不懂,汗啊~
函数返回肯定要用到一个数组的,严格来说确实是用了3个数组,汗啊~
我的代码不够严谨,修改了一下,将13行 arr = arrStr 改为 dim arr() : arr = ReDim arr(Ubound(arrStr)),
相比 [数组2]=[数组1] ,直接使用 [数组2]=[重新定义长度等于数组1的新数组],这样可能会比较省空间?- 'ArrayShift.vbs
- Option Explicit
-
- Dim arrStr, sInfo
- arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
- sInfo = "原数组:" & Join(arrStr, ",") & vbCrLf & vbCrLf
-
- Dim i, sFlag
- For i = -20 To 20
- If i >= 0 Then sFlag = "+"
- sInfo = sInfo & "偏移" & sFlag & i & ":" & Join(ArrayShift(arrStr, i), ",") & vbCrLf
- Next
-
- WScript.Echo sInfo
-
- Function ArrayShift(ByVal arrStr, ByVal nShift)
- Dim arr(), nLength, i, nOffSet
- ReDim arr(UBound(arrStr))
- nLength = UBound(arrStr) + 1
- For i = 0 To UBound(arrStr) Step 1
- nOffSet = (i + nShift) Mod nLength
- If nOffSet < 0 Then nOffSet = nLength + nOffSet
- arr(i) = arrStr(nOffSet) : arrStr(nOffSet) = Null '“清空”数组会比较省空间?
- Next
- ArrayShift = arr
- End Function
复制代码
作者: yu2n 时间: 2015-8-8 10:05
本帖最后由 yu2n 于 2015-8-8 11:49 编辑
回复 4# aa77dd@163.com
第一个算法看晕了。骨灰级算法?
第二个算法的计算实际偏移量部分很不错,算法类似教科书。时间复杂度个人可以接受,是我想要的。多谢
(话说那么晚了还回帖,非常感谢,还请注意休息)
作者: aa77dd@163.com 时间: 2015-8-8 12:42
回复 9# yu2n
那个算法其实很简单:
原数据:
0123456789 克隆一个接起来 01234567890123456789
偏移 3 位:
01234567890123456789红色部分就是要的结果
CrLf 的算法思路我很久以前就琢磨过, 但只停留在上面我分析的那样, 他的代码做了一个范围内的实证(我并没有运行)
那个算法核心已经成为数学问题了, 而数学里核心又是 余数, 约数, 倍数, 整除, 迭代 这些了.
对于 最大公约数 , 我的思路也没有完全厘清, 只能表示未理解, 无法有更多评论了
作者: yu2n 时间: 2015-8-8 14:02
回复 10# aa77dd@163.com
感谢解疑。
我打算把这个函数作为 VB TextBox 的多次撤销、重做,或者是历史记录、临时日志使用。
自己写了一个演示作为结贴,感谢两位。- 'ArrayShiftLog.vbs
- Option Explicit
-
- Call CommandMode(WScript.ScriptName)
-
- Test
- Sub Test()
-
- Dim arrStr, n, sInfo
- arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
- n = 0
- Do
- ArrayPushTop arrStr, "No." & n & vbTab & Now()
-
- sInfo = Now() & vbCrLf & String(78,"=") & vbCrLf
- sInfo = sInfo & Join(arrStr,vbCrLf) & vbCrLf & String(78,"=") & vbCrLf & vbCrLf
- WScript.Echo sInfo
- WScript.Sleep 1000
-
- n = n + 1
- If n>UBound(arrStr) Then n=0
- Loop
-
- End Sub
-
- 'ByRef
- Sub ArrayPushTop(ByRef arrStr, ByVal str)
- Call ArrayShift(arrStr, -1)
- arrStr(0) = str
- End Sub
-
- 'ByRef
- Function ArrayShift(ByRef arrStr, ByVal nShift)
- Dim arr, nLength, i, nOffSet
- arr = arrStr
- nLength = UBound(arrStr) + 1
- For i = 0 To UBound(arrStr) Step 1
- nOffSet = (i + nShift) Mod nLength
- If nOffSet < 0 Then nOffSet = nLength + nOffSet
- arrStr(i) = arr(nOffSet): arr(nOffSet) = ""
- Next
- ArrayShift = arrStr
- End Function
-
- ' 以命令提示符环境运行(保留参数)
- Sub CommandMode(ByVal sTitle)
- If InStr(1, WScript.FullName, "\cscript.exe", vbTextCompare) > 0 Then Exit Sub
- Dim sCommand, oArg, sArgs
- sCommand = "%Comspec% /c title " & sTitle & " & cscript.exe //NoLogo """ & WScript.ScriptFullName & """"
- For Each oArg In WScript.Arguments
- sArgs = sArgs & " " & """" & oArg & """"
- Next
- CreateObject("WScript.Shell").Run sCommand & sArgs & " & pause", 1, False
- WScript.Quit
- End Sub
复制代码
作者: CrLf 时间: 2015-8-8 14:02
本帖最后由 CrLf 于 2015-8-8 16:16 编辑
回复 10# aa77dd@163.com
终于想透彻了
顺便省掉了不必要的 [计数],已修改
------------------------------------------------------------------------------------------
原理解释:
最大公约数是 nLength 和 nShift 都能整除的数字,那么在多轮循环置换后,作用点一定呈相同的栅栏状分布,区别只在于生成的次序:
nShift=2
@1@3@5@7@9
nShift=4
@1@3@5@7@9
nShift=6
@1@3@5@7@9
以回到原点为一周期,那么 周期总数 = 最大公约数
另一方面,最大公约数=1 的时候,“栅栏” 的间隔为 0,所以用一次循环置换就能搞定
作者: aa77dd@163.com 时间: 2015-12-26 21:20
回复 12# CrLf
我后来已经弄清楚了, 你的算法也是对的, 只需一轮循环置换就完全可以,
用不必要的多轮置换, 是很早以前就弄过的, 但当时没有深究能不能 一轮循环置换
到今天, 我差不多又忘了 怎样证明 一轮循环置换 是可行的了, 只是记得在脑袋里确实已经证明过一次了(和你的描述语言不一样,但我们都明白自己的语言), 哈哈哈哈
作者: CrLf 时间: 2015-12-26 21:24
本帖最后由 CrLf 于 2015-12-26 21:26 编辑
回复 13# aa77dd@163.com
其实现在想起来,完全不需要求最大公约数,虽然那是理论支柱,但代码只需要实证结果
欢迎光临 批处理之家 (http://bathome.net./) |
Powered by Discuz! 7.2 |