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

思想之翼

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。

WHY

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

WHY

回复 19# 思想之翼


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

思想之翼

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

terse

根据所需，自行修改

@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'))
复制代码

WHY

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

思想之翼

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

WHY

回复 14# 思想之翼


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

思想之翼

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

我贴一个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
复制代码

WHY

回复 10# 思想之翼


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

WHY

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

思想之翼

回复 9# WHY

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

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

WHY

回复 7# 思想之翼


   

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

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

WHY

回复 5# 思想之翼


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