Intelligenza Artificiale: Relazione sull'elaborato
per l'interpretazione del linguaggio naturale.
A cura di : Pranovi Gabriele, Pedrotti Cristian
Professore : Alfonso Gerevini
Funzioni di gestione delle Stringhe
Analisi Sintattica: Modulo ModChart.bas
Funzioni principali utilizzate dal programma
Dichiarazioni a livello di modulo
Option Compare Text
Global frase As Collection
Sub ANALISI_CHART()
' è la procedura di ingresso per l' analisi sintattica
' In:
' gsfrase variabile globale, memorizza la frase di cui vogliamo
' l' analisi sintattica
' Out:
' restituisce il Chart dell'analisi sintattica
' la tabella chart è memmorizzata nel DB "biblio.mdb"
' che rappresenta la nostra KB
Dim v As Long
Dim elemento As Variant
Dim dizionario As Recordset
' cancello il contenuto della tabella chart per iniziare
' una nuova analisi
kb.Execute "delete * from chart"
On Error Resume Next
' apro la tabella chart
Set chart = kb.OpenRecordset("chart")
'cancello le parole dall' eventuale frase precedente
For v = 0 To frase.Count
frase.Remove v
Next
' inizializzo il chart
With chart
.AddNew
!etichetta = "0,0,S-> * S"
!primonodo = 0
!SecondoNodo = 0
!cerca = "S"
!sintagma = "S"
.Update
End With
' estraggo le parole della frase, eliminando segni di punteggiatura
' e convertendo parole tra apici
Set frase = EstraiCollezione(converti(gsFrase))
' aggiungo tutte le parole della frase al dizionario
' una parola incognita viene aggiunta come di categoria "XXX"
For Each elemento In frase
Set dizionario = kb.OpenRecordset("SELECT Dizionario.* From dizionario" _
& " WHERE (((Dizionario.Parola)='" & elemento & "'));")
If (dizionario.RecordCount = 0 And Len(elemento) > 0) Then
With dizionario
.AddNew
!parola = elemento
!tipo = "XXX"
.Update
End With
End If
Next elemento
' inizio l'analisi lessicale richiamando in sequenza
' Predittore: per fare predizioni in base alle regole della
' grammatica a disposizione
' Scanner: Il riconoscitore di parole nel dizionario
' Terminatore: Completa gli archi dell'analisi
For v = 0 To frase.Count - 1
predittore v
scanner v, frase(v + 1)
terminatore v
Next v
End Sub
Sub predittore(j As Long)
' il predittore consente di espandere le regole della grammatica
' a partire da simboli non terminali fino ai simboli terminali
' In:
' j, rappresenta il secondo nodo dell'arco
' Out:
' aggiunge al chart nuovi archi dedotti dalle regole grammaticali
Dim chartj As Recordset
Dim regole As Recordset
Dim i As Integer
Dim cercati As Recordset
' prendo in esame solo gli archi che hanno j come secondo nodo, che non sono completi,
' e su cui il predittore non ha agito
Set chartj = kb.OpenRecordset("SELECT CHART.* From chart" _
& " WHERE (((CHART.SecondoNodo)=" & j & ") AND ((CHART.Completo)=False) AND ((CHART.Predittore)=False));")
' il predittore non deve fare due volte la stessa predizione
' la tabella "cercati" in Kb tiene traccia delle regole che il predittore ha
' già considerato
kb.Execute "delete * from cercati"
Set cercati = kb.OpenRecordset("cercati", dbOpenDynaset)
' se non ci sono archi da considerare è inutile andare avanti
If (chartj.RecordCount = 0) Then
Exit Sub
End If
' parto dal primo arco, faccio predizioni per tutti gli archi
chartj.MoveFirst
While Not chartj.EOF
On Error Resume Next
' se ho già fatto una predizione passo all'arco successivo
cercati.FindFirst "cercato= '" & chartj!cerca & "'"
If (Not cercati.NoMatch) Then GoTo SuccessivoPred
cercati.AddNew
cercati!cercato = chartj!cerca
cercati.Update
' se il mio arco è in cerca di un certo simbolo Non terminale
' prendo in esame tutte le regole della grammatica che mi generano tale simbolo
Set regole = kb.OpenRecordset(" SELECT Grammatica.sintagma,grammatica.genera From Grammatica " _
& " WHERE (((Grammatica.Sintagma)='" & chartj!cerca & "'));")
' per ogni regola trovata aggiungo un arco al chart
While Not regole.EOF
With chart
.AddNew
!etichetta = CStr(j) & "," & CStr(j) & "," & regole!sintagma & "-> * " & regole!Genera
!primonodo = j
!SecondoNodo = j
!sintagma = regole!sintagma
If (Len(Left(regole!Genera, InStr(regole!Genera, " "))) = 0) Then
!cerca = regole!Genera
Else
!cerca = Left(regole!Genera, InStr(regole!Genera, " "))
End If
.Update
End With
regole.MoveNext
Wend
' il predittore segna gli archi su cui ha già agito
' mettendo a True un flag "predittore" nella tabella chart
SuccessivoPred:
With chartj
.Edit
!predittore = True
.Update
End With
chartj.MoveNext
Wend
chartj.Close
Set chartj = Nothing
End Sub
Sub scanner(j As Long, parola As String)
' lo scanner verifica se la categoria grammaticale di una parola immessa
' concorda con le regole grammaticali che sono state inserite
'In:
' j, è il secondo nodo dell' arco
' parola, è la parola della frase che viene analizzata dallo scanner
' Out:
' se la parola soddisfa una regola
' aggiunge un 'arco al chart indicando parola e categoria, e facendo avanzare
' l' analisi alla parola successiva
Dim chartj As Recordset
Dim Genera As String
Dim generate As Collection
Dim i As Integer
Dim str As Variant
Dim strtemp As String
Dim parole As Recordset
' considero solo gli archi del chart che hanno j come secondo nodo, che non sono completi
' e su cui lo scanner non ha agito
Set chartj = kb.OpenRecordset("SELECT CHART.* From chart" _
& " WHERE (((CHART.SecondoNodo)=" & j & ") AND ((CHART.Completo)=False) AND ((CHART.scanner)=False));")
' se non vi sono archi finiamo subito
If (chartj.RecordCount = 0) Then
Exit Sub
End If
chartj.MoveFirst
While Not chartj.EOF
' seleziono dal dizionario tutte le parole del tipo cercato
Set parole = kb.OpenRecordset(" SELECT Dizionario.* From Dizionario" _
& " WHERE (((Dizionario.tipo)='" & chartj!cerca & "' or Dizionario.tipo='XXX' ));")
While Not parole.EOF
' se la parola soddisfa una regola grammaticale nel chart, aggiungo un arco
If parole!parola = parola Then
With chart
.AddNew
Genera = Mid(chartj!etichetta, InStr(chartj!etichetta, ">") + 1)
Set generate = EstraiCollezione(Genera, " ")
i = 1
strtemp = ""
For Each str In generate
On Error Resume Next
If (str = "*") Then
strtemp = strtemp & " " & generate(i + 1) & " *"
!cerca = generate(i + 2)
i = i + 1
Else
strtemp = strtemp & " " & generate(i)
End If
i = i + 1
Next str
!etichetta = CStr(chartj!primonodo) & "," & CStr(chartj!SecondoNodo + 1) & "," & chartj!sintagma & "-> " & LTrim(strtemp)
!primonodo = chartj!primonodo
!SecondoNodo = chartj!SecondoNodo + 1
!sintagma = chartj!sintagma
If (Right(strtemp, 1) = "*") Then
!Completo = True
End If
With chartj
.Edit
!parola = parola
.Update
End With
.Update
End With
End If
parole.MoveNext
Wend
' Anche lo scanner segna gli archi su cui ha agito
SuccessivoScan:
With chartj
.Edit
!scanner = True
.Update
.MoveNext
End With
Wend
chartj.Close
Set chartj = Nothing
End Sub
Sub terminatore(j As Long)
' il terminatore prende un arco completo , che genera un non terminale
' e completa tutti gli archi che sono in cerca di questo non terminale
' In:
' j, è l'indice che regola il numero di volte in cui il terminatore viene
' richiamato (secondo nodo dell'arco)
Dim chartj As Recordset
Dim completi As Recordset
Dim Genera As String
Dim generate As Collection
Dim i As Integer
Dim str As Variant
Dim strtemp As String
On Error Resume Next
' prendo in esame tutti gli archi completi non terminati
Set completi = kb.OpenRecordset("SELECT CHART.* From chart" _
& " WHERE ((CHART.Completo)=true) AND ((CHART.Terminatore)=false));")
' se non ci sono archi completi è inutile procedere oltre
If (completi.RecordCount = 0) Then
Exit Sub
End If
completi.MoveFirst
While Not completi.EOF
' termino gli archi del chart in cerca di un sintagma generato da un'arco completo
Set chartj = kb.OpenRecordset("SELECT CHART.* From chart" _
& " WHERE ((CHART.Completo)=False) AND ((CHART.Terminatore)=false) AND ((CHART.cerca)='" & completi!sintagma _
& "') AND ((CHART.secondonodo)=" & completi!primonodo & ");")
chartj.MoveFirst
While Not chartj.EOF
strtemp = ""
With chart
.AddNew
Genera = Mid(chartj!etichetta, InStr(chartj!etichetta, ">") + 1)
Set generate = EstraiCollezione(Genera, " ")
i = 1
For Each str In generate
On Error Resume Next
If (str = "*") Then
strtemp = strtemp & " " & generate(i + 1) & " *"
!cerca = generate(i + 2)
i = i + 1
Else
strtemp = strtemp & " " & generate(i)
End If
i = i + 1
Next str
!etichetta = CStr(chartj!primonodo) & "," & CStr(completi!SecondoNodo) & "," & chartj!sintagma & "-> " & LTrim(strtemp)
!primonodo = chartj!primonodo
!SecondoNodo = completi!SecondoNodo
!sintagma = chartj!sintagma
If (Right(strtemp, 1) = "*") Then
!Completo = True
End If
.Update
With chartj
.Edit
!terminatore = True
.Update
End With
End With
chartj.MoveNext
Wend
With completi
.Edit
!terminatore = True
.Update
.MoveNext
End With
completi.MoveNext
Wend
chartj.Close
Set chartj = Nothing
completi.Close
Set completi = Nothing
End Sub
Ritorna
Public Sub RICONTROLLA_CHART()
' Apro il chart che è stato creato dall'analisi sintattica
' in caso vi siano degli errori provo a rieseguire predittore,scanner, e terminatore
' su eventuali archi che sono stati saltati a causa di regole grammaticali "contorte"
Dim v As Long
Dim elemento As Variant
Dim dizionario As Recordset
On Error Resume Next
' apro il chart
Set chart = kb.OpenRecordset("chart")
' rieseguo i tre componenti dell' analisi sintattica
For v = 0 To frase.Count - 1
predittore v
scanner v, frase(v + 1)
terminatore v
Next v
' rivisualizzo i dati nella finestra dei risultati
Visualizza_chart
End Sub
Analisi semantica: Modulo Ricerca.bas
Funzioni principali utilizzate dal programma
Option Compare Text
Dim parole As Recordset ' parole trovate dall'analisi sintattica
Private recrisultati As Recordset ' titoli,autore,genere trovati in base alla domanda effettuata
Dim conta As Boolean ' flag impostato se la domanda richiede il conteggio dei record
Dim titolo As String
Dim autore As String
Dim genere As String
Dim casa_editrice As String
Dim cerca As String
Sub ricerca_generale()
On Error Resume Next
' considero le parole con la corrispondente categoria sintattica
' come risultano dall'analisi sintattica
Set parole = kb.OpenRecordset("paroletrovate")
conta = False
titolo = ""
genere = ""
autore = ""
casa_editrice = ""
cerca = ""
Risultati.txtrisultati = ""
parole.MoveFirst
While Not parole.EOF
' se la parola e di tipo "nome"
' potrebbe essere uno qualunque dei campi di ricerca
If (Trim(parole!cerca) = "nome") Then
cerca = parole!parola
cerca = dhReplaceAll(cerca, "-", " ")
titolo = cerca
genere = cerca
autore = cerca
casa_editrice = cerca
End If
' se la parola è un quantificatore è evidente che venga richiesto il conteggio
' dei record
If (Trim(parole!cerca) = "quantificatore") Then
conta = True
End If
parole.MoveNext
Wend
' la ricerca più generale che ci possa essere analizza tutti i campi della
' tabella "Libri" nel database Kb
Set recrisultati = kb.OpenRecordset("SELECT libri.* From libri" _
& " WHERE (((libri.Titolo)like '*" & titolo & "*')) OR (((libri.Autore)like '*" & autore & "*')) OR (((libri.Genere)like '*" & genere & "*')) OR (((libri.[Casa editrice])like '*" & casa_editrice & "*'));")
If (Not conta) Then
visualizza_titoli
Else
visualizza_totale
End If
End Sub
Private Sub visualizza_titoli
' la procedura estremamente banale serve per visualizzare
' nella maschera risultati le informazioni reperite attraverso
' l' analisi semantica.
' è del tutto ininfluente sulla ricerca effettiva
With Risultati.txtrisultati
.Text = ""
' se non ci sono record visualizzo un messaggio
If (recrisultati.RecordCount = 0) Then
.Text = .Text & "impossibile soddisfare i criteri di ricerca" & vbNewLine
Else
recrisultati.MoveLast
recrisultati.MoveFirst
' altrimenti a seconda di avere 1 record o più di uno visualizzo
' messaggi differenti
If (recrisultati.RecordCount = 1) Then
.Text = .Text & "TROVATO " & recrisultati.RecordCount & " " & "Titolo che soddisfa la ricerca" & vbNewLine & vbNewLine
Else
.Text = .Text & "TROVATI " & recrisultati.RecordCount & " " & "Titoli che soddisfano la ricerca" & vbNewLine & vbNewLine
End If
' per i titoli trovati visualizzo le informazioni su più righe
While Not recrisultati.EOF
.Text = .Text & ">> """ & recrisultati!titolo & """ " & recrisultati!autore & " " & recrisultati![genere] & " " & recrisultati![casa editrice] & vbNewLine
.Text = .Text & recrisultati!note & vbNewLine
If (recrisultati![in prestito]) Then
.Text = .Text & "Libro non disponibile" & vbNewLine
Else
.Text = .Text & "Libro disponibile" & vbNewLine
End If
.Text = .Text & vbNewLine
recrisultati.MoveNext
Wend
End If
End With
End Sub
Private Sub visualizza_totale()
' nel caso in cui la domanda richieda il conteggio dei record trovati
' visualizzo il numero di record
recrisultati.MoveLast
With Risultati.txtrisultati
If (recrisultati.RecordCount = 0) Then
.Text = "Ho trovato " & recrisultati.RecordCount & " libro di " & cerca
Else
.Text = "Ho trovato " & recrisultati.RecordCount & " libri di " & cerca
End If
End With
End Sub
Public Sub Visualizza_chart()
' visualizzo nella maschera risultati
' i dati presenti nella tabella Chart e
' le parole riconosciute dall' analisi con la corrispettiva categoria grammatticale
On Error Resume Next
With Risultati
' inserisco i dati del CHART
With .txtchart
.Text = ""
chart.MoveFirst
While Not chart.EOF
.Text = .Text & chart!etichetta & vbNewLine
chart.MoveNext
Wend
chart.Close
Set chart = Nothing
End With
'inserisco ANALISI LESSICALE
Dim recparole As Recordset
Dim dizionario As Recordset
Dim recparoleunivoche As Recordset
Dim parola As Variant
Dim già_inserita As String
Set recparole = kb.OpenRecordset("ParoleTrovate")
On Error GoTo Nessuna_Parola
già_inserita = ""
recparole.MoveFirst
.txtparole.Text = ""
recparole.MoveFirst
While Not recparole.EOF
If (recparole!parola = già_inserita) Then GoTo successivo
già_inserita = recparole!parola
With .txtparole
.Text = .Text & dhReplaceAll(recparole!parola, "-", " ") & " " & recparole!cerca & vbNewLine
End With
successivo:
recparole.MoveNext
Wend
Exit Sub
Nessuna_Parola:
txtparole = "Parola non presente nel vocabolario"
End With
End Sub
Gestione delle stringhe :Modulo Stringhe.bas
Funzioni principali utilizzate dal programma
Dichiarazioni a livello di modulo
Option Explicit
Option Compare Text
Const dhcTag = 10000
Const dhcDelimiters As String = " ,.!:;<>?'"
Private Declare Function IsCharAlphaNumericA Lib "user32" _
(ByVal bytChar As Byte) As Long
Private Declare Function IsCharAlphaA Lib "user32" _
(ByVal bytChar As Byte) As Long
Private Declare Function IsCharAlphaNumericW Lib "user32" _
(ByVal intChar As Integer) As Long
Private Declare Function IsCharAlphaW Lib "user32" _
(ByVal intChar As Integer) As Long
Function converti(strin As String) As String
' converte la parte tra apici di una frase
' in un'unica parola con - al posto degli spazi
'In:
' strin:
' stringa di ingresso
'Out:
' Converti:
' stringa convertita
'Esempio:
' converti("quanti libri ci sono di 'Intelligenza Artificiale'?")
' restituisce "quanti libri ci sono di Intelligenza-Artificiale?"
' apro il dizionario
Dim dizionario As Recordset
Set dizionario = kb.OpenRecordset("Dizionario", dbOpenDynaset)
Dim str As String
Dim str1 As String
Dim str2 As String
' cerco il primo apice
str = Mid(strin, InStr(strin, "'") + 1)
' se non ci sono apici la stringa non viene modificata
If (str = strin) Then
converti = strin
Exit Function
End If
str1 = Left(str, InStr(str, "'") - 1)
str2 = dhReplaceAll(str1, " ", "-")
' aggiungo al dizionario la parola (titolo,genere,autore..)
' come semplice "nome"
With dizionario
.FindFirst "[parola]=""" & str2 & """"
If (.NoMatch) Then
.AddNew
!parola = str2
!tipo = "nome"
.Update
End If
End With
str = dhReplaceAll(strin, "'" & str1 & "'", str2)
converti = str
End Function
Function dhReplaceAll( _
ByVal strText As String, _
ByVal strFind As String, _
ByVal strReplace As String, _
Optional ByVal intFirst As Integer = 1, _
Optional ByVal intCount As Integer = dhcNoLimit, _
Optional ByVal fCaseSensitive As Boolean = False) As String
' Sostituisce le istanze di strFind con strReplace
' In:
' strText:
' Testo in cui effettuare la ricerca
' strFind:
' testo da ricercare
' strReplace:
' testo da sostituire
' intFirst (Opzionale, default = 1):
' un intero che indica la prima occorrenza da sostituire
' se superiore al numero di occorrenze non sostituisce niente
' -1 sostituisce l'occorrenza finale
' -2 sostituisce la prima occorrenza
' fCaseSensitive (Opzionale, default = False):
' la ricerca è case-sensitive?
' Out:
' Return Value:
' The input string, with the requested replacements made.
' Esempio:
' dhReplaceAll("This IS a test", "is", "X") returns "ThX X a test"
' dhReplaceAll("This IS a test", "is", "X", 2) returns "This X a test"
' because it starts replacing at the second occurrence.
' Richiede:
' dhCountIn
' dhcNoLimit
Dim intLenFind As Integer
Dim intLenReplace As Integer
Dim intPos As Integer
Dim intStart As Integer
Dim intI As Integer
Dim intFound As Integer
Dim intLast As Integer
Dim intMode As Integer
On Error GoTo HandleErr
' If anything's wrong in the various parameters,
' just exit. Unorthodox method, but it works here.
If Len(strText) = 0 Then GoTo ExitHere
If Len(strFind) = 0 Then GoTo ExitHere
If intFirst = 0 Then GoTo ExitHere
If intCount = 0 Then GoTo ExitHere
' The parameters must be reasonable if we're here.
' Handle the three optional parameters.
If intFirst < 0 Then
' -1 == start at the last match.
' -2 == start at the next to the last match, etc.
intFound = dhCountIn(strText, strFind)
intFirst = intFound + intFirst + 1
If intFirst < 1 Then intFirst = 1
End If
If intCount > dhcNoLimit Then
intLast = intFirst + intCount
End If
If fCaseSensitive Then
intMode = vbBinaryCompare
Else
intMode = vbTextCompare
End If
' Store away the length of the find and replace
' text, to speed things up later on.
intLenFind = Len(strFind)
intLenReplace = Len(strReplace)
intPos = 1
intI = 1
Do
intPos = InStr(intPos, strText, strFind, intMode)
If intPos > 0 Then
' Did you find a match? If so, check the other
' issues (starting replacement, and number
' of replacements)
If (intI >= intFirst) And _
((intCount = dhcNoLimit) Or (intI < intLast)) Then
' If the current item is greater than or equal
' the first item the caller has requested to be replaced,
' and...
' If either you don't care about the number of
' replacements, or this one is less than the
' final one you want to make, then do it.
' Perform the replacement.
strText = Left$(strText, intPos - 1) & _
strReplace & Mid$(strText, intPos + intLenFind)
' Skip over the new text.
intPos = intPos + intLenReplace
Else
' Just skip over the search string.
intPos = intPos + intLenFind
End If
intI = intI + 1
' If you know there's no more replacements, no
' need to continue looping. Just get on out!
If (intCount <> dhcNoLimit And intI >= intLast) Then
Exit Do
End If
End If
Loop Until intPos = 0
ExitHere:
dhReplaceAll = strText
Exit Function
HandleErr:
' If any error occurs, just return the text as it
' currently is.
Select Case Err.Number
Case Else
' MsgBox "Error: " & Err.Description & " (" & Err.Number & ")"
End Select
Resume ExitHere
End Function
Variabili Globali e Main Procedure
Global kb As Database ' il database "biblio.mdb" è la nostra kb
Global KBpath As String ' percorso al dataBase
Global gsConnect As String
Global gsRecordsource As String
Global gsFrase As String ' la frase digitata al Prompt
Global genie As Object
Global gstrpath As String
Global gsSQL As String ' stringa SQL utilizzate nelle interrogazioni al vocabolario
Global chart As Recordset ' il chart dell' analisi sintattica
Public fMainForm As frmMain
Sub Main()
gstrpath = App.Path
' imposto il percorso del database contenente i dati
KBpath = gstrpath & "\BIBLIO.MDB"
Set kb = OpenDatabase(KBpath)
' stringa di connessione al database
gsConnect = ""
frmSplash.Show
frmSplash.Refresh
Set fMainForm = New frmMain
' carico e visualizzo la finestra principale
' scaricando lo splash screen
Load fMainForm
Unload frmSplash
fMainForm.Show
End Sub
Torna a Var.glob.e main procedure