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

yu2n

计划使用一个固定长度的数组循环复写来记录日志，写了一个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

回复 13# aa77dd@163.com


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

aa77dd@163.com

回复 12# CrLf

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

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

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

CrLf

回复 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，所以用一次循环置换就能搞定

yu2n

回复 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
复制代码

aa77dd@163.com

回复 9# yu2n

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

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

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

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

yu2n

回复 4# aa77dd@163.com

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

（话说那么晚了还回帖，非常感谢，还请注意休息）

yu2n

回复 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
复制代码

CrLf

回复 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 纳个妾也好啊

aa77dd@163.com

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

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

aa77dd@163.com

只适用于元素全是 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
复制代码

yu2n

回复 2# CrLf

我尝试另写了一个，直接用 ByRef 操作原参数数组，就不用重复一个数组，但是思路不对，没有成功。

CrLf

用一个临时变量不行吗