#!/usr/bin/perl -w use strict; #################################################################################################################### # # # EL PROGRAMA # # # #################################################################################################################### # # # NOM: seXXXqs.pl # # # # FUNCIO: realitza l'aliniament global de dues sequencies en format FASTA mitjanc,ant un algorisme de programacio # # dinamica, i ens mostra l'aliniament optim en format CLUSTAL. # # # # PARAMETRES NECESSARIS PER A EXECUTAR-LO: # # # # $ARGV[0] = hem de posar el nom del fitxer que conte la primera sequencia a aliniar. # # $ARGV[1] = hem de posar el nom del fitxer que conte la segona sequencia a aliniar. # # $ARGV[2] = hem de posar el nom del fitxer que conte la matriu de substitucio que volem emprar. # # $ARGV[3] = hem de posar la puntuacio que volem per penalitzar l'obertura d'un salt a l'aliniament. # # $ARGV[4] = hem de posar la puntuacio que volem per penalitzar l'extensio d'un salt a l'aliniament. # # # # DATA DE CONCEPCIO: Agost'04(fase1) i Febrer'05(fase2). # # # # AUTOR: Guillem Galofre Robles. # # # #################################################################################################################### #################################################################################################################### # # # DECLARACIO DE VARIABLES # # # #################################################################################################################### my $fitxer_seq1; # nom del fitxer que conte la primera sequencia en format FASTA. my $fitxer_seq2; # nom del fitxer que conte la segona sequencia en format FASTA. my $id1; # etiqueta identificadora de la primera sequencia. my $id2; # etiqueta identificadora de la segona sequencia. my @seq1; # primera sequencia, amb cada simbol a la respectiva posicio del vector. my @seq2; # segona sequencia, amb cada simbol a la respectiva posicio del vector. my $fitxer_matriu; # nom del fitxer que conte la matriu de substitucions. my %matriuSUBS; # "hash de hash's" on enregistrem la matriu de substitucio. my $opening; # penalitzacio per l'obertura d'un salt a l'aliniament. my $extension; # penalitzacio per l'extensio d'un salt a l'aliniament. my @matriuPUNT; # matriu de puntuacions; conte les puntuacions de tots els possibles aliniaments. my @matriuALINE; # matriu d'aliniament; indica l'origen del calcul de cada casella de la matriu de puntuacions. my @seq1ali; # vector amb la primera sequencia aliniada, amb els salts que s'hagin introduit. my @seq2ali; # vector amb la segona sequencia aliniada, amb els salts que s'hagin introduit. my $score; # puntuacio final de l'aliniament optim. my $length; # longitud de l'aliniament. my @ident; # vector paral.lel a l'aliniament amb els simbols referents a la identitat i la similitud. my $identity; # percentatge dels simbols aliniats que son identics. my $similarity; # percentatge dels simbols aliniats que tenen entre ells un valor de substitucio superior a 0. #################################################################################################################### # # # ENTRADA DE DADES # # # #################################################################################################################### # ## ### 1-llegim les sequencies i les introduim en vectors per al seu posterior processament: ######################################################################################### ### ## # $fitxer_seq1 = $ARGV[0]; # assignem el primer parametre, o sigui el nom del fitxer en format FASTA que # conte la primera sequencia, a una variable. $fitxer_seq2 = $ARGV[1]; # assignem el segon parametre, o sigui el nom del fitxer en format FASTA que # conte la segona sequencia, a una variable. my $ref_seq1; # referencia del vector @seq1, que ens retornara la funcio FASTArapid. my $ref_seq2; # referencia del vector @seq2, que ens retornara la funcio FASTArapid. ($id1,$ref_seq1) = FASTArapid ($fitxer_seq1); # apliquem la funcio FASTArapid al fitxer amb la primera sequencia. ($id2,$ref_seq2) = FASTArapid ($fitxer_seq2); # apliquem la funcio FASTArapid al fitxer amb la segona sequencia. @seq1 = @{$ref_seq1}; # desreferenciem per a recuperar el vector @seq1. @seq2 = @{$ref_seq2}; # desreferenciem per a recuperar el vector @seq2. # ## ### 2-llegim la matriu de substitucio i l'introduim en un "hash de hash's" per a recuperar posteriorment les puntuacions: ######################################################################################################################### ### ## # $fitxer_matriu = $ARGV[2]; # assignem a una variable el tercer parametre, o sigui # el nom del fitxer que conte la matriu de substitucio. my $ref_matriuSUBS; # referencia del hash %matriuSUBS, que ens retornara la funcio MATRIXexpress. ($ref_matriuSUBS) = MATRIXexpress ($fitxer_matriu); # apliquem la funcio MATRIXexpress al fitxer amb la matriu de substitucio. %matriuSUBS = %{$ref_matriuSUBS}; # desreferenciem per a recuperar el hash %matriuSUBS. #################################################################################################################### # # # COS DEL PROGRAMA # # # #################################################################################################################### # ## ### 1-construim la matriu de puntuacions i la "d'aliniament": ############################################################# ### ## # $opening = $ARGV[3]; # assignem a una variable el quart parametre, o sigui la penalitzacio # escollida per a l'obertura d'un salt a l'aliniament. $extension = $ARGV[4]; # assignem a una variable el cinque parametre, o sigui la penalitzacio # escollida per a l'extensio d'un salt a l'aliniament. my $ref_matriuPUNT; # referencia del vector @matriuPUNT, que ens retornara la funcio SEXoclock. my $ref_matriuALINE; # referencia del vector @matriuALINE, que ens retornara la funcio SEXoclock. ($ref_matriuPUNT,$ref_matriuALINE) = SEXoclock ($opening,$extension); # apliquem la funcio SEXoclock amb les variables # que contenen les penalitzacions de salt escollides. @matriuPUNT = @{$ref_matriuPUNT}; # desreferenciem per a recuperar el vector @matriuPUNT. @matriuALINE = @{$ref_matriuALINE}; # desreferenciem per a recuperar el vector @matriuALINE. # ## ### 2-recuperem l'aliniament optim d'entre tots els aliniaments possibles i n'obtenim la seva puntuacio final: ############################################################################################################## ### ## # my $ref_seq1ali; # referencia del vector @seq1ali, que ens retornara la funcio YANKEESgohome. my $ref_seq2ali; # referencia del vector @seq2ali, que ens retornara la funcio YANKEESgohome. ($score,$ref_seq1ali,$ref_seq2ali) = YANKEESgohome (); # apliquem la funcio YANKEESgohome. @seq1ali = @{$ref_seq1ali}; # desreferenciem per a recuperar el vector @seq1ali. @seq2ali = @{$ref_seq2ali}; # desreferenciem per a recuperar el vector @seq2ali. $length = scalar(@seq1ali); # assignem a una variable la longitud de l'aliniament. # ## ### 3-generem el vector paral.lel a l'aliniament que fa referencia als graus d'identitat i similitud, i els calculem: ##################################################################################################################### ### ## # my $ref_ident; # referencia del vector @ident, que ens retornara la funcio LADYstardust. ($ref_ident,$identity,$similarity) = LADYstardust (); # apliquem la funcio LADYstardust. @ident = @{$ref_ident}; # desreferenciem per a recuperar el vector @ident. #################################################################################################################### # # # SORTIDA DE DADES # # # #################################################################################################################### # ## ### 1-ajustem el format de les variables que contenen les etiquetes identificadores de les sequencies: ###################################################################################################### ### ## # my $ref_id1; # referencia del vector @id1, que ens retornara la funcio LASTname. my $ref_id2; # referencia del vector @id2, que ens retornara la funcio LASTname. my $ref_espais; # referencia del vector @espais, que ens retornara la funcio LASTname. ($ref_id1,$ref_id2,$ref_espais) = LASTname (); # apliquem la funcio LASTname. my @id1 = @{$ref_id1}; # desreferenciem per a recuperar el vector @id1. my @id2 = @{$ref_id2}; # desreferenciem per a recuperar el vector @id2. my @espais = @{$ref_espais}; # desreferenciem per a recuperar el vector @espais. # ## ### 2-mostrem per pantalla el resultat del nostre aliniament en format CLUSTAL: ############################################################################### ### ## # # mostrem per pantalla la capc,alera tipica del format CLUSTAL: print "\n\nCLUSTAL FORMAT, identity $identity%, similarity $similarity%, score $score\n\n\n"; my $salt60 = 0; # generem una variable que ens servira per "tallar" els vectors de l'aliniament en linies de 60 simbols. # la iniciem a 0, pero a cada volta del bucle, augmentara en 60. while ($salt60 < scalar(@seq1ali)) { # mentres la llargada de l'aliniament sigui inferior a aquesta variable, print @id1; # mostrem l'etiqueta identificadora de la 1a sequencia davant la linia amb els 60 simbols. my $i = $salt60; # definim una variable per referir-nos a cada posicio de l'aliniament dins aquest bloc de 60. while ($i < ($salt60 + 60) && exists $seq1ali[$i]) { print $seq1ali[$i]; # mostrem els simbols d'aquesta linia de l'aliniament, referents a la 1a sequencia; $i = $i + 1; # un per un, mentres n'hi hagi. } print "\n"; # saltem de linia, per mostrar la part de l'aliniament referent a la 2a sequencia. print @id2; # mostrem l'etiqueta identificadora de la 2a sequencia davant la linia amb els 60 simbols. $i = $salt60; # definim una variable per referir-nos a cada posicio de l'aliniament dins aquest bloc de 60. while ($i < ($salt60 + 60) && exists $seq2ali[$i]) { print $seq2ali[$i]; # mostrem els simbols d'aquesta linia de l'aliniament, referents a la 2a sequencia; $i = $i + 1; # un per un, mentres n'hi hagi. } print "\n"; # saltem de linia, per mostrar la part de l'aliniament referent a la identitat i similitud. print @espais; # mostrem "l'etiqueta" amb els espais, per a que el vector @ident quedi ben aliniat. $i = $salt60; # definim una variable per referir-nos a cada posicio de l'aliniament dins aquest bloc de 60. while ($i < ($salt60 + 60) && exists $ident[$i]) { print $ident[$i]; # mostrem els simbols d'aquesta linia de l'aliniament, referents a la identitat i similitud; $i = $i + 1; # un per un, mentres n'hi hagi. } print "\n\n"; # saltem de linia 2 cops, per mostrar el seguent bloc de 60 simbols. $salt60 = $salt60 + 60; # augmentem 60, per mostrar els seguents 60 simbols en la propera volta del bucle. } print "alignment length $length\n"; # indiquem la longitud final de l'aliniament, i els parametres que s'han emprat. print "*run with $fitxer_matriu and gap penalties: opening = $opening extension = $extension\n\n\n"; #################################################################################################################### # # # FUNCIONS # # # #################################################################################################################### ############ # FUNCIO-1 # ############ # # Nom: FASTArapid. # # Proposit: donada una sequencia en format FASTA, introduir en una variable singular # l'etiqueta identificadora de la sequencia, i en una variable plural la # sequencia de simbols, ocupant cada un d'ells una posicio del vector. # # Parametres: $_[0] - nom del fitxer que conte la sequencia en format FASTA. # # Retorna: l'etiqueta identificadora i la sequencia de simbols. # sub FASTArapid{ my $fitxer_seq = $_[0]; # prenem el nom del fitxer de la sequencia que volem passar per la funcio. my $id; # variable on enregistrarem la linia del fitxer corresponent a l'etiqueta de la sequencia. my $seqline; # variable on enregistrarem les diferents linies del fitxer. my $seq = ""; # variable amb totes les linies de sequencia del fitxer concatenades. my @seq; # vector amb la sequencia de simbols, amb un per posicio. if (scalar(@ARGV) < 2){ # comprovem que s'han introduit els dos noms dels fitxers de les sequencies; print STDERR "seXXXqs.pl: cal que introdueixis el nom dels fitxers de les dues sequencies!\n"; exit(1); # si no, avis i sortida del programa. } if (!open (SEQ,"< $fitxer_seq ")){ # comprovem que els fitxers es puguin obrir; print STDERR "seXXXqs.pl: no es pot obrir el fitxer $fitxer_seq\n"; exit (1); # si no, avis i sortida del programa. } $id = ; # assignem la primera linia del fitxer a la variable de l'etiqueta. chomp ($id); # eliminem el salt de linia. while () { # llegim la resta del fitxer, linia a linia. $seqline = $_; # assignem la linia llegida a una variable. chomp ($seqline); # eliminem el salt de linia. $seq = $seq . $seqline; # concatenem les diferents linies. } $seq = uc($seq); # convertim tots els simbols a majuscula. @seq = split(//,$seq); # introduim cada simbol a una posicio d'un vector. close (SEQ); # tanquem el FILEHANDLE. return ($id,\@seq); # retornem la variables amb l'etiqueta i la referencia del vector } # que conte la sequencia de simbols. ############ # FUNCIO-2 # ############ # # Nom: MATRIXexpress. # # Proposit: construir un "hash de hash's" per enregistrar-hi la matriu de substitucio que volem emprar. # # Parametres: $_[0] - nom del fitxer que conte la matriu de subtitucio. # # Retorna: el hash amb la matriu de substitucio. # sub MATRIXexpress{ my $s_fitxer_matriu = $_[0]; # prenem el nom del fitxer de la matriu que volem passar per la funcio. my $linia_aa; # linia amb tots els aa (o nucleotids), corresponent a la "primera fila" de la matriu. my @aa; # vector amb tots els aa (o nucleotids), un per posicio, de la "primera fila" de la matriu. my @fila_matriu; # vector on enregistrarem els valors de les diferents files de la matriu. my %h_matriuSUBS; # "hash de hash's" on enregistrarem la matriu de substitucio. if (scalar(@ARGV) < 3){ # comprovem que s'ha introduit el nom del fitxer de la matriu de substitucio; print STDERR "seXXXqs.pl: cal que introdueixis el nom del fitxer de la matriu de substitucio!\n"; exit(1); # si no, avis i sortida del programa. } if (!open (MATSUBS,"< $s_fitxer_matriu ")){ # comprovem que el fitxer es pugui obrir; print STDERR "seXXXqs.pl: no es pot obrir el fitxer $fitxer_matriu\n"; exit (1); # si no, avis i sortida del programa. } my $i = 0; # variable per comptar les files de la matriu. while () { # llegim el fitxer, linia a linia. if ($_ =~ m/[A-Z\*]+/){ # si reconeix la "primera fila" de l'arxiu, corresponent als aa (o nucleotids), $linia_aa = $_; # assignem la linia llegida a una variable, chomp ($linia_aa); # eliminem el salt de linia @aa = ($linia_aa =~ m/[A-Z\*]/g); # i introduim els aa (o nucleotids) a un vector, un per posicio. } elsif (!($_ =~ m/\A\#[\w\W]*/)){ # si no es dona el cas anterior, ni tampoc es tracta # de les primeres files del fitxer, corresponents # a informacio adicional de la matriu, significa # que ja comencem a llegir la matriu en si. chomp ($_); # eliminem el salt de linia, @fila_matriu = ($_ =~ m/\S+/g); # i introduim els valors de la fila que estem llegint de la matriu # a un vector, un per posicio. my $j = 0; # variable per comptar les columnes de la matriu. while ($j < scalar(@fila_matriu)) { # recorrem la fila $h_matriuSUBS{$aa[$i]}{$aa[$j]} = $fila_matriu[$j]; # i introduim els seus valors en un hash de hash's # on les claus seran el parell d'aa (o nucleotids) que es substitueixen. $j = $j + 1; # saltem de columna. } $i = $i + 1; # saltem de fila. } } close (MATSUBS); # tanquem el FILEHANDLE. return (\%h_matriuSUBS); # retornem la referencia del hash amb la matriu de substitucio. } ############ # FUNCIO-3 # ############ # # Nom: SEXoclock. # # Proposit: generar, a partir d'un l'algorisme de programacio dinamica, un "vector de vectors" que contingui la # matriu de puntuacions de tots els possibles aliniaments entre les dues sequencies; les puntuacions # de la qual es calculen mitjanc,ant el hash on es troba enregistrada la matriu de substitucio i les # variables que contenen les penalitzacions de salt escollides. # Donat que aquest programa incorpora l'opcio de diferenciar la penalitzacio per obertura de salt de # la de l'extensio mantenint el mateix ordre de creixement de complexitat de l'algorisme, es generaran # dues matrius previes a la matriu de puntuacions que ens seran necessaries per triar la puntuacio # d'introduir un salt a l'aliniament d'entre les dues possibilitats existents. Aquestes matrius tindran # una posicio extra en la tercera dimensio, per a cada casella, on poder anotar la llargada del salt. # Paral.lela i simultaniament, tambe es genera un altre "vector de vectors" que conte una matriu # (que anomenarem matriu d'aliniament) on s'indica d'on prove el calcul de cada casella en la matriu # de puntuacions. La notacio de les caselles en aquesta matriu es la seguent: # # P - indica que el calcul d'aquesta casella te com a origen la puntuacio parcial de # l'aliniament fins a la casella en diagonal (fila i columna anteriors) mes la # PUNTUACIO d'aliniar el parell d'aa de les dues sequencies. # # 1 - indica que el calcul d'aquesta casella te com a origen la puntuacio parcial de # l'aliniament fins a la casella de l'esquerra (mateixa fila i columna anterior) # mes la penalitzacio d'haver OBERT un salt a la SEQUENCIA 1. # # Xx - indica que el calcul d'aquesta casella te com a origen la puntuacio parcial de # l'aliniament fins a "x" caselles de l'esquerra (mateixa fila i "x" columnes anteriors) # mes la penalitzacio d'haver OBERT i EXTES un salt de "x" longitud a la SEQUENCIA 1. # # 2 - indica que el calcul d'aquesta casella te com a origen la puntuacio parcial de # l'aliniament fins a la casella de dalt (fila anterior i mateixa columna) mes la # penalitzacio d'haver OBERT un salt a la SEQUENCIA 2. # # Yy - indica que el calcul d'aquesta casella te com a origen la puntuacio parcial de # l'aliniament fins a "y" caselles de dalt ("y" files anteriors i mateixa columna) # mes la penalitzacio d'haver OBERT i EXTES un salt de "y" longitud a la SEQUENCIA 2. # # # Parametres: $_[0] - variable que conte la penalitzacio escollida per l'obertura d'un salt. # $_[1] - variable que conte la penalitzacio escollida per l'extensio d'un salt. # # Retorna: la matriu de puntuacions i la matriu d'aliniament. # sub SEXoclock{ my $s_opening = $_[0]; # prenem la penalitzacio per obertura de salt que volem utilitzar a la funcio. my $s_extension = $_[1]; # prenem la penalitzacio per extensio de salt que volem utilitzar a la funcio. my @v_matriuPUNT; # "vector de vectors" amb la matriu de puntuacions. my @v_matriuALINE; # "vector de vectors" amb la matriu d'aliniament. my @v_matriuGAPS1; # matriu previa per triar entre obertura o extensio de salt a la 1a sequencia. my @v_matriuGAPS2; # matriu previa per triar entre obertura o extensio de salt a la 2a sequencia. my $EXT1length; # variable per comptabilitzar la longitud d'un salt extes a la 1a sequencia. my $EXT2length; # variable per comptabilitzar la longitud d'un salt extes a la 2a sequencia. # a mes a mes, farem servir: @seq1, @seq2 i %matriuSUBS. if (scalar(@ARGV) < 5){ # comprovem que s'han escollit les penalitzacions de salt; print STDERR "seXXXqs.pl: cal que escullis els valors per a les penalitzacions de salt!\n"; exit(1); # si no, avis i sortida del programa. } if (!($ARGV[3] =~ m/\A(-\d+|\d+)/)){ print STDERR "seXXXqs.pl: has d'introduir un simbol numeric per a les penalitzacions de salt!\n"; exit(1); # i comprovem tambe que aquestes } # siguin numeros; if (!($ARGV[4] =~ m/\A(-\d+|\d+)/)){ # si no, avis i sortida del programa. print STDERR "seXXXqs.pl: has d'introduir un simbol numeric per a les penalitzacions de salt!\n"; exit(1); } $v_matriuPUNT[0][0] = 0; # omplim la primera casella de la matriu de puntuacions amb la puntuacio inicial # de l'aliniament, o sigui 0. $v_matriuALINE[0][0] = 'F'; # omplim la primera casella de la matriu d'aliniament amb l'indicatiu "F", de "final", # que posteriorment ens indicara que ja hem acabat de recuperar l'aliniament. my $i = 1; # variable per comptar les caselles de la primera columna de les matrius. while ($i <= scalar(@seq1)) { # recorrem la primera columna fins que s'acabi la primera sequencia. $v_matriuPUNT[$i][0] = $v_matriuPUNT[$i-1][0] + $s_extension; $v_matriuALINE[$i][0] ='2'; # seguint l'aliniament per tota la primera columna de la matriu, el que fem es # "arrossegar" la introduccio d'un salt per tota la segona sequencia...aixi que omplirem # tota la columna amb l'acumulacio de la penalitzacio per extensio de salt en la # matriu de puntuacions, i de la notacio "2" en la matriu d'aliniament. $v_matriuGAPS1[$i][0][0] = -99999; # paral.lelament omplim totes les caselles de la primera columna de la matriu d'introduccio # de salts a la 1a sequencia amb un nombre molt baix; aixo ho fem per restringir la primera # eleccio de l'algorisme de manera que a la seguent columna nomes hi hagi l'opccio de # triar obertura de salt. $i = $i + 1; # saltem de casella (dins la primera columna). } my $j = 1; # variable per comptar les caselles de la primera fila de les matrius. while ($j <= scalar(@seq2)) { # recorrem la primera fila fins que s'acabi la segona sequencia. $v_matriuPUNT[0][$j] = $v_matriuPUNT[0][$j-1] + $s_extension; $v_matriuALINE[0][$j] ='1'; # seguint l'aliniament per tota la primera fila de la matriu, el que fem es # "arrossegar" la introduccio d'un salt per tota la primera sequencia...aixi que omplirem # tota la fila amb l'acumulacio de la penalitzacio per extensio de salt en la # matriu de puntuacions, i de la notacio "1" en la matriu d'aliniament. $v_matriuGAPS2[0][$j][0] = -99999; # paral.lelament omplim totes les caselles de la primera fila de la matriu d'introduccio # de salts a la 2a sequencia amb un nombre molt baix; aixo ho fem per restringir la primera # eleccio de l'algorisme de manera que a la seguent fila nomes hi hagi l'opccio de # triar obertura de salt. $j = $j + 1; # saltem de casella (dins la primera fila). } # ara que ja tenim totes les matrius "inicialitzades", comencem a omplir-les a partir de l'algorisme: ##################################################################################################### $i = 1; # variable per comptar les files de les matrius. while ($i <= scalar(@seq1)) { # anirem omplint files fins que s'acabi la primera sequencia. $j = 1; # variable per comptar les columnes de les matrius. while ($j <= scalar(@seq2)) { # anirem omplint columnes fins que s'acabi la segona sequencia. # comencem triant quin tipus de salt a la 1a sequencia pot aportar una puntuacio maxima a aquesta casella: ########################################################################################################## my $OPEN1 = $v_matriuPUNT[$i][$j-1] + $s_opening + $s_extension; # si l'obertura d'un salt nou, my $EXT1 = $v_matriuGAPS1[$i][$j-1][0] + $s_extension; # o l'extensio d'un d'anterior. if ($OPEN1 > $EXT1){ # si la puntuacio es superior obrint-ne un de nou, $v_matriuGAPS1[$i][$j][0] = $OPEN1; # l'assignem a la matriu de salts a la 1a sequencia. $EXT1length = 1; # i ho indiquem en una variable per si despres l'extenem. } else{ # si no, extenem salt i assignem aquesta puntuacio $v_matriuGAPS1[$i][$j][0] = $EXT1; # a la matriu de salts a la 1a sequencia. $EXT1length = $EXT1length + 1; # sumem que hem extes el salt una posicio, $v_matriuGAPS1[$i][$j][1] = $EXT1length; # i ho indiquem a la tercera dimensio de la matriu. } # seguim triant quin tipus de salt a la 2a sequencia pot aportar una puntuacio maxima a aquesta casella: ######################################################################################################## my $OPEN2 = $v_matriuPUNT[$i-1][$j] + $s_opening + $s_extension; # si l'obertura d'un salt nou, my $EXT2 = $v_matriuGAPS2[$i-1][$j][0] + $s_extension; # o l'extensio d'un d'anterior. if ($OPEN2 > $EXT2){ # si la puntuacio es superior obrint-ne un de nou, $v_matriuGAPS2[$i][$j][0] = $OPEN2; # l'assignem a la matriu de salts a la 2a sequencia. } else{ # si no, extenem salt i assignem aquesta puntuacio $v_matriuGAPS2[$i][$j][0] = $EXT2; # a la matriu de salts a la 2a sequencia. if (!exists $v_matriuGAPS2[$i-1][$j][1]){ # si es tracta de la primera extensio d'aquest salt, $EXT2length = 2; # ho indiquem; } else{ # si no (ja venim d'una extensio de salt), $EXT2length = $v_matriuGAPS2[$i-1][$j][1] + 1; # sumem que hem extes el salt una posicio. } $v_matriuGAPS2[$i][$j][1] = $EXT2length; # ho indiquem a la tercera dimensio de la matriu. } # un cop que ja s'ha triat el tipus de salt, passem a triar entre les tres opcions possibles per puntuar: ######################################################################################################### my $PUNT = $v_matriuPUNT[$i-1][$j-1] + $matriuSUBS{$seq1[$i-1]}{$seq2[$j-1]}; # aliniant les dues sequencies my $GAP1 = $v_matriuGAPS1[$i][$j][0]; # introduint un salt a la 1a sequencia my $GAP2 = $v_matriuGAPS2[$i][$j][0]; # introduint un salt a la 2a sequencia my @PUNTUACIONS = ($PUNT,$GAP1,$GAP2); # generem un vector per escollir l'opcio que puntua mes alt: my $c = 0; my $max = -99999; while ($c < scalar(@PUNTUACIONS)) { # recorrem aquest vector if ($PUNTUACIONS[$c] >= $max){ $max = $PUNTUACIONS[$c]; # i enregistrem en una variable el valor maxim. } $c = $c + 1; } if ($max == $PUNT){ # si el valor maxim prove d'aliniar les dues sequencies, $v_matriuPUNT[$i][$j] = $PUNT; # assignem aquest valor a la matriu de puntuacions $v_matriuALINE[$i][$j] = 'P'; # i posem la notacio "P" a la matriu d'aliniament. } if ($max == $GAP1){ # si prove d'introduir un salt a la 1a sequencia, $v_matriuPUNT[$i][$j] = $GAP1; # assignem aquest valor a la matriu de puntuacions $v_matriuALINE[$i][$j] ='1'; # i posem la notacio "1" a la matriu d'aliniament. if (exists $v_matriuGAPS1[$i][$j][1]){# ara be, si tenim valor a la 3a dimensio de la matriu de salts, $v_matriuALINE[$i][$j] ="X$v_matriuGAPS1[$i][$j][1]"; } # aquest ens indica que el salt prove d'un d'anterior que s'ha extes; } # i ens indica tambe la llargada i ho anotem a la matriu d'aliniament. if ($max == $GAP2){ # si prove d'introduir un salt a la 2a sequencia, $v_matriuPUNT[$i][$j] = $GAP2; # assignem aquest valor a la matriu de puntuacions $v_matriuALINE[$i][$j] ='2'; # i posem la notacio "2" a la matriu d'aliniament. if (exists $v_matriuGAPS2[$i][$j][1]){# ara be, si tenim valor a la 3a dimensio de la matriu de salts $v_matriuALINE[$i][$j] ="Y$v_matriuGAPS2[$i][$j][1]"; } # aquest ens indica que el salt prove d'un d'anterior que s'ha extes; } # i ens indica tambe la llargada i ho anotem a la matriu d'aliniament. $j = $j + 1; # saltem de columna. } $i = $i + 1; # saltem de fila. } return (\@v_matriuPUNT,\@v_matriuALINE); # retornem les referencies de la matriu de } # puntuacions i de la matriu d'aliniament. ############ # FUNCIO-4 # ############ # # Nom: YANKEESgohome. # # Proposit: recuperar l'aliniament optim d'entre tots els possibles. Aixo es realitza "remuntant" el cami # que ha portat a la darrera casella de la matriu de puntuacions; precisament aquesta darrera casella # sera la que ens mostrara la puntuacio final (o "score") de l'aliniament optim. Per a la "remuntada" # pero, farem servir la matriu d'aliniament que per aixo ha estat creada...doncs cada casella ens # indica d'on prove el calcul de la respectiva casella en la matriu de puntuacions. # # Retorna: la puntuacio final de l'aliniament optim i les dues sequencies aliniades. # sub YANKEESgohome{ my $s_score; # puntuacio final de l'aliniament optim. my $casella; # variable per a la casella de la matriu d'aliniament que estiguem remuntant en cada moment. my $salts1; # variables per comptabilitzar el nombre de salts a introduir a l'aliniament en cas d'haver my $salts2; # extes un salt a la 1a o la 2a sequencia, respectivament. my @r_seq1ali; # vector on anirem enregistrant el "remuntat" de l'aliniament de la primera sequencia. my @r_seq2ali; # vector on anirem enregistrant el "remuntat" de l'aliniament de la segona sequencia. my @v_seq1ali; # vector amb la primera sequencia aliniada. my @v_seq2ali; # vector amb la segona sequencia aliniada. # a mes a mes, farem servir: @seq1, @seq2, @matriuPUNT i @matriuALINE. my $i = scalar(@seq1); # variable per referir-nos a les files de la matriu d'aliniament. my $j = scalar(@seq2); # variable per referir-nos a les columnes de la matriu d'aliniament. my $c = 0; # variable per referir-nos a la posicio de l'aliniament "remuntat". $s_score = $matriuPUNT[$i][$j]; # assignem el valor de l'ultima casella de la matriu de puntuacions a una variable. $casella = $matriuALINE[$i][$j]; # assignem la notacio de l'ultima casella de la matriu d'aliniament a una variable, # aixi sabrem cap a on comenc,ar a "remuntar" l'aliniament. while ($casella ne 'F') { # anem "remuntant" fins que arribem a la primera casella de la matriu. $casella = $matriuALINE[$i][$j]; # variable per referir-nos a la casella de la matriu d'aliniament # en la que estem en cada moment. if ($casella eq 'P'){ # si es tracta que la puntuacio prove d'aliniar les dues sequencies, $r_seq1ali[$c] = $seq1[$i-1]; # prenem un simbol de la primera sequencia $r_seq2ali[$c] = $seq2[$j-1]; # i un altre de la segona sequencia. $i = $i - 1; # retrocedim en diagonal, o sigui pugem una fila $j = $j - 1; # i reculem una columna. $c = $c + 1; # avancem una posicio en la "remuntada" de l'aliniament. } if ($casella eq '1'){ # si es tracta que la puntuacio prove d'obrir un salt a la primera sequencia, $r_seq1ali[$c] = '-'; # l'introduim a l'esmentada sequencia $r_seq2ali[$c] = $seq2[$j-1]; # i prenem un simbol de la segona sequencia. $j = $j - 1; # reculem nomes una columna. $c = $c + 1; # avancem una posicio en la "remuntada" de l'aliniament. } if ($casella =~ m/X(\d+)/){ # si es tracta que la puntuacio prove d'extendre un salt a la 1a sequencia, $salts1 = $1; # enregistrem en una variable la llargada del salt. while ($salts1 > 0) { $r_seq1ali[$c] = '-'; # introduim, per tant, tants salts a l'esmentada sequencia $r_seq2ali[$c] = $seq2[$j-1]; # i prenem tants simbols de la 2a sequencia. $j = $j - 1; # igualment, reculem tantes columnes $c = $c + 1; # i avancem tantes posicions en la "remuntada" de l'aliniament. $salts1 = $salts1 - 1; } } if ($casella eq '2'){ # si es tracta que la puntuacio prove d'obrir un salt a la segona sequencia, $r_seq1ali[$c] = $seq1[$i-1]; # prenem un simbol de la primera sequencia $r_seq2ali[$c] = '-'; # i introduim un salt a la segona sequencia. $i = $i - 1; # reculem nomes una fila. $c = $c + 1; # avancem una posicio en la "remuntada" de l'aliniament. } if ($casella =~ m/Y(\d+)/){ # si es tracta que la puntuacio prove d'extendre un salt a la 2a sequencia, $salts2 = $1; # enregistrem en una variable la llargada del salt. while ($salts2 > 0) { $r_seq1ali[$c] = $seq1[$i-1]; # prenem, per tant, tants simbols de la 1a sequencia $r_seq2ali[$c] = '-'; # i introduim tants salts a la 2a sequencia. $i = $i - 1; # igualment, reculem tantes files $c = $c + 1; # i avancem tantes posicions en la "remuntada" de l'aliniament. $salts2 = $salts2 - 1; } } } @v_seq1ali = reverse(@r_seq1ali); # invertim el "remuntat" de l'aliniament de la primera sequencia. @v_seq2ali = reverse(@r_seq2ali); # invertim el "remuntat" de l'aliniament de la segona sequencia. return ($s_score,\@v_seq1ali,\@v_seq2ali); # retornem la puntuacio final de l'aliniament optim } # i les referencies dels vectors de les dues sequencies aliniades. ############ # FUNCIO-5 # ############ # # Nom: LADYstardust. # # Proposit: generar un vector paral.lel a l'aliniament que ens informi simbol per simbol sobre la similitud entre les # dues sequencies; aixi doncs, en aquest vector introduirem el simbol de l'asterisc (*) si els dos simbols # aliniats son identics, el dels dos punts (:) si el valor de substitucio entre ells es superior a 0 i, # finalment, un espai ( ) en qualsevol altre cas (o sigui gaps i simbols aliniats amb valors de substitucio # iguals o inferiors a 0). A mes a mes, tambe calcularem el grau d'identitat i similitud (en percentatge) # entre les dues sequencies aliniades. # # Retorna: el vector amb els simbols d'identitat i similitud, i dues variables singulars amb el grau d'identitat i de similitud. # sub LADYstardust{ my @v_ident; # vector on anirem introduint els simbols en funcio de la relacio entre els dos aa aliniats. my $s_ident; # variable corresponent al percentatge d'identitat entre les dues sequencies aliniades. my $s_simil; # variable corresponent al percentatge de similitud entre les dues sequencies aliniades. # a mes a mes, farem servir: @seq1ali, @seq2ali, %matriuSUBS. my $cident = 0; # variable per anar comptant quants simbols d'asterisc (*) assignem. my $csimil = 0; # variable per anar comptant quants simbols de dos punts (:) assignem. my $i = 0; # variable per referir-nos a quina posicio de l'aliniament estem evaluant. while ($i < scalar(@seq1ali)) { # recorrem tot l'aliniament des de la primera posicio. if ($seq1ali[$i] ne '-' && $seq2ali[$i] ne '-') { # si no hi ha cap salt en aquesta posicio de l'aliniament, if ($matriuSUBS{$seq1ali[$i]}{$seq2ali[$i]} > 0) { # i, si el valor de substitucio entre els dos simbols es > 0, if ($seq1ali[$i] eq $seq2ali[$i]) { # i si, a mes, aquests dos son identics, $v_ident[$i] = '*'; # introduim un asterisc al vector que estem construint $cident = $cident + 1; # i el comptem. } else { # si aquests dos simbols no son identics, $v_ident[$i] = ':'; # introduim dos punts al vector que estem construint $csimil = $csimil + 1; # i els comptem. } } else { # si el valor de substitucio entre els dos simbols no es > 0, $v_ident[$i] = ' '; # introduim un espai al vector que estem construint. } } else { # si hi ha algun salt en aquesta posicio de l'aliniament, $v_ident[$i] = ' '; # introduim un espai al vector que estem construint. } $i = $i + 1; # avancem una posicio en l'aliniament. } $s_ident = ($cident / scalar(@v_ident)) * 100; # calculem el percentatge d'identitat entre les dues sequencies, $s_ident = sprintf("%.2f",$s_ident); # i l'arrodonim a dos decimals. $s_simil = (($cident + $csimil) / scalar(@v_ident)) * 100; # calculem el percentatge de similitud entre les dues sequencies, $s_simil = sprintf("%.2f",$s_simil); # i l'arrodonim a dos decimals. return (\@v_ident,$s_ident,$s_simil); # retornem la referencia del vector amb els simbols d'identitat } # i similitud, i dues variables amb el grau d'identitat i de similitud. ############ # FUNCIO-6 # ############ # # Nom: LASTname. # # Proposit: preparar el format de les variables que contenten l'etiqueta identificadora de les sequencies, # de manera que s'ajustin a les nostres necessitats a l'hora de mostrar-les per pantalla. A mes, # generarem un vector ple d'espais, donat que encara que el vector @ident de l'aliniament (amb els # simbols d'identitat i similitud) no te etiqueta, tambe necessita una separacio per estar ben # aliniat quan el mostrem per pantalla. # # Retorna: els vectors amb les etiquetes ja preparades i un vector amb espais. # sub LASTname{ if ($id1 =~ m/\A>([\w\W]*)/){ # si l'etiqueta identificadora de la 1a sequencia conte el simbol ">" al davant $id1 = $1; # (caracteristic del format FASTA), el treiem. } my @id1 = split(//,$id1); # a mes, ho passem a vector. if ($id2 =~ m/\A>([\w\W]*)/){ # si l'etiqueta identificadora de la 2a sequencia conte el simbol ">" al davant $id2 = $1; # (caracteristic del format FASTA), el treiem. } my @id2 = split(//,$id2); # a mes, ho passem a vector. if (scalar(@id1) > 30) { # comprovem si l'etiqueta de la 1a sequencia conte mes de 30 simbols; my @id1tall; # en cas afirmatiu, generem un vector my $i = 0; while ($i < 30) { # on hi posarem nomes els 30 primers simbols. $id1tall[$i] = $id1[$i]; $i = $i + 1; } @id1 = @id1tall; # assignem aquesta nova etiqueta "retallada" al vector inicial. } if (scalar(@id2) > 30) { # comprovem si l'etiqueta de la 2a sequencia conte mes de 30 simbols; my @id2tall; # en cas afirmatiu, generem un vector my $i = 0; while ($i < 30) { # on hi posarem nomes els 30 primers simbols. $id2tall[$i] = $id2[$i]; $i = $i + 1; } @id2 = @id2tall; # assignem aquesta nova etiqueta "retallada" al vector inicial. } my $dif = scalar(@id1) - scalar(@id2); # calculem la diferencia de longituds entre les dues etiquetes. if ($dif > 0) { # si la de la 1a sequencia es mes llarga, my $i = scalar(@id2); while (scalar(@id2) < scalar(@id1)) { # afegim espais a l'etiqueta de la 2a sequencia fins a igualar les llargades. $id2[$i] = ' '; $i = $i + 1; } } if ($dif < 0) { # si la de la 2a sequencia es mes llarga, my $i = scalar(@id1); while (scalar(@id1) < scalar(@id2)) { # afegim espais a l'etiqueta de la 1a sequencia fins a igualar les llargades. $id1[$i] = ' '; $i = $i + 1; } } my $i = scalar(@id1); # un cop ja ens hem assegurat que cap de les dues etiquetes sobrepassa els 30 simbols, my $j = $i + 6; # i que tenen la mateixa llargada (inclosos els espais afegits), while ($i < $j) { # afegim 6 espais, que separaran les etiquetes identificadores del respectius $id1[$i] = ' '; # vectors de l'aliniament. $id2[$i] = ' '; $i = $i + 1; } my @espais; # generem el vector ple d'espais per al correcte aliniament de @ident. $i = 0; while (scalar(@espais) < scalar(@id1)) { $espais[$i] = ' '; $i = $i + 1; } return (\@id1,\@id2,\@espais); # retornem la referencia dels tres vectors generats. } ######################################################################################################################################### ######################################################## EL FIN ####################################################################### #########################################################################################################################################