KMP

Imports System.IO
Module Module1
    Private arrPrefix() As Integer
    Private intCounter As Int64 = 0
    Sub Main()
        Dim strInput As String = "This is a KMP substring search algorithm."
        Dim strPattern0 As String = "KMP"

        Console.WriteLine(FindSubstring(strInput, strPattern0)) 'Вызов трех алгоритмов поиска нужен для прогрева JIT компилятора
        Console.WriteLine(RabinKarpSearch(strInput, strPattern0))
        Console.WriteLine(SimpleSearch(strInput, strPattern0) - 1)
        Console.WriteLine()

        Dim book As String = File.ReadAllText("Солярис.txt") '351231 символ
        Dim output = New List(Of String)

        Dim textLength As Integer = 2000
        While (textLength < book.Length)
            Dim currentText As String = book.Substring(0, textLength)
            Dim patternLength As Integer = 1000
            Dim calculationsCount As Integer = 10000
            output.Add(
                String.Format(
                    "{0}    {1} {2} {3}",
                    textLength,
                    GetAverageTime(AddressOf SimpleSearch, currentText, patternLength, calculationsCount),
                    GetAverageTime(AddressOf RabinKarpSearch, currentText, patternLength, calculationsCount),
                    GetAverageTime(AddressOf FindSubstring, currentText, patternLength, calculationsCount)
                    )
            )

            Console.WriteLine(textLength)

            textLength += textLength / 32
        End While

        File.WriteAllLines("result.txt", output)
    End Sub

    Private Function GetAverageTime(searchFunc As Func(Of String, String, Integer), text As String, patternLength As Integer, count As Integer) As Integer
        Dim randomGen = New Random
        Dim timer = New Stopwatch

        Dim sum As Long = 0

        For i As Integer = 1 To count
            Dim startIndex As Integer = randomGen.Next(0, text.Length - patternLength)
            Dim strPattern As String = text.Substring(startIndex, patternLength)

            timer.Reset()
            timer.Start()
            searchFunc(text, strPattern)
            timer.Stop()

            sum += timer.ElapsedTicks
        Next

        Return sum / count
    End Function
    Private Function GetPrefixFunction(ByVal strPattern As String) As Integer()
        Dim result(strPattern.Length - 1) As Integer
        result(0) = 0

        For i As Integer = 1 To strPattern.Length - 1
            Dim k As Integer = result(i - 1)
            While k > 0 AndAlso strPattern(k) <> strPattern(i)
                k = result(k - 1)
            End While

            If strPattern(k) = strPattern(i) Then k += 1

            result(i) = k
        Next

        Return result
    End Function


    Public Function FindSubstring(ByVal strInput As String, ByVal strPattern As String) As Integer
        Dim intInputLen As Integer = Len(strInput)
        Dim intPatternLen As Integer = Len(strPattern)

        Dim i, j As Integer
        Dim blnFlag As Boolean

        If intInputLen = 0 Or intPatternLen = 0 Then Return -2

        arrPrefix = GetPrefixFunction(strPattern)

        ' j - количество совпавших символов
        j = 0
        ' i - номер сравниваемого очередного символа в входной строке
        For i = 1 To intInputLen
            blnFlag = False
            Do While j > 0 AndAlso GetChar(strPattern, j + 1) <> GetChar(strInput, i)
                j = arrPrefix(j - 1) 'Не хватало - 1
                intCounter += 1
                blnFlag = True
            Loop
            If blnFlag = False Then intCounter += 1
            If GetChar(strPattern, j + 1) = GetChar(strInput, i) Then
                j += 1
            End If
            If j = intPatternLen Then
                Return i - intPatternLen
            End If
        Next

        Return -1

    End Function

    Public Function SimpleSearch(ByVal strInput As String, ByVal strPattern As String) As Integer
        Dim intInputLen As Integer = Len(strInput)
        Dim intPatternLen As Integer = Len(strPattern)
        Dim i, j, k As Integer

        If intInputLen = 0 Or intPatternLen = 0 Then Return -2

        For i = 1 To intInputLen - intPatternLen + 1
            j = 1
            k = i
            Do While GetChar(strPattern, j) = GetChar(strInput, k)
                j += 1
                k += 1
                intCounter += 1
                If j > intPatternLen Then
                    Return i
                End If
            Loop
        Next
        Return -1

    End Function

    Public Function RabinKarpSearch(str As String, seekingStr As String) As Int32 'Из предыдущего задания
        Dim seekingHashCode As Int32 = GetStringHashCode(seekingStr)
        Dim seekingLength As Int32 = seekingStr.Length

        Dim firstSubstring As String = str.Substring(0, seekingLength)

        Dim previousHashCode As Int32 = GetStringHashCode(firstSubstring) 'Хэш первого образца

        If previousHashCode = seekingHashCode Then
            If firstSubstring = seekingStr Then Return 0
        End If

        For i As Int32 = 1 To str.Length - seekingStr.Length
            'Рассчет простейшей кольцевой хэш функции
            Dim currentHashCode As Int32 = previousHashCode - AscW(str(i - 1)) + AscW(str(i + seekingLength - 1))

            If currentHashCode = seekingHashCode Then 'Если совпадает, то посимвольное сравнение
                Dim success As Boolean = True
                For j As Int32 = 0 To seekingLength - 1
                    If str(i + j) <> seekingStr(j) Then
                        success = False
                        Exit For
                    End If
                Next

                If (success) Then Return i
            End If

            previousHashCode = currentHashCode
        Next

        Return -1
    End Function

    Private Function GetStringHashCode(str As String) As Int32
        Dim hashCode As Int32 = 0
        For i As Int32 = 0 To str.Length - 1
            hashCode += AscW(str(i))
        Next

        Return hashCode
    End Function
End Module