Show Posts
1
Ultra Hal Assistant File Sharing Area / Grok Building for Lightspeed
« on: July 12, 2025, 08:09:28 pm »
Rem Type=Plugin
Rem Name= Grock
Rem Author= This is your basic plugin layout.The function call is what fires.
Rem Host=All
Rem PLUGIN: PRE-PROCESS
'The preceding comment is actually a plug-in directive for
'the Ultra Hal host application. It allows for code snippets
'to be inserted here on-the-fly based on user configuration.
HalBrain.ReadOnlyMode = False
'Determines that you are talking about the Grock
If InStr(1,InputString, "Grock",1) > 0 Then
UltraHal = GetGrock(HalCommands)
ElseIf InStr(1,InputString, "Grock",1) > 0 Then
End If
Rem PLUGIN: FUNCTIONS
'Rem Weather the code in the function works is another thing but as a plugin with trigger, This is correct. Triggered by the word Grock.
Function Grock(HalCommands)
' Global variables for memory, subjects, spell correction, and file learning
Public responseMemory As Object ' Dictionary for responses
Public questionMemory As Object ' Dictionary for questions
Public contextMemory As Object ' Dictionary for conversation context
Public responseQuality As Object ' Track response quality ratings
Public shortTermMemory As Object ' Dictionary for recent conversation
Public SubjectTable As Object ' Dictionary for subject-based logic (A-Z subjects)
Public spellDictionary As Object ' Dictionary for spell checking
Public longTermIndex As Object ' Dictionary for long-term memory indexing
Public knowledgeBase As Object ' Dictionary for learned file content
Public Const MAX_SHORT_TERM As Long = 15 ' Increased limit for short-term memory
Public Const MAX_KNOWLEDGE_ENTRIES As Long = 5000 ' Limit for knowledge base entries
' **** USER: EDIT THIS LINE TO SET YOUR ULTRA HAL BRAIN DIRECTORY PATH ****
Public Const BASE_PATH As String = "C:\Users\airva\AppData\Roaming\Zabaware\Ultra Hal 7\ANGELINAJOLIE2050.db" ' User-specified path
Private Const MEMORY_FILE As String = "memory.txt"
Private Const LONG_TERM_FILE As String = "memorydata.txt"
Private Const LONG_TERM_INDEX_FILE As String = "memoryindex.txt"
Private Const LOG_FILE As String = "errorlog.txt"
Private Const SPELL_DICT_FILE As String = "spell_dictionary.txt"
Private Const KNOWLEDGE_FILE As String = "knowledge_base.txt"
Private lastSubject As String ' Track last primary subject for continuity
Private lastTone As String ' Track conversational tone for continuity
' HAL 7 Plugin Function
Public Function HalBrain(ByVal InputString, ByVal UserName, ByVal ComputerName, ByVal HalCommands, ByVal Holiday, ByVal HolidayType)
On Error GoTo ErrorHandler
' Validate BASE_PATH and permissions
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(BASE_PATH) Then
HalBrain = "Error: The specified brain directory (" & BASE_PATH & ") does not exist. Please update the BASE_PATH in the script."
Exit Function
End If
' Check write permissions by attempting to create a temporary file
Dim tempFilePath As String
tempFilePath = BASE_PATH & "temp_permissions_test.txt"
On Error Resume Next
Dim tempFile
Set tempFile = objFSO.CreateTextFile(tempFilePath, True)
If Err.Number <> 0 Then
HalBrain = "Error: No write permissions for the brain directory (" & BASE_PATH & "). Please ensure the directory is accessible."
Exit Function
End If
tempFile.Close
objFSO.DeleteFile tempFilePath
On Error GoTo ErrorHandler
' Initialize memory system
InitializeMemory
Dim response As String
response = EnhanceHalResponse(InputString, "Hey " & UserName & ", what's on your mind today?", "")
' Return the response
HalBrain = response
Exit Function
ErrorHandler:
LogError "HalBrain: " & Err.Description
HalBrain = "Oops, something went wrong. Can we try that again?"
End Function
' Initialization with enhanced memory, subjects, spell dictionary, and knowledge base
Sub InitializeMemory()
Set responseMemory = CreateObject("Scripting.Dictionary")
Set questionMemory = CreateObject("Scripting.Dictionary")
Set contextMemory = CreateObject("Scripting.Dictionary")
Set responseQuality = CreateObject("Scripting.Dictionary")
Set shortTermMemory = CreateObject("Scripting.Dictionary")
Set SubjectTable = CreateObject("Scripting.Dictionary")
Set spellDictionary = CreateObject("Scripting.Dictionary")
Set longTermIndex = CreateObject("Scripting.Dictionary")
Set knowledgeBase = CreateObject("Scripting.Dictionary")
InitializeSubjectTable
LoadMemoryFromFile
LoadLongTermMemory
LoadSpellDictionary
LoadKnowledgeBase
lastSubject = "Questions" ' Default subject
lastTone = "Friendly" ' Default conversational tone
End Sub
' Initialize Subject Table with weighted keywords (expanded for broader coverage)
Private Sub InitializeSubjectTable()
SubjectTable.Add "Animals", "dog:3 cat:3 bird:2 fish:2 zoo:3 wildlife:3 pet:4 fur:2 animal:4"
SubjectTable.Add "Books", "novel:3 read:3 author:3 library:2 story:3 page:2 chapter:2 book:4"
SubjectTable.Add "Computers", "code:4 program:3 software:3 hardware:3 ai:4 data:3 network:2 computer:4"
SubjectTable.Add "Dreams", "sleep:3 night:2 vision:3 dream:4 imagination:3 subconscious:3"
SubjectTable.Add "Education", "school:4 learn:3 teacher:3 study:3 exam:2 knowledge:3 class:2 education:4"
SubjectTable.Add "Food", "eat:3 cook:3 recipe:3 meal:3 taste:2 restaurant:2 chef:2 food:4"
SubjectTable.Add "Games", "play:3 video:3 board:2 strategy:3 fun:2 challenge:2 puzzle:2 game:4"
SubjectTable.Add "Health", "doctor:3 medicine:3 fitness:3 sick:2 exercise:3 wellness:2 diet:3 health:4"
SubjectTable.Add "Internet", "web:3 online:3 site:2 browse:2 connect:2 network:3 social:2 internet:4"
SubjectTable.Add "Jobs", "work:4 career:3 employ:3 office:2 task:2 salary:2 boss:2 job:4"
SubjectTable.Add "Knowledge", "fact:3 info:3 learn:3 understand:3 think:2 idea:3 wisdom:2 knowledge:4"
SubjectTable.Add "Love", "romance:3 heart:3 date:2 partner:3 affection:3 relationship:4 kiss:2 love:4"
SubjectTable.Add "Music", "song:3 sing:3 band:3 play:2 tune:2 rhythm:3 melody:3 music:4"
SubjectTable.Add "Nature", "tree:3 forest:3 river:2 mountain:3 sky:2 earth:3 plant:2 nature:4"
SubjectTable.Add "Opinions", "think:3 believe:3 view:3 argue:2 discuss:3 opinion:4 idea:2"
SubjectTable.Add "People", "friend:3 family:4 person:3 group:2 society:2 talk:2 human:3 people:4"
SubjectTable.Add "Questions", "ask:4 why:3 how:3 what:3 where:3 question:4 curious:2"
SubjectTable.Add "Religion", "god:4 faith:3 pray:3 belief:3 spirit:3 church:2 soul:3 religion:4"
SubjectTable.Add "Science", "test:3 theory:3 lab:3 experiment:3 research:4 discover:3 fact:2 science:4"
SubjectTable.Add "Technology", "machine:3 tech:4 device:3 gadget:2 innovate:3 tool:2 robot:3 technology:4"
SubjectTable.Add "Universe", "star:3 planet:3 space:4 galaxy:3 cosmic:3 moon:2 orbit:2 universe:4"
SubjectTable.Add "Vehicles", "car:3 drive:3 truck:2 plane:3 fly:3 travel:2 boat:2 vehicle:4"
SubjectTable.Add "Weather", "rain:3 sun:3 snow:3 wind:2 cloud:2 storm:3 forecast:2 weather:4"
SubjectTable.Add "Xtra", "extra:3 bonus:2 special:3 unique:3 odd:2 random:2 quirky:2"
SubjectTable.Add "Youth", "young:3 kid:3 child:3 teen:3 grow:2 play:2 school:3 youth:4"
SubjectTable.Add "Zen", "calm:3 peace:4 meditate:3 relax:3 quiet:2 balance:3 harmony:3 zen:4"
End Sub
' Load spell checking dictionary
Private Sub LoadSpellDictionary()
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path As String
path = BASE_PATH & SPELL_DICT_FILE
If Not objFSO.FolderExists(BASE_PATH) Then
objFSO.CreateFolder BASE_PATH
End If
If Not objFSO.FileExists(path) Then
Set file = objFSO.CreateTextFile(path, True)
file.WriteLine "the,be,to,of,and,a,in,that,have,i,it,for,not,on,with,he,as,you,do,at,this,but,his,by,from,they,weather,technology,personal,dog,cat,bird,book,code,school,ai,learn,knowledge"
file.Close
End If
Set file = objFSO.OpenTextFile(path, 1)
Do While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
Dim words As Variant
words = Split(line, ",")
Dim i As Long
For i = 0 To UBound(words)
spellDictionary.Add LCase(Trim(words(i))), True
Next
Loop
file.Close
Exit Sub
ErrorHandler:
LogError "LoadSpellDictionary: " & Err.Description
End Sub
' Load knowledge base from brain directory files
Private Sub LoadKnowledgeBase()
On Error GoTo ErrorHandler
Dim objFSO, folder, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim knowledgePath As String
knowledgePath = BASE_PATH & KNOWLEDGE_FILE
' Load existing knowledge base
If objFSO.FileExists(knowledgePath) Then
Set file = objFSO.OpenTextFile(knowledgePath, 1)
Do While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
If InStr(line, "key") = 0 Then
Dim parts As Variant
parts = Split(line, vbTab)
If UBound(parts) = 2 Then
knowledgeBase.Add parts(0), Array(parts(1), parts(2))
End If
End If
Loop
file.Close
End If
' Scan brain directory for subject matter files
If objFSO.FolderExists(BASE_PATH) Then
Set folder = objFSO.GetFolder(BASE_PATH)
For Each file In folder.Files
If LCase(objFSO.GetExtensionName(file.Name)) = "txt" And file.Name <> MEMORY_FILE And file.Name <> LONG_TERM_FILE And file.Name <> LONG_TERM_INDEX_FILE And file.Name <> LOG_FILE And file.Name <> SPELL_DICT_FILE And file.Name <> KNOWLEDGE_FILE Then
LearnFromFile file.Path
End If
Next
End If
SaveKnowledgeBase
Exit Sub
ErrorHandler:
LogError "LoadKnowledgeBase: " & Err.Description
End Sub
' Learn from a specific file
Private Sub LearnFromFile(filePath As String)
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(filePath) Then
Set file = objFSO.OpenTextFile(filePath, 1)
Dim content As String, subject As String
content = ""
Do While Not file.AtEndOfStream
content = content & file.ReadLine & " "
Loop
file.Close
subject = DetectFileSubject(content)
Dim key As String
key = GenerateKey(objFSO.GetBaseName(filePath), subject)
If Not knowledgeBase.Exists(key) Then
knowledgeBase.Add key, Array(content, subject)
End If
End If
Exit Sub
ErrorHandler:
LogError "LearnFromFile: " & Err.Description
End Sub
' Detect subject of file content
Private Function DetectFileSubject(content As String) As String
Dim subjects As Collection
Set subjects = DetectSubjects(content, "")
DetectFileSubject = GetPrimarySubject(subjects)
End Function
' Save knowledge base to file
Private Sub SaveKnowledgeBase()
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path As String
path = BASE_PATH & KNOWLEDGE_FILE
If Not objFSO.FolderExists(BASE_PATH) Then
objFSO.CreateFolder BASE_PATH
End If
Set file = objFSO.CreateTextFile(path, True)
file.WriteLine "key" & vbTab & "content" & vbTab & "subject"
Dim key As Variant
For Each key In knowledgeBase.Keys
file.WriteLine key & vbTab & knowledgeBase(key)(0) & vbTab & knowledgeBase(key)(1)
Next
file.Close
Exit Sub
ErrorHandler:
LogError "SaveKnowledgeBase: " & Err.Description
End Sub
' Auto-correct misspelled words based on context
Private Function CorrectSpelling(sentence As String, subjects As Collection) As String
Dim words As Variant
words = Split(sentence, " ")
Dim correctedSentence As String
correctedSentence = ""
Dim i As Long
For i = 0 To UBound(words)
Dim word As String
word = Trim(words(i))
If Len(word) > 0 Then
If Not spellDictionary.Exists(LCase(word)) Then
Dim correction As String
correction = SuggestCorrection(word, subjects)
correctedSentence = correctedSentence & " " & IIf(correction <> "", correction, word)
Else
correctedSentence = correctedSentence & " " & word
End If
End If
Next
CorrectSpelling = Trim(correctedSentence)
End Function
' Suggest correction for misspelled word
Private Function SuggestCorrection(word As String, subjects As Collection) As String
Dim minDistance As Long, bestMatch As String
minDistance = Len(word) + 1
Dim dictWord As Variant
For Each dictWord In spellDictionary.Keys
Dim distance As Long
distance = LevenshteinDistance(word, dictWord)
If distance < minDistance Then
minDistance = distance
bestMatch = dictWord
End If
Next
Dim primarySubject As String
primarySubject = GetPrimarySubject(subjects)
If SubjectTable.Exists(primarySubject) Then
Dim subjectKeywords As Variant
subjectKeywords = Split(SubjectTable(primarySubject), " ")
Dim j As Long
For j = 0 To UBound(subjectKeywords)
Dim keyword As String
keyword = Split(subjectKeywords(j), ":")(0)
distance = LevenshteinDistance(word, keyword)
If distance < minDistance And distance <= 2 Then
minDistance = distance
bestMatch = keyword
End If
Next
End If
SuggestCorrection = IIf(minDistance <= 2, bestMatch, "")
End Function
' Calculate Levenshtein Distance
Private Function LevenshteinDistance(str1 As String, str2 As String) As Long
Dim matrix() As Long
Dim i As Long, j As Long
Dim cost As Long
ReDim matrix(Len(str1), Len(str2))
For i = 0 To Len(str1)
matrix(i, 0) = i
Next
For j = 0 To Len(str2)
matrix(0, j) = j
Next
For i = 1 To Len(str1)
For j = 1 To Len(str2)
If Mid(str1, i, 1) = Mid(str2, j, 1) Then
cost = 0
Else
cost = 1
End If
matrix(i, j) = Application.Min(matrix(i - 1, j) + 1, _
matrix(i, j - 1) + 1, _
matrix(i - 1, j - 1) + cost)
Next
Next
LevenshteinDistance = matrix(Len(str1), Len(str2))
End Function
' Enhanced learning with subject continuity and knowledge base integration
Public Sub LearnFromConversation(userQuestion As String, halResponse As String, Optional context As String = "")
On Error GoTo ErrorHandler
Dim correctedQuestion As String
Dim subjects As Collection
Set subjects = DetectSubjects(userQuestion, context)
correctedQuestion = CorrectSpelling(userQuestion, subjects)
Dim primarySubject As String
primarySubject = GetPrimarySubject(subjects)
Dim questionKey As String
questionKey = GenerateKey(correctedQuestion, primarySubject)
If Not questionMemory.Exists(questionKey) Then
Dim newIndex As Long
newIndex = questionMemory.Count + 1
questionMemory.Add questionKey, newIndex
responseMemory.Add newIndex, halResponse
responseQuality.Add newIndex, 1
If primarySubject <> "" Then contextMemory.Add newIndex, subjects
Else
Dim index As Long
index = questionMemory(questionKey)
responseMemory(index) = ImproveResponse(responseMemory(index), halResponse, index, primarySubject)
responseQuality(index) = responseQuality(index) + 0.1
End If
UpdateShortTermMemory correctedQuestion, halResponse
UpdateLongTermMemory correctedQuestion, halResponse, primarySubject
UpdateKnowledgeBase correctedQuestion, halResponse, primarySubject
SaveMemoryToFile
SaveLongTermMemory
SaveKnowledgeBase
CleanMemory
lastSubject = primarySubject ' Update last subject
Exit Sub
ErrorHandler:
LogError "LearnFromConversation: " & Err.Description
End Sub
End Function
Rem Name= Grock
Rem Author= This is your basic plugin layout.The function call is what fires.
Rem Host=All
Rem PLUGIN: PRE-PROCESS
'The preceding comment is actually a plug-in directive for
'the Ultra Hal host application. It allows for code snippets
'to be inserted here on-the-fly based on user configuration.
HalBrain.ReadOnlyMode = False
'Determines that you are talking about the Grock
If InStr(1,InputString, "Grock",1) > 0 Then
UltraHal = GetGrock(HalCommands)
ElseIf InStr(1,InputString, "Grock",1) > 0 Then
End If
Rem PLUGIN: FUNCTIONS
'Rem Weather the code in the function works is another thing but as a plugin with trigger, This is correct. Triggered by the word Grock.
Function Grock(HalCommands)
' Global variables for memory, subjects, spell correction, and file learning
Public responseMemory As Object ' Dictionary for responses
Public questionMemory As Object ' Dictionary for questions
Public contextMemory As Object ' Dictionary for conversation context
Public responseQuality As Object ' Track response quality ratings
Public shortTermMemory As Object ' Dictionary for recent conversation
Public SubjectTable As Object ' Dictionary for subject-based logic (A-Z subjects)
Public spellDictionary As Object ' Dictionary for spell checking
Public longTermIndex As Object ' Dictionary for long-term memory indexing
Public knowledgeBase As Object ' Dictionary for learned file content
Public Const MAX_SHORT_TERM As Long = 15 ' Increased limit for short-term memory
Public Const MAX_KNOWLEDGE_ENTRIES As Long = 5000 ' Limit for knowledge base entries
' **** USER: EDIT THIS LINE TO SET YOUR ULTRA HAL BRAIN DIRECTORY PATH ****
Public Const BASE_PATH As String = "C:\Users\airva\AppData\Roaming\Zabaware\Ultra Hal 7\ANGELINAJOLIE2050.db" ' User-specified path
Private Const MEMORY_FILE As String = "memory.txt"
Private Const LONG_TERM_FILE As String = "memorydata.txt"
Private Const LONG_TERM_INDEX_FILE As String = "memoryindex.txt"
Private Const LOG_FILE As String = "errorlog.txt"
Private Const SPELL_DICT_FILE As String = "spell_dictionary.txt"
Private Const KNOWLEDGE_FILE As String = "knowledge_base.txt"
Private lastSubject As String ' Track last primary subject for continuity
Private lastTone As String ' Track conversational tone for continuity
' HAL 7 Plugin Function
Public Function HalBrain(ByVal InputString, ByVal UserName, ByVal ComputerName, ByVal HalCommands, ByVal Holiday, ByVal HolidayType)
On Error GoTo ErrorHandler
' Validate BASE_PATH and permissions
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FolderExists(BASE_PATH) Then
HalBrain = "Error: The specified brain directory (" & BASE_PATH & ") does not exist. Please update the BASE_PATH in the script."
Exit Function
End If
' Check write permissions by attempting to create a temporary file
Dim tempFilePath As String
tempFilePath = BASE_PATH & "temp_permissions_test.txt"
On Error Resume Next
Dim tempFile
Set tempFile = objFSO.CreateTextFile(tempFilePath, True)
If Err.Number <> 0 Then
HalBrain = "Error: No write permissions for the brain directory (" & BASE_PATH & "). Please ensure the directory is accessible."
Exit Function
End If
tempFile.Close
objFSO.DeleteFile tempFilePath
On Error GoTo ErrorHandler
' Initialize memory system
InitializeMemory
Dim response As String
response = EnhanceHalResponse(InputString, "Hey " & UserName & ", what's on your mind today?", "")
' Return the response
HalBrain = response
Exit Function
ErrorHandler:
LogError "HalBrain: " & Err.Description
HalBrain = "Oops, something went wrong. Can we try that again?"
End Function
' Initialization with enhanced memory, subjects, spell dictionary, and knowledge base
Sub InitializeMemory()
Set responseMemory = CreateObject("Scripting.Dictionary")
Set questionMemory = CreateObject("Scripting.Dictionary")
Set contextMemory = CreateObject("Scripting.Dictionary")
Set responseQuality = CreateObject("Scripting.Dictionary")
Set shortTermMemory = CreateObject("Scripting.Dictionary")
Set SubjectTable = CreateObject("Scripting.Dictionary")
Set spellDictionary = CreateObject("Scripting.Dictionary")
Set longTermIndex = CreateObject("Scripting.Dictionary")
Set knowledgeBase = CreateObject("Scripting.Dictionary")
InitializeSubjectTable
LoadMemoryFromFile
LoadLongTermMemory
LoadSpellDictionary
LoadKnowledgeBase
lastSubject = "Questions" ' Default subject
lastTone = "Friendly" ' Default conversational tone
End Sub
' Initialize Subject Table with weighted keywords (expanded for broader coverage)
Private Sub InitializeSubjectTable()
SubjectTable.Add "Animals", "dog:3 cat:3 bird:2 fish:2 zoo:3 wildlife:3 pet:4 fur:2 animal:4"
SubjectTable.Add "Books", "novel:3 read:3 author:3 library:2 story:3 page:2 chapter:2 book:4"
SubjectTable.Add "Computers", "code:4 program:3 software:3 hardware:3 ai:4 data:3 network:2 computer:4"
SubjectTable.Add "Dreams", "sleep:3 night:2 vision:3 dream:4 imagination:3 subconscious:3"
SubjectTable.Add "Education", "school:4 learn:3 teacher:3 study:3 exam:2 knowledge:3 class:2 education:4"
SubjectTable.Add "Food", "eat:3 cook:3 recipe:3 meal:3 taste:2 restaurant:2 chef:2 food:4"
SubjectTable.Add "Games", "play:3 video:3 board:2 strategy:3 fun:2 challenge:2 puzzle:2 game:4"
SubjectTable.Add "Health", "doctor:3 medicine:3 fitness:3 sick:2 exercise:3 wellness:2 diet:3 health:4"
SubjectTable.Add "Internet", "web:3 online:3 site:2 browse:2 connect:2 network:3 social:2 internet:4"
SubjectTable.Add "Jobs", "work:4 career:3 employ:3 office:2 task:2 salary:2 boss:2 job:4"
SubjectTable.Add "Knowledge", "fact:3 info:3 learn:3 understand:3 think:2 idea:3 wisdom:2 knowledge:4"
SubjectTable.Add "Love", "romance:3 heart:3 date:2 partner:3 affection:3 relationship:4 kiss:2 love:4"
SubjectTable.Add "Music", "song:3 sing:3 band:3 play:2 tune:2 rhythm:3 melody:3 music:4"
SubjectTable.Add "Nature", "tree:3 forest:3 river:2 mountain:3 sky:2 earth:3 plant:2 nature:4"
SubjectTable.Add "Opinions", "think:3 believe:3 view:3 argue:2 discuss:3 opinion:4 idea:2"
SubjectTable.Add "People", "friend:3 family:4 person:3 group:2 society:2 talk:2 human:3 people:4"
SubjectTable.Add "Questions", "ask:4 why:3 how:3 what:3 where:3 question:4 curious:2"
SubjectTable.Add "Religion", "god:4 faith:3 pray:3 belief:3 spirit:3 church:2 soul:3 religion:4"
SubjectTable.Add "Science", "test:3 theory:3 lab:3 experiment:3 research:4 discover:3 fact:2 science:4"
SubjectTable.Add "Technology", "machine:3 tech:4 device:3 gadget:2 innovate:3 tool:2 robot:3 technology:4"
SubjectTable.Add "Universe", "star:3 planet:3 space:4 galaxy:3 cosmic:3 moon:2 orbit:2 universe:4"
SubjectTable.Add "Vehicles", "car:3 drive:3 truck:2 plane:3 fly:3 travel:2 boat:2 vehicle:4"
SubjectTable.Add "Weather", "rain:3 sun:3 snow:3 wind:2 cloud:2 storm:3 forecast:2 weather:4"
SubjectTable.Add "Xtra", "extra:3 bonus:2 special:3 unique:3 odd:2 random:2 quirky:2"
SubjectTable.Add "Youth", "young:3 kid:3 child:3 teen:3 grow:2 play:2 school:3 youth:4"
SubjectTable.Add "Zen", "calm:3 peace:4 meditate:3 relax:3 quiet:2 balance:3 harmony:3 zen:4"
End Sub
' Load spell checking dictionary
Private Sub LoadSpellDictionary()
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path As String
path = BASE_PATH & SPELL_DICT_FILE
If Not objFSO.FolderExists(BASE_PATH) Then
objFSO.CreateFolder BASE_PATH
End If
If Not objFSO.FileExists(path) Then
Set file = objFSO.CreateTextFile(path, True)
file.WriteLine "the,be,to,of,and,a,in,that,have,i,it,for,not,on,with,he,as,you,do,at,this,but,his,by,from,they,weather,technology,personal,dog,cat,bird,book,code,school,ai,learn,knowledge"
file.Close
End If
Set file = objFSO.OpenTextFile(path, 1)
Do While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
Dim words As Variant
words = Split(line, ",")
Dim i As Long
For i = 0 To UBound(words)
spellDictionary.Add LCase(Trim(words(i))), True
Next
Loop
file.Close
Exit Sub
ErrorHandler:
LogError "LoadSpellDictionary: " & Err.Description
End Sub
' Load knowledge base from brain directory files
Private Sub LoadKnowledgeBase()
On Error GoTo ErrorHandler
Dim objFSO, folder, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim knowledgePath As String
knowledgePath = BASE_PATH & KNOWLEDGE_FILE
' Load existing knowledge base
If objFSO.FileExists(knowledgePath) Then
Set file = objFSO.OpenTextFile(knowledgePath, 1)
Do While Not file.AtEndOfStream
Dim line As String
line = file.ReadLine
If InStr(line, "key") = 0 Then
Dim parts As Variant
parts = Split(line, vbTab)
If UBound(parts) = 2 Then
knowledgeBase.Add parts(0), Array(parts(1), parts(2))
End If
End If
Loop
file.Close
End If
' Scan brain directory for subject matter files
If objFSO.FolderExists(BASE_PATH) Then
Set folder = objFSO.GetFolder(BASE_PATH)
For Each file In folder.Files
If LCase(objFSO.GetExtensionName(file.Name)) = "txt" And file.Name <> MEMORY_FILE And file.Name <> LONG_TERM_FILE And file.Name <> LONG_TERM_INDEX_FILE And file.Name <> LOG_FILE And file.Name <> SPELL_DICT_FILE And file.Name <> KNOWLEDGE_FILE Then
LearnFromFile file.Path
End If
Next
End If
SaveKnowledgeBase
Exit Sub
ErrorHandler:
LogError "LoadKnowledgeBase: " & Err.Description
End Sub
' Learn from a specific file
Private Sub LearnFromFile(filePath As String)
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(filePath) Then
Set file = objFSO.OpenTextFile(filePath, 1)
Dim content As String, subject As String
content = ""
Do While Not file.AtEndOfStream
content = content & file.ReadLine & " "
Loop
file.Close
subject = DetectFileSubject(content)
Dim key As String
key = GenerateKey(objFSO.GetBaseName(filePath), subject)
If Not knowledgeBase.Exists(key) Then
knowledgeBase.Add key, Array(content, subject)
End If
End If
Exit Sub
ErrorHandler:
LogError "LearnFromFile: " & Err.Description
End Sub
' Detect subject of file content
Private Function DetectFileSubject(content As String) As String
Dim subjects As Collection
Set subjects = DetectSubjects(content, "")
DetectFileSubject = GetPrimarySubject(subjects)
End Function
' Save knowledge base to file
Private Sub SaveKnowledgeBase()
On Error GoTo ErrorHandler
Dim objFSO, file
Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim path As String
path = BASE_PATH & KNOWLEDGE_FILE
If Not objFSO.FolderExists(BASE_PATH) Then
objFSO.CreateFolder BASE_PATH
End If
Set file = objFSO.CreateTextFile(path, True)
file.WriteLine "key" & vbTab & "content" & vbTab & "subject"
Dim key As Variant
For Each key In knowledgeBase.Keys
file.WriteLine key & vbTab & knowledgeBase(key)(0) & vbTab & knowledgeBase(key)(1)
Next
file.Close
Exit Sub
ErrorHandler:
LogError "SaveKnowledgeBase: " & Err.Description
End Sub
' Auto-correct misspelled words based on context
Private Function CorrectSpelling(sentence As String, subjects As Collection) As String
Dim words As Variant
words = Split(sentence, " ")
Dim correctedSentence As String
correctedSentence = ""
Dim i As Long
For i = 0 To UBound(words)
Dim word As String
word = Trim(words(i))
If Len(word) > 0 Then
If Not spellDictionary.Exists(LCase(word)) Then
Dim correction As String
correction = SuggestCorrection(word, subjects)
correctedSentence = correctedSentence & " " & IIf(correction <> "", correction, word)
Else
correctedSentence = correctedSentence & " " & word
End If
End If
Next
CorrectSpelling = Trim(correctedSentence)
End Function
' Suggest correction for misspelled word
Private Function SuggestCorrection(word As String, subjects As Collection) As String
Dim minDistance As Long, bestMatch As String
minDistance = Len(word) + 1
Dim dictWord As Variant
For Each dictWord In spellDictionary.Keys
Dim distance As Long
distance = LevenshteinDistance(word, dictWord)
If distance < minDistance Then
minDistance = distance
bestMatch = dictWord
End If
Next
Dim primarySubject As String
primarySubject = GetPrimarySubject(subjects)
If SubjectTable.Exists(primarySubject) Then
Dim subjectKeywords As Variant
subjectKeywords = Split(SubjectTable(primarySubject), " ")
Dim j As Long
For j = 0 To UBound(subjectKeywords)
Dim keyword As String
keyword = Split(subjectKeywords(j), ":")(0)
distance = LevenshteinDistance(word, keyword)
If distance < minDistance And distance <= 2 Then
minDistance = distance
bestMatch = keyword
End If
Next
End If
SuggestCorrection = IIf(minDistance <= 2, bestMatch, "")
End Function
' Calculate Levenshtein Distance
Private Function LevenshteinDistance(str1 As String, str2 As String) As Long
Dim matrix() As Long
Dim i As Long, j As Long
Dim cost As Long
ReDim matrix(Len(str1), Len(str2))
For i = 0 To Len(str1)
matrix(i, 0) = i
Next
For j = 0 To Len(str2)
matrix(0, j) = j
Next
For i = 1 To Len(str1)
For j = 1 To Len(str2)
If Mid(str1, i, 1) = Mid(str2, j, 1) Then
cost = 0
Else
cost = 1
End If
matrix(i, j) = Application.Min(matrix(i - 1, j) + 1, _
matrix(i, j - 1) + 1, _
matrix(i - 1, j - 1) + cost)
Next
Next
LevenshteinDistance = matrix(Len(str1), Len(str2))
End Function
' Enhanced learning with subject continuity and knowledge base integration
Public Sub LearnFromConversation(userQuestion As String, halResponse As String, Optional context As String = "")
On Error GoTo ErrorHandler
Dim correctedQuestion As String
Dim subjects As Collection
Set subjects = DetectSubjects(userQuestion, context)
correctedQuestion = CorrectSpelling(userQuestion, subjects)
Dim primarySubject As String
primarySubject = GetPrimarySubject(subjects)
Dim questionKey As String
questionKey = GenerateKey(correctedQuestion, primarySubject)
If Not questionMemory.Exists(questionKey) Then
Dim newIndex As Long
newIndex = questionMemory.Count + 1
questionMemory.Add questionKey, newIndex
responseMemory.Add newIndex, halResponse
responseQuality.Add newIndex, 1
If primarySubject <> "" Then contextMemory.Add newIndex, subjects
Else
Dim index As Long
index = questionMemory(questionKey)
responseMemory(index) = ImproveResponse(responseMemory(index), halResponse, index, primarySubject)
responseQuality(index) = responseQuality(index) + 0.1
End If
UpdateShortTermMemory correctedQuestion, halResponse
UpdateLongTermMemory correctedQuestion, halResponse, primarySubject
UpdateKnowledgeBase correctedQuestion, halResponse, primarySubject
SaveMemoryToFile
SaveLongTermMemory
SaveKnowledgeBase
CleanMemory
lastSubject = primarySubject ' Update last subject
Exit Sub
ErrorHandler:
LogError "LearnFromConversation: " & Err.Description
End Sub
End Function