========================== ========================== === CLASSE ALIGNMENT ===== ========================== ========================== === DICHIARAZIONI ====== ========================== ========================== Option Compare Database Option Explicit 'da dilazionare nel codice - solo le COSTANTI possono ' essere valorizzate in sede di dichiarazione 'MaxR = 0 'MaxC = 0 'gap = -1 'gapopen=-12 'gapext=-2 'locThreshold = 2 'numMaxLocal = 1 'Due SEQUENZE che ospiteranno le sequenze da allineare Private S1 As New Sequence 'sequenza 1 Private S2 As New Sequence 'sequenza 2 'I massimi indice di RIGA (prima stringa) e COLONNA (seconda stringa) 'della matrice di allineamento e score Private maxR As Integer 'lunghezza S1+1 Private maxC As Integer 'lunghezza S2+1 'Dimensiona array simbolica per similitudini tra amminoacidi Private Const DIMSYMBOL As Integer = 23 'le lettere degli amminoacidi 'Costanti rappresentative degli spostamenti da effettuare 'sulla matrice di backward tracking Private Const COL As String = "C" 'mi muovo in alto Private Const DIA As String = "D" 'in diagonale Private Const ROW As String = "R" 'sulla riga Private Const ZERO As String = "0" 'Simbolo di GAP Private Const gapsymbol As String = "-" 'simbolo utilizzato per il gap 'Punteggio di MATCH secco e di MISMATCH secco Private Const Match As Integer = 1 Private Const misMatch As Integer = -1 'Gap e grandezze associate Private gap As Double 'singolo gap per gli algoritmi semplici Private gapopen As Double Private gapext As Double Private infinito As Double 'Matrice di SCORE Private matS() As Integer 'Matrice letta dei punteggi redim quando servirà 'Matrice di Private matMR() As Double 'Matrice di MATCH REPLACE redim quando servirà Private matI() As Double 'Matrice delle INSERZIONI redim quando servirà Private matD() As Double 'matrice delle DELEZIONI redim quando servirà 'MAtrice di BACKWARD TRACKING Private matBack() As String 'matrice dei PERCORSI BACKWARD redim quando servirà Private matBack1() As String 'seconda matrice di backward tracking per ALGOTOHALSIM Private matBack2() As String 'terza matrice di backward tracking per ALGOTOHALSIM 'Soglia locale Private locThreshold As Double 'soglia stampa degli allineamenti locali 'Massimo locale: punteggio e coordinate Private numMaxLocal As Integer 'numero massimo di allineamenti locali Private locMaxR As Integer 'posizione RIGA del miglior allineamento locale Private locMaxC As Integer 'posizione COLONNA del migliore allineamento locale Private locBest As Double 'punteggio del migliore allineamento locale Private METODOCORRENTE As String 'il metodo corrente di allineamento ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT MATCHSIM ======================================= ======================================= 'Routine per alimentare l' ALIGNMENT con le SEQUENZE da allineare Public Sub PassaSequenze(PrimaSeq As Sequence, SecondaSeq As Sequence) On Error GoTo Err_PassaSequenze 'Impongo alle sequenze "interne" all'allineamento un contenuto 'corrispettivo a quello delle sequenze passate S1.setSeq (PrimaSeq.getSeq) S2.setSeq (SecondaSeq.getSeq) 'Fisso la dimensione massima delle matrici (in base zero) 'ad un valore pari a quello della corrispettiva stringa, 'aumentato di uno. Ciò mi creerà dei problemi in sede di 'rappresentazione del risultato, visto che il maxR-esimo 'carattere di Sequenza 1 ed il maxC-esimo carattere di 'Stringa 2 NON ESISTONO, e dovrò "diminuire" i MaxR e MaxC 'di uno maxR = S1.getSeqLen() + 1 maxC = S2.getSeqLen() + 1 'La REDIM si rende necessaria per tutte le matrici coinvolte ReDim matMR(maxR, maxC) ReDim matI(maxR, maxC) ReDim matD(maxR, maxC) ReDim matBack(maxR, maxC) ReDim matBack1(maxR, maxC) ReDim matBack2(maxR, maxC) 'ReDim matS as .... (originale è this.matS = setPam250(); ) METODOCORRENTE = "NESSUNO" Exit_PassaSequenze: Exit Sub Err_PassaSequenze: MsgBox "PassaSequenze: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_PassaSequenze End Sub ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT MATCHSIM ======================================= ======================================= Private Function matchSim(thisI As Integer, thisJ As Integer) As Double 'funzione di scoring match/mismatch alle 2 posizioni i e j 'Error trapping On Error GoTo Err_matchSim 'Raffronto l '"i-esimo" carettere della prima sequenza 'ed il "j-esimo" carattere della seconda sequenza If S1.getSeqChar(thisI) = S2.getSeqChar(thisJ) Then 'se sono uguali, rendo il punteggio di "MATCH" matchSim = Match Else 'se sono uguali, rendo il punteggio di "MISMATCH" matchSim = misMatch End If Exit_matchSim: Exit Function Err_matchSim: MsgBox "matchSim: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_matchSim End Function ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT INDEXR_MAX ======================================= ======================================= 'restituisce l'indice RIGA della casella della matrice degli score con il massimo score Public Function IndexR_Max() As Integer 'Error Trapping On Error GoTo Err_IndexR_Max '=========================== ' Perchè la funzione lavori sia nel caso dell'algoritmo LOCALE ' sia nel caso dell'algoritmo GLOBALE, devo prevedere il caso ' che locMaxR non sia valorizzato, ed in questo caso restituire maxR '================================================================ 'QUESTA SELECT CASE E' PLETORICA, MA MI E' SERVITA PER INDAGARE 'I DIVERSI COMPORTAMENTI DEI METODI. 'Basterebbe distinguere il caso del SIMPLELOCALALSIM. '================================================================ Select Case METODOCORRENTE Case "SIMPLEALSIM" 'Algoritmo GLOBALE: parto comunque da MAXR IndexR_Max = maxR Case "SIMPLELOCALALSIM" 'Algoritmo LOCALE: memorizzato in locMaxR IndexR_Max = locMaxR Case "GOTOHALSIM" 'Algoritmo GLOBALE: parto comunque da MAXR IndexR_Max = maxR Case "SIMPLEALDIST" 'Algoritmo GLOBALE: parto comunque da MAXR IndexR_Max = maxR End Select Exit_IndexR_Max: Exit Function Err_IndexR_Max: MsgBox "IndexR_Max: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_IndexR_Max End Function ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT INDEXC_MAX ======================================= ======================================= 'restituisce l'indice COLONNA della casella della matrice degli score con il massimo score Public Function IndexC_Max() As Integer 'Error Trapping On Error GoTo Err_IndexC_Max '=========================== ' Perchè la funzione lavori sia nel caso dell'algoritmo LOCALE ' sia nel caso dell'algoritmo GLOBALE, devo prevedere il caso ' che locMaxR non sia valorizzato, ed in questo caso restituire maxC '================================================================ 'QUESTA SELECT CASE E' PLETORICA, MA MI E' SERVITA PER INDAGARE 'I DIVERSI COMPORTAMENTI DEI METODI. 'Basterebbe distinguere il caso del SIMPLELOCALALSIM. '================================================================ Select Case METODOCORRENTE Case "SIMPLEALSIM" 'Algoritmo GLOBALE: parto comunque da MAXC IndexC_Max = maxC Case "SIMPLELOCALALSIM" 'Algoritmo LOCALE: memorizzato in locMaxC IndexC_Max = locMaxC Case "GOTOHALSIM" 'Algoritmo GLOBALE: parto comunque da MAXC IndexC_Max = maxC Case "SIMPLEALDIST" 'Algoritmo GLOBALE: parto comunque da MAXC IndexC_Max = maxC End Select Exit_IndexC_Max: Exit Function Err_IndexC_Max: MsgBox "IndexC_Max: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_IndexC_Max End Function ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT RETURNMATBACK ======================================= ======================================= 'restituisce una cella dalla matrice di Backward Tracking Public Function returnMatBack(whatI As Integer, whatJ As Integer) As String 'Error Trapping On Error GoTo Err_returnMatBack 'La funzione assume il valore della cella delle coordinate indicate returnMatBack = matBack(whatI, whatJ) Exit_returnMatBack: Exit Function Err_returnMatBack: MsgBox "returnMatBack: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_returnMatBack End Function ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT RETURNMATSCORE ======================================= ======================================= 'restituisce una cella la matrice di Score Public Function returnMatScore(whatI As Integer, whatJ As Integer) As Double 'Error Trapping On Error GoTo Err_returnMatScore 'La funzione assume il valore della cella delle coordinate indicate returnMatScore = matMR(whatI, whatJ) Exit_returnMatScore: Exit Function Err_returnMatScore: MsgBox "returnMatScore: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_returnMatScore End Function ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT ALLINEA ======================================= ======================================= Public Function Allinea(Metodo As String) As Double 'Allinea - versione PARAMETRICA "concentrata" degli algoritimi 'di allineamento che prima avevano ognuno il proprio metodo On Error GoTo Err_Allinea 'Indici di uso locale Dim myI As Integer Dim myJ As Integer 'Per metodo a penalità di gap: cumulatore di penalità crescente Dim t As Double 'Massimo score Dim maxScore As Double 'Minimo score Dim minScore As Double 'per il raffronto delle adiacenze della mia cella di matrice Dim dtmp As Double Dim ctmp As Double Dim rtmp As Double 'E' stata (per chiarezza) collassata qui all'interno la originale 'routine MAX, e questo valore M serve a decidere 'l'esito del confronto delle adiacenze della mia cella Dim m As Double '================================================= ' NOTA SULLE RIGHE E SULLE COLONNE DI INDICE ZERO '================================================= 'L'algoritmo parte esaminano la cella "in alto a sinistra" '(ovvero con indice-riga minore di uno e indice-colonna minore di uno) 'rispetto alla cella corrente. Esso deve ovviamente contenere un valore, 'e dato che l'algoritmo parte da indici 1 e 1 è ovvio che verranno spazzate 'le caselle di row zero e column zero. Ecco perchè vanno inizializzate, 'ed in particolare perchè inizializzarle a zero. Inoltre, 'lo "zero" costituisce un punto di arrivo delle operazioni 'di backward tracking. Nella ipotesi che almeno una delle due sequenze 'sia utilizzata fino all'ultimo carattere mi troverei a ripercorrerla 'interamente fino alla "zeresima" colonna, che mi deve servire da "muro" 'per non proseguire ulteriormente. '============================================= 'INIZIALIZZAZIONI CHE PRESCINDONO DAL METODO '============================================= '======================= 'RIGA ZERO COLONNA ZERO '======================= matMR(0, 0) = 0 '============================================= 'INIZIALIZZAZIONI METODO - SPECIFICHE '============================================= '====================================================== 'Per uniformare il trattamento, vengono inizializzate 'tutte le variabili, a prescindere dal fatto che abbiano 'o meno un significato nell'algoritmo in questione '====================================================== Select Case Metodo '=================> Allineamento GLOBALE semplice Case "SIMPLEALSIM" '============================================== '= MEMORIZZO CON CHE METODO STO LAVORANDO '= IN VARIABILE PUBLIC (il parametro METODO è '= locale alla funzione ALLINEA) '============================================== METODOCORRENTE = "SIMPLEALSIM" gap = -1 'penalità di gap semplice gapopen = 0 'penalità di apertura gap gapext = 0 'penalità di estensione gap matBack(0, 0) = DIA 'Inizializzo a "DIAGONALE" la zeresima cella '=================> Allineamento LOCALE semplice Case "SIMPLELOCALALSIM" '============================================== '= MEMORIZZO CON CHE METODO STO LAVORANDO '= IN VARIABILE PUBLIC (il parametro METODO è '= locale alla funzione ALLINEA) '============================================== METODOCORRENTE = "SIMPLEALDIST" gap = -1 'penalità di gap semplice gapopen = 0 'penalità di apertura gap gapext = 0 'penalità di estensione gap matBack(0, 0) = ZERO 'Inizializzo a "ZERO" la zeresima cella locBest = 0 'massimo locale locMaxR = 0 'Riga della cella con il massimo locale locMaxC = 0 'colonna della cella con il massimo locale '=================> Allineamento CON PENALITA' DI GAP Case "GOTOHALSIM" '============================================== '= MEMORIZZO CON CHE METODO STO LAVORANDO '= IN VARIABILE PUBLIC (il parametro METODO è '= locale alla funzione ALLINEA) '============================================== METODOCORRENTE = "GOTOHALSIM" gap = -1 gapopen = -12 gapext = -2 infinito = -10000 matBack(0, 0) = ZERO 'Inizializzo a "DIAGONALE" la zeresima cellaù matBack1(0, 0) = ZERO 'Inizializzo a "DIAGONALE" la zeresima cella matBack2(0, 0) = ZERO 'Inizializzo a "DIAGONALE" la zeresima cella '=================> Allineamento basato su DISTANZA con GAP = +1 Case "SIMPLEALDIST" '============================================== '= MEMORIZZO CON CHE METODO STO LAVORANDO '= IN VARIABILE PUBLIC (il parametro METODO è '= locale alla funzione ALLINEA) '============================================== METODOCORRENTE = "SIMPLEALDIST" gap = 1 'penalità di gap semplice (in questo caso, "invertita") gapopen = 0 'penalità di apertura gap gapext = 0 'penalità di estensione gap matBack(0, 0) = DIA 'Inizializzo a "DIAGONALE" la zeresima cella '=================> Qui su ERRORE Case Else MsgBox "Avete indicato un metodo di allineamento non supportato :" + Metodo Exit Function End Select '=========> La seguente per metodo a penalità di gap crescente t = gapopen '======================== 'RIGA ZERO ALTRE COLONNE '======================= For myJ = 1 To maxC Select Case Metodo '=================> Allineamento GLOBALE semplice Case "SIMPLEALSIM" 'Inizializzo a VALORI DI GAP CRESCENTE e a "RIGA" matMR(0, myJ) = matMR(0, myJ - 1) + gap matBack(0, myJ) = ROW '=================> Allineamento LOCALE semplice Case "SIMPLELOCALALSIM" 'Inizializzo a "ZERO" matMR(0, myJ) = 0 matBack(0, myJ) = ZERO '=================> Allineamento CON PENALITA' DI GAP Case "GOTOHALSIM" 'Inizializzo a VALORI DI GAP CRESCENTE e a RIGA t = t + gapext matMR(0, myJ) = t matI(0, myJ) = 0 'in precedenza, era matD(0, myJ) = t + gapopen matD(0, myJ) = infinito matBack(0, myJ) = ROW matBack1(0, myJ) = ROW matBack2(0, myJ) = ROW '=================> Allineamento basato su DISTANZA con GAP = +1 Case "SIMPLEALDIST" 'Inizializzo a VALORI DI GAP CRESCENTE e a RIGA matMR(0, myJ) = matMR(0, myJ - 1) + gap matBack(0, myJ) = ROW End Select Next '============================================= '=========> La seguente per metodo a penalità di gap crescente t = gapopen '========================= 'ALTRE RIGHE COLONNA ZERO '========================= For myI = 1 To maxR Select Case Metodo '=================> Allineamento GLOBALE semplice Case "SIMPLEALSIM" 'Inizializzo a a VALORI DI GAP CRESCENTE e a COLONNA matMR(myI, 0) = matMR(myI - 1, 0) + gap matBack(myI, 0) = COL '=================> Allineamento LOCALE semplice Case "SIMPLELOCALALSIM" 'Inizializzo a ZERO matMR(myI, 0) = 0 matBack(myI, 0) = ZERO '=================> Allineamento CON PENALITA' DI GAP Case "GOTOHALSIM" 'Inizializzo a a VALORI DI GAP CRESCENTE e a COLONNA t = t + gapext matMR(myI, 0) = t matD(myI, 0) = 0 ' in precedenza, era matD(myI, 0) = t + gapopen matI(myI, 0) = infinito matBack(myI, 0) = COL matBack1(myI, 0) = COL matBack2(myI, 0) = COL '=================> Allineamento basato su DISTANZA con GAP = +1 Case "SIMPLEALDIST" 'Inizializzo a a VALORI DI GAP CRESCENTE e a COLONNA matMR(myI, 0) = matMR(myI - 1, 0) + gap matBack(myI, 0) = COL End Select Next '=================== '=================== ' Inizio Algoritmo '=================== '=================== '=========> La seguente per metodo a penalità di gap crescente t = gapopen 'per tutte le righe (=Caratteri di stringa 1) For myI = 1 To maxR '=========> La seguente per metodo a penalità di gap crescente t = t + gapext 'per tutte le colonne (caratteri di stringa 2) For myJ = 1 To maxC '=========================================== 'STEP 1 - VALUTAZIONE DELLE CELLE ADIACENTI '=========================================== Select Case Metodo '=================> Allineamento CON PENALITA' DI GAP Case "GOTOHALSIM" '================ Se la cella in matrice delle "inserzioni" '================ collocata a sinistra della cella corrente '================ contiene un valore più elevato della '================ corrispettiva cella in matMR aumentata della '================ penalità di apertura gap, salvo in '================ cella corrente il valore dalla matI aumentato '================ della penalità di estensione gap, se no, '================ quello dalla matMR aumentato delle penalità '================ di apertura ed estensione di gap. If matI(myI, myJ - 1) > matMR(myI, myJ - 1) + gapopen Then matI(myI, myJ) = matI(myI, myJ - 1) + gapext matBack1(myI, myJ) = ROW Else matI(myI, myJ) = matMR(myI, myJ - 1) + gapopen + gapext matBack1(myI, myJ) = DIA End If '================ Se la cella in matrice delle "delezioni" '================ collocata sopra alla cella corrente '================ contiene un valore più elevato della '================ corrispettiva cella in matMR aumentata della '================ penalità di apertura gap, salvo in '================ cella corrente il valore dalla matD aumentato '================ della penalità di estensione gap, se no, '================ quello dalla matMR aumentato delle penalità '================ di apertura ed estensione di gap. If matD(myI - 1, myJ) > matMR(myI - 1, myJ) + gapopen Then matD(myI, myJ) = matD(myI - 1, myJ) + gapext matBack2(myI, myJ) = COL Else matD(myI, myJ) = matMR(myI - 1, myJ) + gapopen + gapext matBack2(myI, myJ) = DIA End If '=============== In DTMP ("Diagonale") i valori della matMR '=============== più il MATCHSIM relativo a tale posizione dtmp = matMR(myI - 1, myJ - 1) + matchSim(myI - 1, myJ - 1) '=============== In RTMP ("sulla riga") i valori della matrice '=============== delle INSERZIONI della cella corrente rtmp = matI(myI, myJ) '=============== In RTMP ("sulla riga") i valori della matrice '=============== delle INSERZIONI della cella corrente ctmp = matD(myI, myJ) '=================> Altri Allineamenti Case Else 'in valore DTMP, sommo il valore matMR della cella "in diagonale" '(ovvero "in alto a sinistra") rispetto alla mia, con il valore del 'match tra l'i(meno uno)esimo carattere della prima stringa ed il 'j(meno uno)esimo carattere della seconda stringa: '=========================================================== ' ATTENZIONE! matchDist (che nell'originale è invocato per ' il metodo basato sulle DISTANZE) è IDENTICO A matchSIM, ' da cui la aggregazione sotto questa stessa CASE '=========================================================== dtmp = matMR(myI - 1, myJ - 1) + matchSim(myI - 1, myJ - 1) 'in valore RTMP, sommo il valore matMR della cella "in riga" '(ovvero "a sinistra") rispetto alla mia, con il valore del gap rtmp = matMR(myI, myJ - 1) + gap 'in valore CTMP, sommo il valore matMR della cella "in colonna" '(ovvero "sopra") rispetto alla mia, con il valore del gap ctmp = matMR(myI - 1, myJ) + gap End Select ' Fine Step 1 '============================================ 'STEP 2 - RAFFRONTO DEI VALORI COSI' OTTENUTI '============================================ Select Case Metodo '=================> Allineamento basato su DISTANZA con GAP = +1 '===========> CERCO IL MINIMO VALORE Case "SIMPLEALDIST" 'ora vedo quale dei valori è MENO elevato If dtmp <= ctmp Then If dtmp <= rtmp Then 'DTMP è più basso di CTMP e RTMP 'Memorizziamo DIAGONALE come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella in diagonale") matMR(myI, myJ) = dtmp matBack(myI, myJ) = DIA Else 'RTMP è più basso di CTMP e RTMP 'Memorizziamo RIGA come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella a sinistra") matMR(myI, myJ) = rtmp matBack(myI, myJ) = ROW End If Else If ctmp <= rtmp Then 'CTMP è più basso di DTMP e RTMP 'Memorizziamo COLONNA come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella in alto") matMR(myI, myJ) = ctmp matBack(myI, myJ) = COL Else 'RTMP è più basso di CTMP e RTMP 'Memorizziamo RIGA come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella a sinistra") matMR(myI, myJ) = rtmp matBack(myI, myJ) = ROW End If End If '=========> ALTRI ALLINEAMENTI (locale e GLOBALI) '===========> CERCO IL MASSIMO VALORE '=========> Dovendo coprire anche il caso dell'Allineamento '=========> LOCALE, inizializziamo anche maxScore ed m che sono '=========> di esclusicvo interesse dell'allineamento LOCALE Case Else 'ora vedo quale dei valori è più elevato 'Inizializzo "m" m = 0 If dtmp >= ctmp Then If dtmp >= rtmp Then 'DTMP è più alto di CTMP e RTMP 'Memorizziamo DIAGONALE come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella in diagonale") maxScore = dtmp matMR(myI, myJ) = dtmp matBack(myI, myJ) = DIA m = dtmp Else 'RTMP è più alto di CTMP e RTMP 'Memorizziamo RIGA come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella a sinistra") maxScore = rtmp matMR(myI, myJ) = rtmp matBack(myI, myJ) = ROW m = rtmp End If Else If ctmp >= rtmp Then 'CTMP è più alto di CTMP e RTMP 'Memorizziamo COLONNA come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella in alto") maxScore = ctmp matMR(myI, myJ) = ctmp matBack(myI, myJ) = COL m = ctmp Else 'RTMP è più alto di CTMP e RTMP 'Memorizziamo RIGA come spostamento 'associato a questa cella (ovvero "la strada 'migliore passa per la cella a sinistra") maxScore = rtmp matMR(myI, myJ) = rtmp matBack(myI, myJ) = ROW m = rtmp End If End If '=**\ '=***> Coda di attività specifica dell'allineamento LOCALE '=**/ If Metodo = "SIMPLELOCALALSIM" Then '=========================================================== 'Se comunque alla fine di tutto nessuno dei valori score 'ha superato lo ZERO (compreso quello nel quale ho assommato 'il match locale e quelli in diagonale) significa che da qui 'in poi non vale la pena di proseguire: segnamo uno ZERO '=========================================================== If m <= 0 Then maxScore = 0 matMR(myI, myJ) = 0 matBack(myI, myJ) = ZERO End If '============================================== 'Se il massimo così ottenuto 'supera il "local best" precedente 'aggiorniamo loaclbest e le relative coordinate '============================================== If maxScore > locBest Then locBest = maxScore locMaxR = myI locMaxC = myJ End If End If '=**\ '=***> FINE Coda di attività specifica dell'allineamento LOCALE '=**/ End Select ' Fine Step 2 Next ' for myJ (COLONNE) Next ' for myI (RIGHE) '================================================= '== RESTITUZIONE DI VALORI SPECIFICA DEL METODO '================================================= Select Case Metodo '=================> Allineamento LOCALE semplice Case "SIMPLELOCALALSIM" '========================================== ' restituisco il massimo locale più elevato '(richiederò con apposite funzioni a quali ' coordinate I, J corrisponde) '========================================== Allinea = locBest '=================> Allineamenti GLOBALI Case Else '========================================== 'restituisco il punteggio che corrisponde 'all'ultima cella raffrontata (coordinate 'maxR-1 e maxC-1) '========================================== Allinea = matMR(maxR - 1, maxC - 1) End Select Exit_Allinea: Exit Function Err_Allinea: MsgBox "Allinea: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Allinea End Function ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT RETURNMATBACK1 ======================================= ======================================= 'restituisce una cella dalla SECONDA matrice di Backward Tracking specifica dell'algoritmo ALGOTOH Public Function returnMatBack1(whatI As Integer, whatJ As Integer) As String 'Error Trapping On Error GoTo Err_returnMatBack1 'La funzione assume il valore della cella delle coordinate indicate returnMatBack1 = matBack1(whatI, whatJ) Exit_returnMatBack1: Exit Function Err_returnMatBack1: MsgBox "returnMatBack1: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_returnMatBack1 End Function ======================================= ======================================= Modulo di Classe Metodo ALIGNMENT RETURNMATBACK2 ======================================= ======================================= 'restituisce una cella dalla TERZA matrice di Backward Tracking specifica dell'algoritmo ALGOTOH Public Function returnMatBack2(whatI As Integer, whatJ As Integer) As String 'Error Trapping On Error GoTo Err_returnMatBack2 'La funzione assume il valore della cella delle coordinate indicate returnMatBack2 = matBack2(whatI, whatJ) Exit_returnMatBack2: Exit Function Err_returnMatBack2: MsgBox "returnMatBack2: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_returnMatBack2 End Function ========================== ========================== === CLASSE SEQUENCE ===== ========================== ========================== === DICHIARAZIONI ====== ========================== ========================== Option Compare Database Option Explicit Private nome As String Private seque As String Private lunga As Integer ======================================= ======================================= Modulo di Classe Metodo SEQUENCE SETSEQNAME ======================================= ======================================= 'Cambia il nome di una sequenza gia' esistente Public Sub setSeqName(name As String) nome = name End Sub ======================================= ======================================= Modulo di Classe Metodo SEQUENCE GETSEQNAME ======================================= ======================================= 'restituisce il nome di una sequenza gia' esistente Public Function getSeqName() As String getSeqName = nome End Function ======================================= ======================================= Modulo di Classe Metodo SEQUENCE SETSEQ ======================================= ======================================= 'Cambia il contenuto di una sequenza gia' esistente Public Sub setSeq(seq As String) seque = seq lunga = Len(seq) End Sub ======================================= ======================================= Modulo di Classe Metodo SEQUENCE GETSEQ ======================================= ======================================= 'restituisce il contenuto di una sequenza gia' esistente Public Function getSeq() As String getSeq = seque End Function ======================================= ======================================= Modulo di Classe Metodo SEQUENCE GETSEQLEN ======================================= ======================================= 'restituisce la lunghezza di una sequenza gia' esistente Public Function getSeqLen() As String getSeqLen = lunga End Function ======================================= ======================================= Modulo di Classe Metodo SEQUENCE GETSEQCHAR ======================================= ======================================= 'restituisce l'ennesimo carattere di una sequenza Public Function getSeqChar(enne As Integer) As String 'getSeqChar = Mid$(seque, enne, 1) ' In JAVA, il primo carattere della stringa ha indice ZERO 'In BASIC il primo carattere della stringa ha indice UNO getSeqChar = Mid$(seque, enne + 1, 1) End Function ======================================= ======================================= Modulo di Classe Metodo SEQUENCE CLEANSEQUENCERES ======================================= ======================================= '/** Uniformazione della sequenza di residui - modifica la sequenza corrente*/ 'rispetto all'originale di Piero, non crea una nuova sequenza. 'Per rilevare il contenuto modificato si farà una getseq Public Sub cleanSequenceRes() Dim myI As Integer Dim contenuto As String For myI = 1 To lunga Select Case (Mid$(seque, myI, 1)) Case "a" contenuto = contenuto + "A" Case "c" contenuto = contenuto + "C" Case "d" contenuto = contenuto + "D" Case "e" contenuto = contenuto + "E" Case "F" contenuto = contenuto + "F" Case "G" contenuto = contenuto + "G" Case "H" contenuto = contenuto + "H" Case "I" contenuto = contenuto + "I" Case "K" contenuto = contenuto + "K" Case "L" contenuto = contenuto + "L" Case "M" contenuto = contenuto + "M" Case "N" contenuto = contenuto + "N" Case "P" contenuto = contenuto + "P" Case "Q" contenuto = contenuto + "Q" Case "R" contenuto = contenuto + "R" Case "S" contenuto = contenuto + "S" Case "T" contenuto = contenuto + "T" Case "V" contenuto = contenuto + "V" Case "W" contenuto = contenuto + "W" Case "Y" contenuto = contenuto + "Y" Case "B" contenuto = contenuto + "B" Case "X" contenuto = contenuto + "X" End Select Next seque = contenuto lunga = Len(seque) End Sub ========================== ========================== === CLASSE MODULO 1 ===== ========================== ========================== === DICHIARAZIONI ====== ========================== ========================== Option Compare Database Option Explicit Public Colori(10) As Long Public LetterIndex(23) As String Public PAM250(23, 23) As Variant ======================================= ======================================= Modulo di Classe Metodo MODULO1 INIZIALIZZA ======================================= ======================================= Sub Inizializza() Colori(1) = 255 ' Rosso Colori(2) = 16969139 ' Bianco Colori(3) = 16744703 ' Fuchsia Colori(4) = 65535 ' Giallo Colori(5) = 32768 ' Verde Colori(6) = 12615808 ' Blu1 Colori(7) = 33023 ' Arancio Colori(8) = 8454016 ' Verde evidenziatore Colori(9) = 8388736 ' Viola Profondo Colori(10) = 32896 ' Verde Oliva '=========================== '= Inizializzo matrice Pam250 ===== '=========================== PAM250(0, 1) = 2 PAM250(0, 2) = -2 PAM250(0, 3) = 0 PAM250(0, 4) = 0 PAM250(0, 5) = -2 PAM250(0, 6) = 0 PAM250(0, 7) = 0 PAM250(0, 8) = 1 PAM250(0, 9) = -1 PAM250(0, 10) = -1 PAM250(0, 11) = -2 PAM250(0, 12) = -1 PAM250(0, 13) = -1 PAM250(0, 14) = -4 PAM250(0, 15) = 1 PAM250(0, 16) = 1 PAM250(0, 17) = 1 PAM250(0, 18) = -6 PAM250(0, 19) = -3 PAM250(0, 20) = 0 PAM250(0, 21) = 0 PAM250(0, 22) = 0 PAM250(0, 23) = 0 PAM250(1, 1) = -2 PAM250(1, 2) = 6 PAM250(1, 3) = 0 PAM250(1, 4) = -1 PAM250(1, 5) = -4 PAM250(1, 6) = 1 PAM250(1, 7) = -1 PAM250(1, 8) = -3 PAM250(1, 9) = 2 PAM250(1, 10) = -2 PAM250(1, 11) = -3 PAM250(1, 12) = 3 PAM250(1, 13) = 0 PAM250(1, 14) = -4 PAM250(1, 15) = 0 PAM250(1, 16) = 0 PAM250(1, 17) = -1 PAM250(1, 18) = 2 PAM250(1, 19) = -4 PAM250(1, 20) = -2 PAM250(1, 21) = -1 PAM250(1, 22) = 0 PAM250(1, 23) = 0 PAM250(2, 1) = 0 PAM250(2, 2) = 0 PAM250(2, 3) = 2 PAM250(2, 4) = 2 PAM250(2, 5) = -4 PAM250(2, 6) = 1 PAM250(2, 7) = 1 PAM250(2, 8) = 0 PAM250(2, 9) = 2 PAM250(2, 10) = -2 PAM250(2, 11) = -3 PAM250(2, 12) = 1 PAM250(2, 13) = -2 PAM250(2, 14) = -4 PAM250(2, 15) = -1 PAM250(2, 16) = 1 PAM250(2, 17) = 0 PAM250(2, 18) = -4 PAM250(2, 19) = -2 PAM250(2, 20) = -2 PAM250(2, 21) = 2 PAM250(2, 22) = 1 PAM250(2, 23) = 0 PAM250(3, 1) = 0 PAM250(3, 2) = -1 PAM250(3, 3) = 2 PAM250(3, 4) = 4 PAM250(3, 5) = -5 PAM250(3, 6) = 2 PAM250(3, 7) = 3 PAM250(3, 8) = 1 PAM250(3, 9) = 1 PAM250(3, 10) = -2 PAM250(3, 11) = -4 PAM250(3, 12) = 0 PAM250(3, 13) = -3 PAM250(3, 14) = -6 PAM250(3, 15) = -1 PAM250(3, 16) = 0 PAM250(3, 17) = 0 PAM250(3, 18) = -7 PAM250(3, 19) = -4 PAM250(3, 20) = -2 PAM250(3, 21) = 3 PAM250(3, 22) = 3 PAM250(3, 23) = 0 PAM250(4, 1) = -2 PAM250(4, 2) = -4 PAM250(4, 3) = -4 PAM250(4, 4) = -5 PAM250(4, 5) = 12 PAM250(4, 6) = -5 PAM250(4, 7) = -5 PAM250(4, 8) = -3 PAM250(4, 9) = -3 PAM250(4, 10) = -2 PAM250(4, 11) = -6 PAM250(4, 12) = -5 PAM250(4, 13) = -5 PAM250(4, 14) = -4 PAM250(4, 15) = -3 PAM250(4, 16) = 0 PAM250(4, 17) = -2 PAM250(4, 18) = -8 PAM250(4, 19) = 0 PAM250(4, 20) = -2 PAM250(4, 21) = -4 PAM250(4, 22) = -5 PAM250(4, 23) = 0 PAM250(5, 1) = 0 PAM250(5, 2) = 1 PAM250(5, 3) = 1 PAM250(5, 4) = 2 PAM250(5, 5) = -5 PAM250(5, 6) = 4 PAM250(5, 7) = 2 PAM250(5, 8) = -1 PAM250(5, 9) = 3 PAM250(5, 10) = -2 PAM250(5, 11) = -2 PAM250(5, 12) = 1 PAM250(5, 13) = -1 PAM250(5, 14) = -5 PAM250(5, 15) = 0 PAM250(5, 16) = -1 PAM250(5, 17) = -1 PAM250(5, 18) = -5 PAM250(5, 19) = -4 PAM250(5, 20) = -2 PAM250(5, 21) = 1 PAM250(5, 22) = 3 PAM250(5, 23) = 0 PAM250(6, 1) = 0 PAM250(6, 2) = -1 PAM250(6, 3) = 1 PAM250(6, 4) = 3 PAM250(6, 5) = -5 PAM250(6, 6) = 2 PAM250(6, 7) = 4 PAM250(6, 8) = 0 PAM250(6, 9) = 1 PAM250(6, 10) = -2 PAM250(6, 11) = -3 PAM250(6, 12) = 0 PAM250(6, 13) = -2 PAM250(6, 14) = -5 PAM250(6, 15) = -1 PAM250(6, 16) = 0 PAM250(6, 17) = 0 PAM250(6, 18) = -7 PAM250(6, 19) = -4 PAM250(6, 20) = -2 PAM250(6, 21) = 2 PAM250(6, 22) = 3 PAM250(6, 23) = 0 PAM250(7, 1) = 1 PAM250(7, 2) = -3 PAM250(7, 3) = 0 PAM250(7, 4) = 1 PAM250(7, 5) = -3 PAM250(7, 6) = -1 PAM250(7, 7) = 0 PAM250(7, 8) = 5 PAM250(7, 9) = -2 PAM250(7, 10) = -3 PAM250(7, 11) = -4 PAM250(7, 12) = -2 PAM250(7, 13) = -3 PAM250(7, 14) = -5 PAM250(7, 15) = -1 PAM250(7, 16) = 1 PAM250(7, 17) = 0 PAM250(7, 18) = -7 PAM250(7, 19) = -5 PAM250(7, 20) = -1 PAM250(7, 21) = 0 PAM250(7, 22) = -1 PAM250(7, 23) = 0 PAM250(8, 1) = -1 PAM250(8, 2) = 2 PAM250(8, 3) = 2 PAM250(8, 4) = 1 PAM250(8, 5) = -3 PAM250(8, 6) = 3 PAM250(8, 7) = 1 PAM250(8, 8) = -2 PAM250(8, 9) = 6 PAM250(8, 10) = -2 PAM250(8, 11) = -2 PAM250(8, 12) = 0 PAM250(8, 13) = -2 PAM250(8, 14) = -2 PAM250(8, 15) = 0 PAM250(8, 16) = -1 PAM250(8, 17) = -1 PAM250(8, 18) = -3 PAM250(8, 19) = 0 PAM250(8, 20) = -2 PAM250(8, 21) = 1 PAM250(8, 22) = 2 PAM250(8, 23) = 0 PAM250(9, 1) = -1 PAM250(9, 2) = -2 PAM250(9, 3) = -2 PAM250(9, 4) = -2 PAM250(9, 5) = -2 PAM250(9, 6) = -2 PAM250(9, 7) = -2 PAM250(9, 8) = -3 PAM250(9, 9) = -2 PAM250(9, 10) = 5 PAM250(9, 11) = 2 PAM250(9, 12) = -2 PAM250(9, 13) = 2 PAM250(9, 14) = 1 PAM250(9, 15) = -2 PAM250(9, 16) = -1 PAM250(9, 17) = 0 PAM250(9, 18) = -5 PAM250(9, 19) = -1 PAM250(9, 20) = 4 PAM250(9, 21) = -2 PAM250(9, 22) = -2 PAM250(9, 23) = 0 PAM250(10, 1) = -2 PAM250(10, 2) = -3 PAM250(10, 3) = -3 PAM250(10, 4) = -4 PAM250(10, 5) = -6 PAM250(10, 6) = -2 PAM250(10, 7) = -3 PAM250(10, 8) = -4 PAM250(10, 9) = -2 PAM250(10, 10) = 2 PAM250(10, 11) = 6 PAM250(10, 12) = -3 PAM250(10, 13) = 4 PAM250(10, 14) = 2 PAM250(10, 15) = -3 PAM250(10, 16) = -3 PAM250(10, 17) = -2 PAM250(10, 18) = -2 PAM250(10, 19) = -1 PAM250(10, 20) = 2 PAM250(10, 21) = -3 PAM250(10, 22) = -3 PAM250(10, 23) = 0 PAM250(11, 1) = -1 PAM250(11, 2) = 3 PAM250(11, 3) = 1 PAM250(11, 4) = 0 PAM250(11, 5) = -5 PAM250(11, 6) = 1 PAM250(11, 7) = 0 PAM250(11, 8) = -2 PAM250(11, 9) = 0 PAM250(11, 10) = -2 PAM250(11, 11) = -3 PAM250(11, 12) = 5 PAM250(11, 13) = 0 PAM250(11, 14) = -5 PAM250(11, 15) = -1 PAM250(11, 16) = 0 PAM250(11, 17) = 0 PAM250(11, 18) = -3 PAM250(11, 19) = -4 PAM250(11, 20) = -2 PAM250(11, 21) = 1 PAM250(11, 22) = 0 PAM250(11, 23) = 0 PAM250(12, 1) = -1 PAM250(12, 2) = 0 PAM250(12, 3) = -2 PAM250(12, 4) = -3 PAM250(12, 5) = -5 PAM250(12, 6) = -1 PAM250(12, 7) = -2 PAM250(12, 8) = -3 PAM250(12, 9) = -2 PAM250(12, 10) = 2 PAM250(12, 11) = 4 PAM250(12, 12) = 0 PAM250(12, 13) = 6 PAM250(12, 14) = 0 PAM250(12, 15) = -2 PAM250(12, 16) = -2 PAM250(12, 17) = -1 PAM250(12, 18) = -4 PAM250(12, 19) = -2 PAM250(12, 20) = 2 PAM250(12, 21) = -2 PAM250(12, 22) = -2 PAM250(12, 23) = 0 PAM250(13, 1) = -4 PAM250(13, 2) = -4 PAM250(13, 3) = -4 PAM250(13, 4) = -6 PAM250(13, 5) = -4 PAM250(13, 6) = -5 PAM250(13, 7) = -5 PAM250(13, 8) = -5 PAM250(13, 9) = -2 PAM250(13, 10) = 1 PAM250(13, 11) = 2 PAM250(13, 12) = -5 PAM250(13, 13) = 0 PAM250(13, 14) = 9 PAM250(13, 15) = -5 PAM250(13, 16) = -3 PAM250(13, 17) = -3 PAM250(13, 18) = 0 PAM250(13, 19) = 7 PAM250(13, 20) = -1 PAM250(13, 21) = -5 PAM250(13, 22) = -5 PAM250(13, 23) = 0 PAM250(14, 1) = 1 PAM250(14, 2) = 0 PAM250(14, 3) = -1 PAM250(14, 4) = -1 PAM250(14, 5) = -3 PAM250(14, 6) = 0 PAM250(14, 7) = -1 PAM250(14, 8) = -1 PAM250(14, 9) = 0 PAM250(14, 10) = -2 PAM250(14, 11) = -3 PAM250(14, 12) = -1 PAM250(14, 13) = -2 PAM250(14, 14) = -5 PAM250(14, 15) = 6 PAM250(14, 16) = 1 PAM250(14, 17) = 0 PAM250(14, 18) = -6 PAM250(14, 19) = -5 PAM250(14, 20) = -1 PAM250(14, 21) = -1 PAM250(14, 22) = 0 PAM250(14, 23) = 0 PAM250(15, 1) = 1 PAM250(15, 2) = 0 PAM250(15, 3) = 1 PAM250(15, 4) = 0 PAM250(15, 5) = 0 PAM250(15, 6) = -1 PAM250(15, 7) = 0 PAM250(15, 8) = 1 PAM250(15, 9) = -1 PAM250(15, 10) = -1 PAM250(15, 11) = -3 PAM250(15, 12) = 0 PAM250(15, 13) = -2 PAM250(15, 14) = -3 PAM250(15, 15) = 1 PAM250(15, 16) = 2 PAM250(15, 17) = 1 PAM250(15, 18) = -2 PAM250(15, 19) = -3 PAM250(15, 20) = -1 PAM250(15, 21) = 0 PAM250(15, 22) = 0 PAM250(15, 23) = 0 PAM250(16, 1) = 1 PAM250(16, 2) = -1 PAM250(16, 3) = 0 PAM250(16, 4) = 0 PAM250(16, 5) = -2 PAM250(16, 6) = -1 PAM250(16, 7) = 0 PAM250(16, 8) = 0 PAM250(16, 9) = -1 PAM250(16, 10) = 0 PAM250(16, 11) = -2 PAM250(16, 12) = 0 PAM250(16, 13) = -1 PAM250(16, 14) = -3 PAM250(16, 15) = 0 PAM250(16, 16) = 1 PAM250(16, 17) = 3 PAM250(16, 18) = -5 PAM250(16, 19) = -3 PAM250(16, 20) = 0 PAM250(16, 21) = 0 PAM250(16, 22) = -1 PAM250(16, 23) = 0 PAM250(17, 1) = -6 PAM250(17, 2) = 2 PAM250(17, 3) = -4 PAM250(17, 4) = -7 PAM250(17, 5) = -8 PAM250(17, 6) = -5 PAM250(17, 7) = -7 PAM250(17, 8) = -7 PAM250(17, 9) = -3 PAM250(17, 10) = -5 PAM250(17, 11) = -2 PAM250(17, 12) = -3 PAM250(17, 13) = -4 PAM250(17, 14) = 0 PAM250(17, 15) = -6 PAM250(17, 16) = -2 PAM250(17, 17) = -5 PAM250(17, 18) = 17 PAM250(17, 19) = 0 PAM250(17, 20) = -6 PAM250(17, 21) = -5 PAM250(17, 22) = -6 PAM250(17, 23) = 0 PAM250(18, 1) = -3 PAM250(18, 2) = -4 PAM250(18, 3) = -2 PAM250(18, 4) = -4 PAM250(18, 5) = 0 PAM250(18, 6) = -4 PAM250(18, 7) = -4 PAM250(18, 8) = -5 PAM250(18, 9) = 0 PAM250(18, 10) = -1 PAM250(18, 11) = -1 PAM250(18, 12) = -4 PAM250(18, 13) = -2 PAM250(18, 14) = 7 PAM250(18, 15) = -5 PAM250(18, 16) = -3 PAM250(18, 17) = -3 PAM250(18, 18) = 0 PAM250(18, 19) = 10 PAM250(18, 20) = -2 PAM250(18, 21) = -3 PAM250(18, 22) = -4 PAM250(18, 23) = 0 PAM250(19, 1) = 0 PAM250(19, 2) = -2 PAM250(19, 3) = -2 PAM250(19, 4) = -2 PAM250(19, 5) = -2 PAM250(19, 6) = -2 PAM250(19, 7) = -2 PAM250(19, 8) = -1 PAM250(19, 9) = -2 PAM250(19, 10) = 4 PAM250(19, 11) = 2 PAM250(19, 12) = -2 PAM250(19, 13) = 2 PAM250(19, 14) = -1 PAM250(19, 15) = -1 PAM250(19, 16) = -1 PAM250(19, 17) = 0 PAM250(19, 18) = -6 PAM250(19, 19) = -2 PAM250(19, 20) = 4 PAM250(19, 21) = -2 PAM250(19, 22) = -2 PAM250(19, 23) = 0 PAM250(20, 1) = 0 PAM250(20, 2) = -1 PAM250(20, 3) = 2 PAM250(20, 4) = 3 PAM250(20, 5) = -4 PAM250(20, 6) = 1 PAM250(20, 7) = 2 PAM250(20, 8) = 0 PAM250(20, 9) = 1 PAM250(20, 10) = -2 PAM250(20, 11) = -3 PAM250(20, 12) = 1 PAM250(20, 13) = -2 PAM250(20, 14) = -5 PAM250(20, 15) = -1 PAM250(20, 16) = 0 PAM250(20, 17) = 0 PAM250(20, 18) = -5 PAM250(20, 19) = -3 PAM250(20, 20) = -2 PAM250(20, 21) = 2 PAM250(20, 22) = 2 PAM250(20, 23) = 0 PAM250(21, 1) = 0 PAM250(21, 2) = 0 PAM250(21, 3) = 1 PAM250(21, 4) = 3 PAM250(21, 5) = -5 PAM250(21, 6) = 3 PAM250(21, 7) = 3 PAM250(21, 8) = -1 PAM250(21, 9) = 2 PAM250(21, 10) = -2 PAM250(21, 11) = -3 PAM250(21, 12) = 0 PAM250(21, 13) = -2 PAM250(21, 14) = -5 PAM250(21, 15) = 0 PAM250(21, 16) = 0 PAM250(21, 17) = -1 PAM250(21, 18) = -6 PAM250(21, 19) = -4 PAM250(21, 20) = -2 PAM250(21, 21) = 2 PAM250(21, 22) = 3 PAM250(21, 23) = 0 PAM250(22, 1) = 0 PAM250(22, 2) = 0 PAM250(22, 3) = 0 PAM250(22, 4) = 0 PAM250(22, 5) = 0 PAM250(22, 6) = 0 PAM250(22, 7) = 0 PAM250(22, 8) = 0 PAM250(22, 9) = 0 PAM250(22, 10) = 0 PAM250(22, 11) = 0 PAM250(22, 12) = 0 PAM250(22, 13) = 0 PAM250(22, 14) = 0 PAM250(22, 15) = 0 PAM250(22, 16) = 0 PAM250(22, 17) = 0 PAM250(22, 18) = 0 PAM250(22, 19) = 0 PAM250(22, 20) = 0 PAM250(22, 21) = 0 PAM250(22, 22) = 0 PAM250(22, 23) = 0 PAM250(23, 1) = 0 PAM250(23, 2) = 0 PAM250(23, 3) = 0 PAM250(23, 4) = 0 PAM250(23, 5) = 0 PAM250(23, 6) = 0 PAM250(23, 7) = 0 PAM250(23, 8) = 0 PAM250(23, 9) = 0 PAM250(23, 10) = 0 PAM250(23, 11) = 0 PAM250(23, 12) = 0 PAM250(23, 13) = 0 PAM250(23, 14) = 0 PAM250(23, 15) = 0 PAM250(23, 16) = 0 PAM250(23, 17) = 0 PAM250(23, 18) = 0 PAM250(23, 19) = 0 PAM250(23, 20) = 0 PAM250(23, 21) = 0 PAM250(23, 22) = 0 PAM250(23, 23) = 0 LetterIndex(0) = "A" LetterIndex(1) = "R" LetterIndex(2) = "N" LetterIndex(3) = "D" LetterIndex(4) = "C" LetterIndex(5) = "Q" LetterIndex(6) = "E" LetterIndex(7) = "G" LetterIndex(8) = "H" LetterIndex(9) = "I" LetterIndex(10) = "L" LetterIndex(11) = "K" LetterIndex(12) = "M" LetterIndex(13) = "F" LetterIndex(14) = "P" LetterIndex(15) = "S" LetterIndex(16) = "T" LetterIndex(17) = "W" LetterIndex(18) = "Y" LetterIndex(19) = "V" LetterIndex(20) = "B" LetterIndex(21) = "Z" LetterIndex(22) = "X" LetterIndex(23) = "" End Sub ======================================= ======================================= Modulo di Classe Metodo MODULO1 FindInPam250 ======================================= ======================================= Public Function FindInPam250(char1, char2) As Double 'indice per la esplorazione della mmatrice Dim firstindex As Integer Dim secondindex As Integer firstindex = 0 secondindex = 0 'Cerco in LetterIndex l'indice associato al primo carattere Do firstindex = firstindex + 1 If firstindex > 23 Then Exit Do End If If LetterIndex(firstindex) = char1 Then Exit Do End If Loop 'se ne ho spazzati più di 23 senza trovarlo, errore - avverto e restituisco ZERO If firstindex > 23 Then MsgBox "Passato primo carattere non decodificante :" + char1 FindInPam250 = 0 Exit Function End If 'Cerco in LetterIndex l'indice associato al secondo carattere Do secondindex = secondindex + 1 If firstindex > 23 Then Exit Do End If If LetterIndex(secondindex) = char1 Then Exit Do End If Loop 'se ne ho spazzati più di 23 senza trovarlo, errore - avverto e restituisco ZERO If secondindex > 23 Then MsgBox "Passato secondo carattere non decodificante :" + char2 FindInPam250 = 0 Exit Function End If '========> Arrivo qui se trovato regolarmente ambo i caratteri '========> restituisco il risultato del match FindInPam250 = PAM250(firstindex, secondindex) End Function ========================== ========================== === MODULO LOCALE ===== = TEST_ALLINEAMENTI_CORTI= ========================== ========================== === DICHIARAZIONI ====== ========================== ========================== ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI DICHIARAZIONI ======================================= ======================================= Option Compare Database Option Explicit Public ALGORITMO As String Dim PrimaStringa As String Dim SecondaStringa As String ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI COLORA_CELLA ======================================= ======================================= Public Sub ColoraCella(Riga As Integer, Colonna As Integer, Colore As Integer) 'Error trap On Error GoTo Err_ColoraCella Dim CtrlName As String 'Compongo il nome del controllo sulla base dei parametri passati CtrlName = "R" & LTrim$(Str$(Riga)) & "C" & LTrim$(Str$(Colonna)) 'Forzo il colore "Colore" su tale controllo If Colore = 8 Then Me(CtrlName).ForeColor = 0 Me(CtrlName).BackColor = Colori(Colore) Else Me(CtrlName).ForeColor = 16777215 Me(CtrlName).BackColor = Colori(Colore) End If Exit_ColoraCella: Exit Sub Err_ColoraCella: MsgBox "ColoraCella: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_ColoraCella End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI ALLINEADIST_CLICK ======================================= ======================================= Private Sub AllineaDist_Click() On Error GoTo Err_AllineaDist If Len(PrimaStringa) = 0 Or Len(SecondaStringa) = 0 Then MsgBox "Dovete selezionare due sequenze da raffrontare" Exit Sub End If '=============================' Predispongo tipo di algoritmo scelto ALGORITMO = "SIMPLEALDIST" '===' Avvio routine di allineamento Allinea_Click Exit_AllineaDist: Exit Sub Err_AllineaDist: MsgBox "AllineaDist: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_AllineaDist End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI ALLINEAGLOBALE_CLICK ======================================= ======================================= Private Sub AllineaGlobale_Click() On Error GoTo Err_AllineaGlobale If Len(PrimaStringa) = 0 Or Len(SecondaStringa) = 0 Then MsgBox "Dovete selezionare due sequenze da raffrontare" Exit Sub End If '=============================' Predispongo tipo di algoritmo scelto ALGORITMO = "SIMPLEALSIM" '===' Avvio routine di allineamento Allinea_Click Exit_AllineaGlobale: Exit Sub Err_AllineaGlobale: MsgBox "AllineaGlobale: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_AllineaGlobale End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI ALLINEAGOTOHALSIM_CLICK ======================================= ======================================= Private Sub AllineaGotohalsim_Click() On Error GoTo Err_AllineaGotohalsim If Len(PrimaStringa) = 0 Or Len(SecondaStringa) = 0 Then MsgBox "Dovete selezionare due sequenze da raffrontare" Exit Sub End If '=============================' Predispongo tipo di algoritmo scelto ALGORITMO = "GOTOHALSIM" '===' Avvio routine di allineamento Allinea_Click Exit_AllineaGotohalsim: Exit Sub Err_AllineaGotohalsim: MsgBox "AllineaGotohalsim: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_AllineaGotohalsim End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI ALLINEALOCALE_CLICK ======================================= ======================================= Private Sub AllineaLocale_Click() On Error GoTo Err_AllineaLocale If Len(PrimaStringa) = 0 Or Len(SecondaStringa) = 0 Then MsgBox "Dovete selezionare due sequenze da raffrontare" Exit Sub End If '=============================' Predispongo tipo di algoritmo scelto ALGORITMO = "SIMPLELOCALALSIM" '===' Avvio routine di allineamento Allinea_Click Exit_AllineaLocale: Exit Sub Err_AllineaLocale: MsgBox "AllineaLocale: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_AllineaLocale End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI FORM_OPEN ======================================= ======================================= Private Sub Form_Open(Cancel As Integer) 'Error trap On Error GoTo Err_Form_Open '================> Questi combobox '================> hanno la tendenza a rimanere valorizzati: '================> li pulisco Me!Scegli_S1.Value = "" Me!Scegli_S2.Value = "" 'Inizializzo elementi vettore COLORI Inizializza 'Mostro spiegazione iniziale Me.Presentazione.Top = 0 Me.Presentazione.Left = 0 Me.Presentazione.Width = 8610 Me.Presentazione.Height = 4100 Me.Presentazione.Visible = True Exit_Form_Open: Exit Sub Err_Form_Open: MsgBox "FORM_OPEN: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Form_Open End Sub Private Sub Chiudi_Click() On Error GoTo Err_Chiudi_Click 'Chiudo la form DoCmd.Close Exit_Chiudi_Click: Exit Sub Err_Chiudi_Click: MsgBox "Chiudi: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Chiudi_Click End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI PRESENTAZIONE_CLICK ======================================= ======================================= Private Sub Presentazione_Click() On Error GoTo Err_Presentazione 'Faccio sparire il riquadro iniziale di testo 'per prima cosa, passo il "fuoco" da un'altra parte, così da 'potere rendere invisibile il controllo corrente Me.Scegli_S1.SetFocus Me.Presentazione.Visible = False Exit_Presentazione: Exit Sub Err_Presentazione: MsgBox "Presentazione_Click: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Presentazione End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI Scegli_S1_AfterUpdate ======================================= ======================================= Private Sub Scegli_S1_AfterUpdate() On Error GoTo Err_S1_AfterUpdate 'Stringa 1 - RIGHE matrice 'Pulisco eventuali assegnazioni pregresse SvuotaStringheAllineateVideo 'Metto in variabile PUBLIC "PrimaStringa" la stringa scelta PrimaStringa = Scegli_S1.Value 'Metto un carattere alla volta di stringa in "Intestazioni Righe Matrice" IntestaRighe PrimaStringa Exit_S1_AfterUpdate: Exit Sub Err_S1_AfterUpdate: MsgBox "Scegli_S1_AfterUpdate: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_S1_AfterUpdate End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI Scegli_S2_AfterUpdate ======================================= ======================================= Private Sub Scegli_S2_AfterUpdate() On Error GoTo Err_S2_AfterUpdate 'Stringa 2 - COLONNE matrice 'Pulisco eventuali assegnazioni pregresse SvuotaStringheAllineateVideo 'Metto in variabile PUBLIC "SecondaStringa" la stringa scelta SecondaStringa = Scegli_S2.Value 'Metto un carattere alla volta di stringa in "Intestazioni Colonne Matrice" IntestaColonne SecondaStringa Exit_S2_AfterUpdate: Exit Sub Err_S2_AfterUpdate: MsgBox "Scegli_S2_AfterUpdate: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_S2_AfterUpdate End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI ALLINEA_CLICK ======================================= ======================================= Private Sub Allinea_Click() On Error GoTo Err_Allinea_Click 'Variabili di interesse locale Dim Risultato As Double 'MaxLocal Score restituito da algoritmo di allineamento Dim PostAlignment1 As String 'Stringa1 con eventuali gap da backward tracking Dim PostAlignment2 As String 'Stringa1 con eventuali gap da backward tracking Dim BIndexR As Integer 'Indice righe che uso per il backward tracking Dim BIndexC As Integer 'Indice colonne che uso per il backward tracking Dim NomeCTRL As String 'Per puntare ad una casella della matrice su video Dim qualeprendoS1 As Integer 'quale carattere prendo da prima stringa Dim qualeprendoS2 As Integer 'quale carattere prendo da seconda stringa Dim LocalI As Integer 'indice per loop loop locale Dim LocalJ As Integer 'INDICE PER LOOP LOCALE Dim FinalMaxR As Integer 'massimo indice riga a valle dell'algoritmo Dim FinalMaxC As Integer 'massimo indice colonna a valle dell'algoritmo Dim PuntiPartenzaAllLocali() As String 'per esplorare altri allineamenti locali Dim daCercare As Double 'punteggio di riferimento per ulteriori passate algoritmo locale Dim EsibiscoRisultati As Integer 'La utilizzo per contare se visualizzo il migliore allineamento oppure un allineamento alternativo Dim mat As Integer 'quale delle tre matrici di backward tracking di ALGOTOH devo usare '============================== ' CREO DUE SEQUENZE '============================== 'Creo una nuova istanza della classe SEQUENCE Dim Sequenza1 As New Sequence 'Assegno un nome alla sequenza creata Sequenza1.setSeqName ("PRIMA_SEQ") 'Assegno alla sequenza creata un "valore" (proprietà SEQUE) corrispondente alla prima stringa selezionata Sequenza1.setSeq (PrimaStringa) 'Creo una nuova istanza della classe SEQUENCE Dim Sequenza2 As New Sequence 'Assegno un nome alla sequenza creata Sequenza2.setSeqName ("SECONDA_SEQ") 'Assegno alla sequenza creata un "valore" (proprietà SEQUE) corrispondente alla prima stringa selezionata Sequenza2.setSeq (SecondaStringa) '=============================== ' CREO UN ALLINEAMENTO '=============================== 'creo una nuova istanza della classe ALIGNMENT Dim Allineamento As New Alignment 'Passo all'allineamento le due sequenze da allineare Allineamento.PassaSequenze Sequenza1, Sequenza2 '================================================= '== ALLINEO SECONDO L'ALGORITMO PREFERITO '== selezionato sulla _CLICK del pulsante premuto '================================================= Risultato = Allineamento.Allinea(ALGORITMO) '======================================= ' VISUALIZZO LE DUE STRINGHE ALLINEATE '======================================= 'avviso MsgBox ("Visualizzo matrice di SCORE") PulisciMatriceVideo MostraMatriceScore Sequenza1.getSeqLen + 1, Sequenza2.getSeqLen + 1, Allineamento 'avviso MsgBox ("Visualizzo matrice di backward tracking") PulisciMatriceVideo MostraMatriceBack Sequenza1.getSeqLen + 1, Sequenza2.getSeqLen + 1, Allineamento 'avviso MsgBox ("Compongo Stringhe Allineate") 'Ottengo l'indice LocMaxR alla fine del giro dell'algoritmo BIndexR = Allineamento.IndexR_Max 'Ottengo l'indice LocMaxC alla fine del giro dell'algoritmo BIndexC = Allineamento.IndexC_Max '============================================================ 'ALLINEAMENTI LOCALI - PROPOSTA DI ALLINEAMENTI ALTERNATIVI ' Inizializzo vuota la matrice nella quale memorizzo i punti ' di partenza già sfruttati per proporre allineamenti locali '=========================================== ReDim PuntiPartenzaAllLocali(BIndexR, BIndexC) For LocalI = 1 To BIndexR For LocalJ = 1 To BIndexC PuntiPartenzaAllLocali(LocalI, LocalJ) = " " Next Next '=========================================== ' memorizzo il fatto che sto per partire da una certa cella ' con il mio allineamento '=========================================== PuntiPartenzaAllLocali(BIndexR, BIndexC) = "*" '====================================================== 'In eventuali successive passate, cercherò punteggi pari a "risultato" 'in ulteriori allineamenti locali '====================================================== daCercare = Risultato '=============================== ' ORRORE: UNA LABEL DI GOTO! 'torno qua '=============================== AltroAllineamentoLocale: 'INIZIALIZZO A "NIENTE" LE CASELLE DESTINATE 'ALLA VISUALIZZAZIONE DELLE STRINGHE ALLINEATE SvuotaStringheAllineateVideo 'Inizializzo stringhe vuote PostAlignment1 = "" PostAlignment2 = "" 'coloro la cella di partenza ColoraCella BIndexR, BIndexC, 8 '====== Se si tratta di allineamento LOCALE che mi escluda '====== la fine della stringa, posiziono gli ultimi caratteri '====== della stringa in apposito campo MostraUltimiCaratteriStringheAllineate PrimaStringa, SecondaStringa, BIndexR + 1, BIndexC + 1 '====== Prenderò il carattere della prima stringa in posizione corrispondente '====== all'indice RIGA della cella di valore massimo qualeprendoS1 = BIndexR '====== Prenderò il carattere della seconda stringa in posizione corrispondente '====== all'indice COLONNA della cella di valore massimo qualeprendoS2 = BIndexC '=================================================================================== '=================================================================================== ' DISTINGUO IL CASO DI GOTOHALSIM, CHE LAVORA SU TRE MATRICI DI BACKTRACKING, ' DA QUELLO DEGLI ALTRI ALGORITMI '=================================================================================== '=================================================================================== If ALGORITMO = "GOTOHALSIM" Then 'avviso MsgBox ("Visualizzo seconda matrice di backward tracking") PulisciMatriceVideo MostraMatriceBack1 Sequenza1.getSeqLen + 1, Sequenza2.getSeqLen + 1, Allineamento MsgBox ("Visualizzo terza matrice di backward tracking") PulisciMatriceVideo MostraMatriceBack2 Sequenza1.getSeqLen + 1, Sequenza2.getSeqLen + 1, Allineamento MsgBox "Il backward tracking si svolge su tre matrici contemporaneamente e non è rappresentabile a video!" '=====================> Quale matrice usare mat = 0 Do Cambiamatrice: Select Case mat Case 0 '============================== ' USO MATBACK '============================== 'Uno per volta, esamino i caratteri lungo il percorso di backward tracking Select Case Allineamento.returnMatBack(BIndexR, BIndexC) Case "D" '"CONSUMO" UN CARATTERE DI AMBO LE STRINGHE - NESSUN GAP 'Prendo il "Qualeprendos1" carattere di stringa 1 e lo aggiungo a Postalignment1 PostAlignment1 = Mid$(PrimaStringa, qualeprendoS1, 1) + PostAlignment1 'Prendo il "Qualeprendos2" carattere di stringa 2 e lo aggiungo a Postalignment1 PostAlignment2 = Mid$(SecondaStringa, qualeprendoS2, 1) + PostAlignment2 'PASSO ALLA CELLA IN DIAGONALE RISPETTO ALLA MIA NELLA MATRICE DEI PERCORSI BIndexR = BIndexR - 1 BIndexC = BIndexC - 1 'Registro l'utilizzo di un carattere da ambo le stringhe qualeprendoS1 = qualeprendoS1 - 1 qualeprendoS2 = qualeprendoS2 - 1 mat = 0 GoTo Cambiamatrice Case "R" '============== 'Cambio matrice '============== mat = 1 GoTo Cambiamatrice Case "C" '============== 'Cambio matrice '============== mat = 2 GoTo Cambiamatrice End Select Case 1 '============================== ' USO MATBACK1 '============================== 'Uno per volta, esamino i caratteri lungo il percorso di backward tracking Select Case Allineamento.returnMatBack1(BIndexR, BIndexC) Case "D" '============== 'Cambio matrice '============== mat = 0 GoTo Cambiamatrice Case "R" '============== 'Cambio matrice '============== mat = 1 GoTo Cambiamatrice Case "C" '============== 'I IMMUTATO! '============== '"CONSUMO" un carattere della seconda stringa (ovvero "passo alla colonna 'accanto sulla stessa riga"), ed aggiungo un GAP nella PostAlignment1 PostAlignment1 = "-" + PostAlignment1 PostAlignment2 = Mid$(SecondaStringa, qualeprendoS2, 1) + PostAlignment2 'PASSO ALLA CELLA A SINISTRA DELLA MIA NELLA MATRICE DEI PERCORSI BIndexC = BIndexC - 1 'Registro l'utilizzo di un carattere della seconda stringa qualeprendoS2 = qualeprendoS2 - 1 End Select Case 2 '============================== ' USO MATBACK2 '============================== 'Uno per volta, esamino i caratteri lungo il percorso di backward tracking Select Case Allineamento.returnMatBack2(BIndexR, BIndexC) Case "D" '============== 'Cambio matrice '============== mat = 0 GoTo Cambiamatrice Case "C" '============== 'Cambio matrice '============== mat = 2 GoTo Cambiamatrice Case "R" '============== 'J IMMUTATO! '============== '"CONSUMO" un carattere della prima stringa (ovvero "passo alla riga 'sopra sulla stessa colonna"), ed aggiungo un GAP nella PostAlignment2 PostAlignment1 = Mid$(PrimaStringa, qualeprendoS1, 1) + PostAlignment1 PostAlignment2 = "-" + PostAlignment2 'PASSO ALLA CELLA SOPRA ALLA MIA NELLA MATRICE DEI PERCORSI BIndexR = BIndexR - 1 'Registro l'utilizzo di un carattere della prima stringa qualeprendoS1 = qualeprendoS1 - 1 End Select End Select '=============================================== ' se no resto in loop '=============================================== If BIndexR = 0 Or BIndexC = 0 Then Exit Do End If Loop Else '=================================================================================== '=================================================================================== 'Tutti gli altri algoritmi '=================================================================================== '=================================================================================== Do 'Uno per volta, esamino i caratteri lungo il percorso di backward tracking Select Case Allineamento.returnMatBack(BIndexR, BIndexC) Case "D" '"CONSUMO" UN CARATTERE DI AMBO LE STRINGHE - NESSUN GAP 'Prendo il "Qualeprendos1" carattere di stringa 1 e lo aggiungo a Postalignment1 PostAlignment1 = Mid$(PrimaStringa, qualeprendoS1, 1) + PostAlignment1 'Prendo il "Qualeprendos2" carattere di stringa 2 e lo aggiungo a Postalignment1 PostAlignment2 = Mid$(SecondaStringa, qualeprendoS2, 1) + PostAlignment2 'PASSO ALLA CELLA IN DIAGONALE RISPETTO ALLA MIA NELLA MATRICE DEI PERCORSI BIndexR = BIndexR - 1 BIndexC = BIndexC - 1 'Registro l'utilizzo di un carattere da ambo le stringhe qualeprendoS1 = qualeprendoS1 - 1 qualeprendoS2 = qualeprendoS2 - 1 Case "R" '"CONSUMO" un carattere della seconda stringa (ovvero "passo alla colonna 'accanto sulla stessa riga"), ed aggiungo un GAP nella PostAlignment1 PostAlignment1 = "-" + PostAlignment1 PostAlignment2 = Mid$(SecondaStringa, qualeprendoS2, 1) + PostAlignment2 'PASSO ALLA CELLA A SINISTRA DELLA MIA NELLA MATRICE DEI PERCORSI BIndexC = BIndexC - 1 'Registro l'utilizzo di un carattere della seconda stringa qualeprendoS2 = qualeprendoS2 - 1 Case "C" '"CONSUMO" un carattere della prima stringa (ovvero "passo alla riga 'sopra sulla stessa colonna"), ed aggiungo un GAP nella PostAlignment2 PostAlignment1 = Mid$(PrimaStringa, qualeprendoS1, 1) + PostAlignment1 PostAlignment2 = "-" + PostAlignment2 'PASSO ALLA CELLA SOPRA ALLA MIA NELLA MATRICE DEI PERCORSI BIndexR = BIndexR - 1 'Registro l'utilizzo di un carattere della prima stringa qualeprendoS1 = qualeprendoS1 - 1 Case "0" 'Esco (Vale solo per allineamento locale - vedi subito sotto) Exit Do End Select '=========> La precedente CASE "0" mi provoca la uscita dal loop nel caso in cui '=========> abbia girato SimpleLocalAlSim, che appunto fa allineamenti locali, e il '=========> trovare ZERO significa "Sei alla fine dell'allineamento locale" '=========> Se sto facendo un allineamento GLOBALE, non avrò alcuna cella valorizzata a "zero" '=========> e posso arrivare a valori di INDEXC ed INDEXR uguali a ZERO, caso nel quale '=========> devo uscire dal loop di forza, avendo esaurito tutti i caratteri della stringa, '=========> prima che una routine qualsiasi (ad esempo la ColoraCella qui sotto) '=========> mi vada in errore perchè cerca di intervenire sullo "zeresimo" o sul "meno unesimo" '=========> carattere di una stringa, o controllo del video If BIndexR = 0 Or BIndexC = 0 Then Exit Do End If 'Coloro la cella che ho appena esaminato nella matrice dei percorsi ColoraCella BIndexR, BIndexC, 8 Loop End If '================================================================================= 'Se a questo punto QUALEPRENDOS1 o QUALEPRENDOS2 sono maggiori di zero, 'significa che ho svolto un allineamento locale tale da non 'esaurire tutti i caratteri della stringa. 'Per bellezza, mostro anche i caratteri non allineati all'inizio della stringa '================================================================================= MostraPrimiCaratteriStringheAllineate PrimaStringa, SecondaStringa, qualeprendoS1, qualeprendoS2 '====================== 'Riempio le stringhe allineate '====================== For LocalI = 1 To Len(PostAlignment1) 'caselle destinate ai caratteri della prima stringa NomeCTRL = "PA_" & LTrim$(Str$(LocalI)) Me(NomeCTRL).Caption = Mid$(PostAlignment1, LocalI, 1) 'caselle destinate ai caratteri della prima stringa NomeCTRL = "SA_" & LTrim$(Str$(LocalI)) Me(NomeCTRL).Caption = Mid$(PostAlignment2, LocalI, 1) Next '================================================================ ' Se era un allineamento LOCALE, chiedo se vogliono provare a trovarne un altro '================================================================ If ALGORITMO = "SIMPLELOCALALSIM" Then If MsgBox("Volete cercare altri allineamenti locali nella matrice visualizzata?", vbYesNo, "Allineamento locale") = vbYes Then Do 'Parto da 2 per escludere la prima riga e la prima colonna, che certo non sono 'foriere di allineamenti interessanti For LocalI = 2 To Sequenza1.getSeqLen + 1 For LocalJ = 2 To Sequenza2.getSeqLen + 1 'Esamino solo caselle di partenza non ancora utilizzate If PuntiPartenzaAllLocali(LocalI, LocalJ) = " " Then 'Se trovo una casella il cui score sia quello cercato ..... If Allineamento.returnMatScore(LocalI, LocalJ) = daCercare Then 'marco la casella come sfruttata PuntiPartenzaAllLocali(LocalI, LocalJ) = "*" 'imposto BINDEXR e BINDEXC BIndexR = LocalI BIndexC = LocalJ 'propongo nuovo allineamento GoTo AltroAllineamentoLocale End If End If Next Next '=========================== ' Arrivo qui se nessuno ha punteggio pari a "dacercare" ' allento il requisito '============================ daCercare = daCercare - 1 '================> Se sono arrivato a valore zero, smetto If daCercare = 0 Then Exit Sub End If Loop Else Exit Sub End If End If Exit_Allinea_Click: Exit Sub Err_Allinea_Click: MsgBox "Allinea_Click: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_Allinea_Click End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI PulisciMatriceVideo ======================================= ======================================= Sub PulisciMatriceVideo() On Error GoTo Err_PulisciMatriceVideo Dim LocalI As Integer Dim LocalJ As Integer Dim NomeCTRL As String ' Pulisco il video For LocalI = 1 To 11 For LocalJ = 1 To 11 'Compongo il nome del controllo-etichetta di cui modificare la proprietà CAPTION NomeCTRL = "R" & LTrim$(Str$(LocalI)) & "C" & LTrim$(Str$(LocalJ)) '"Pulisco" nella CAPTION del controllo-etichetta di cui ho composto il nome Me(NomeCTRL).Caption = " " Me(NomeCTRL).BackColor = 12615808 Me(NomeCTRL).ForeColor = 65535 Next Next Exit_PulisciMatriceVideo: Exit Sub Err_PulisciMatriceVideo: MsgBox "PulisciMatriceVideo: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_PulisciMatriceVideo End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI MostraMatriceScore ======================================= ======================================= Sub MostraMatriceScore(QuanteI As Integer, QuanteJ As Integer, QualeAllineamento As Alignment) On Error GoTo Err_MostraMatriceScore Dim LocalI As Integer Dim LocalJ As Integer Dim NomeCTRL As String ' Riempio schermo con matrice di Score For LocalI = 1 To QuanteI For LocalJ = 1 To QuanteJ 'Compongo il nome del controllo-etichetta di cui modificare la proprietà CAPTION NomeCTRL = "R" & LTrim$(Str$(LocalI)) & "C" & LTrim$(Str$(LocalJ)) '"Scrivo" nella CAPTION del controllo-etichetta di cui ho composto il nome il corrispettivo 'elemento della matrice di Score Me(NomeCTRL).Caption = Str$(QualeAllineamento.returnMatScore(LocalI, LocalJ)) Next Next Exit_MostraMatriceScore: Exit Sub Err_MostraMatriceScore: MsgBox "MostraMatriceScore: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_MostraMatriceScore End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI MostraMatriceBack ======================================= ======================================= Sub MostraMatriceBack(QuanteI As Integer, QuanteJ As Integer, QualeAllineamento As Alignment) On Error GoTo Err_MostraMatriceBack Dim LocalI As Integer Dim LocalJ As Integer Dim NomeCTRL As String ' Riempio schermo con matrice di Score For LocalI = 1 To QuanteI For LocalJ = 1 To QuanteJ 'Compongo il nome del controllo-etichetta di cui modificare la proprietà CAPTION NomeCTRL = "R" & LTrim$(Str$(LocalI)) & "C" & LTrim$(Str$(LocalJ)) '"Scrivo" nella CAPTION del controllo-etichetta di cui ho composto il nome il corrispettivo 'elemento della matrice di Score Me(NomeCTRL).Caption = QualeAllineamento.returnMatBack(LocalI, LocalJ) Next Next Exit_MostraMatriceBack: Exit Sub Err_MostraMatriceBack: MsgBox "MostraMatriceBack: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_MostraMatriceBack End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI MostraMatriceBack1 ======================================= ======================================= Sub MostraMatriceBack1(QuanteI As Integer, QuanteJ As Integer, QualeAllineamento As Alignment) On Error GoTo Err_MostraMatriceBack1 Dim LocalI As Integer Dim LocalJ As Integer Dim NomeCTRL As String ' Riempio schermo con matrice di Score For LocalI = 1 To QuanteI For LocalJ = 1 To QuanteJ 'Compongo il nome del controllo-etichetta di cui modificare la proprietà CAPTION NomeCTRL = "R" & LTrim$(Str$(LocalI)) & "C" & LTrim$(Str$(LocalJ)) '"Scrivo" nella CAPTION del controllo-etichetta di cui ho composto il nome il corrispettivo 'elemento della matrice di Score Me(NomeCTRL).Caption = QualeAllineamento.returnMatBack1(LocalI, LocalJ) Next Next Exit_MostraMatriceBack1: Exit Sub Err_MostraMatriceBack1: MsgBox "MostraMatriceBack1: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_MostraMatriceBack1 End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI MostraMatriceBack2 ======================================= ======================================= Sub MostraMatriceBack2(QuanteI As Integer, QuanteJ As Integer, QualeAllineamento As Alignment) On Error GoTo Err_MostraMatriceBack2 Dim LocalI As Integer Dim LocalJ As Integer Dim NomeCTRL As String ' Riempio schermo con matrice di Score For LocalI = 1 To QuanteI For LocalJ = 1 To QuanteJ 'Compongo il nome del controllo-etichetta di cui modificare la proprietà CAPTION NomeCTRL = "R" & LTrim$(Str$(LocalI)) & "C" & LTrim$(Str$(LocalJ)) '"Scrivo" nella CAPTION del controllo-etichetta di cui ho composto il nome il corrispettivo 'elemento della matrice di Score Me(NomeCTRL).Caption = QualeAllineamento.returnMatBack2(LocalI, LocalJ) Next Next Exit_MostraMatriceBack2: Exit Sub Err_MostraMatriceBack2: MsgBox "MostraMatriceBack2: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_MostraMatriceBack2 End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI MostraUltimiCaratteriStringheAllineate ======================================= ======================================= Sub MostraUltimiCaratteriStringheAllineate(Prima As String, Seconda As String, R As Integer, C As Integer) On Error GoTo Err_MostraUltimiCaratteriStringheAllineate '====== Se si tratta di allineamento LOCALE che mi escluda '====== la fine della stringa, posiziono gli ultimi caratteri '====== della stringa in apposito campo If R < Len(Prima) Then Me.FinS1.Caption = Mid$(Prima, R) End If If C < Len(Seconda) Then Me.FinS2.Caption = Mid$(Seconda, C) End If Exit_MostraUltimiCaratteriStringheAllineate: Exit Sub Err_MostraUltimiCaratteriStringheAllineate: MsgBox "MostraUltimiCaratteriStringheAllineate: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_MostraUltimiCaratteriStringheAllineate End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI MostraPrimiCaratteriStringheAllineate ======================================= ======================================= Sub MostraPrimiCaratteriStringheAllineate(Prima As String, Seconda As String, QS1 As Integer, QS2 As Integer) On Error GoTo Err_MostraPrimiCaratteriStringheAllineate '================================================================================= 'Se a questo punto QUALEPRENDOS1 o QUALEPRENDOS2 sono maggiori di zero, 'significa che ho svolto un allineamento locale tale da non 'esaurire tutti i caratteri della stringa. 'Per bellezza, mostro anche i caratteri non allineati all'inizio della stringa '================================================================================= If QS1 > 0 Then Me.IniS1.Caption = Left$(Prima, QS1) End If If QS2 > 0 Then Me.IniS2.Caption = Left$(Seconda, QS2) End If Exit_MostraPrimiCaratteriStringheAllineate: Exit Sub Err_MostraPrimiCaratteriStringheAllineate: MsgBox "MostraPrimiCaratteriStringheAllineate: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_MostraPrimiCaratteriStringheAllineate End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI SvuotaStringheAllineateVideo ======================================= ======================================= Sub SvuotaStringheAllineateVideo() On Error GoTo Err_SvuotaStringheAllineateVideo Dim LocalI As Integer Dim LocalJ As Integer Dim NomeCTRL As String 'INIZIALIZZO A "NIENTE" LE CASELLE DESTINATE 'ALLA VISUALIZZAZIONE DELLE STRINGHE ALLINEATE For LocalI = 1 To 13 'caselle destinate ai caratteri della prima stringa NomeCTRL = "PA_" & LTrim$(Str$(LocalI)) Me(NomeCTRL).Caption = " " 'caselle destinate ai caratteri della prima stringa NomeCTRL = "SA_" & LTrim$(Str$(LocalI)) Me(NomeCTRL).Caption = " " Next Me.IniS1.Caption = " " Me.IniS2.Caption = " " Me.FinS1.Caption = " " Me.FinS2.Caption = " " Exit_SvuotaStringheAllineateVideo: Exit Sub Err_SvuotaStringheAllineateVideo: MsgBox "SvuotaStringheAllineateVideo: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_SvuotaStringheAllineateVideo End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI IntestaRighe ======================================= ======================================= Sub IntestaRighe(Stringa As String) On Error GoTo Err_IntestaRighe 'Variabili locali Dim I As Integer Dim pezzo As String Dim NomeCTRL As String 'Metto un carattere alla volta di stringa in "Intestazioni Righe Matrice" For I = 1 To Len(Stringa) 'Un carattere da prima stringa pezzo = Mid$(Stringa, I, 1) 'In NomeCtrl1, i nomi delle INTESTAZIONI DELLE RIGHE NomeCTRL = "IntR" & LTrim$(Str$(I)) 'Imposto la proprietà CAPTION della etichetta INTESTAZIONE RIGA ad uno dei caratteri della STRINGA 1 Me(NomeCTRL).Caption = pezzo Next Exit_IntestaRighe: Exit Sub Err_IntestaRighe: MsgBox "IntestaRighe: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_IntestaRighe End Sub Sub IntestaColonne(Stringa As String) ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI IntestaColonne ======================================= ======================================= On Error GoTo Err_IntestaColonne 'Variabili locali Dim I As Integer Dim pezzo As String Dim NomeCTRL As String 'Metto un carattere alla volta di stringa in "Intestazioni Colonne Matrice" For I = 1 To Len(Stringa) 'Un carattere da prima stringa pezzo = Mid$(Stringa, I, 1) 'In NomeCtrl1, i nomi delle INTESTAZIONI DELLE COLONNE NomeCTRL = "IntC" & LTrim$(Str$(I)) 'Imposto la proprietà CAPTION della etichetta INTESTAZIONE COLONNA ad uno dei caratteri della STRINGA 2 Me(NomeCTRL).Caption = pezzo Next Exit_IntestaColonne: Exit Sub Err_IntestaColonne: MsgBox "IntestaColonne: Errore " & Str(Err.Number) & " generato da " _ & Err.Source & Chr(13) & Err.Description, , "Errore", Err.HelpFile, Err.HelpContext Resume Exit_IntestaColonne End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI Prove_Click ======================================= ======================================= Option Compare Database Option Explicit Private Sub Prove_Click() On Error GoTo Err_Prove_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "TEST_ALLINEAMENTI_CORTI" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_Prove_Click: Exit Sub Err_Prove_Click: MsgBox Err.Description Resume Exit_Prove_Click End Sub Private Sub Esci_Click() On Error GoTo Err_Esci_Click DoCmd.Quit Exit_Esci_Click: Exit Sub Err_Esci_Click: MsgBox Err.Description Resume Exit_Esci_Click End Sub ======================================= ======================================= Modulo di Classe Metodo TEST_ALLINEAMENTI_CORTI Reale_Click ======================================= ======================================= Private Sub Reale_Click() On Error GoTo Err_Reale_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "TEST_REALISTICO" DoCmd.OpenForm stDocName, , , stLinkCriteria Exit_Reale_Click: Exit Sub Err_Reale_Click: MsgBox Err.Description Resume Exit_Reale_Click End Sub