eliza port vb.aSS

[fukurou]

Public Class LimUniqueResponder
    Private responses As List(Of String)
    Private urg As UniqueRandomGenerator = New UniqueRandomGenerator(0)
    Private ReadOnly lim As Integer

    ' Constructor
    Public Sub New(lim As Integer)
        responses = New List(Of String)()
        Me.lim = lim
    End Sub

    ' Method to get a response
    Public Function GetAResponse() As String
        If responses.Count = 0 Then
            Return ""
        End If
        Return responses(urg.GetUniqueRandom())
    End Function

    ' Method to check if responses contain a string
    Public Function ResponsesContainsStr(item As String) As Boolean
        Return responses.Contains(item)
    End Function

    ' Method to check if a string contains any response
    Public Function StrContainsResponse(item As String) As Boolean
        For Each response As String In responses
            If String.IsNullOrEmpty(response) Then
                Continue For
            End If
            If item.Contains(response) Then
                Return True
            End If
        Next
        Return False
    End Function

    ' Method to add a response
    Public Sub AddResponse(s1 As String)
        If Me.responses.Count > lim - 1 Then
            responses.RemoveAt(0)
        End If
        If Not responses.Contains(s1) Then
            responses.Add(s1)
            urg = New UniqueRandomGenerator(responses.Count)
        End If
    End Sub

    ' Method to add multiple responses
    Public Sub AddResponses(ParamArray replies As String())
        For Each value As String In replies
            AddResponse(value)
        Next
    End Sub

    ' Method to get a savable string
    Public Function GetSavableStr() As String
        Return String.Join("_", responses)
    End Function

    ' Method to get the last item
    Public Function GetLastItem() As String
        If responses.Count = 0 Then
            Return ""
        End If
        Return responses(responses.Count - 1)
    End Function
End Class

 

[fukurou]

Public Class EventChatV2
    Private ReadOnly dic As New Dictionary(Of String, LimUniqueResponder)()
    Private ReadOnly modifiedKeys As New HashSet(Of String)()
    Private ReadOnly lim As Integer

    ' Constructor
    Public Sub New(lim As Integer)
        Me.lim = lim
    End Sub

    ' Get modified keys
    Public Function GetModifiedKeys() As HashSet(Of String)
        Return modifiedKeys
    End Function

    ' Check if a key exists
    Public Function KeyExists(key As String) As Boolean
        Return modifiedKeys.Contains(key)
    End Function

    ' Add items
    Public Sub AddItems(ur As LimUniqueResponder, ParamArray args As String())
        For Each arg As String In args
            dic(arg) = ur
        Next
    End Sub

    ' Add from database
    Public Sub AddFromDB(key As String, value As String)
        If String.IsNullOrEmpty(value) OrElse value = "null" Then
            Return
        End If
        Dim tool1 As New AXStringSplit()
        Dim values As String() = tool1.Split(value)
        If Not dic.ContainsKey(key) Then
            dic(key) = New LimUniqueResponder(lim)
        End If
        For Each item As String In values
            dic(key).AddResponse(item)
        Next
    End Sub

    ' Add key-value pair
    Public Sub AddKeyValue(key As String, value As String)
        modifiedKeys.Add(key)
        If dic.ContainsKey(key) Then
            dic(key).AddResponse(value)
        Else
            dic(key) = New LimUniqueResponder(lim)
            dic(key).AddResponse(value)
        End If
    End Sub

    ' Add key-values from a list of AXKeyValuePair
    Public Sub AddKeyValues(elizaResults As List(Of AXKeyValuePair))
        For Each pair As AXKeyValuePair In elizaResults
            AddKeyValue(pair.GetKey(), pair.GetValue())
        Next
    End Sub

    ' Get response
    Public Function Response(in1 As String) As String
        Return If(dic.ContainsKey(in1), dic(in1).GetAResponse(), "")
    End Function

    ' Get latest response
    Public Function ResponseLatest(in1 As String) As String
        Return If(dic.ContainsKey(in1), dic(in1).GetLastItem(), "")
    End Function

    ' Get save string
    Public Function GetSaveStr(key As String) As String
        Return dic(key).GetSavableStr()
    End Function
End Class

 

[fukurou]

Imports System.Collections.Generic
Imports System.Text.RegularExpressions

Public Class ElizaDeducer
    ' This class populates a special chat dictionary based on the matches added via its AddPhraseMatcher function.
    ' See subclass ElizaDeducerInitializer for example:
    ' Dim ed As New ElizaDeducerInitializer(2) ' 2 = limit of replies per input

    Public babble2 As List(Of PhraseMatcher)
    Private ReadOnly patternIndex As Dictionary(Of String, List(Of PhraseMatcher))
    Private ReadOnly responseCache As Dictionary(Of String, List(Of AXKeyValuePair))
    Private ReadOnly ec2 As EventChatV2 ' Chat dictionary, use getter for access. Hardcoded replies can also be added.

    Public Sub New(lim As Integer)
        babble2 = New List(Of PhraseMatcher)()
        patternIndex = New Dictionary(Of String, List(Of PhraseMatcher))()
        responseCache = New Dictionary(Of String, List(Of AXKeyValuePair))()
        ec2 = New EventChatV2(lim)
    End Sub

    Public Function GetEc2() As EventChatV2
        Return ec2
    End Function

    Public Sub Learn(msg As String)
        ' Populate EventChat dictionary
        ' Check cache first
        If responseCache.ContainsKey(msg) Then
            ec2.AddKeyValues(New List(Of AXKeyValuePair)(responseCache(msg)))
        End If

        ' Search for matching patterns
        Dim potentialMatchers As List(Of PhraseMatcher) = GetPotentialMatchers(msg)
        For Each pm As PhraseMatcher In potentialMatchers
            If pm.Matches(msg) Then
                Dim response As List(Of AXKeyValuePair) = pm.Respond(msg)
                responseCache(msg) = response
                ec2.AddKeyValues(response)
            End If
        Next
    End Sub

    Public Function LearnedBool(msg As String) As Boolean
        ' Same as Learn method but returns True if it learned new replies
        Dim learned As Boolean = False

        ' Populate EventChat dictionary
        ' Check cache first
        If responseCache.ContainsKey(msg) Then
            ec2.AddKeyValues(New List(Of AXKeyValuePair)(responseCache(msg)))
            learned = True
        End If

        ' Search for matching patterns
        Dim potentialMatchers As List(Of PhraseMatcher) = GetPotentialMatchers(msg)
        For Each pm As PhraseMatcher In potentialMatchers
            If pm.Matches(msg) Then
                Dim response As List(Of AXKeyValuePair) = pm.Respond(msg)
                responseCache(msg) = response
                ec2.AddKeyValues(response)
                learned = True
            End If
        Next

        Return learned
    End Function

    Public Function Respond(str1 As String) As String
        Return ec2.Response(str1)
    End Function

    Public Function RespondLatest(str1 As String) As String
        ' Get most recent reply/data
        Return ec2.ResponseLatest(str1)
    End Function

    Private Function GetPotentialMatchers(msg As String) As List(Of PhraseMatcher)
        Dim potentialMatchers As New List(Of PhraseMatcher)()
        For Each key As String In patternIndex.Keys
            If msg.Contains(key) Then
                potentialMatchers.AddRange(patternIndex(key))
            End If
        Next
        Return potentialMatchers
    End Function

    Public Sub AddPhraseMatcher(pattern As String, ParamArray kvPairs As String())
        Dim kvs As New List(Of AXKeyValuePair)()
        For i As Integer = 0 To kvPairs.Length - 1 Step 2
            kvs.Add(New AXKeyValuePair(kvPairs(i), kvPairs(i + 1)))
        Next
        Dim matcher As New PhraseMatcher(pattern, kvs)
        babble2.Add(matcher)
        IndexPattern(pattern, matcher)
    End Sub

    Private Sub IndexPattern(pattern As String, matcher As PhraseMatcher)
        For Each word As String In pattern.Split(" "c)
            If Not patternIndex.ContainsKey(word) Then
                patternIndex(word) = New List(Of PhraseMatcher)()
            End If
            patternIndex(word).Add(matcher)
        Next
    End Sub

    Public Class PhraseMatcher
        Public ReadOnly Matcher As Regex
        Public ReadOnly Responses As List(Of AXKeyValuePair)

        Public Sub New(matcher As String, responses As List(Of AXKeyValuePair))
            Me.Matcher = New Regex(matcher)
            Me.Responses = responses
        End Sub

        Public Function Matches(str As String) As Boolean
            Return Matcher.IsMatch(str)
        End Function

        Public Function Respond(str As String) As List(Of AXKeyValuePair)
            Dim m As Match = Matcher.Match(str)
            Dim result As New List(Of AXKeyValuePair)()
            If m.Success Then
                Dim tmp As Integer = m.Groups.Count - 1 ' GroupCount in Java is equivalent to Groups.Count - 1 in .NET
                For Each kv As AXKeyValuePair In Me.Responses
                    Dim tempKV As New AXKeyValuePair(kv.GetKey(), kv.GetValue())
                    For i As Integer = 0 To tmp - 1
                        Dim s As String = m.Groups(i + 1).Value
                        tempKV.SetKey(tempKV.GetKey().Replace("{" & i & "}", s).ToLower())
                        tempKV.SetValue(tempKV.GetValue().Replace("{" & i & "}", s).ToLower())
                    Next
                    result.Add(tempKV)
                Next
            End If
            Return result
        End Function
    End Class
End Class

 

[fukurou]

Public Class ElizaDeducerInitializer
    Inherits ElizaDeducer

    ' Constructor
    Public Sub New(lim As Integer)
        ' Recommended lim = 5; it's the limit of responses per key in the EventChat dictionary.
        ' The purpose of the lim is to make saving and loading data easier.
        MyBase.New(lim)
        InitializeBabble2()
    End Sub

    ' Initialize the babble2 list with predefined phrase matchers
    Private Sub InitializeBabble2()
        AddPhraseMatcher(
            "(.*) is (.*)",
            "what is {0}", "{0} is {1}",
            "explain {0}", "{0} is {1}"
        )

        AddPhraseMatcher(
            "if (.*) or (.*) than (.*)",
            "{0}", "{2}",
            "{1}", "{2}"
        )

        AddPhraseMatcher(
            "if (.*) and (.*) than (.*)",
            "{0}", "{1}"
        )

        AddPhraseMatcher(
            "(.*) because (.*)",
            "{1}", "i guess {0}"
        )
    End Sub
End Class

 

[fukurou]

Public Class ElizaDBWrapper
    ' This (function wrapper) class adds save/load functionality to the ElizaDeducer Object.
    ' Example usage:
    ' Dim ed As New ElizaDeducerInitializer(2)
    ' ed.GetEc2().AddFromDB("test", "one_two_three") ' Manual load for testing
    ' Dim k As New Kokoro(New AbsDictionaryDB()) ' Use skill's kokoro attribute
    ' Dim ew As New ElizaDBWrapper()
    ' Console.WriteLine(ew.Respond("test", ed.GetEc2(), k)) ' Get reply for input, tries loading reply from DB
    ' Console.WriteLine(ew.Respond("test", ed.GetEc2(), k)) ' Doesn't try DB load on second run
    ' ed.Learn("a is b") ' Learn only after respond
    ' ew.SleepNSave(ed.GetEc2(), k) ' Save when bot is sleeping, not on every skill input method visit

    Private ReadOnly modifiedKeys As New HashSet(Of String)()

    Public Function Respond(in1 As String, ec As EventChatV2, kokoro As Kokoro) As String
        If modifiedKeys.Contains(in1) Then
            Return ec.Response(in1)
        End If
        modifiedKeys.Add(in1)
        ' Load
        ec.AddFromDB(in1, kokoro.GrimoireMemento.SimpleLoad(in1))
        Return ec.Response(in1)
    End Function

    Public Function RespondLatest(in1 As String, ec As EventChatV2, kokoro As Kokoro) As String
        If modifiedKeys.Contains(in1) Then
            Return ec.ResponseLatest(in1)
        End If
        modifiedKeys.Add(in1)
        ' Load and get latest reply for input
        ec.AddFromDB(in1, kokoro.GrimoireMemento.SimpleLoad(in1))
        Return ec.ResponseLatest(in1)
    End Function

    Public Sub SleepNSave(ecv2 As EventChatV2, kokoro As Kokoro)
        For Each element As String In ecv2.GetModifiedKeys()
            kokoro.GrimoireMemento.SimpleSave(element, ecv2.GetSaveStr(element))
        Next
    End Sub
End Class