标题: [文本处理] 【已解决】如何用 递归哈希算法 或 匹配表算法 搜索字符串 [打印本页]
作者: 思想之翼 时间: 2023-3-29 18:41 标题: 【已解决】如何用 递归哈希算法 或 匹配表算法 搜索字符串
本帖最后由 思想之翼 于 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。
作者: czjt1234 时间: 2023-3-29 19:04
http://www.bathome.net/thread-65332-1-1.html
感觉和这个有点相似?
作者: xczxczxcz 时间: 2023-3-29 19:47
是不是介样子呢?- $t='WADCBADCBAFEGFLIFABCDEFABCDEFALI';
- $f=$t.ToCharArray();
- [array]::Reverse($f);
- $e=-join($f);
-
- $d=[regex]::Matches($e, "(?s)(.)((?:(?!\1).)+)\1(?=\2\1){1,}").value;
-
- # 这是获取最长一个为 :输出B
- if($null -ne $d -and $d.Length -gt 0){
- $s=[Linq.Enumerable]::Max($d, [func[object,int]]{param($i); $i.Length;});
- $d.Where{$_.Length -eq $s}.Foreach{$_.SubString($_.Length-2,1)}
- }
-
- # 这是获取每一个为 ;输出 B;D
- if($null -ne $d -and $d.Length -gt 0){
- $d.ForEach{$_.SubString($_.Length-2,1)}
- }
复制代码
作者: WHY 时间: 2023-4-1 22:45
- @if(0)==(0) echo off
- type a.txt | cscript //nologo //e:jscript "%~f0" > b.txt
- pause & exit
- @end
-
- var str = WSH.StdIn.ReadAll().replace(/\s/g, '');
- var Len = str.length;
- var flag = false;
-
- for (var i = Len-1; i > 0; i--) {
- var key = str.substr(Len-i);
- for (var j = 0; j < Len-i; j++) {
- if (str.substr(j, i) === key) {
- flag = true;
- WSH.Echo(str.substr(i+j, 1));
- }
- }
- if (flag) break;
- }
复制代码
作者: 思想之翼 时间: 2023-4-7 23:24
回复 4# WHY
感谢!有一点疑惑:计算1列2000行的数据,该代码耗时22秒,VBS代码却只耗时0.07125秒,老刘一号不是说:“随便换个编译型语言效率就可以薄纱vbs”吗?
作者: terse 时间: 2023-4-8 18:41
回复 5# 思想之翼
计算1列2000行 应该不需要22秒 一楼的意思应该是要匹配的字符总是第一位开始 是这样吗
作者: 思想之翼 时间: 2023-4-8 20:27
本帖最后由 思想之翼 于 2023-4-8 21:34 编辑
回复 6# terse
您好!是的。
递增:A(有重复) AB(有重复) ABC(有重复) ABCD(有重复) ABCDA(有重复) ABCDAB(无重复)... 找到ABCDA有重复,且最长字符串。
从总字符串的一半(奇数则+1)开始递减,是否更快?
ABCDAB(无重复) ABCDA(有重复)... 找到ABCDA有重复,且最长字符串。
实际运用中,没有极端情况,比如:AAAAAAAAAAAAAA 或者 ABABABABABABAB 或者 ABCABCABCABC ...
作者: WHY 时间: 2023-4-8 22:04
回复 5# 思想之翼
把你测试用的 2000 行的文本放到网盘,分享链接,我看看是什么情况。
作者: WHY 时间: 2023-4-8 22:12
回复 7# 思想之翼
从总字符串的一半(奇数则+1)开始递减,是否更快?
这种办法行不通,WADCBADCBA,WADCBADCBA,出现重复的子串在整个字符串中是重叠的。
你不能确定被截掉的另一半是否有重复的子串。
作者: 思想之翼 时间: 2023-4-8 22:40
本帖最后由 思想之翼 于 2023-4-8 22:57 编辑
回复 9# WHY
链接:https://pan.baidu.com/s/1Jw90mkqCSH1AzBsqvM_wfg?pwd=v5ak
提取码:v5ak
感谢帮助!您的代码这次测试是6.23秒,VBS代码测试是0.14秒
作者: WHY 时间: 2023-4-9 01:13
回复 10# 思想之翼 - @if(0)==(0) echo off
- type a.txt | cscript //nologo //e:jscript "%~f0" > b.txt
- pause & exit
- @end
-
- var str = WSH.StdIn.ReadAll().replace(/\s/g, '');
- var Len = str.length;
-
- for (var i = Len-1; i > 0; i--) {
- var key = str.substr(Len-i);
- var arr = str.substr(0, Len-1).split(key);
- if (arr.length > 1) {
- for (var j = 0; j < Len-i; j++) {
- if (str.substr(j, i) === key) {
- WSH.Echo(str.substr(i+j, 1));
- }
- }
- break;
- }
- }
复制代码
作者: WHY 时间: 2023-4-9 01:19
回复 10# 思想之翼
这个VBS脚本不能用来解决这个问题,思路不一样。
如果字符串是:WADCBADCBAADCBA
应该提取红色的两个字符D和A,VBS只提取了一个A
作者: WHY 时间: 2023-4-9 22:34
本帖最后由 WHY 于 2023-4-10 07:26 编辑
我贴一个vbs,0.03s 左右- ST = Timer
-
- Dim srcFile, dstFile
- srcFile = "a.txt"
- dstFile = "b.txt"
-
- Dim fso, objFile
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set objFile = fso.OpenTextFile(srcFile, 1)
-
- Dim strIn, strLine
- strIn = ""
- Do Until objFile.AtEndOfStream
- strLine = objFile.ReadLine
- If strLine <> "" Then strIn = strLine & strIn
- Loop
-
- Dim reg
- Set reg = New RegExp
- reg.Global = True
-
- Dim strOut, i, key, match
- strOut = ""
- For i = Len(strIn)-1 To 1 Step -1
- key = Left(strIn, i)
- If InStr(2, strIn, key) > 0 Then
- reg.Pattern = ".(?=" & key & ")"
- For Each match In reg.Execute(strIn)
- strOut = strOut & match & vbCrLf
- Next
- Exit For
- End If
- Next
-
- fso.OpenTextFile(dstFile, 2, True).Write(strOut)
-
- MsgBox Timer - ST
复制代码
作者: 思想之翼 时间: 2023-4-9 23:32
回复 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
作者: WHY 时间: 2023-4-10 00:15
回复 14# 思想之翼
报错信息是什么?
D:\测试1\a.txt 和 E:\测试2 必须是真实存在的。脚本必须 ANSI 编码,UTF8 编码的话中文会出现乱码。
作者: 思想之翼 时间: 2023-4-22 11:51
本帖最后由 思想之翼 于 2023-4-23 03:53 编辑
回复 13# WHY
感谢帮助!求教:VBS代码搜索出全部符合条件的字符后,在写入文本前,如何增添一个筛选判断,只输出搜索所得字符中重复次数最多的字符,或重复次数最少的字符,或重复次数指定N次的字符(如无,文本为空)。真诚希望通过这个实例,深入学习VBS判断语句的写法。
作者: WHY 时间: 2023-4-23 23:43
回复 16# 思想之翼
你试试吧,我只做了一下简单测试- Dim srcFile, dstFile
- srcFile = "a.txt"
- dstFile = "b.txt"
-
- Dim n, max, min
- max = 0 '最大值初始化
- min = CLng(1000000000) '最小值初始化
- n = 2 '指定次数n=2
-
- Dim fso, objFile
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set objFile = fso.OpenTextFile(srcFile, 1)
-
- Dim objDic
- Set objDic = CreateObject("Scripting.Dictionary")
-
- Dim strIn, strLine
- strIn = ""
- Do Until objFile.AtEndOfStream
- strLine = objFile.ReadLine
- If strLine <> "" Then strIn = strLine & strIn
- Loop
-
- Function SaveToDictionary(pattern)
- Dim reg, match, key
- Set reg = New RegExp
- reg.Global = True
- reg.Pattern = ".(?=" & pattern & ")"
- For Each match In reg.Execute(strIn)
- key = match.Value
- If Not objDic.Exists(key) Then
- objDic.Add key, 1 '字典赋值
- Else
- objDic.Item(key) = objDic.Item(key) + 1
- End If
- Next
- End Function
-
- Dim i, k
- For i = Len(strIn)-1 To 1 Step -1
- k = Left(strIn, i)
- If InStr(2, strIn, k) > 0 Then
- SaveToDictionary k
- Exit For
- End If
- Next
-
- Dim s1, s2, s3, key
- s1 = "" '次数最多的字符
- s2 = "" '次数最少的字符
- s3 = "" '指定次数的字符
- For Each key In objDic.Keys '遍历字典
- If objDic.Item(key) > max Then '最大值
- max = objDic.Item(key)
- s1 = key & vbCrLf
- ElseIf objDic.Item(key) = max Then
- s1 = s1 & key & vbCrLf
- End If
- If objDic.Item(key) < min Then '最小值
- min = objDic.Item(key)
- s2 = key & vbCrLf
- ElseIf objDic.Item(key) = min Then
- s2 = s2 & key & vbCrLf
- End If
- If objDic.Item(key) = n Then '指定次数
- s3 = s3 & key & vbCrLf
- End If
- Next
-
- fso.OpenTextFile(dstFile, 2, True).Write(s1) '写入文本,次数最多的字符
- 'fso.OpenTextFile(dstFile, 2, True).Write(s2) '写入文本,次数最少的字符
- 'fso.OpenTextFile(dstFile, 2, True).Write(s3) '写入文本,指定次数的字符
-
- MsgBox "Done"
复制代码
作者: terse 时间: 2023-4-24 22:06
根据所需,自行修改- @if(0)==(0) echo off
- cscript -NoLogo -E:JScript %0 <a.txt
- pause&goto:eof
- @end
-
- function getRepeatedStr(s) {
- var arr = [],res = {};
- for (var i = 0; i < s.length; i++) {
- arr[i] = i;
- }
- arr.sort(function compare(a, b) {
- return s.substring(a).localeCompare(s.substring(b));
- });
- for (var i = 1; i < s.length; i++) {
- var num = 0;
- var si = arr[i];
- var sj = arr[i-1];
- while(s.charAt(si+num) == s.charAt(sj+num)) {
- num++;
- if (num>0) {
- var tmp=s.substring(si, si+num)
- res[tmp]=1+res[tmp]||1;
- max = Math.max(max, res[tmp]);
- min = Math.min(min, res[tmp]);
- }
- }
- }
- return res;
- }
-
- var text = WSH.StdIn.ReadAll().replace(/\r?\n/mg,'')
- var max = -1, min = Number.MAX_VALUE;
- var result = getRepeatedStr(text)
- var n = 4, arr=[], minarr=[], maxarr=[];
- for (var k in result) {
- var i = result[k];
- if (i == max) {
- maxarr.push(k);
- }
- else if (i == min) {
- minarr.push(k);
- }
- if (i== n) {
- arr.push(k);
- }
- }
-
- WSH.Echo('最小重复次数',min,'\n重复字符:',minarr.join('\n'))
- WSH.Echo('最大重复次数',max,'\n重复字符:',maxarr.join('\n'))
- WSH.Echo('指定重复次数',n,'\n重复字符:',arr.join('\n'))
复制代码
作者: 思想之翼 时间: 2023-4-25 21:10
本帖最后由 思想之翼 于 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
作者: WHY 时间: 2023-4-27 17:43
本帖最后由 WHY 于 2023-4-27 17:57 编辑
回复 19# 思想之翼
不建议把脚本一股脑全部放在 for 循环体里面,脚本会很难看。
一定要这么干,也得把 Function 放到 for 循环体外面。
作者: WHY 时间: 2023-4-27 17:50
- Dim i, j, srcFile, dstFile1, dstFile2
- For i = 1 To 1624
- For j = 1 To 7
- srcFile = "e:\ZA\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
- dstFile1 = "e:\ZD\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
- dstFile2 = "e:\ZS\" & Right("00000" & i, 6) & "\"& Right("00000" & i, 6) & "_" & j & ".txt"
- GetStr srcFile, dstFile1, dstFile2
- Next
- Next
-
- Function GetStr(srcFile, dstFile1, dstFile2)
- Dim max, min
- max = 0 '最大值初始化
- min = CLng(1000000000) '最小值初始化
-
- Dim fso, objFile, objDic
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set objFile = fso.OpenTextFile(srcFile, 1)
- Set objDic = CreateObject("Scripting.Dictionary")
-
- Dim strIn, strLine
- strIn = ""
- Do Until objFile.AtEndOfStream
- strLine = objFile.ReadLine
- If strLine <> "" Then strIn = strLine & strIn
- Loop
- objFile.Close()
-
- Dim i, k
- For i = Len(strIn)-1 To 1 Step -1
- k = Left(strIn, i)
- If InStr(2, strIn, k) > 0 Then
- MsgBox k
- SaveToDictionary objDic, strIn, k
- Exit For
- End If
- Next
-
- Dim s1, s2, key
- s1 = "" '次数最多的字符
- s2 = "" '次数最少的字符
- For Each key In objDic.Keys '遍历字典
- If objDic.Item(key) > max Then '最大值
- max = objDic.Item(key)
- s1 = key & vbCrLf
- ElseIf objDic.Item(key) = max Then
- s1 = s1 & key & vbCrLf
- End If
- If objDic.Item(key) < min Then '最小值
- min = objDic.Item(key)
- s2 = key & vbCrLf
- ElseIf objDic.Item(key) = min Then
- s2 = s2 & key & vbCrLf
- End If
- Next
-
- fso.OpenTextFile(dstFile1, 2, True).Write(s1) '写入文本,次数最多的字符
- fso.OpenTextFile(dstFile2, 2, True).Write(s2) '写入文本,次数最少的字符
- Set objDic = Nothing
- Set fso = Nothing
- End Function
-
- Function SaveToDictionary(dic, str, pattern)
- Dim reg, match, key
- Set reg = New RegExp
- reg.Global = True
- reg.Pattern = ".(?=" & pattern & ")"
- For Each match In reg.Execute(str)
- key = match.Value
- If Not dic.Exists(key) Then
- dic.Add key, 1 '字典赋值
- Else
- dic.Item(key) = dic.Item(key) + 1
- End If
- Next
- End Function
-
- MsgBox "Done"
复制代码
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |