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

[文本处理] 【已解决】如何用 递归哈希算法 或 匹配表算法 搜索字符串

本帖最后由 思想之翼 于 2023-4-9 05:37 编辑

https://zhuanlan.zhihu.com/p/389419957
该文阐述字符串搜索算法有  朴素算法   Rabin-karp算法(递归哈希)   Kruth-Morris-Pratt算法(匹配表),这三种算法,时空复杂度犹如云泥之别。
文章结论:由于在文本字符串中遍历时,不管模式字符串多长,每次计算量只涉及一次旧值的去除和一次新值的添加,Rabin Karp算法最适合用于模式字符串非常长的情况,比如长句子在论文中的查重。
我曾用VBS代码解决类似字符串匹配问题,运行速度之慢,难于言表。
限于网络难以搜寻到类似参考代码,故特举例,恳请各位老师指点(不拘泥于上述列举算法)。

例:文本A.txt 记录字符串
W
A
D
C
B
A
D
C
B
A


1.首先,读取A.txt文本字符串,并反转文本字符串为:ABCDABCDAW
2.其次,始终以A为起点,选择模式字符串。本例中,ABCDA 在文本字符串中存在2个及以上,且为最长相同字符串,故确定 ABCDA 为模式字符串。
3.然后,在文本字符串中,提取模式字符串的前缀。
4.结果:本例提取的前缀为D,写入文本B.txt  ;如有多个模式字符串的前缀,则不去重,依次竖排(另起一行)写入文本B.txt。
1

评分人数

    • Batcher: 感谢给帖子标题标注[已解决]字样PB + 2

  1. Dim i, j, srcFile, dstFile1, dstFile2
  2. For i = 1 To 1624
  3.     For j = 1 To 7
  4.         srcFile  = "e:\ZA\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
  5.         dstFile1 = "e:\ZD\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
  6.         dstFile2 = "e:\ZS\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
  7.         GetStr srcFile, dstFile1, dstFile2
  8.     Next
  9. Next
  10. Function GetStr(srcFile, dstFile1, dstFile2)
  11.     Dim max, min
  12.     max = 0                       '最大值初始化
  13.     min = CLng(1000000000)        '最小值初始化
  14.     Dim fso, objFile, objDic
  15.     Set fso = CreateObject("Scripting.FileSystemObject")
  16.     Set objFile = fso.OpenTextFile(srcFile, 1)
  17.     Set objDic  = CreateObject("Scripting.Dictionary")
  18.     Dim strIn, strLine
  19.     strIn = ""
  20.     Do Until objFile.AtEndOfStream
  21.        strLine = objFile.ReadLine
  22.        If strLine <> "" Then strIn =  strLine & strIn
  23.     Loop
  24.     objFile.Close()
  25.     Dim i, k
  26.     For i = Len(strIn)-1 To 1 Step -1
  27.         k = Left(strIn, i)
  28.         If InStr(2, strIn, k) > 0 Then
  29.             MsgBox k
  30.             SaveToDictionary objDic, strIn, k
  31.             Exit For
  32.         End If
  33.     Next
  34.     Dim s1, s2, key
  35.     s1 = ""              '次数最多的字符
  36.     s2 = ""              '次数最少的字符
  37.     For Each key In objDic.Keys              '遍历字典
  38.         If objDic.Item(key) > max Then       '最大值
  39.             max = objDic.Item(key)
  40.             s1 = key & vbCrLf
  41.         ElseIf objDic.Item(key) = max Then
  42.             s1 = s1 & key & vbCrLf
  43.         End If
  44.         If objDic.Item(key) < min Then       '最小值
  45.             min = objDic.Item(key)
  46.             s2 = key & vbCrLf
  47.         ElseIf objDic.Item(key) = min Then
  48.             s2 = s2 & key & vbCrLf
  49.         End If
  50.     Next
  51.     fso.OpenTextFile(dstFile1, 2, True).Write(s1)    '写入文本,次数最多的字符
  52.     fso.OpenTextFile(dstFile2, 2, True).Write(s2)    '写入文本,次数最少的字符
  53.     Set objDic = Nothing
  54.     Set fso = Nothing
  55. End Function
  56. Function SaveToDictionary(dic, str, pattern)
  57.     Dim reg, match, key
  58.     Set reg = New RegExp
  59.     reg.Global = True
  60.     reg.Pattern = ".(?=" & pattern & ")"
  61.     For Each match In reg.Execute(str)
  62.         key = match.Value
  63.         If Not dic.Exists(key) Then
  64.             dic.Add key, 1            '字典赋值
  65.         Else
  66.             dic.Item(key) = dic.Item(key) + 1
  67.         End If
  68.     Next
  69. End Function
  70. MsgBox "Done"
复制代码
1

评分人数

TOP

本帖最后由 WHY 于 2023-4-27 17:57 编辑

回复 19# 思想之翼


    不建议把脚本一股脑全部放在 for 循环体里面,脚本会很难看。
一定要这么干,也得把 Function 放到 for 循环体外面。
1

评分人数

TOP

本帖最后由 思想之翼 于 2023-4-26 10:16 编辑

回复 17# WHY
感谢帮助!代码运行正确。
有个问题求教:如下述方法添加 for...next 循环后,Function SaveToDictionary(pattern) 显示语法错误 800A03EA,问题出在哪?
For f = 1 to 1624
For g = 1 to 7
Dim srcFile, dstFile1, dstFile2
srcFile = "e:\ZA\" & Right("00000" & f, 6) & "\"& Right("00000" & f, 6) & "_" & g & ".txt"
dstFile1 = "e:\ZD\" & Right("00000" & f, 6) & "\"& Right("00000" & f, 6) & "_" & g & ".txt"
dstFile2 = "e:\ZS\" & Right("00000" & f, 6) & "\"& Right("00000" & f, 6) & "_" & g & ".txt"
...
...
fso.OpenTextFile(dstFile1, 2, True).Write(s1)
fso.OpenTextFile(dstFile2, 2, True).Write(s2)
next
next

TOP

根据所需,自行修改
  1. @if(0)==(0) echo off
  2. cscript -NoLogo -E:JScript %0 <a.txt
  3. pause&goto:eof
  4. @end
  5. function getRepeatedStr(s) {
  6.     var arr = [],res = {};
  7.     for (var i = 0; i < s.length; i++) {
  8.           arr[i] = i;
  9.     }
  10.     arr.sort(function compare(a, b) {
  11.         return s.substring(a).localeCompare(s.substring(b));
  12.     });
  13.     for (var i = 1; i < s.length; i++) {
  14.         var num = 0;
  15.         var si = arr[i];
  16.         var sj = arr[i-1];
  17.         while(s.charAt(si+num) == s.charAt(sj+num)) {
  18.             num++;
  19.             if (num>0) {
  20.                var tmp=s.substring(si, si+num)
  21.                res[tmp]=1+res[tmp]||1;
  22.                max = Math.max(max, res[tmp]);
  23.                min = Math.min(min, res[tmp]);
  24.             }
  25.         }
  26.     }
  27.     return res;
  28. }
  29. var text = WSH.StdIn.ReadAll().replace(/\r?\n/mg,'')
  30. var max = -1, min = Number.MAX_VALUE;
  31. var result = getRepeatedStr(text)
  32. var n = 4, arr=[], minarr=[], maxarr=[];
  33. for (var k in result) {
  34.       var i = result[k];
  35.       if (i == max) {
  36.          maxarr.push(k);
  37.       }
  38.       else if (i == min) {
  39.          minarr.push(k);
  40.       }
  41.       if (i== n) {
  42.           arr.push(k);
  43.       }
  44. }
  45. WSH.Echo('最小重复次数',min,'\n重复字符:',minarr.join('\n'))
  46. WSH.Echo('最大重复次数',max,'\n重复字符:',maxarr.join('\n'))
  47. WSH.Echo('指定重复次数',n,'\n重复字符:',arr.join('\n'))
复制代码
1

评分人数

TOP

回复 16# 思想之翼


    你试试吧,我只做了一下简单测试
  1. Dim srcFile, dstFile
  2. srcFile = "a.txt"
  3. dstFile = "b.txt"
  4. Dim n, max, min
  5. max = 0                       '最大值初始化
  6. min = CLng(1000000000)        '最小值初始化
  7. n = 2                         '指定次数n=2
  8. Dim fso, objFile
  9. Set fso = CreateObject("Scripting.FileSystemObject")
  10. Set objFile = fso.OpenTextFile(srcFile, 1)
  11. Dim objDic
  12. Set objDic  = CreateObject("Scripting.Dictionary")
  13. Dim strIn, strLine
  14. strIn = ""
  15. Do Until objFile.AtEndOfStream
  16.    strLine = objFile.ReadLine
  17.    If strLine <> "" Then strIn =  strLine & strIn
  18. Loop
  19. Function SaveToDictionary(pattern)
  20.     Dim reg, match, key
  21.     Set reg = New RegExp
  22.     reg.Global = True
  23.     reg.Pattern = ".(?=" & pattern & ")"
  24.     For Each match In reg.Execute(strIn)
  25.         key = match.Value
  26.         If Not objDic.Exists(key) Then
  27.             objDic.Add key, 1            '字典赋值
  28.         Else
  29.             objDic.Item(key) = objDic.Item(key) + 1
  30.         End If
  31.     Next
  32. End Function
  33. Dim i, k
  34. For i = Len(strIn)-1 To 1 Step -1
  35.     k = Left(strIn, i)
  36.     If InStr(2, strIn, k) > 0 Then
  37.         SaveToDictionary k
  38.         Exit For
  39.     End If
  40. Next
  41. Dim s1, s2, s3, key
  42. s1 = ""              '次数最多的字符
  43. s2 = ""              '次数最少的字符
  44. s3 = ""              '指定次数的字符
  45. For Each key In objDic.Keys              '遍历字典
  46.     If objDic.Item(key) > max Then       '最大值
  47.         max = objDic.Item(key)
  48.         s1 = key & vbCrLf
  49.     ElseIf objDic.Item(key) = max Then
  50.         s1 = s1 & key & vbCrLf
  51.     End If
  52.     If objDic.Item(key) < min Then       '最小值
  53.         min = objDic.Item(key)
  54.         s2 = key & vbCrLf
  55.     ElseIf objDic.Item(key) = min Then
  56.         s2 = s2 & key & vbCrLf
  57.     End If
  58.     If objDic.Item(key) = n Then         '指定次数
  59.         s3 = s3 & key & vbCrLf
  60.     End If
  61. Next
  62. fso.OpenTextFile(dstFile, 2, True).Write(s1)    '写入文本,次数最多的字符
  63. 'fso.OpenTextFile(dstFile, 2, True).Write(s2)   '写入文本,次数最少的字符
  64. 'fso.OpenTextFile(dstFile, 2, True).Write(s3)   '写入文本,指定次数的字符
  65. MsgBox "Done"
复制代码
1

评分人数

TOP

本帖最后由 思想之翼 于 2023-4-23 03:53 编辑

回复 13# WHY
感谢帮助!求教:VBS代码搜索出全部符合条件的字符后,在写入文本前,如何增添一个筛选判断,只输出搜索所得字符中重复次数最多的字符,或重复次数最少的字符,或重复次数指定N次的字符(如无,文本为空)。真诚希望通过这个实例,深入学习VBS判断语句的写法。

TOP

回复 14# 思想之翼


    报错信息是什么?
D:\测试1\a.txt 和 E:\测试2 必须是真实存在的。脚本必须 ANSI 编码,UTF8 编码的话中文会出现乱码。
1

评分人数

TOP

回复 11# WHY
虚心请教:下述表示路径出错,如何正确表述?
type a.txt | cscript //nologo //e:jscript "%~f0" > b.txt
type d:\测试1\a.txt | cscript //nologo //e:jscript "%~f0" > e:\测试2\b.txt

TOP

本帖最后由 WHY 于 2023-4-10 07:26 编辑

我贴一个vbs,0.03s 左右
  1. ST = Timer
  2. Dim srcFile, dstFile
  3. srcFile = "a.txt"
  4. dstFile = "b.txt"
  5. Dim fso, objFile
  6. Set fso = CreateObject("Scripting.FileSystemObject")
  7. Set objFile = fso.OpenTextFile(srcFile, 1)
  8. Dim strIn, strLine
  9. strIn = ""
  10. Do Until objFile.AtEndOfStream
  11.    strLine = objFile.ReadLine
  12.    If strLine <> "" Then strIn =  strLine & strIn
  13. Loop
  14. Dim reg
  15. Set reg = New RegExp
  16. reg.Global = True
  17. Dim strOut, i, key, match
  18. strOut = ""
  19. For i = Len(strIn)-1 To 1 Step -1
  20.     key = Left(strIn, i)
  21.     If InStr(2, strIn, key) > 0 Then
  22.         reg.Pattern = ".(?=" & key & ")"
  23.         For Each match In reg.Execute(strIn)
  24.             strOut = strOut & match & vbCrLf
  25.         Next
  26.         Exit For
  27.     End If
  28. Next
  29. fso.OpenTextFile(dstFile, 2, True).Write(strOut)
  30. MsgBox Timer - ST
复制代码
1

评分人数

TOP

回复 10# 思想之翼


    这个VBS脚本不能用来解决这个问题,思路不一样。
如果字符串是:WADCBADCBAADCBA
应该提取红色的两个字符D和A,VBS只提取了一个A
1

评分人数

TOP

回复 10# 思想之翼
  1. @if(0)==(0) echo off
  2. type a.txt | cscript //nologo //e:jscript "%~f0" > b.txt
  3. pause & exit
  4. @end
  5. var str = WSH.StdIn.ReadAll().replace(/\s/g, '');
  6. var Len = str.length;
  7. for (var i = Len-1; i > 0; i--) {
  8.     var key = str.substr(Len-i);
  9.     var arr = str.substr(0, Len-1).split(key);
  10.     if (arr.length > 1) {
  11.         for (var j = 0; j < Len-i; j++) {
  12.             if (str.substr(j, i) === key) {
  13.                 WSH.Echo(str.substr(i+j, 1));
  14.             }
  15.         }
  16.         break;
  17.     }
  18. }
复制代码
1

评分人数

TOP

本帖最后由 思想之翼 于 2023-4-8 22:57 编辑

回复 9# WHY

链接:https://pan.baidu.com/s/1Jw90mkqCSH1AzBsqvM_wfg?pwd=v5ak
提取码:v5ak

感谢帮助!您的代码这次测试是6.23秒,VBS代码测试是0.14秒

TOP

回复 7# 思想之翼


   
从总字符串的一半(奇数则+1)开始递减,是否更快?

这种办法行不通,WADCBADCBA,WADCBADCBA,出现重复的子串在整个字符串中是重叠的。
你不能确定被截掉的另一半是否有重复的子串。

TOP

回复 5# 思想之翼


    把你测试用的 2000 行的文本放到网盘,分享链接,我看看是什么情况。

TOP

返回列表