Imports System
Imports System.Collections.Generic
Imports System.Data
Imports System.Data.SqlClient
Imports System.Data.SqlTypes
Imports Microsoft.SqlServer.Server
Imports Microsoft.VisualBasic

Partial Public Class UserDefinedFunctions

    Private Structure RetCount
        Public lngSubRows As Integer
        Public lngCountLike As Integer
    End Structure

    'Нечеткое сравнение строк 
    'Аргументы: 
    '   lngMaxLen - максимальная длина сравниваемых подстрок (читайте описание алгоритма сравнения строк), 
    '   strStringMatching - первая строка,
    '   strStringStandart - вторая строка, 
    '   lngCase - тип сравнения (без учёта - 0, с учётом регистра - 1)
    'Назначение: Нечеткое сравнение двух строк 
    'Возвращает: Возвращает коэффициент совпадения строк от 0 до 100 
    '   (0 - строки не совпадают, 100 - полное совпадение)
    'Алгоритм сравнения строк Функция нечёткого сравнения использует в качестве аргументов две строки и параметр сравнения - максимальную длину
    'сравниваемых подстрок. Результатом работы функции является число, лежащее в пределах от 0 до 1. 0 соответствует полному 
    'несовпадению двух строк, а 1 - полной (в определённом ниже смысле) их идентичности. Сравнение строк происходит по следующей схеме. 
    'Пусть, например, в качестве аргументов заданы две строки "test" и "text" и некоторая максимальная длина подстрок, скажем, 4. 
    'Функция сравнения составляет все возможные комбинации подстрок с длиной вплоть до указанной и подсчитывает их совпадения в двух сравниваемых строках. 
    'Количество совпадений, разделённое на число вариантов, объявляется коэффициентом схожести строк и выдаётся в качестве результата работы функции. 

    <Microsoft.SqlServer.Server.SqlFunction()>
    Public Shared Function IndistinctMatching(MaxLen As SqlInt32, StringMatching As SqlString, StringStandart As SqlString, MatchingCase As SqlInt32) As SqlInt32
        Dim gret As RetCount
        Dim tret As RetCount
        Dim lngCurLen As Integer

        If MaxLen.IsNull Or MatchingCase.IsNull Or StringMatching.IsNull Or StringStandart.IsNull Then
            Return SqlInt32.Null
        End If

        If MaxLen = 0 Or CType(StringMatching, String).Length = 0 Or CType(StringStandart, String).Length = 0 Then
            IndistinctMatching = 0
            Exit Function
        End If

        Dim _CompareMethod As CompareMethod
        If MatchingCase = 0 Then _CompareMethod = CompareMethod.Text Else _CompareMethod = CompareMethod.Binary

        gret.lngCountLike = 0
        gret.lngSubRows = 0
        For lngCurLen = 1 To CType(MaxLen, Integer)
            tret = MatchingStrings(CType(StringMatching, String), CType(StringStandart, String), lngCurLen, _CompareMethod)
            gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
            gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
            tret = MatchingStrings(CType(StringStandart, String), CType(StringMatching, String), lngCurLen, _CompareMethod)
            gret.lngCountLike = gret.lngCountLike + tret.lngCountLike
            gret.lngSubRows = gret.lngSubRows + tret.lngSubRows
        Next lngCurLen
        If gret.lngSubRows = 0 Then
            Return 0
        End If
        Return CType((gret.lngCountLike / gret.lngSubRows) * 100, SqlInt32)
    End Function

    Private Shared Function MatchingStrings(strA As String, strB As String, lngLen As Integer, lngCase As CompareMethod) As RetCount
        Dim tret As RetCount
        Dim y As Integer, z As Integer
        Dim strta As String
        Dim strtb As String

        For z = 0 To strA.Length - lngLen
            strta = strA.Substring(z, lngLen)
            For y = 0 To strB.Length - lngLen
                strtb = strB.Substring(y, lngLen)
                If StrComp(strta, strtb, lngCase) = 0 Then
                    tret.lngCountLike = tret.lngCountLike + 1
                    Exit For
                End If
            Next y
            tret.lngSubRows = tret.lngSubRows + 1
        Next z
        MatchingStrings.lngCountLike = tret.lngCountLike
        MatchingStrings.lngSubRows = tret.lngSubRows
    End Function

    'Дистанция Левенштейна
    '"Наивный" алгоритм из Викиучебника
    'Сравнение без учета регистра
    <Microsoft.SqlServer.Server.SqlFunction()>
    Public Shared Function LevenshteinDistance(source As SqlString, target As SqlString) As SqlInt32

        'Если одна из строк неизвестна - результат неизвестен
        If source.IsNull Or target.IsNull Then
            Return SqlInt32.Null
        End If

        Dim l1 As Integer = CType(source, String).Length
        Dim l2 As Integer = CType(target, String).Length

        ' Если одна из строк пустая - результат - размер непустой строки
        If l1 = 0 Or l2 = 0 Then
            Return Math.Max(l1, l2)
        End If

        Dim m(l1, l2) As Integer
        Dim diff As Integer

        For i As Integer = 0 To l1
            m(i, 1) = i
        Next

        For j As Integer = 0 To l2
            m(1, j) = j
        Next

        For i As Integer = 1 To l1
            For j As Integer = 1 To l2
                If CType(source, String)(i - 1) = CType(target, String)(j - 1) Then diff = 0 Else diff = 1
                m(i, j) = Math.Min(Math.Min(m(i - 1, j) + 1, m(i, j - 1) + 1), m(i - 1, j - 1) + diff)
            Next
        Next

        Return m(l1, l2)
    End Function

    'Дистанция Дамерау-Левенштейна
    '"Наивный" алгоритм из Викиучебника
    'Сравнение без учета регистра
    <Microsoft.SqlServer.Server.SqlFunction()>
    Public Shared Function DamerauLevenshteinDistance(source As SqlString, target As SqlString) As SqlInt32

        'Если одна из строк неизвестна - результат неизвестен
        If source.IsNull Or target.IsNull Then
            Return SqlInt32.Null
        End If

        Dim l1 As Integer = CType(source, String).Length
        Dim l2 As Integer = CType(target, String).Length

        ' Если одна из строк пустая - результат - размер непустой строки
        If l1 = 0 Or l2 = 0 Then
            Return Math.Max(l1, l2)
        End If

        Dim h(l1 + 2, l2 + 2) As Integer
        Dim INF As Integer = l1 + l2

        h(0, 0) = INF

        For i As Integer = 0 To l1
            h(i + 1, 1) = i
            h(i + 1, 0) = INF
        Next

        For j As Integer = 0 To l2
            h(1, j + 1) = j
            h(0, j + 1) = INF
        Next

        Dim sd As New SortedDictionary(Of Char, Integer)
        For Each letter As Char In CType(source, String) & CType(target, String)
            If Not sd.ContainsKey(letter) Then sd.Add(letter, 0)
        Next

        For i As Integer = 1 To l1
            Dim DB As Integer = 0
            For j As Integer = 1 To l2
                Dim i1 As Integer = sd(CType(target, String)(j - 1))
                Dim j1 As Integer = DB
                If CType(source, String)(i - 1) = CType(target, String)(j - 1) Then
                    h(i + 1, j + 1) = h(i, j)
                    DB = j
                Else
                    h(i + 1, j + 1) = Math.Min(h(i, j), Math.Min(h(i + 1, j), h(i, j + 1))) + 1
                End If
                h(i + 1, j + 1) = Math.Min(h(i + 1, j + 1), h(i1, j1) + (i - i1 - 1) + 1 + (j - j1 - 1))
            Next
            sd(CType(source, String)(i - 1)) = i
        Next
        Return h(l1 + 1, l2 + 1)
    End Function

    'Инкапсулирует Regex.Replace
    <Microsoft.SqlServer.Server.SqlFunction()>
    Public Shared Function RegexReplace(source As SqlString, pattern As SqlString) As SqlString
        If source.IsNull Or pattern.IsNull Then
            Return SqlString.Null
        End If
        Return Text.RegularExpressions.Regex.Replace(source.ToString, pattern.ToString, String.Empty)
    End Function

End Class