[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[技术讨论] [已解决]VBS 数组元素循环移动如何优化?

本帖最后由 yu2n 于 2015-8-8 14:03 编辑

计划使用一个固定长度的数组循环复写来记录日志,写了一个ArrayShift函数,此函数并无问题,但是此函数使用了两个数组,如何缩减为一个?求优化…
  1. 'ArrayShift.vbs
  2. Dim arrStr, sInfo
  3. arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
  4. sInfo = "原字符串:" & Join(arrStr, ",") & vbCrLf
  5. sInfo = sInfo & "偏移+2:" & Join(ArrayShift(arrStr, 2), ",") & vbCrLf
  6. sInfo = sInfo & "偏移-2:" & Join(ArrayShift(arrStr, -2), ",") & vbCrLf
  7. sInfo = sInfo & "偏移+10086:" & Join(ArrayShift(arrStr, 10086), ",") & vbCrLf
  8. sInfo = sInfo & "偏移-10086:" & Join(ArrayShift(arrStr, -10086), ",") & vbCrLf
  9. MsgBox sInfo
  10. Function ArrayShift(ByVal arrStr, ByVal nShift)
  11.   Dim arr, nLength, i, s1, s, nOffSet
  12.   arr = arrStr
  13.   nLength = UBound(arrStr)
  14.   For i = 0 To nLength Step 1
  15.     nOffSet = ((i + nShift) Mod (nLength + 1))
  16.     If nOffSet >= 0 Then
  17.       arr(i) = arrStr(nOffSet)
  18.     ElseIf nOffSet < 0 Then
  19.       nOffSet = (nLength + 1) + nOffSet
  20.       arr(i) = arrStr(nOffSet)
  21.     End If
  22.   Next
  23.   ArrayShift = arr
  24. End Function
复制代码
示例结果如下:
  1. 原字符串:0,1,2,3,4,5,6,7,8,9
  2. 偏移+2:2,3,4,5,6,7,8,9,0,1
  3. 偏移-2:8,9,0,1,2,3,4,5,6,7
  4. 偏移+10086:6,7,8,9,0,1,2,3,4,5
  5. 偏移-10086:4,5,6,7,8,9,0,1,2,3
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

本帖最后由 CrLf 于 2015-12-26 21:26 编辑

回复 13# aa77dd@163.com


   
    其实现在想起来,完全不需要求最大公约数,虽然那是理论支柱,但代码只需要实证结果

TOP

回复 12# CrLf

我后来已经弄清楚了, 你的算法也是对的, 只需一轮循环置换就完全可以,

用不必要的多轮置换, 是很早以前就弄过的, 但当时没有深究能不能 一轮循环置换

到今天, 我差不多又忘了 怎样证明 一轮循环置换 是可行的了, 只是记得在脑袋里确实已经证明过一次了(和你的描述语言不一样,但我们都明白自己的语言), 哈哈哈哈

TOP

本帖最后由 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,所以用一次循环置换就能搞定

TOP

回复 10# aa77dd@163.com

感谢解疑。

我打算把这个函数作为 VB TextBox 的多次撤销、重做,或者是历史记录、临时日志使用。
自己写了一个演示作为结贴,感谢两位。
  1. 'ArrayShiftLog.vbs
  2. Option Explicit
  3. Call CommandMode(WScript.ScriptName)
  4. Test
  5. Sub Test()
  6.   Dim arrStr, n, sInfo
  7.   arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
  8.   n = 0
  9.   Do
  10.     ArrayPushTop arrStr, "No." & n & vbTab & Now()
  11.    
  12.     sInfo = Now() & vbCrLf & String(78,"=") & vbCrLf
  13.     sInfo = sInfo & Join(arrStr,vbCrLf) & vbCrLf & String(78,"=") & vbCrLf & vbCrLf
  14.     WScript.Echo sInfo
  15.     WScript.Sleep 1000
  16.    
  17.     n = n + 1
  18.     If n>UBound(arrStr) Then n=0
  19.   Loop
  20.   
  21. End Sub
  22. 'ByRef
  23. Sub ArrayPushTop(ByRef arrStr, ByVal str)
  24.   Call ArrayShift(arrStr, -1)
  25.   arrStr(0) = str
  26. End Sub
  27. 'ByRef
  28. Function ArrayShift(ByRef arrStr, ByVal nShift)
  29.   Dim arr, nLength, i, nOffSet
  30.   arr = arrStr
  31.   nLength = UBound(arrStr) + 1
  32.   For i = 0 To UBound(arrStr) Step 1
  33.     nOffSet = (i + nShift) Mod nLength
  34.     If nOffSet < 0 Then nOffSet = nLength + nOffSet
  35.     arrStr(i) = arr(nOffSet): arr(nOffSet) = ""
  36.   Next
  37.   ArrayShift = arrStr
  38. End Function
  39. ' 以命令提示符环境运行(保留参数)
  40. Sub CommandMode(ByVal sTitle)
  41.   If InStr(1, WScript.FullName, "\cscript.exe", vbTextCompare) > 0 Then Exit Sub
  42.   Dim sCommand, oArg, sArgs
  43.   sCommand = "%Comspec% /c title " & sTitle & " & cscript.exe //NoLogo """ & WScript.ScriptFullName & """"
  44.   For Each oArg In WScript.Arguments
  45.     sArgs = sArgs & " " & """" & oArg & """"
  46.   Next
  47.   CreateObject("WScript.Shell").Run sCommand & sArgs & " & pause", 1, False
  48.   WScript.Quit
  49. End Sub
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

回复 9# yu2n

那个算法其实很简单:
原数据:
0123456789 克隆一个接起来  01234567890123456789
偏移 3 位:
01234567890123456789红色部分就是要的结果

CrLf 的算法思路我很久以前就琢磨过, 但只停留在上面我分析的那样, 他的代码做了一个范围内的实证(我并没有运行)

那个算法核心已经成为数学问题了, 而数学里核心又是 余数, 约数, 倍数, 整除, 迭代 这些了.

对于 最大公约数 , 我的思路也没有完全厘清, 只能表示未理解, 无法有更多评论了

TOP

本帖最后由 yu2n 于 2015-8-8 11:49 编辑

回复 4# aa77dd@163.com

第一个算法看晕了。骨灰级算法?
第二个算法的计算实际偏移量部分很不错,算法类似教科书。时间复杂度个人可以接受,是我想要的。多谢

(话说那么晚了还回帖,非常感谢,还请注意休息)
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

本帖最后由 yu2n 于 2015-8-8 11:28 编辑

回复 7# CrLf
好长…逻辑很好。
最大公约数那个有点看不懂,汗啊~

函数返回肯定要用到一个数组的,严格来说确实是用了3个数组,汗啊~

我的代码不够严谨,修改了一下,将13行 arr = arrStr 改为 dim arr() : arr = ReDim arr(Ubound(arrStr)),
相比 [数组2]=[数组1] ,直接使用 [数组2]=[重新定义长度等于数组1的新数组],这样可能会比较省空间?
  1. 'ArrayShift.vbs
  2. Option Explicit
  3. Dim arrStr, sInfo
  4. arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
  5. sInfo = "原数组:" & Join(arrStr, ",") & vbCrLf & vbCrLf
  6. Dim i, sFlag
  7. For i = -20 To 20
  8.   If i >= 0 Then sFlag = "+"
  9.   sInfo = sInfo & "偏移" & sFlag & i & ":" & Join(ArrayShift(arrStr, i), ",") & vbCrLf
  10. Next
  11. WScript.Echo sInfo
  12. Function ArrayShift(ByVal arrStr, ByVal nShift)
  13.   Dim arr(), nLength, i, nOffSet
  14.   ReDim arr(UBound(arrStr))
  15.   nLength = UBound(arrStr) + 1
  16.   For i = 0 To UBound(arrStr) Step 1
  17.     nOffSet = (i + nShift) Mod nLength
  18.     If nOffSet < 0 Then nOffSet = nLength + nOffSet
  19.     arr(i) = arrStr(nOffSet) : arrStr(nOffSet) = Null   '“清空”数组会比较省空间?
  20.   Next
  21.   ArrayShift = arr
  22. End Function
复制代码
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

本帖最后由 CrLf 于 2015-8-8 15:59 编辑

回复 6# aa77dd@163.com


是这个思路,例:
  1. 'ArrayShift.vbs
  2. Dim arrStr, sInfo
  3. arrStr = Split("0,1,2,3,4,5,6,7,8,9,10,11,12", ",")
  4. sInfo = "原字符串:" & Join(arrStr, ",") & vbCrLf
  5. For i = -20 To 20
  6. sInfo = sInfo & "偏移+" & i & ":" & Join(ArrayShift(arrStr, i), ",") & vbCrLf
  7. Next
  8. WSH.Echo sInfo
  9. Function ArrayShift(ByVal arrStr, ByVal nShift)
  10. Dim arr, nLength, i, s1, s, nOffSet, [起始]
  11. nLength = UBound(arrStr) + 1
  12. nShift = (nShift Mod nLength + nLength) Mod nLength
  13. For [起始] = 0 To [func最大公约数](nLength,nShift) - 1
  14. i = (([起始] + nShift) Mod (nLength))
  15. tmpStr = arrStr(i)
  16. Do While i <> [起始]
  17. nOffSet = ((i + nShift) Mod (nLength))
  18. arrStr(i) = arrStr(nOffSet)
  19. i = nOffSet
  20. Loop
  21. arrStr(nOffSet) = tmpStr
  22. Next
  23. ArrayShift = arrStr
  24. End Function
  25. Function [func最大公约数](ByVal a,ByVal b)
  26. Dim c
  27. If b=0 Then a=0
  28. Do While b <> 0
  29. c = a Mod b
  30. a = b
  31. b = c
  32. Loop
  33. [func最大公约数] = a
  34. End Function
复制代码
代码逻辑:闭环遍历置换,头尾相衔,回到原点时 +1 继续,一直循环到次数不小于元素个数
如此可实现单表无冗余置换,时间复杂度和空间复杂度比较均衡
事实上顶楼是三数组,因为还要算上函数返回值,如果不想设置临时变量,可以直接使用返回值进行映射,省得最后还要传递一次变量
其实我想说的是,楼主还是投奔 JS 党吧...非 VBS 不娶的话,用 wsf 或者 hta 纳个妾也好啊
1

评分人数

    • yu2n: 乐于助人技术 + 1

TOP

回复 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

每轮置换链闭环时, 才能释放临时变量. 否则将需要更多临时变量保存链头信息.

TOP

目前有另一种思路,利用单个临时变量循环置换,写了个雏形,但还有些问题没想明白

TOP

本帖最后由 aa77dd@163.com 于 2015-8-8 00:15 编辑

只适用于元素全是 1 位数的
  1. Dim arrStr
  2. arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
  3. offs = -10086
  4. slen = len(join(arrStr, ""))
  5. msgbox "原字符串:" & Join(arrStr, ",") & vbCrLf _
  6. & "偏移" & offs & ":" & _
  7. join(split(mid(join(arrStr, ";") & ";" & join(arrStr, ";"), 2*(1 + (offs mod slen + slen) mod slen)-1, 2*slen-1), ";"), ",")
复制代码
通用的
算法在时间和空间消耗上是矛盾的, 以时间换空间:
  1. 'ArrShift.vbs
  2. Dim arrStr, sInfo
  3. arrStr = Split("0,1,2,3,4,5,6,7,8,9", ",")
  4. sInfo = "原字符串:" & Join(arrStr, ",") & vbCrLf
  5. sInfo = sInfo & "偏移+2:" & Join(ArrShift(arrStr, 2), ",") & vbCrLf
  6. sInfo = sInfo & "偏移-2:" & Join(ArrShift(arrStr, -2), ",") & vbCrLf
  7. sInfo = sInfo & "偏移+10086:" & Join(ArrShift(arrStr, 10086), ",") & vbCrLf
  8. sInfo = sInfo & "偏移-10086:" & Join(ArrShift(arrStr, -10086), ",") & vbCrLf
  9. MsgBox sInfo
  10. Function ArrShift(ByVal arrStr, ByVal nShift)
  11.   Dim i, t, a_len, tmp
  12.   a_len = UBound(arrStr) + 1
  13.   rem nShift 去符号
  14.   nShift = (nShift mod a_len + a_len)
  15.   for t = 1 to nShift step 1
  16.       tmp = arrStr(0)
  17.       For i = 0 To UBound(arrStr) - 1 Step 1
  18.         arrStr(i) = arrStr( i + 1 )
  19.       next
  20.       arrStr(UBound(arrStr)) = tmp
  21.   next
  22.   ArrShift = arrStr
  23. End Function
复制代码
1

评分人数

    • yu2n: 乐于助人技术 + 1

TOP

回复 2# CrLf

我尝试另写了一个,直接用 ByRef 操作原参数数组,就不用重复一个数组,但是思路不对,没有成功。
『千江有水千江月』千江有水,月映千江;万里无云,万里青天。    http://yu2n.qiniudn.com/

TOP

用一个临时变量不行吗

TOP

返回列表