hhmakemodel.pl 47 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289
  1. #! /usr/bin/env perl
  2. #
  3. # hhmakemodel.pl
  4. # Generate a model from an output alignment of hhsearch.
  5. # Usage: hhmakemodel.pl -i file.out (-ts file.pdb|-al file.al) [-m int|-m name|-m auto] [-pdb pdbdir]
  6. # (C) Johannes Soeding 2012
  7. # HHsuite version 2.0.16 (February 2013)
  8. #
  9. # Reference:
  10. # Remmert M., Biegert A., Hauser A., and Soding J.
  11. # HHblits: Lightning-fast iterative protein sequence searching by HMM-HMM alignment.
  12. # Nat. Methods, epub Dec 25, doi: 10.1038/NMETH.1818 (2011).
  13. # This program is free software: you can redistribute it and/or modify
  14. # it under the terms of the GNU General Public License as published by
  15. # the Free Software Foundation, either version 3 of the License, or
  16. # (at your option) any later version.
  17. # This program is distributed in the hope that it will be useful,
  18. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  19. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  20. # GNU General Public License for more details.
  21. # You should have received a copy of the GNU General Public License
  22. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  23. # We are very grateful for bug reports! Please contact us at [email protected]
  24. use lib $ENV{"HHLIB"}."/scripts";
  25. use HHPaths; # config file with path variables for nr, blast, psipred, pdb, dssp etc.
  26. use strict;
  27. use Align;
  28. $|=1; # force flush after each print
  29. # Default parameters
  30. our $d=7; # gap opening penalty for Align.pm; more than 2 mismatches - 2 matches ## previously: 1
  31. our $e=0.01; # gap extension penatlty for Align.pm; allow to leave large gaps bridging uncrystallized regions ## previously: 0.1
  32. our $g=0.1; # endgap penalty for Align.pm; allow to shift SEQRES residues for uncrystallized aas to ends of alignment ## previously: 0.9
  33. my $v=2; # 3: DEBUG
  34. my $formatting="CASP"; # CASP or LIVEBENCH
  35. my $servername="My server"; #
  36. my $MINRES=30; # minumum number of new query residues required for a hit to be used as additional parent
  37. my $infile="";
  38. my $outfile="";
  39. my $outformat="fas";
  40. my $pickhits="1 "; # default: build one model from best hit
  41. my $Pthr=0;
  42. my $Ethr=0;
  43. my $Prob=0;
  44. my $shift=0; # ATTENTION: set to 0 as default!
  45. my $NLEN=14; # length of the name field in alignments of hhsearch-output
  46. my $NUMRES=100; # number of residues per line in FASTA, A2M, PIR format
  47. my $program=$0; # name of perl script
  48. my $usage="
  49. hhmakemodel.pl from HHsuite $VERSION
  50. From the top hits in an hhsearch output file (hhr), you can
  51. * generate a MSA (multiple sequence alignment) containing all representative
  52. template sequences from all selected alignments (options -fas, -a2m, -a3m, -pir)
  53. * generate several concatenated pairwise alignments in AL format (option -al)
  54. * generate several concatenated coarse 3D models in PDB format (option -ts)
  55. In PIR, PDB and AL format, the pdb files are required in order to read the pdb residue numbers
  56. and ATOM records.
  57. The PIR formatted file can be used directly as input to the MODELLER homology modelling package.
  58. Usage: $program [-i] file.hhr [options]
  59. Options:
  60. -i <file.hhr> results file from hhsearch with hit list and alignments
  61. -fas <file.fas> write a FASTA-formatted multiple alignment to file.fas
  62. -a2m <file.a2m> write an A2M-formatted multiple alignment to file.a2m
  63. -a3m <file.a3m> write an A3M-formatted multiple alignment to file.a3m
  64. -m <int> [<int> ...] pick hits with specified indices (default='-m 1')
  65. -p <probability> minimum probability threshold (default=$Pthr)
  66. -e <E-value> maximum E-value threshold (default=$Ethr)
  67. -q <query_ali> use the full-length query sequence in the alignment
  68. (not only the aligned part);
  69. the query alignment file must be in HHM, FASTA, A2M,
  70. or A3M format.
  71. -N use query name from hhr filename (default: use same
  72. name as in hhr file)
  73. -first include only first Q or T sequence of each hit in MSA
  74. -v verbose mode (default=$v)
  75. Options when database matches in hhr file are PDB or SCOP sequences
  76. -pir <file.pir> write a PIR-formatted multiple alignment to file.pir
  77. -ts <file.pdb> write the PDB-formatted models based on *pairwise*
  78. alignments into file.pdb
  79. -al <file.al> write the AL-formatted *pairwise* alignments into file.al
  80. -d <pdbdirs> directories containing the pdb files (for PDB, SCOP, or DALI
  81. sequences) (default=$pdbdir)
  82. -s <int> shift the residue indices up/down by an integer (default=$shift);
  83. -CASP formatting for CASP (for -ts, -al options) (default: LIVEBENCH
  84. formatting)
  85. Options when query is compared to itself (for repeat detection)
  86. -conj include also conjugate alignments in MSA (with query and
  87. template exchanged)
  88. -conjs include conjugate alignments and sort by ascending diagonal
  89. value (i.e. i0-j0)
  90. \n";
  91. # Options to help extract repeats from self-alignments:
  92. # 1. default 2. -conj 3. -conj_diag 4. -conj_compact
  93. # ABCD ABCD ---A ABCD
  94. # BCD- BCD- --AB BCDA
  95. # D--- CD-- -ABC CDAB
  96. # CD-- D--- ABCD DABC
  97. # ---A BCD-
  98. # --AB CD--
  99. # -ABC D---
  100. # Variable declarations
  101. my $line; # input line
  102. my $score=-1; # score of the best model; at the moment: Probability
  103. my $qname=""; # name of query from hhsearch output file (infile)
  104. my $tname=""; # name of template (hit) from hhsearch output file (infile)
  105. my $qnameline=""; # nameline of query
  106. my $tnameline; # nameline of template
  107. my $pdbfile; # name of pdbfile to read
  108. my $pdbcode; # four-letter pdb code in lower case and _A if chain A (e.g. 1h7w_A)
  109. my $aaq; # query amino acids from hhsearch output
  110. my @aaq; # query amino acids from hhsearch output
  111. my @qname; # query names in present alignment as returned from ReadAlignment()
  112. my @qfirst; # indices of first residues in present alignmet as returned from ReadAlignment()
  113. my @qlast; # indices of last residues in present alignmet as returned from ReadAlignment()
  114. my @qseq; # sequences of querys in present alignment as returned from ReadAlignment()
  115. my @tname; # template names in present alignment as returned from ReadAlignment()
  116. my @tfirst; # indices of first residues in present alignmet as returned from ReadAlignment()
  117. my @tlast; # indices of last residues in present alignmet as returned from ReadAlignment()
  118. my @tseq; # sequences of templates in present alignment as returned from ReadAlignment()
  119. my $aat; # template amino acids from hhsearch output
  120. my @aat; # template amino acids from hhsearch output
  121. my $aapdb; # template amino acids from pdb file
  122. my @aapdb; # template amino acids from pdb file
  123. my $qfirst=0; # first residue of query
  124. my $qlast=0; # last residue of query
  125. my $qlength; # length of query sequence
  126. my $tfirst=0; # first residue of template
  127. my $tlast=0; # first residue of template
  128. my $tlength; # length of template sequence
  129. my $l=1; # counts template residues from pdb file (first=1, like for i[col2] and j[col2]
  130. my $col1=0; # counts columns from hhsearch alignment
  131. my $col2=0; # counts columns from alignment (by function &AlignNW) of $aat versus $aapdb
  132. my @i1; # $i1[$col1] = index of query residue in column $col1 of hhsearch-alignment
  133. my @j1; # $j1[$col1] = index of template residue in column $col1 of hhsearch-alignment
  134. my @j2; # $j2[$col2] = index of hhsearch template seq in $col2 of alignment against pdb template sequence
  135. my @l2; # $l2[$col2] = index of pdb template seq in $col2 of alignment against hhsearch template sequence
  136. my @l1; # $l1[$col1] = $l2[$col2]
  137. my $res; # residue name
  138. my $chain; # pdb chain from template name
  139. my $qfile; # name of query sequence file (for -q option)
  140. my $qmatch; # number of match states in alignment
  141. my $hit; # index of hit in hit list
  142. my $k; # index of hit sorted by position in alignment with query (k=1,...,k=@first-2)
  143. my %picked=(); # $picked{$hit} is defined and =$k for hits that will be transformed into model
  144. my @remarks;
  145. my @printblock; # block 0: header block k: k'th hit
  146. my $keyword=""; # either METHOD for CASP format or REMARK for LIVEBENCH format
  147. my $conj=0; # include conjugate sequences? Sort in which way?
  148. my $conjugate=0; # when query is compared to itself: do not include conjugate alignments
  149. my $onlyfirst=0; # include only first representative sequence of each Q/T alignment
  150. my $dummy; # dummy
  151. my $addchain=1; # 1: PDB files contain chain-id as in 1abc_A.pdb (not 1abc.pdb or pdb1abc.pdb etc.)
  152. my $pdbdirs=$pdbdir; # default pdb directory with *.pdb files
  153. my $options="";
  154. # Processing command line options
  155. if (@ARGV<1) {die $usage;}
  156. for (my $i=0; $i<@ARGV; $i++) {$options.=" $ARGV[$i] ";}
  157. # Set options
  158. if ($options=~s/ -i\s+(\S+) / /g) {$infile=$1;}
  159. if ($options=~s/ -q\s+(\S+) / /g) {$qfile=$1;}
  160. if ($options=~s/ -ts\s+(\S+) / /ig) {$outfile=$1; $outformat="TS";}
  161. if ($options=~s/ -pdb\s+(\S+) / /ig) {$outfile=$1; $outformat="TS";}
  162. if ($options=~s/ -al\s+(\S+) / /ig) {$outfile=$1; $outformat="AL";}
  163. if ($options=~s/ -pir\s+(\S+) / /ig) {$outfile=$1; $outformat="PIR";}
  164. if ($options=~s/ -fas\s+(\S+) / /ig) {$outfile=$1; $outformat="FASTA";}
  165. if ($options=~s/ -a2m\s+(\S+) / /ig) {$outfile=$1; $outformat="A2M";}
  166. if ($options=~s/ -a3m\s+(\S+) / /ig) {$outfile=$1; $outformat="A3M";}
  167. if ($options=~s/ -p\s+(\S+) / /g) {$Pthr=$1;}
  168. if ($options=~s/ -e\s+(\S+) / /g) {$Ethr=$1;}
  169. if ($options=~s/ -s\s+(\S+) / /g) {$shift=$1;}
  170. if ($options=~s/ -d\s+(([^-\s]\S*\s+)*)/ /g) {$pdbdirs=$1;}
  171. if ($options=~s/ -m\s+((\d+\s+)+)/ /g) {$pickhits=$1; }
  172. if ($options=~s/ -first\s+/ /ig) {$onlyfirst=1;}
  173. # Self-alignment options
  174. if ($options=~s/ -conj\s+/ /ig) {$conj=1;}
  175. if ($options=~s/ -conjs\s+/ /ig) {$conj=2;}
  176. # Switch formatting and method description
  177. if ($options=~s/ -CASP\s+/ /ig) {$formatting="CASP";}
  178. if ($options=~s/ -LIVEBENCH\s+/ /ig) {$formatting="LIVEBENCH";}
  179. if ($options=~s/ -server\s+(\S+)/ /g) {$servername=$1;}
  180. # Set verbose mode?
  181. if ($options=~s/ -v\s+(\d+) / /g) {$v=$1;}
  182. elsif ($options=~s/ -v\s+/ /g) {$v=1;}
  183. # Read infile and outfile
  184. if (!$infile && $options=~s/^\s*([^-]\S+)\s*/ /) {$infile=$1;}
  185. if (!$outfile && $options=~s/^\s*([^-]\S+)\s*/ /) {$outfile=$1;}
  186. if ($options=~s/ -N / /ig) {
  187. $qname=$infile;
  188. $qname=~s/^.*?([^\/]+)$/$1/; # remove path
  189. $qname=~s/^(.*)\.[^\.]*$/$1/; # remove extension
  190. $qnameline=$qname;
  191. }
  192. # Warn if unknown options found or no infile/outfile
  193. if ($options!~/^\s*$/) {$options=~s/^\s*(.*?)\s*$/$1/g; die("Error: unknown options '$options'\n");}
  194. if ($infile eq "") {die("$usage\nError in $program: input file missing: $!\n");}
  195. if ($outfile eq "") {die("$usage\nError in $program: output file missing: $!\n");}
  196. my @pdbdirs = split(/\s+/,$pdbdirs);
  197. # Find query name in input file
  198. open (INFILE, "<$infile") || die "Error in $program: Couldn't open $infile: $!\n";
  199. while ($line=<INFILE>) {
  200. if ($v>=3) {print("$line");}
  201. if ($qname eq "" && $line=~/^Query:?\s*(\S+)(.*)/) {$qname=$1; $qnameline=$1.$2;}
  202. if ($line=~/^Match_columns:?\s*(\S+)/) {$qmatch=$1; last;}
  203. }
  204. if (!($line=<INFILE>)) {die ("Error in $program: wrong format in $infile: $!\n");}
  205. # Prepare hash %pick with indices of hits that will be transformed into model
  206. # No Hit Prob E-value P-value Score SS Cols Query HMM Template HMM
  207. # 1 153l Lysozyme (E.C.3.2.1.17) 100.0 0 0 381.0 19.4 185 1-185 1-185 (185)
  208. # 2 1qsa_A Soluble lytic transglyc 100.0 2.1E-39 2.5E-43 225.8 8.3 149 21-182 423-600 (618)
  209. # 3 1ltm 36 kDa soluble lytic tr 95.9 3.5E-06 4.1E-10 50.3 11.0 95 28-122 76-221 (320)
  210. # option '-m m1 m2 m3': pick models manually
  211. my @pickhits = split(/\s+/,$pickhits);
  212. $k=1;
  213. foreach $hit (@pickhits) {
  214. if (!defined $picked{$hit}) {$picked{$hit}=$k;}
  215. $k++;
  216. }
  217. if ($outformat eq "AL" || $outformat eq "TS") {
  218. &MakePairwiseAlignments();
  219. } else {
  220. &MakeMultipleAlignment();
  221. }
  222. exit;
  223. ##################################################################################
  224. # Construct AL or TS formatted alignment as a list of pairwise alignments
  225. ##################################################################################
  226. sub MakePairwiseAlignments()
  227. {
  228. # Scan through query-vs-template-alignments from infile and create first (combination) model
  229. $hit=0; # counts hits in hit list
  230. my $models=0;
  231. while ($line=<INFILE>) {
  232. if ($line=~/^>(\S+)/) {
  233. $hit++;
  234. if ($Pthr || $Ethr || defined $picked{$hit}) {
  235. # Found right alignment (hit)
  236. if (defined $picked{$hit}) {$k=$picked{$hit};} else {$k=$hit;}
  237. if ($line=~/^>(.*?)\s+E=.*$/) {
  238. $line=$1; # remove E=1.3E-30 etc. at the end
  239. } else {
  240. $line=~/^>(.*)/;
  241. $line=$1;
  242. }
  243. my $nameline=$line;
  244. my $evalue;
  245. $line=<INFILE>;
  246. if ($line=~/Probab\s*=\s*(\S+).*E-value\s*=\s*(\S+)/) {$score=$1; $evalue=$2}
  247. else {$score=0; warn("WARNING: could not print score $line");}
  248. if ($line=~/Aligned_cols=\s*(\S+)/) {;} else {warn("WARNING: could not find aligned_cols\n");}
  249. if ($Pthr && $score<$Pthr) {last;} # Probability too low -> finished
  250. if ($Ethr && $evalue>$Ethr) {last;} # Evalue too high > finished
  251. # Commented out in CASP format
  252. if ($formatting eq "LIVEBENCH") {
  253. $printblock[$k] ="PFRMAT $outformat\n";
  254. $printblock[$k].="TARGET $qname\n";
  255. }
  256. $remarks[$k]="REMARK $k: $nameline\n";
  257. $remarks[$k].="REMARK $line";
  258. &ReadAlignment();
  259. $qfirst = $qfirst[0];
  260. $qlast = $qlast[0];
  261. $aaq = $qseq[0];
  262. $tfirst = $tfirst[0];
  263. $aat = $tseq[0];
  264. $tname = $tname[0];
  265. if ($v>=3) {
  266. for (my $i=0; $i<@qfirst; $i++) {
  267. printf("Q %-14.14s %s\n",$qname[$i],$qseq[$i]);
  268. }
  269. printf("\n");
  270. for (my $i=0; $i<@tfirst; $i++) {
  271. printf("T %-14.14s %s\n",$tname[$i],$tseq[$i]);
  272. }
  273. printf("\n");
  274. }
  275. # Extract pdbcode and construct name of pdbfile and return in global variables $pdbid and $chain
  276. if (&ExtractPdbcodeAndChain($tname[0])) {next;}
  277. if ($chain eq "[A ]") {$pdbcode.="_A";} elsif ($chain eq ".") {;} else {$pdbcode.="_$chain";}
  278. # Read score (=probability)
  279. $printblock[$k].="REMARK $nameline\n";
  280. $printblock[$k].="REMARK $line";
  281. $printblock[$k].="SCORE $score\n";
  282. $printblock[$k].="PARENT $pdbcode\n";
  283. $printblock[$k].="MODEL $k\n";
  284. &WritePairwiseAlignments();
  285. $printblock[$k].="END\n";
  286. $models++;
  287. }
  288. }
  289. }
  290. $k=$#printblock; # set $k to last index in @printblock
  291. if ($k<0) {
  292. $printblock[1]="PARENT NONE\nTER\n";
  293. $printblock[1].="END\n";
  294. if ($v>=1) {print("WARNING: no hits found for model!\n");}
  295. }
  296. close (INFILE);
  297. if ($v>=2) {
  298. printf("$models models built\n");
  299. }
  300. # Write model file header
  301. #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
  302. # Print header
  303. my $date = scalar(localtime);
  304. if ($formatting eq "CASP") {
  305. $printblock[0]="PFRMAT $outformat\n";
  306. $printblock[0].="TARGET $qname\n";
  307. }
  308. $printblock[0].="REMARK AUTHOR $servername\n";
  309. $printblock[0].="REMARK $date\n";
  310. # $printblock[0].="REMARK J. Soeding \n";
  311. # Add remarks
  312. for ($k=0; $k<@remarks; $k++) {
  313. if (defined $remarks[$k]) {
  314. $printblock[0].=$remarks[$k];
  315. }
  316. }
  317. $printblock[0].="REMARK \n";
  318. # Print @printblock into outfile
  319. open (OUTFILE, ">$outfile") || die "Error in $program: Couldn't open $outfile: $!\n";
  320. foreach my $printstr (@printblock) {
  321. my @printarr=split(/\n/,$printstr);
  322. if ($outformat eq "TS") {
  323. foreach $printstr (@printarr) {
  324. printf(OUTFILE "%-80.80s\n",$printstr);
  325. }
  326. } else {
  327. foreach $printstr (@printarr) {
  328. printf(OUTFILE "%s\n",$printstr);
  329. }
  330. }
  331. }
  332. close (OUTFILE);
  333. if ($outformat eq "TS") {
  334. # Call MaxSprout to generate sidechains
  335. }
  336. return;
  337. }
  338. ##################################################################################
  339. # Construct multiple alignment in FASTA, A2M, or PIR format
  340. ##################################################################################
  341. sub MakeMultipleAlignment()
  342. {
  343. my @hitnames=(); # $hitnames[$k] is the nameline of the ihit'th hit
  344. my @hitseqs=(); # $hitseqs[$k] contains the residues of the ihit'th hit
  345. my @hitdiag=(); # $hitdiag[$k] = $qfirst[0]-$tfirst[0]
  346. my @conjnames=(); # $hitnames[$k] is the nameline of the ihit'th conjugate hit
  347. my @conjseqs=(); # $hitseqs[$k] contains the residues of the ihit'th conjugate hit
  348. my @conjdiag=(); # $hitdiag[$k] = $qfirst[0]-$tfirst[0] for conjugate alignments
  349. my $new_hit; # residues of new hit
  350. my $i; # residue index
  351. my $j; # residue index
  352. my $k; # sequence index
  353. $hitnames[0]="";
  354. $hitseqs[0]="";
  355. $hitdiag[0]=0;
  356. $conjnames[0]="";
  357. $conjseqs[0]="";
  358. $conjdiag[0]=0;
  359. open (INFILE, "<$infile") || die "Error in $program: Couldn't open $infile: $!\n";
  360. $hit=0; # counts hits in hit list
  361. # Read one alignment after the other
  362. while ($line=<INFILE>) {
  363. # Found new aligment
  364. if ($line=~/^>(\S+)/) {
  365. $hit++;
  366. # Is alignment selected by user?
  367. if ($Pthr || $Ethr || defined $picked{$hit}) {
  368. if ($line=~/^>(\S+)(.*)/) {$tname=$1; $tnameline=$1.$2;}
  369. else {die("\nError: bad format in $infile, line $.: code 1\n");}
  370. $line = <INFILE>;
  371. if ($line=~/Probab\s*=\s*(\S+).*E-value\s*=\s*(\S+)/) {
  372. if ($Pthr && $1<$Pthr) {last;} # Probability too low -> finished
  373. if ($Ethr && $2>$Ethr) {last;} # Evalue too high > finished
  374. } else { die("\nError: bad format in $infile, line $.: code 2\n"); }
  375. # Read next alignment with $aaq, $qfirst, @tseq, @first, and @tname
  376. &ReadAlignment();
  377. chomp($tnameline);
  378. if ($tnameline=~/\S+\s+(.*)/) {$tname[0].=" $1";} # template seed sequence gets its description
  379. # Format sequences into @hitseqs and @hitnames
  380. &FormatSequences(\@hitnames,\@hitseqs,\@hitdiag,\@qname,\@qseq,\@qfirst,\@qlast,\$qlength,\@tname,\@tseq,\@tfirst,\@tlast,\$tlength);
  381. # Use conjugate alignments?
  382. if ($conj>0) {
  383. &FormatSequences(\@conjnames,\@conjseqs,\@conjdiag,\@tname,\@tseq,\@tfirst,\@tlast,\$tlength,\@qname,\@qseq,\@qfirst,\@qlast,\$qlength);
  384. }
  385. } # end: if ($Pthr>0 || defined $picked{$hit})
  386. } # end: if ($line=~/^>(\S+)/) # found new alignment
  387. } # end while
  388. close (INFILE);
  389. # Insert full-length query sequence?
  390. if ($qfile) {
  391. $hitseqs[0]="";
  392. open (QFILE, "<$qfile") || die "Error in $program: Couldn't open $qfile: $!\n";
  393. while ($line=<QFILE>) {
  394. if ($line=~/^>/ && $line!~/^>ss_/ && $line!~/^>sa_/ && $line!~/^>aa_/ && $line!~/^>Consensus/) {last;}
  395. }
  396. while ($line=<QFILE>) {
  397. if ($line=~/^>/ || $line=~/^\#/) {last;}
  398. $line=~tr/\n\.-//d;
  399. $line=~tr/a-z/A-Z/;
  400. $hitseqs[0].=$line;
  401. }
  402. close(QFILE);
  403. if ($v>=2) {printf("\nQ(full) %-14.14s %s\n",$qname,$hitseqs[0]);}
  404. }
  405. # DEBUG
  406. if ($v>=3) {
  407. printf("\nQuery %-14.14s %s\n",$qname,$hitseqs[0]);
  408. for ($k=1; $k<@hitnames; $k++) {
  409. printf("T hit %3i %-14.14s %s\n",$k,$hitnames[$k],$hitseqs[$k]);
  410. }
  411. printf("\n");
  412. printf("\nQuery %-14.14s %s\n",$qname,$conjseqs[0]);
  413. for ($k=1; $k<@conjnames; $k++) {
  414. printf("T conj %3i %-14.14s %s\n",$k,$conjnames[$k],$conjseqs[$k]);
  415. }
  416. printf("\n");
  417. }
  418. # Include conjugate sequences?
  419. if ($conj>0) {
  420. shift(@conjseqs); # delete zeroth ("query") sequence of @conjseqs
  421. shift(@conjnames); #
  422. shift(@conjdiag); #
  423. # Sort by diagonals $hitdiag[], $conjdiag[]
  424. &Sort(\@hitdiag,\@hitseqs,\@hitnames);
  425. &Sort(\@conjdiag,\@conjseqs,\@conjnames);
  426. # Append conjugate sequences to hitseqs
  427. splice(@hitseqs,scalar(@hitseqs),0,@conjseqs);
  428. splice(@hitnames,scalar(@hitnames),0,@conjnames);
  429. if ($v>=3) {
  430. printf("\nQuery %-14.14s %s\n",$qname,$hitseqs[0]);
  431. for ($k=1; $k<@hitnames; $k++) {
  432. chomp($hitnames[$k]);
  433. printf("T tot %3i %-14.14s %s\n",$k,$hitnames[$k],$hitseqs[$k]);
  434. $hitnames[$k].="\n";
  435. }
  436. }
  437. }
  438. # Insert gaps:
  439. my @len_ins; # $len_ins[$j] will count the maximum number of inserted residues after match state $j.
  440. my @inserts; # $inserts[$j] contains the insert (in small case) of sequence $k after the $j'th match state
  441. my $insert;
  442. my $ngap;
  443. # For each match state determine length of LONGEST insert after this match state and store in @len_ins
  444. for ($k=0; $k<@hitnames; $k++) {
  445. # split into list of single match states and variable-length inserts
  446. # ([A-Z]|-) is the split pattern. The parenthesis indicate that split patterns are to be included as list elements
  447. # The '#' symbol is prepended to get rid of a perl bug in split
  448. $j=0;
  449. @inserts = split(/([A-Z]|-)/,"#".$hitseqs[$k]."#");
  450. # printf("Sequence $k: $hitseqs[$k]\n");
  451. # printf("Sequence $k: @inserts\n");
  452. foreach $insert (@inserts) {
  453. if( !defined $len_ins[$j] || length($insert)>$len_ins[$j]) {
  454. $len_ins[$j]=length($insert);
  455. }
  456. $j++;
  457. # printf("$insert|");
  458. }
  459. # printf("\n");
  460. }
  461. # After each match state insert residues and fill up with gaps to $len_ins[$i] characters
  462. for ($k=0; $k<@hitnames; $k++) {
  463. # split into list of single match states and variable-length inserts
  464. @inserts = split(/([A-Z]|-)/,"#".$hitseqs[$k]."#");
  465. $j=0;
  466. # append the missing number of gaps after each match state
  467. foreach $insert (@inserts) {
  468. if($outformat eq "FASTA") {
  469. for ($i=length($insert); $i<$len_ins[$j]; $i++) {$insert.="-";}
  470. }
  471. else {
  472. for ($i=length($insert); $i<$len_ins[$j]; $i++) {$insert.=".";}
  473. }
  474. $j++;
  475. }
  476. $hitseqs[$k] = join("",@inserts);
  477. $hitseqs[$k] =~ tr/\#//d; # remove the '#' symbols inserted at the beginning and end
  478. }
  479. # Remove columns at beginning and end with gaps in all sequences
  480. my $remove_start;
  481. my $remove_end;
  482. my $len;
  483. $hitseqs[0]=~/^(-*)/;
  484. $remove_start=length($1);
  485. $hitseqs[0]=~/(-*)$/;
  486. $remove_end=length($1);
  487. for ($k=0; $k<@hitnames; $k++) {
  488. $hitseqs[$k]=~s/^.{$remove_start}(.*).{$remove_end}/$1/;
  489. }
  490. $len=($hitseqs[0]=~tr/a-zA-Z/a-zA-Z/);
  491. # Prepare name line of query
  492. if ($outformat eq "PIR") {
  493. my $qnametmp=$qname;
  494. $qnametmp=~tr/:/;/;
  495. $qnameline=~/^\S+\s*(.*)/;
  496. my $qnamelinetmp=$1;
  497. $qnamelinetmp=~tr/:/;/;
  498. $hitnames[0] = sprintf(">P1;%s\nsequence:%s:%4i: :%4i: :%s: : 0.00: 0.00\n",$qnametmp,$qnametmp,$remove_start+1,$len+$remove_start,$qnamelinetmp);
  499. } else {
  500. # outformat is "FASTA" or "A2M" or "A3M" or ...
  501. $hitnames[0] = ">$qnameline\n";
  502. }
  503. # If pretty diagonally sorted order is wanted...
  504. if ($conj>0) {
  505. if ($conj==2) {
  506. my $center = 0.5*(scalar(@hitseqs)-1);
  507. @conjseqs = splice(@hitseqs,$center+1,$center);
  508. splice(@hitseqs,0,0,@conjseqs);
  509. @hitseqs = reverse(@hitseqs);
  510. @conjnames = splice(@hitnames,$center+1,$center);
  511. splice(@hitnames,0,0,@conjnames);
  512. @hitnames = reverse(@hitnames);
  513. # Shorten namelines of all but first sequence
  514. my %count;
  515. for ($k=0; $k<@hitnames; $k++) {
  516. if ($k==$center) {$k++;}
  517. $hitnames[$k]=~/(\S{1,14})/;
  518. if (!defined $count{$1}) {$count{$1}=0;}
  519. my $count = ++$count{$1};
  520. # printf("vorher: %s ",$hitnames[$k]);
  521. $hitnames[$k]=~s/^(\S{1,14}).*/$1:$count/;
  522. # printf("nachher: %s\n",$hitnames[$k]);
  523. }
  524. } else {
  525. for ($k=0; $k<@hitnames; $k++) {$hitnames[$k]=">$qname\n";}
  526. }
  527. }
  528. # Remove gaps? Captialize?
  529. if ($outformat eq "PIR") {
  530. for ($k=0; $k<@hitnames; $k++) {
  531. $hitseqs[$k].="*";; # Transform to upper case
  532. $hitseqs[$k]=~tr/a-z./A-Z-/; # Transform to upper case
  533. $hitseqs[$k]=~s/(.{1,$NUMRES})/$1\n/g; # insert newlines every NUMRES positions
  534. }
  535. } elsif ($outformat eq "FASTA") {
  536. for ($k=0; $k<@hitnames; $k++) {
  537. $hitseqs[$k]=~tr/a-z./A-Z-/; # Transform to upper case
  538. $hitseqs[$k]=~s/(.{1,$NUMRES})/$1\n/g; # insert newlines every NUMRES positions
  539. }
  540. } elsif ($outformat eq "A2M") {
  541. for ($k=0; $k<@hitnames; $k++) {$hitseqs[$k]=~s/(.{1,$NUMRES})/$1\n/g;} # insert newlines every NUMRES positions
  542. } elsif ($outformat eq "A3M") {
  543. for ($k=0; $k<@hitnames; $k++) {$hitseqs[$k]=~tr/.//d;$hitseqs[$k].="\n";} # Remove gaps aligned to inserts
  544. }
  545. # Write sequences into output file
  546. open (OUTFILE, ">$outfile") || die ("cannot open $outfile:$!");
  547. for ($k=0; $k<@hitnames; $k++) {
  548. print(OUTFILE "$hitnames[$k]$hitseqs[$k]");
  549. }
  550. close OUTFILE;
  551. if ($v>=2) {
  552. printf("%i sequences written to $outfile\n",scalar(@hitnames));
  553. }
  554. }
  555. # Format sequences into @hitseqs and @hitnames
  556. # & Call with FormatSequences(\@hitnames,\@hitseqs,\@qname,\@qseq,\@qfirst,\@qlast,\$qlength,\@tname,\@tseq,\@tfirst,\@tlast,\$tlength);
  557. sub FormatSequences()
  558. {
  559. my $p_hitnames = $_[0]; # typeglob to $hitname
  560. my $p_hitseqs = $_[1]; # ...
  561. my $p_hitdiag = $_[2]; # ...
  562. my $p_qname = $_[3]; #
  563. my $p_qseq = $_[4]; #
  564. my $p_qfirst = $_[5]; #
  565. my $p_qlast = $_[6]; #
  566. my $p_qlength = $_[7]; #
  567. my $p_tname = $_[8]; #
  568. my $p_tseq = $_[9]; #
  569. my $p_tfirst = $_[10]; #
  570. my $p_tlast = $_[11]; #
  571. my $p_tlength = $_[12]; #
  572. my $i;
  573. if ($v>=2) {
  574. if (defined $picked{$hit}) {
  575. print("hit=$hit picked=$picked{$hit} tname=$tname[0]");
  576. } else {
  577. print("hit=$hit picked=evalue<$Ethr tname=$tname[0]");
  578. }
  579. for (my $i=1; $i<@{$p_tname}; $i++) {
  580. print(", $tname[$i]");
  581. }
  582. print("\n");
  583. }
  584. my $qfirst = ${$p_qfirst}[0];
  585. my $qlast = ${$p_qlast}[0];
  586. my $qlength = ${$p_qlength};
  587. my $aaq = ${$p_qseq}[0];
  588. @aaq = unpack("C*",$aaq); # needed for transforming template sequences into a3m based on query residues (NOT HMM match states!)
  589. $aaq=~tr/.-//d; # remove all gaps from query sequence
  590. # For all template sequences in the present alignment
  591. for (my $k=0; $k<@{$p_tname}; $k++) {
  592. $tname =${$p_tname}[$k];
  593. $tfirst=${$p_tfirst}[$k];
  594. $aat =${$p_tseq}[$k];
  595. # Transform template residues into a3m format:
  596. # match states are those where query has residue (NOT where HMM has match state!)
  597. # This makes sense since we want to build a model for the query sequence.
  598. @aat = unpack("C*",$aat);
  599. $aat="";
  600. # Transform all columns with residue in query into match/delete states, all others to inserts
  601. for ($i=0; $i<scalar(@aaq); $i++) {
  602. if ($aaq[$i]!=45 && $aaq[$i]!=46) { # no gap in query
  603. if($aat[$i]==46) {
  604. $aat.="-"; # transform '.' to '-' if aligned with a query residue
  605. } else {
  606. $aat .= uc(chr($aat[$i])); # UPPER case if aligned with a query residue (match state)
  607. }
  608. } else {
  609. if($aat[$i]!=45 && $aat[$i]!=46) { # no gap in template?
  610. $aat.=lc(chr($aat[$i])); # lower case if aligned with a gap in the query (insert state)
  611. }
  612. }
  613. }
  614. if ($v>=2) {
  615. printf("\nQ %-14.14s %s\n",$qname,$aaq);
  616. printf("T %-14.14s %s\n",$tname,$aat);
  617. }
  618. # Outformat is PIR? => read residues and indices from PDB ATOM records
  619. if ($outformat eq "PIR") {
  620. # Extract pdbcode and construct name of pdbfile and return in global variables $pdbid and $chain
  621. if (&ExtractPdbcodeAndChain($tname)) {next;}
  622. # Read sequence from pdb file
  623. if (!open (PDBFILE, "$pdbfile")) {
  624. die ("Error in $program: Couldn't open $pdbfile: $!\n");
  625. }
  626. $aapdb="";
  627. $l=0;
  628. my @nres; # $nres[$l] = pdb residue index for residue $aapdb[$l]
  629. my $nres=-1e6;
  630. my $resolution=-1.00;
  631. my $rvalue=-1.00;
  632. my $chain_started=0;
  633. while ($line=<PDBFILE>) {
  634. if ($line=~/^REMARK.*RESOLUTION\.\s+(\d+\.?\d*)/) {$resolution=$1;}
  635. if ($line=~/^REMARK.*R VALUE\s+\(WORKING SET\)\s+:\s+(\d+\.?\d*)/) {$rvalue=$1;}
  636. if ($line=~/^ENDMDL/) {last;} # if file contains NMR models read only first one
  637. if ($line=~/^TER / && $chain_started==1) {last;} # Chain is terminated; this is needed since single MET or other amino acids not linked with chain can be designated part of same chain (e.g. see MET A 772 in pdb1u1j.ent)
  638. if (($line=~/^ATOM\s+\d+ .. [ A](\w{3}) $chain\s*(-?\d+.)/ ||
  639. ($line=~/^HETATM\s+\d+ .. [ A](\w{3}) $chain\s*(-?\d+.)/ && &Three2OneLetter($1) ne "X") ) &&
  640. $2 ne $nres ) {
  641. $res=$1;
  642. $nres=$2;
  643. $nres[$l]=$2;
  644. $res=&Three2OneLetter($res);
  645. $aapdb[$l++]=$res;
  646. $aapdb.=$res;
  647. $chain_started=1;
  648. }
  649. }
  650. close (PDBFILE);
  651. if (length($aapdb)<=0) {die("Error: chain $chain not found in pdb file $pdbfile\n");}
  652. # Align template in hh-alignment ($aat) with template sequence in pdb ($aapdb)
  653. my $xseq=$aat;
  654. $xseq=~tr/-/~/; # transform Deletes to '~' to distinguish them from gaps '-' inserted by Align.pm
  655. my $yseq=$aapdb;
  656. my ($jmin,$jmax,$lmin,$lmax);
  657. my $Sstr;
  658. my $score;
  659. # The aligned characters are returend in $j2[$col2] and $l2[$col2]
  660. $score=&AlignNW(\$xseq,\$yseq,\@j2,\@l2,\$jmin,\$jmax,\$lmin,\$lmax,\$Sstr);
  661. # DEBUG
  662. if ($v>=3) {
  663. printf("Template (hh) $xseq\n");
  664. printf("Identities $Sstr\n");
  665. printf("Template (pdb) $yseq\n");
  666. printf("\n");
  667. if ($v>=4) {
  668. for ($col2=0; $col2<@l2 && $col2<1000; $col2++) {
  669. printf("%3i %3i:%s %3i:%s -> %i\n",$col2,$j2[$col2],substr($aat,$j2[$col2]-1,1),$l2[$col2],substr($aapdb,$l2[$col2]-1,1),$nres[$l2[$col2]-1]);
  670. }
  671. }
  672. }
  673. # check for reasonable alignment
  674. my $num_match = 0;
  675. for ($i=0; $i<@l2; $i++) {
  676. if ($j2[$i] > 0 && $l2[$i] > 0) {
  677. $num_match++;
  678. }
  679. }
  680. if (($score/$num_match) < 1) {
  681. print "WARNING! Match score with PDBfile (score: $score num: $num_match score/num:".($score/$num_match).") to low => $pdbfile not included!\n";
  682. next;
  683. }
  684. # Assign a3m-formatted amino acid sequence from pdb file to $aapdb
  685. $aapdb="";
  686. my @xseq=unpack("C*",$xseq);
  687. my @yseq=unpack("C*",$yseq);
  688. for ($i=0; $i<@yseq; $i++) {
  689. if(($xseq[$i]>=65 && $xseq[$i]<=90) || $xseq[$i]==ord('~')) { # if $aat has upper case residue or Delete state
  690. # Match state
  691. $aapdb.=uc(chr($yseq[$i]));
  692. } else {
  693. # Insert state
  694. if ($yseq[$i]!=45) {$aapdb.=lc(chr($yseq[$i]));} # add only if not a gap '-'
  695. }
  696. }
  697. # Remove overlapping ends of $aapdb
  698. $aapdb=~s/^[a-z]*(.*?)[a-z]*$/$1/;
  699. # Glue gaps at beginning and end of aligned pdb sequence and add sequence to alignment
  700. push (@{$p_hitseqs}, ("-" x ($qfirst-1)).$aapdb.("-" x ($qlength-$qlast)) ); # use ATOM record residues $aapdb!
  701. # Write hitname in PIR format into @hitnames
  702. my $descr;
  703. my $organism;
  704. my $struc=$pdbcode;
  705. if ($tnameline=~/^(\S+)\s+(.*)/) {$descr=$2; $descr=~tr/://d;} else {$descr=" ";}
  706. if ($tnameline=~/^(\S+)\s+.*\s+\{(.*)\}/) {$organism=$2;} else {$organism=" ";}
  707. if (length($chain)>1 || $chain eq ".") { # MODELLER's special symbol for 'chain unspecified'
  708. $chain=".";
  709. } elsif ($addchain && $chain ne " ") {
  710. $struc.="_$chain";
  711. }
  712. # push (@{$p_hitnames}, sprintf(">P1;%s\nstructureX:%4s:%4i:%1s:%4i:%1s:%s:%s:%-.2f:%-.2f\n",$struc,$struc,$nres[$lmin-1],$chain,$nres[$lmax-1],$chain,$descr,$organism,$resolution,$rvalue) );
  713. my $descrtmp=$descr;
  714. $descrtmp=~tr/:/;/;
  715. $organism=~tr/://d;
  716. push (@{$p_hitnames}, sprintf(">P1;%s\nstructureX:%4s: :%1s: :%1s:%s:%s:%-.2f:%-.2f\n",$struc,$struc,$chain,$chain,$descrtmp,$organism,$resolution,$rvalue) );
  717. push (@{$p_hitdiag}, $tfirst-$qfirst);
  718. } else {
  719. # outformat is "FASTA" or "A2M" or "A3M" or ...
  720. # Write hitname in FASTA format into @hitnames
  721. push (@{$p_hitseqs}, ("-" x ($qfirst-1)).$aat.("-" x ($qlength-$qlast)) );
  722. push (@{$p_hitnames}, ">$tname\n" );
  723. push (@{$p_hitdiag}, $tfirst-$qfirst);
  724. }
  725. if ($onlyfirst>0) {last;} # extract only first (seed?) sequence in each alignment
  726. } # end: for (my $k=0; $k<@{$tname}; $k++)
  727. # Paste aligned subsequence of query over $hitseqs[0]
  728. if (${$p_hitseqs}[0] eq "") {${$p_hitseqs}[0] = "-" x $qlength;}
  729. if (!$qfile) {substr(${$p_hitseqs}[0],$qfirst-1,length($aaq),$aaq);}
  730. return;
  731. }
  732. ##################################################################################
  733. # Read Alignment from infile (*.hhr file)
  734. # Results:
  735. # $aaq: query residues in present alignment
  736. # $qfirst: index of first query residue in present alignment
  737. # @tname: template names in present alignmen
  738. # @tfirst: indices of first residues in present alignmet
  739. # @tseq: sequences of templates in present alignment
  740. ##################################################################################
  741. sub ReadAlignment() {
  742. @qname=(); # name of $it'th query in this alignment
  743. @qfirst=(); # index of first residue in $it'th query in this alignment
  744. @qlast=(); # index of last residue in $it'th query in this alignment
  745. @qseq=(); # residues of $it'th query in this alignment
  746. @tname=(); # name of $it'th template in this alignment
  747. @tfirst=(); # index of first residue in $it'th template in this alignment
  748. @tlast=(); # index of last residue in $it'th template in this alignment
  749. @tseq=(); # residues of $it'th template in this alignment
  750. if ($v>=3) {printf("Searching for Q $qname vs T $tname\n");}
  751. $line=<INFILE>;
  752. # Search for first line beginning with Q ot T and not followed by aa_, ss_pred, ss_conf, or Consensus
  753. while (1) {
  754. my $i; # index for query sequence in this alignment
  755. # Scan up to first line starting with Q; stop when line 'No\s+\d+' or 'Done' is found
  756. while (defined $line && $line!~/^Q\s(\S+)/) {
  757. if ($line=~/^No\s+\d/ || $line=~/^Done/) {last;}
  758. $line=<INFILE>; next;
  759. }
  760. if (!defined $line || $line=~/^No\s+\d/ || $line=~/^Done/) {last;}
  761. # Scan up to first line that is not secondary structure line or consensus line
  762. while (defined $line && $line=~/^Q\s+(ss_|sa_|aa_|Consens|Cons-)/) {$line=<INFILE>;}
  763. # Read next block of query sequences
  764. $i=0;
  765. while ($line=~/^Q\s+/) {
  766. if ($line!~/^Q\s+(ss_|sa_|aa_|Consens|Cons-)/ && $line=~/^Q\s*(\S+)\s+(\d+)\s+(\S+)\s+(\d+)\s+\((\d+)/) {
  767. $qname[$i]=$1;
  768. if (!$qfirst[$i]) {$qfirst[$i]=$2;} # if $qfirst is undefined then this is the first alignment block -> set $qfirst to $1
  769. if (!$qseq[$i]) {$qseq[$i]=$3;} else {$qseq[$i].=$3;}
  770. $qlast[$i]=$4;
  771. if ($i==0) {$qlength=$5}
  772. $i++;
  773. }
  774. $line=<INFILE>;
  775. }
  776. if ($i==0) {
  777. die("\nError in $program: bad format in $infile, line $.: query block\n");
  778. }
  779. # Scan up to first line starting with T
  780. while (defined $line && $line!~/^T\s+(\S+)/) {$line=<INFILE>;}
  781. # Scan up to first line that is not secondary structure line or consensus line
  782. while (defined $line && $line=~/^T\s+(ss_|sa_|aa_|Consens|Cons-)/) {$line=<INFILE>;}
  783. # Read next block of template sequences
  784. $i=0;
  785. while ($line=~/^T\s+/) {
  786. if ($line!~/^T\s+(ss_|sa_|aa_|Consens|Cons-)/ && $line=~/^T\s*(\S+)\s+(\d+)\s+(\S+)\s+(\d+)\s+\((\d+)/){
  787. $tname[$i]=$1;
  788. if (!$tfirst[$i]) {$tfirst[$i]=$2;} # if $tfirst is undefined then this is the first alignment block -> set $tfirst to $1
  789. if (!$tseq[$i]) {$tseq[$i]=$3;} else {$tseq[$i].=$3;}
  790. $tlast[$i]=$4;
  791. if ($i==0) {$tlength=$5}
  792. $i++;
  793. }
  794. $line=<INFILE>;
  795. }
  796. if ($i==0) {
  797. die("\nError in $program: bad format in $infile, line $.: template block\n");
  798. }
  799. } # end while ($line=<INFILE>)
  800. # if (!$qfirst) {$qfirst=1;} # if still $qfirst==0 then set $qfirst to 1
  801. # for (my $i=0; $i<@tfirst; $i++) {
  802. # if (!$tfirst[$i]) {$tfirst[$i]=1;} # if still $tfirst[$i]==0 then set $tfirst to 1
  803. # }
  804. # Check lengths
  805. if (length($qseq[0])!=length($tseq[0])) {
  806. print("\nError: query and template lines do not have the same length in $infile, line $.\n");
  807. for (my $i=0; $i<@qfirst; $i++) {
  808. printf("Q %-14.14s %s\n",$qname[$i],$qseq[$i]);
  809. }
  810. printf("\n");
  811. for (my $i=0; $i<@tfirst; $i++) {
  812. printf("T %-14.14s %s\n",$tname[$i],$tseq[$i]);
  813. }
  814. printf("\n");
  815. exit 1;
  816. }
  817. if ($v>=3) {
  818. for (my $i=0; $i<@qfirst; $i++) {
  819. printf("Q %-14.14s %s\n",$qname[$i],$qseq[$i]);
  820. }
  821. printf("\n");
  822. for (my $i=0; $i<@tfirst; $i++) {
  823. printf("T %-14.14s %s\n",$tname[$i],$tseq[$i]);
  824. }
  825. printf("\n");
  826. }
  827. return;
  828. }
  829. ##################################################################################
  830. # Write Alignment to $printblock[$k]
  831. ##################################################################################
  832. sub WritePairwiseAlignments() {
  833. #Delete columns with gaps in both sequences
  834. $aaq=uc($aaq);
  835. $aat=uc($aat);
  836. @aaq=split(//,$aaq);
  837. @aat=split(//,$aat);
  838. my $col=0;
  839. for ($col1=0; $col1<@aaq; $col1++) {
  840. if ($aaq[$col1]=~tr/a-zA-Z/a-zA-Z/ || $aat[$col1]=~tr/a-zA-Z/a-zA-Z/) {
  841. $aaq[$col]=$aaq[$col1];
  842. $aat[$col]=$aat[$col1];
  843. $col++;
  844. }
  845. }
  846. splice(@aaq,$col); # delete end of @aaq;
  847. splice(@aat,$col);
  848. $aaq=join("",@aaq);
  849. $aat=join("",@aat);
  850. # Count query and template residues into @i1 and @j1
  851. for ($col1=0; $col1<@aaq; $col1++) {
  852. if ($aaq[$col1]=~tr/a-zA-Z/a-zA-Z/) {
  853. $i1[$col1]=$qfirst++; #found query residue in $col1
  854. } else {
  855. $i1[$col1]=0; #found gap in $col1
  856. }
  857. if ($aat[$col1]=~tr/a-zA-Z/a-zA-Z/) {
  858. $j1[$col1]=$tfirst++; #found template residue in $col1
  859. } else {
  860. $j1[$col1]=0; #found gap in $col1
  861. }
  862. }
  863. # DEBUG
  864. if ($v>=3) {
  865. printf ("col Q i1 T j1\n");
  866. for ($col1=0; $col1<@aaq; $col1++) {
  867. printf ("%3i %s %3i %s %3i\n",$col1,$aaq[$col1],$i1[$col1],$aat[$col1],$j1[$col1]);
  868. }
  869. printf ("\n");
  870. }
  871. # Read protein chain from pdb file
  872. # ----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
  873. # ATOM 1 N SER A 27 38.637 79.034 59.693 1.00 79.70 # ATOM 2083 CD1 LEU A 22S 15.343 -12.020 43.761 1.00 5.00 C
  874. # Extract pdbcode and construct name of pdbfile and return in global variables $pdbid and $chain
  875. if (&ExtractPdbcodeAndChain($tname)) {next;}
  876. # Read sequence from pdb file
  877. if (! defined $pdbfile) {die ("Error in $program: Couldn't find pdb code in $tname\n");}
  878. open (PDBFILE, "$pdbfile") || die ("Error in $program: Couldn't open $pdbfile: $!\n");
  879. if ($chain eq "[A ]") {$pdbcode.="_A";} elsif ($chain eq ".") {;} else {$pdbcode.="_$chain";}
  880. $aapdb=""; $l=1;
  881. $line=<PDBFILE>;
  882. while ($line) {if ($line=~/^ATOM/) {last;} $line=<PDBFILE>;} # advance to ATOM records
  883. my @nres; # $nres[$l] = pdb residue index for residue $aapdb[$l]
  884. my @coord; # $coord[$l] = coordinates of CA atom of residue $aapdb[$l]
  885. while ($line) {
  886. if ($line=~/^ATOM\s+\d+ CA [ AB](\w{3}) $chain\s*(-?\d+.) (\s*\S+\s+\S+\s+\S+)/ ||
  887. ($line=~/^HETATM\s+\d+ CA [ AB](\w{3}) $chain\s*(-?\d+.) (\s*\S+\s+\S+\s+\S+)/ && &Three2OneLetter($1) ne "X") ) {
  888. $res=$1;
  889. $nres[$l]=$2;
  890. $coord[$l]=$3." 1.00";
  891. $res=&Three2OneLetter($res);
  892. $aapdb[$l]=$res;
  893. $aapdb.=$res;
  894. $l++;
  895. }
  896. elsif ($l>10 && $line=~/^ATOM\s+\d+ CA/) {last;}
  897. elsif ($line=~/^ENDMDL/) {last;} # if file contains NMR models read only first one
  898. $line=<PDBFILE>;
  899. }
  900. close (PDBFILE);
  901. # Align template in hh-alignment ($aat) with template sequence in pdb ($aapdb)
  902. my $xseq=$aat;
  903. my $yseq=$aapdb;
  904. my ($jmin,$jmax,$lmin,$lmax);
  905. my $Sstr;
  906. my $score;
  907. $xseq=~tr/-/~/d; # transform Deletes to '~' to distinguish them from gaps inserted by Align.pm
  908. #the aligned characters are returend in $j2[$col2] and $l2[$col2]
  909. if ($v>=3) {
  910. printf("Template (hh) $xseq\n");
  911. printf("Identities $Sstr\n");
  912. printf("Template (pdb) $yseq\n");
  913. printf("\n");
  914. }
  915. $score=&AlignNW(\$xseq,\$yseq,\@j2,\@l2,\$jmin,\$jmax,\$lmin,\$lmax,\$Sstr);
  916. # DEBUG
  917. if ($v>=3) {
  918. printf("Template (hh) $xseq\n");
  919. printf("Identities $Sstr\n");
  920. printf("Template (pdb) $yseq\n");
  921. printf("\n");
  922. if ($v>=4) {
  923. for ($col2=0; $col2<@l2 && $col2<200; $col2++) {
  924. printf("%3i %3i %3i\n",$col2,$j2[$col2],$l2[$col2]);
  925. }
  926. }
  927. }
  928. # DEBUG
  929. # Construct alignment of $aaq <-> $aapdb via alignments $aaq <-> $aat and $aat <-> $aapdb:
  930. # Find $l1[$col1] = line of pdb file corresponding to residue $aat[$col1] and $aaq[$col1]
  931. $col2=0;
  932. for ($col1=0; $col1<@aaq; $col1++) {
  933. if ($j1[$col1]==0 || $i1[$col1]==0) {$l1[$col1]=0; next;} # skip gaps in query and gaps in template
  934. while ($j2[$col2]<$col1+1) {$col2++;} # in $j2[col2] first index is 1, in $col1 first column is 0
  935. $l1[$col1] = $l2[$col2];
  936. if ($v>=4) {printf("l1[%i]=%i l2[%i]=%i\n",$col1,$l1[$col1],$col2,$l2[$col2]);}
  937. }
  938. if ($pdbcode ne "NONE") {
  939. if ($outformat eq "TS") {
  940. for ($col1=0; $col1<@aat; $col1++) {
  941. if ($i1[$col1]==0) {next;} # skip gaps in query
  942. if ($j1[$col1]==0) {next;} # skip gaps in template sequence
  943. if ($l1[$col1]==0) {next;} # skip if corresponding residue was skipped in pdb file
  944. $printblock[$k].=sprintf("ATOM %5i CA %3s %4i %-50.50s\n",$i1[$col1],&One2ThreeLetter($aaq[$col1]),$i1[$col1]+$shift,$coord[$l1[$col1]]);
  945. if ($v>=4) {
  946. printf("ATOM %5i CA %3s %4i %-50.50s\n",$i1[$col1],&One2ThreeLetter($aaq[$col1]),$i1[$col1]+$shift,$coord[$l1[$col1]]);
  947. }
  948. }
  949. } else {
  950. for ($col1=0; $col1<@aat; $col1++) {
  951. if ($i1[$col1]==0) {next;} # skip gaps in query
  952. if ($j1[$col1]==0) {next;} # skip gaps in template sequence
  953. if ($l1[$col1]==0) {next;} # skip if corresponding residue was skipped in pdb file
  954. $printblock[$k].=sprintf("%1s %3i %1s %s\n",$aaq[$col1],$i1[$col1],$aat[$col1],$nres[$l1[$col1]]);
  955. if ($v>=4) {printf("%1s %3i %1s %s\n",$aaq[$col1],$i1[$col1],$aat[$col1],$nres[$l1[$col1]]);}
  956. }
  957. }
  958. }
  959. $printblock[$k].=sprintf("TER\n");
  960. return;
  961. }
  962. # Extract pdbcode and construct name of pdbfile and return in global variables $pdbid and $chain
  963. sub ExtractPdbcodeAndChain()
  964. {
  965. my $name=$_[0];
  966. print "name=$name\n";
  967. $name=~/^(\S+)/;
  968. $name=$1;
  969. # SCOP ID? (d3lkfa_,d3grs_3,d3pmga1,g1m26.1)
  970. if ($name=~/^[defgh](\d[a-z0-9]{3})([a-z0-9_.])[a-z0-9_]$/) {
  971. $pdbcode=$1;
  972. if ($2 eq "_") {$chain="[A ]";} else {$chain=uc($2);}
  973. }
  974. # PDB ID? (8fab, 1a0i)
  975. elsif ($name=~/^(\d[a-z0-9]{3})$/) {
  976. $pdbcode=$1;
  977. $chain="[A ]";
  978. }
  979. # PDB ID? (8fab_A)
  980. elsif ($name=~/^(\d[a-z0-9]{3})_(\S)$/) {
  981. $pdbcode=$1;
  982. $chain=$2;
  983. }
  984. # PDB ID? (1u1z_ABC)
  985. elsif ($name=~/^(\d[a-z0-9]{3})_(\S\S+)$/) {
  986. $pdbcode=$1;
  987. $chain="[$2]";
  988. }
  989. # DALI ID? (8fabA_0,1a0i_2)
  990. elsif ($name=~/^(\d[a-z0-9]{3})([A-Za-z0-9]?)_\d+$/) {
  991. $pdbcode=$1;
  992. $chain=$2;
  993. }
  994. else {
  995. $pdbcode=$name;
  996. $chain="A";
  997. # return 1; # no SCOP/DALI/pdb sequence
  998. }
  999. # &FindPDBfile($pdbcode);
  1000. # for casp database
  1001. &FindPDBfile($name);
  1002. if ($pdbfile eq "") {
  1003. if ($v>=2) {print("Warning: no pdb file found for sequence name '$name'\n");}
  1004. return 1;
  1005. }
  1006. return 0;
  1007. }
  1008. # Resort arrays according to sorting array0:
  1009. # Resort(\@array0,\@array1,...,\@arrayN)
  1010. sub Sort()
  1011. {
  1012. my $p_array0 = $_[0];
  1013. my @index=();
  1014. for (my $i=0; $i<@{$p_array0}; $i++) {$index[$i]=$i;}
  1015. @index = sort { ${$p_array0}[$a] <=> ${$p_array0}[$b] } @index;
  1016. foreach my $p_array (@_) {
  1017. my @dummy = @{$p_array};
  1018. @{$p_array}=();
  1019. foreach my $i (@index) {
  1020. push(@{$p_array}, $dummy[$i]);
  1021. }
  1022. }
  1023. }
  1024. ##################################################################################
  1025. # Convert three-letter amino acid code into one-letter code
  1026. ##################################################################################
  1027. sub Three2OneLetter {
  1028. my $res=uc($_[0]);
  1029. if ($res eq "GLY") {return "G";}
  1030. elsif ($res eq "ALA") {return "A";}
  1031. elsif ($res eq "VAL") {return "V";}
  1032. elsif ($res eq "LEU") {return "L";}
  1033. elsif ($res eq "ILE") {return "I";}
  1034. elsif ($res eq "MET") {return "M";}
  1035. elsif ($res eq "PHE") {return "F";}
  1036. elsif ($res eq "TYR") {return "Y";}
  1037. elsif ($res eq "TRP") {return "W";}
  1038. elsif ($res eq "ASN") {return "N";}
  1039. elsif ($res eq "ASP") {return "D";}
  1040. elsif ($res eq "GLN") {return "Q";}
  1041. elsif ($res eq "GLU") {return "E";}
  1042. elsif ($res eq "CYS") {return "C";}
  1043. elsif ($res eq "PRO") {return "P";}
  1044. elsif ($res eq "SER") {return "S";}
  1045. elsif ($res eq "THR") {return "T";}
  1046. elsif ($res eq "LYS") {return "K";}
  1047. elsif ($res eq "HIS") {return "H";}
  1048. elsif ($res eq "ARG") {return "R";}
  1049. # The HETATM selenomethionine is read by MODELLER like a normal MET in both its HETATM_IO=off and on mode!
  1050. elsif ($res eq "MSE") {return "M";} # SELENOMETHIONINE
  1051. elsif ($res eq "ASX") {return "B";}
  1052. elsif ($res eq "GLX") {return "Z";}
  1053. else {return "X";}
  1054. # The following post-translationally modified residues are ignored by MODELLER in its default SET HETATM_IO=off mode
  1055. # elsif ($res eq "SEC") {return "C";} # SELENOCYSTEINE
  1056. # elsif ($res eq "SEP") {return "S";} # PHOSPHOSERINE
  1057. # elsif ($res eq "TPO") {return "T";} # PHOSPHOTHREONINE
  1058. # elsif ($res eq "TYS") {return "Y";} # SULFONATED TYROSINE
  1059. # elsif ($res eq "KCX") {return "K";} # LYSINE NZ-CARBOXYLIC ACID
  1060. }
  1061. ##################################################################################
  1062. # Convert one-letter amino acid code into three-letter code
  1063. ##################################################################################
  1064. sub One2ThreeLetter {
  1065. my $res=uc($_[0]);
  1066. if ($res eq "G") {return "GLY";}
  1067. elsif ($res eq "A") {return "ALA";}
  1068. elsif ($res eq "V") {return "VAL";}
  1069. elsif ($res eq "L") {return "LEU";}
  1070. elsif ($res eq "I") {return "ILE";}
  1071. elsif ($res eq "M") {return "MET";}
  1072. elsif ($res eq "F") {return "PHE";}
  1073. elsif ($res eq "Y") {return "TYR";}
  1074. elsif ($res eq "W") {return "TRP";}
  1075. elsif ($res eq "N") {return "ASN";}
  1076. elsif ($res eq "D") {return "ASP";}
  1077. elsif ($res eq "Q") {return "GLN";}
  1078. elsif ($res eq "E") {return "GLU";}
  1079. elsif ($res eq "C") {return "CYS";}
  1080. elsif ($res eq "P") {return "PRO";}
  1081. elsif ($res eq "S") {return "SER";}
  1082. elsif ($res eq "T") {return "THR";}
  1083. elsif ($res eq "K") {return "LYS";}
  1084. elsif ($res eq "H") {return "HIS";}
  1085. elsif ($res eq "R") {return "ARG";}
  1086. elsif ($res eq "U") {return "SEC";}
  1087. elsif ($res eq "B") {return "ASX";}
  1088. elsif ($res eq "Z") {return "GLX";}
  1089. else {return "UNK";}
  1090. }
  1091. # Find the pdb file with $pdbcode in pdb directory
  1092. sub FindPDBfile() {
  1093. #my $pdbcode=lc($_[0]);
  1094. my $pdbcode=$_[0];
  1095. foreach $pdbdir (@pdbdirs) {
  1096. if (! -e "$pdbdir") {warn("Warning in $program: pdb directory '$pdbdir' does not exist!\n"); next;}
  1097. if (-e "$pdbdir/all") {$pdbfile="$pdbdir/all/";}
  1098. elsif (-e "$pdbdir/divided") {$pdbfile="$pdbdir/divided/".substr($pdbcode,1,2)."/";}
  1099. else {$pdbfile="$pdbdir/";}
  1100. if ($pdbdir=~/divided.?$/) {$pdbfile.=substr($pdbcode,1,2)."/";}
  1101. if (-e $pdbfile."pdb$pdbcode.ent") {$pdbfile.="pdb$pdbcode.ent";}
  1102. elsif (-e $pdbfile."pdb$pdbcode.ent.gz") {$pdbfile="gunzip -c $pdbfile"."pdb$pdbcode.ent.gz |";}
  1103. elsif (-e $pdbfile."pdb$pdbcode.ent.Z") {$pdbfile="gunzip -c $pdbfile"."pdb$pdbcode.ent.Z |";}
  1104. elsif (-e $pdbfile."$pdbcode.pdb") {$pdbfile.="$pdbcode.pdb";}
  1105. else {next;}
  1106. return $pdbfile;
  1107. }
  1108. printf(STDERR "Warning in $program: Cannot find pdb file $pdbfile"."pdb$pdbcode.ent!\n");
  1109. return "";
  1110. }