File Coverage

blib/lib/HackaMol.pm
Criterion Covered Total %
statement 300 396 75.7
branch 36 62 58.0
condition 2 9 22.2
subroutine 29 32 90.6
pod 13 16 81.2
total 380 515 73.7


line stmt bran cond sub pod time code
1             package HackaMol;
2             $HackaMol::VERSION = '0.051';
3             #ABSTRACT: HackaMol: Object-Oriented Library for Molecular Hacking
4 11     11   1890630 use 5.008;
  11         127  
5 11     11   5971 use Moose;
  11         4227997  
  11         95  
6 11     11   91419 use HackaMol::AtomGroup;
  11         55  
  11         682  
7 11     11   7990 use HackaMol::Molecule;
  11         52  
  11         664  
8 11     11   8009 use HackaMol::Atom;
  11         48  
  11         546  
9 11     11   6979 use HackaMol::Bond;
  11         54  
  11         592  
10 11     11   6938 use HackaMol::Angle;
  11         47  
  11         569  
11 11     11   7177 use HackaMol::Dihedral;
  11         59  
  11         594  
12 11     11   115 use Math::Vector::Real;
  11         28  
  11         811  
13 11     11   93 use namespace::autoclean;
  11         30  
  11         114  
14 11     11   1217 use MooseX::StrictConstructor;
  11         32  
  11         94  
15 11     11   43598 use Scalar::Util qw(refaddr);
  11         34  
  11         629  
16 11     11   84 use Carp;
  11         27  
  11         44971  
17              
18             has 'readline_func' => (
19             is => 'rw',
20             isa => 'CodeRef',
21             predicate => 'has_readline_func',
22             clearer => 'clear_readline_func',
23             );
24              
25             with
26             'HackaMol::Roles::NameRole',
27             'HackaMol::Roles::MolReadRole',
28             'HackaMol::Roles::PathRole',
29             'HackaMol::Roles::ExeRole',
30             'HackaMol::Roles::FileFetchRole',
31             'HackaMol::Roles::NERFRole',
32             'HackaMol::Roles::RcsbRole';
33              
34              
35              
36             sub pdbid_mol {
37 1     1 1 139 my $self = shift;
38 1   33     31 my $pdbid = shift || croak "Croak on passing pdbid, e.g. 2cba";
39 0         0 my ($file) = $self->getstore_pdbid($pdbid);
40 0         0 return $self->read_file_mol($file);
41             }
42              
43             sub read_file_push_coords_mol {
44 5     5 1 1540 my $self = shift;
45 5         9 my $file = shift;
46 5 100       30 my $mol = shift or croak "must pass molecule to add coords to";
47              
48 4         34 my @atoms = $self->read_file_atoms($file);
49 4         208 my @matoms = $mol->all_atoms;
50              
51 4 100       22 if ( scalar(@matoms) != scalar(@atoms) ) {
52 1         33 croak "file_push_coords_mol> number of atoms not same";
53             }
54 3         16 foreach my $i ( 0 .. $#atoms ) {
55 117 100       2785 if ( $matoms[$i]->Z != $atoms[$i]->Z ) {
56 1         30 croak "file_push_coords_mol> atom mismatch";
57             }
58 116         4050 $matoms[$i]->push_coords($_) foreach ( $atoms[$i]->all_coords );
59             }
60             }
61              
62             sub read_pdbfile_mol {
63              
64             # keeps the header, and a map of model_ids
65 1     1 0 11 my $self = shift;
66 1         3 my $file = shift;
67 1         8 my ( $header, $atoms, $model_ids ) = $self->read_file_pdb_parts($file);
68             return (
69 1         44 HackaMol::Molecule->new(
70             name => $file,
71             atoms => $atoms,
72             info => $header,
73             model_ids => $model_ids
74             )
75             );
76             }
77              
78             sub read_file_mol {
79 6     6 1 102 my $self = shift;
80 6         18 my $file = shift;
81              
82 6         55 my @atoms = $self->read_file_atoms($file);
83 6         46 my $name = $file;
84 6         492 return ( HackaMol::Molecule->new( name => $name, atoms => [@atoms] ) );
85             }
86              
87             sub read_string_mol {
88 6     6 0 1155 my $self = shift;
89 6         14 my $string = shift;
90 6 50       32 my $format = shift or croak "must pass format: xyz, pdb, pdbqt, zmat, yaml";
91              
92 6         41 my @atoms = $self->read_string_atoms( $string, $format );
93 6         31 my $name = $format . ".mol";
94 6         262 return ( HackaMol::Molecule->new( name => $name, atoms => [@atoms] ) );
95             }
96              
97             sub build_bonds {
98              
99             #take a list of n, atoms; walk down list and generate bonds
100 4     4 1 139 my $self = shift;
101 4         22 my @atoms = @_;
102 4 100       30 croak "<2 atoms passed to build_bonds" unless ( @atoms > 1 );
103 3         8 my @bonds;
104              
105             # build the bonds
106 3         6 my $k = 0;
107 3         14 while ( $k + 1 <= $#atoms ) {
108             my $name =
109 177         377 join( "_", map { _name_resid( $_, 'B' ) } @atoms[ $k .. $k + 1 ] );
  354         774  
110 177         4415 push @bonds,
111             HackaMol::Bond->new(
112             name => $name,
113             atoms => [ @atoms[ $k, $k + 1 ] ]
114             );
115 177         426 $k++;
116             }
117 3         72 return (@bonds);
118             }
119              
120             sub build_angles {
121              
122             #take a list of n, atoms; walk down list and generate angles
123 4     4 1 95 my $self = shift;
124 4         16 my @atoms = @_;
125 4 100       26 croak "<3 atoms passed to build_angles" unless ( @atoms > 2 );
126 3         11 my @angles;
127              
128             # build the angles
129 3         10 my $k = 0;
130              
131 3         15 while ( $k + 2 <= $#atoms ) {
132             my $name =
133 174         363 join( "_", map { _name_resid( $_, 'A' ) } @atoms[ $k .. $k + 2 ] );
  522         1039  
134 174         4426 push @angles,
135             HackaMol::Angle->new(
136             name => $name,
137             atoms => [ @atoms[ $k .. $k + 2 ] ]
138             );
139 174         495 $k++;
140             }
141 3         65 return (@angles);
142             }
143              
144             sub _name_resid {
145 1560     1560   2202 my $atom = shift;
146 1560         1936 my $default = shift;
147 1560 100       44977 return ( $default . $atom->resid )
148             unless $atom->has_name; # this comes up when undefined atoms are passed
149 1040         24373 return ( $atom->name . $atom->resid );
150             }
151              
152             sub build_dihedrals {
153              
154             #take a list of n, atoms; walk down list and generate dihedrals
155 4     4 1 167 my $self = shift;
156 4         20 my @atoms = @_;
157 4 100       41 croak "<4 atoms passed to build_dihedrals" unless ( @atoms > 3 );
158 3         10 my @dihedrals;
159              
160             # build the dihedrals
161 3         10 my $k = 0;
162 3         15 while ( $k + 3 <= $#atoms ) {
163             my $name =
164 171         376 join( "_", map { _name_resid( $_, 'D' ) } @atoms[ $k .. $k + 3 ] );
  684         1328  
165 171         4609 push @dihedrals,
166             HackaMol::Dihedral->new(
167             name => $name,
168             atoms => [ @atoms[ $k .. $k + 3 ] ]
169             );
170 171         474 $k++;
171             }
172 3         67 return (@dihedrals);
173             }
174              
175             sub group_by_atom_attr {
176              
177             # group atoms by attribute
178             # Z, name, bond_count, etc.
179 16     16 1 38 my $self = shift;
180 16         25 my $attr = shift;
181 16         101 my @atoms = @_;
182              
183 16         27 my %group;
184 16         38 foreach my $atom (@atoms) {
185 1520         2027 push @{ $group{ $atom->$attr } }, $atom;
  1520         36511  
186             }
187              
188             my @atomgroups =
189 16         137 map { HackaMol::AtomGroup->new( atoms => $group{$_} ) } sort
  130         3710  
190             keys(%group);
191              
192 16         189 return (@atomgroups);
193              
194             }
195              
196             sub group_by_atom_attrs {
197              
198             # group atoms by attributes
199             # Z, name, bond_count, etc.
200             # keep splitting the groups until there are no more attributes
201 1     1 1 4 my $self = shift;
202 1         4 my @attrs = @{ +shift };
  1         4  
203 1         31 my @atoms = @_;
204              
205 1 50       6 return () unless @attrs;
206              
207 1         69 my @groups = ( HackaMol::AtomGroup->new( atoms => [@atoms] ) );
208              
209 1         4 foreach my $attr (@attrs) {
210 2         5 my @local_groups;
211 2         6 foreach my $group (@groups) {
212 13         524 push @local_groups,
213             $self->group_by_atom_attr( $attr, $group->all_atoms );
214             }
215 2         73 @groups = @local_groups;
216             }
217              
218 1         25 return (@groups);
219              
220             }
221              
222             sub mol_disulfide_bonds {
223              
224             # take atom group
225 1     1 1 583 my $self = shift;
226 1         3 my $mol = shift;
227 1         2 my $fudge = shift;
228 1 50       5 $fudge = 0.15 unless defined($fudge);
229              
230 1         9 my @sulfs = $mol->select_group("Z 16")->all_atoms;
231 1 50       34 return unless @sulfs;
232 1         35 my $dcut = 2 * $sulfs[0]->covalent_radius + $fudge;
233 1         5 my $nm = "S-S";
234 1         2 my $count = 1;
235 1         4 my @bonds = ();
236 1         7 foreach my $is ( 0 .. $#sulfs ) {
237 27         49 my $at_i = $sulfs[$is];
238 27         80 foreach my $js ( $is + 1 .. $#sulfs ) {
239 351         519 my $at_j = $sulfs[$js];
240 351         736 my $dist = $at_j->distance($at_i);
241 351 100       764 if ( $dist <= $dcut ) {
242 9         270 push @bonds,
243             HackaMol::Bond->new(
244             name => $nm . "_" . $count++,
245             atoms => [ $at_i, $at_j ],
246             );
247             }
248             }
249             }
250 1         15 return @bonds;
251             }
252              
253             sub find_disulfide_bonds {
254              
255             # to be deprecated
256             # works fine for single disulfide bonds
257             # but does not
258 1     1 1 11 my $self = shift;
259              
260 1         9 my @sulf = grep { $_->Z == 16 } @_;
  3009         67122  
261 1         27 my @ss = $self->find_bonds_brute(
262             bond_atoms => [@sulf],
263             candidates => [@sulf],
264             fudge => 0.15, # 0.45 is too large
265             max_bonds => 1,
266             );
267 1         11 return @ss;
268             }
269              
270             sub find_bonds_brute {
271 6     6 1 16 my $self = shift;
272 6         35 my %args = @_;
273 6         13 my @bond_atoms = @{ $args{bond_atoms} };
  6         20  
274 6         14 my @atoms = @{ $args{candidates} };
  6         50  
275              
276 6         16 my $fudge = 0.45;
277 6         10 my $max_bonds = 99;
278              
279 6 100       29 $fudge = $args{fudge} if ( exists( $args{fudge} ) );
280 6 100       21 $max_bonds = $args{max_bonds} if ( exists( $args{max_bonds} ) );
281              
282 6         26 my @init_bond_counts = map { $_->bond_count } ( @bond_atoms, @atoms );
  338         7562  
283              
284 6         16 my @bonds;
285             my %name;
286              
287 6         18 foreach my $at_i (@bond_atoms) {
288 37 100       869 next if ( $at_i->bond_count >= $max_bonds );
289 28         713 my $cov_i = $at_i->covalent_radius;
290              
291 28         58 foreach my $at_j (@atoms) {
292 1030 100       2555 next if ( refaddr($at_i) == refaddr($at_j) );
293 1002 100       23642 next if ( $at_j->bond_count >= $max_bonds );
294 844         20162 my $cov_j = $at_j->covalent_radius;
295 844         2007 my $dist = $at_j->distance($at_i);
296              
297 844 100       2301 if ( $dist <= $cov_i + $cov_j + $fudge ) {
298 33         854 my $nm = $at_i->symbol . "-" . $at_j->symbol;
299 33         76 $name{$nm}++;
300             push @bonds,
301             HackaMol::Bond->new(
302 33         957 name => "$nm\_" . $name{$nm},
303             atoms => [ $at_i, $at_j ],
304             );
305 33         1203 $at_i->inc_bond_count;
306 33         1038 $at_j->inc_bond_count;
307             }
308              
309             }
310             }
311              
312 6         18 my $i = 0;
313 6         20 foreach my $at ( @bond_atoms, @atoms ) {
314 338         10591 $at->reset_bond_count;
315 338         10700 $at->inc_bond_count( $init_bond_counts[$i] );
316 338         502 $i++;
317             }
318 6         111 return (@bonds);
319              
320             }
321              
322             sub group_rot {
323              
324             # no pod yet
325             # this method walks out from the two atoms in a bond and returns a group
326 0     0 0 0 my $self = shift;
327 0         0 my $mol = shift;
328 0         0 my $bond = shift;
329 0         0 my $iba = $bond->get_atoms(0)->iatom;
330 0         0 my $ibb = $bond->get_atoms(1)->iatom;
331              
332 0         0 my $init = {
333             $iba => 1,
334             $ibb => 1,
335             };
336 0         0 my $root = $ibb;
337 0         0 my $rotation_indices = _qrotatable( $mol->atoms, $ibb, $init );
338 0         0 delete( $rotation_indices->{$iba} );
339 0         0 delete( $rotation_indices->{$ibb} );
340              
341             return (
342             HackaMol::AtomGroup->new(
343             atoms => [
344 0         0 map { $mol->get_atoms($_) }
345 0         0 keys %{$rotation_indices}
  0         0  
346             ]
347             )
348             );
349              
350             }
351              
352             sub superpose_rt {
353              
354             # args: two HackaMol::AtomGroup or HackaMol::Molecule with the same number of atoms
355             # the atoms are assumed to be in the same order, that's it!
356             #
357             # uses all vectors (mvr) in group to calculate the rotation matrix, and translation vector
358             # needed to superpose the second group on to the first group.
359             #
360             # a typical workflow will run this to get the rotation and translation and then the AtomGroupRole
361             # rotate_translate method to actually do the coordinate transformation.
362             #
363             # the algorithm is lifted from Bio::PDB::Structure, which in turn implements
364             # method from S. Kearsley, Acta Cryst. A45, 208-210 1989
365             # may not be very fast. better suited to PDL
366             #
367             # returns:
368             # 1. rotation matrix [3 rows, each is a MVR , e.g. x' = row_1 * xyz]
369             # 2. translation vector (MVR)
370             # 3. rmsd
371             #
372 1     1 1 11 my $self = shift;
373 1         3 my $g2 = shift; # switch order, function here vs method in Bio::PDB
374 1         2 my $g1 = shift;
375              
376 1         39 my $nrd1 = $g1->count_atoms;
377 1         37 my $nrd2 = $g2->count_atoms;
378 1 50 33     10 die "superpose error: groups must have same number of atoms\n"
379             unless ( $nrd1 == $nrd2 && $nrd1 > 0 );
380              
381 1         19 my ( $x1, $y1, $z1 );
382 1         0 my ( $x2, $y2, $z2 );
383 1         0 my ( $xm, $ym, $zm );
384 1         0 my ( $xp, $yp, $zp );
385 1         0 my ( $Sxmxm, $Sxpxp, $Symym, $Sypyp, $Szmzm, $Szpzp );
386 1         0 my ( $Sxmym, $Sxmyp, $Sxpym, $Sxpyp );
387 1         0 my ( $Sxmzm, $Sxmzp, $Sxpzm, $Sxpzp );
388 1         0 my ( $Symzm, $Symzp, $Sypzm, $Sypzp );
389              
390 1         7 my $gc1 = $g1->center;
391 1         6 my $gc2 = $g2->center; # these are MVRs
392              
393 1         36 my @mvr1 = map { $_->xyz - $gc1 } $g1->all_atoms;
  7         22  
394 1         38 my @mvr2 = map { $_->xyz - $gc2 } $g2->all_atoms;
  7         18  
395              
396 1         6 foreach my $i ( 0 .. $nrd1 - 1 ) {
397 7         23 ( $x1, $y1, $z1 ) = @{ $mvr1[$i] };
  7         16  
398 7         12 ( $x2, $y2, $z2 ) = @{ $mvr2[$i] };
  7         11  
399 7         11 $xm = ( $x1 - $x2 );
400 7         11 $xp = ( $x1 + $x2 );
401 7         9 $ym = ( $y1 - $y2 );
402 7         10 $yp = ( $y1 + $y2 );
403 7         8 $zm = ( $z1 - $z2 );
404 7         8 $zp = ( $z1 + $z2 );
405              
406 7         15 $Sxmxm += $xm * $xm;
407 7         9 $Sxpxp += $xp * $xp;
408 7         9 $Symym += $ym * $ym;
409 7         11 $Sypyp += $yp * $yp;
410 7         10 $Szmzm += $zm * $zm;
411 7         10 $Szpzp += $zp * $zp;
412              
413 7         8 $Sxmym += $xm * $ym;
414 7         11 $Sxmyp += $xm * $yp;
415 7         11 $Sxpym += $xp * $ym;
416 7         9 $Sxpyp += $xp * $yp;
417              
418 7         8 $Sxmzm += $xm * $zm;
419 7         9 $Sxmzp += $xm * $zp;
420 7         9 $Sxpzm += $xp * $zm;
421 7         10 $Sxpzp += $xp * $zp;
422              
423 7         11 $Symzm += $ym * $zm;
424 7         10 $Symzp += $ym * $zp;
425 7         9 $Sypzm += $yp * $zm;
426 7         10 $Sypzp += $yp * $zp;
427             }
428              
429 1         8 my @m;
430 1         3 $m[0] = $Sxmxm + $Symym + $Szmzm;
431 1         3 $m[1] = $Sypzm - $Symzp;
432 1         4 $m[2] = $Sxmzp - $Sxpzm;
433 1         3 $m[3] = $Sxpym - $Sxmyp;
434 1         2 $m[4] = $m[1];
435 1         3 $m[5] = $Sypyp + $Szpzp + $Sxmxm;
436 1         3 $m[6] = $Sxmym - $Sxpyp;
437 1         3 $m[7] = $Sxmzm - $Sxpzp;
438 1         5 $m[8] = $m[2];
439 1         4 $m[9] = $m[6];
440 1         3 $m[10] = $Sxpxp + $Szpzp + $Symym;
441 1         3 $m[11] = $Symzm - $Sypzp;
442 1         3 $m[12] = $m[3];
443 1         4 $m[13] = $m[7];
444 1         3 $m[14] = $m[11];
445 1         5 $m[15] = $Sxpxp + $Sypyp + $Szmzm;
446              
447             #compute the egienvectors and eigenvalues of the matrix
448 1         8 my ( $revec, $reval ) = &__diagonalize(@m);
449              
450             #the smallest eigenvalue is the rmsd for the optimal alignment
451 1         5 my $rmsd = sqrt( abs( $reval->[0] ) / $nrd1 );
452              
453             #fetch the optimal quaternion
454 1         3 my @q;
455 1         3 $q[0] = $revec->[0][0];
456 1         4 $q[1] = $revec->[1][0];
457 1         3 $q[2] = $revec->[2][0];
458 1         3 $q[3] = $revec->[3][0];
459              
460             #construct the rotation matrix given by the quaternion
461 1         2 my @mt;
462 1         6 $mt[0] = $q[0] * $q[0] + $q[1] * $q[1] - $q[2] * $q[2] - $q[3] * $q[3];
463 1         4 $mt[1] = 2.0 * ( $q[1] * $q[2] - $q[0] * $q[3] );
464 1         4 $mt[2] = 2.0 * ( $q[1] * $q[3] + $q[0] * $q[2] );
465              
466 1         3 $mt[3] = 2.0 * ( $q[2] * $q[1] + $q[0] * $q[3] );
467 1         5 $mt[4] = $q[0] * $q[0] - $q[1] * $q[1] + $q[2] * $q[2] - $q[3] * $q[3];
468 1         5 $mt[5] = 2.0 * ( $q[2] * $q[3] - $q[0] * $q[1] );
469              
470 1         5 $mt[6] = 2.0 * ( $q[3] * $q[1] - $q[0] * $q[2] );
471 1         3 $mt[7] = 2.0 * ( $q[3] * $q[2] + $q[0] * $q[1] );
472 1         5 $mt[8] = $q[0] * $q[0] - $q[1] * $q[1] - $q[2] * $q[2] + $q[3] * $q[3];
473              
474             #compute the displacement vector
475 1         2 my @vt;
476 1         5 $vt[0] =
477             $gc2->[0] - $mt[0] * $gc1->[0] - $mt[1] * $gc1->[1] - $mt[2] * $gc1->[2];
478 1         6 $vt[1] =
479             $gc2->[1] - $mt[3] * $gc1->[0] - $mt[4] * $gc1->[1] - $mt[5] * $gc1->[2];
480 1         5 $vt[2] =
481             $gc2->[2] - $mt[6] * $gc1->[0] - $mt[7] * $gc1->[1] - $mt[8] * $gc1->[2];
482              
483 1         26 return ( [ V( @mt[ 0, 1, 2 ] ), V( @mt[ 3, 4, 5 ] ), V( @mt[ 6, 7, 8 ] ) ],
484             V(@vt), $rmsd );
485             }
486              
487             sub rmsd {
488 0     0 1 0 my $self = shift;
489 0         0 my $g1 = shift; # switch order, function here vs method in Bio::PDB
490 0         0 my $g2 = shift;
491 0         0 my $w = shift;
492              
493 0         0 my $nrd1 = $g1->count_atoms;
494 0         0 my $nrd2 = $g2->count_atoms;
495 0 0 0     0 die "rmsd error: groups must have same number of atoms\n"
496             unless ( $nrd1 == $nrd2 && $nrd1 > 0 );
497              
498 0         0 my @w;
499 0 0       0 if ( defined($w) ) {
500 0         0 @w = @{$w};
  0         0  
501             }
502             else {
503 0         0 @w = map { 1 } 0 .. $nrd1 - 1;
  0         0  
504             }
505              
506 0 0       0 die "rmsd error: atom array weight must have same dimension as groups\n"
507             unless ( $nrd1 == scalar(@w) );
508 0         0 my $sum_weights =
509             0; # will be same as number of atoms if no weights are defined
510              
511 0         0 $sum_weights += $_ foreach @w;
512              
513 0         0 my @xyz_1 = map { $_->xyz } $g1->all_atoms;
  0         0  
514 0         0 my @xyz_2 = map { $_->xyz } $g2->all_atoms;
  0         0  
515              
516 0         0 my $sqr_dev = 0;
517 0         0 $sqr_dev += $w[$_] * $xyz_1[$_]->dist2( $xyz_2[$_] ) foreach 0 .. $#xyz_1;
518 0         0 return sqrt( $sqr_dev / $sum_weights );
519             }
520              
521             sub _qrotatable {
522 0     0   0 my $atoms = shift;
523 0         0 my $iroot = shift;
524 0         0 my $visited = shift;
525              
526 0         0 $visited->{$iroot}++;
527              
528 0 0       0 if ( scalar( keys %$visited ) > 80 ) {
529 0         0 carp "search too deep. exiting recursion";
530 0         0 return;
531             }
532              
533 0         0 my @cands;
534 0         0 foreach my $at (@$atoms) {
535 0 0       0 push @cands, $at unless ( grep { $at->iatom == $_ } keys %{$visited} );
  0         0  
  0         0  
536             }
537              
538             #not calling in object context, hence the dummy 'self'
539 0         0 my @bonds = find_bonds_brute(
540             'self',
541             bond_atoms => [ $atoms->[$iroot] ],
542             candidates => [@cands],
543             fudge => 0.45,
544             );
545              
546 0         0 foreach my $cand ( map { $_->get_atoms(1) } @bonds ) {
  0         0  
547 0 0       0 next if $visited->{ $cand->iatom };
548 0         0 my $visited = _qrotatable( $atoms, $cand->iatom, $visited );
549             }
550 0         0 return ($visited);
551             }
552              
553             #Jacobi diagonalizer
554             sub __diagonalize {
555 1     1   13 my ( $onorm, $dnorm );
556 1         0 my ( $b, $dma, $q, $t, $c, $s );
557 1         0 my ( $atemp, $vtemp, $dtemp );
558 1         0 my ( $i, $j, $k, $l );
559 1         0 my @a;
560 1         0 my @v;
561 1         0 my @d;
562 1         4 my $nrot = 30; #number of sweeps
563              
564 1         7 for ( $i = 0 ; $i < 4 ; $i++ ) {
565 4         10 for ( $j = 0 ; $j < 4 ; $j++ ) {
566 16         23 $a[$i][$j] = $_[ 4 * $i + $j ];
567 16         40 $v[$i][$j] = 0.0;
568             }
569             }
570              
571 1         8 for ( $j = 0 ; $j <= 3 ; $j++ ) {
572 4         7 $v[$j][$j] = 1.0;
573 4         10 $d[$j] = $a[$j][$j];
574             }
575              
576 1         6 for ( $l = 1 ; $l <= $nrot ; $l++ ) {
577 1         3 $dnorm = 0.0;
578 1         4 $onorm = 0.0;
579 1         5 for ( $j = 0 ; $j <= 3 ; $j++ ) {
580 4         7 $dnorm += abs( $d[$j] );
581 4         12 for ( $i = 0 ; $i <= $j - 1 ; $i++ ) {
582 6         13 $onorm += abs( $a[$i][$j] );
583             }
584             }
585 1 50       8 last if ( ( $onorm / $dnorm ) <= 1.0e-12 );
586 0         0 for ( $j = 1 ; $j <= 3 ; $j++ ) {
587 0         0 for ( $i = 0 ; $i <= $j - 1 ; $i++ ) {
588 0         0 $b = $a[$i][$j];
589 0 0       0 if ( abs($b) > 0.0 ) {
590 0         0 $dma = $d[$j] - $d[$i];
591 0 0       0 if ( ( abs($dma) + abs($b) ) <= abs($dma) ) {
592 0         0 $t = $b / $dma;
593             }
594             else {
595 0         0 $q = 0.5 * $dma / $b;
596 0         0 $t = 1.0 / ( abs($q) + sqrt( 1.0 + $q * $q ) );
597 0 0       0 $t *= -1.0 if ( $q < 0.0 );
598             }
599 0         0 $c = 1.0 / sqrt( $t * $t + 1.0 );
600 0         0 $s = $t * $c;
601 0         0 $a[$i][$j] = 0.0;
602 0         0 for ( $k = 0 ; $k <= $i - 1 ; $k++ ) {
603 0         0 $atemp = $c * $a[$k][$i] - $s * $a[$k][$j];
604 0         0 $a[$k][$j] = $s * $a[$k][$i] + $c * $a[$k][$j];
605 0         0 $a[$k][$i] = $atemp;
606             }
607 0         0 for ( $k = $i + 1 ; $k <= $j - 1 ; $k++ ) {
608 0         0 $atemp = $c * $a[$i][$k] - $s * $a[$k][$j];
609 0         0 $a[$k][$j] = $s * $a[$i][$k] + $c * $a[$k][$j];
610 0         0 $a[$i][$k] = $atemp;
611             }
612 0         0 for ( $k = $j + 1 ; $k <= 3 ; $k++ ) {
613 0         0 $atemp = $c * $a[$i][$k] - $s * $a[$j][$k];
614 0         0 $a[$j][$k] = $s * $a[$i][$k] + $c * $a[$j][$k];
615 0         0 $a[$i][$k] = $atemp;
616             }
617 0         0 for ( $k = 0 ; $k <= 3 ; $k++ ) {
618 0         0 $vtemp = $c * $v[$k][$i] - $s * $v[$k][$j];
619 0         0 $v[$k][$j] = $s * $v[$k][$i] + $c * $v[$k][$j];
620 0         0 $v[$k][$i] = $vtemp;
621             }
622 0         0 $dtemp =
623             $c * $c * $d[$i] + $s * $s * $d[$j] - 2.0 * $c * $s * $b;
624 0         0 $d[$j] =
625             $s * $s * $d[$i] + $c * $c * $d[$j] + 2.0 * $c * $s * $b;
626 0         0 $d[$i] = $dtemp;
627             }
628             }
629             }
630             }
631 1         3 $nrot = $l;
632 1         5 for ( $j = 0 ; $j <= 2 ; $j++ ) {
633 3         8 $k = $j;
634 3         4 $dtemp = $d[$k];
635 3         8 for ( $i = $j + 1 ; $i <= 3 ; $i++ ) {
636 6 50       15 if ( $d[$i] < $dtemp ) {
637 0         0 $k = $i;
638 0         0 $dtemp = $d[$k];
639             }
640             }
641              
642 3 50       8 if ( $k > $j ) {
643 0         0 $d[$k] = $d[$j];
644 0         0 $d[$j] = $dtemp;
645 0         0 for ( $i = 0 ; $i <= 3 ; $i++ ) {
646 0         0 $dtemp = $v[$i][$k];
647 0         0 $v[$i][$k] = $v[$i][$j];
648 0         0 $v[$i][$j] = $dtemp;
649             }
650             }
651             }
652              
653 1         8 return ( \@v, \@d );
654             }
655              
656             __PACKAGE__->meta->make_immutable;
657              
658             1;
659              
660             __END__
661              
662             =pod
663              
664             =head1 NAME
665              
666             HackaMol - HackaMol: Object-Oriented Library for Molecular Hacking
667              
668             =head1 VERSION
669              
670             version 0.051
671              
672             =head1 DESCRIPTION
673              
674             The L<HackaMol publication|http://pubs.acs.org/doi/abs/10.1021/ci500359e> has
675             a more complete description of the library (L<pdf available from researchgate|http://www.researchgate.net/profile/Demian_Riccardi/publication/273778191_HackaMol_an_object-oriented_Modern_Perl_library_for_molecular_hacking_on_multiple_scales/links/550ebec60cf27526109e6ade.pdf>).
676              
677             Citation: J. Chem. Inf. Model., 2015, 55, 721
678              
679             Loading the HackaMol library in a script with
680              
681             use HackaMol;
682              
683             provides attributes and methods of a builder class. It also loads all the
684             classes provided by the core so including them is not necessary, e.g.:
685              
686             use HackaMol::Atom;
687             use HackaMol::Bond;
688             use HackaMol::Angle;
689             use HackaMol::Dihedral;
690             use HackaMol::AtomGroup;
691             use HackaMol::Molecule;
692              
693             The methods, described below, facilitate the creation of objects from files and
694             other objects. It is a builder class that evolves more rapidly than the classes for the molecular objects.
695             For example, the superpose_rt and rmsd methods will likely be moved to a more suitable class or
696             functional module.
697              
698             =head1 METHODS
699              
700             =head2 pdbid_mol
701              
702             one argument: pdbid
703              
704             This method will download the pdb, unless it exists, and load it into a
705             HackaMol::Molecule object. For example,
706              
707             my $mol = HackaMol->new->pdbid_mol('2cba');
708              
709             =head2 read_file_atoms
710              
711             one argument: filename.
712              
713             This method parses the file (e.g. file.xyz, file.pdb) and returns an
714             array of HackaMol::Atom objects. It uses the filename postfix to decide which parser to use. e.g. file.pdb will
715             trigger the pdb parser.
716              
717             =head2 read_file_mol
718              
719             one argument: filename.
720              
721             This method parses the file (e.g. file.xyz, file.pdb) and returns a
722             HackaMol::Molecule object.
723              
724             =head2 read_file_push_coords_mol
725              
726             two arguments: filename and a HackaMol::Molecule object.
727              
728             This method reads the coordinates from a file and pushes them into the atoms
729             contained in the molecule. Thus, the atoms in the molecule and the atoms in
730             the file must be the same.
731              
732             =head2 build_bonds
733              
734             takes a list of atoms and returns a list of bonds. The bonds are generated for
735             "list neighbors" by simply stepping through the atom list one at a time. e.g.
736              
737             my @bonds = $hack->build_bonds(@atoms[1,3,5]);
738              
739             will return two bonds: B13 and B35
740              
741             =head2 build_angles
742              
743             takes a list of atoms and returns a list of angles. The angles are generated
744             analagously to build_bonds, e.g.
745              
746             my @angles = $hack->build_angles(@atoms[1,3,5]);
747              
748             will return one angle: A135
749              
750             =head2 build_dihedrals
751              
752             takes a list of atoms and returns a list of dihedrals. The dihedrals are generated
753             analagously to build_bonds, e.g.
754              
755             my @dihedral = $hack->build_dihedrals(@atoms[1,3,5]);
756              
757             will croak! you need atleast four atoms.
758              
759             my @dihedral = $hack->build_dihedrals(@atoms[1,3,5,6,9]);
760              
761             will return two dihedrals: D1356 and D3569
762              
763             =head2 group_by_atom_attr
764              
765             args: atom attribute (e.g. 'name') ; list of atoms (e.g. $mol->all_atoms)
766              
767             returns array of AtomGroup objects
768              
769             =head2 group_by_atom_attrs
770              
771             args: array reference of multiple atom attributes (e.g. ['resname', 'chain' ]); list of atoms.
772              
773             returns array of AtomGroup objects
774              
775             =head2 find_bonds_brute
776              
777             The arguments are key_value pairs of bonding criteria (see example below).
778              
779             This method returns bonds between bond_atoms and the candidates using the
780             criteria (many of wich have defaults).
781              
782             my @oxy_bonds = $hack->find_bonds_brute(
783             bond_atoms => [$hg],
784             candidates => [$mol->all_atoms],
785             fudge => 0.45,
786             max_bonds => 6,
787             );
788              
789             fudge is optional with Default is 0.45 (open babel uses same default);
790             max_bonds is optional with default of 99. max_bonds is compared against
791             the atom bond count, which are incremented during the search. Before returning
792             the bonds, the bond_count are returned the values before the search. For now,
793             molecules are responsible for setting the number of bonds in atoms.
794             find_bonds_brute uses a bruteforce algorithm that tests the interatomic
795             separation against the sum of the covalent radii + fudge. It will not test
796             for bond between atoms if either atom has >= max_bonds. It does not return
797             a self bond for an atom (C< next if refaddr($ati) == refaddr($atj) >).
798              
799             =head2 mol_disulfide_bonds
800              
801             my @ss = $bldr->mol_disulfide_bonds($mol, [$fudge]); # default $fudge = 0.15
802              
803             Returns all disulfide bonds with lengths leq 2 x S->covalent_radius + $fudge. $mol can be an AtomGroup
804             or Molecule.
805              
806             =head2 find_disulfide_bonds
807              
808             my @ss = $bldr->find_disulfide_bonds(@atoms);
809              
810             DEPRECATED. Uses find_bonds_brute with fudge of 0.15 and max_bonds 1. mol_disulfides was developed
811             after finding funky cysteine clusters (e.g. 1f3h)
812              
813             =head2 rmsd ($group1,$group2,$weights)
814              
815             my $rmsd = $bldr->rmsd($group1, $group2, [$weights]); #optional weights need to be tested
816              
817             Computes the root mean square deviation between atomic vectors of the two AtomGroup/Molecule objects.
818              
819             =head2 superpose_rt ($group1, $group2)
820              
821             WARNING: 1. needs more testing (feel free to contribute tests!). 2. may shift to another class.
822              
823             args: two hackmol objects (HackaMol::AtomGroup or HackaMol::Molecule) with same number of atoms.
824             This method is intended to be very flexible. It does not check meta data of the atoms, it just pulls
825             the vectors in each group to calculate the rotation matrix and translation vector needed to superpose
826             the second set on to the first set.
827              
828             The vectors assumed to be in the same order, that's it!
829              
830             A typical workflow:
831              
832             my $bb1 = $mol1->select_group('backbone');
833             my $bb2 = $mol2->select_group('backbone');
834             my ($rmat,$trans,$rmsd) = HackaMol->new()->superpose_rt($bb1,$bb2);
835             # $rmsd is the RMSD between backbones
836              
837             # to calculate rmsd between other atoms after the backbone alignment
838             $mol2->rotate_translate($rmat,$trans);
839             my $total_rmsd = HackaMol->new()->rmsd($mol1,$mol2);
840             # $total_rmsd is from all atoms in each mol
841              
842             the algorithm is lifted from Bio::PDB::Structure, which implements
843             algorithm from S. Kearsley, Acta Cryst. A45, 208-210 1989
844              
845             returns:
846             1. rotation matrix [3 rows, each is a MVR , e.g. x' = row_1 * xyz]
847             2. translation vector (MVR)
848             3. rmsd
849              
850             =head1 ATTRIBUTES
851              
852             =head2 name
853              
854             name is a rw str provided by HackaMol::NameRole.
855              
856             =head2 readline_func
857              
858             hook to add control to parsing files
859              
860             HackaMol->new(
861             readline_func => sub {return "PDB_SKIP" unless /LYS/ }
862             )
863             ->pdbid_mol("2cba")
864             ->print_pdb; # will parse lysines because the PDB reader looks for the PDB_SKIP return value
865              
866             =head1 SYNOPSIS
867              
868             # simple example: load pdb file and extract the disulfide bonds
869              
870             use HackaMol;
871              
872             my $bldr = HackaMol->new( name => 'builder');
873             my $mol = $bldr->pdbid_mol('1kni');
874              
875             my @disulfide_bonds = $bldr->find_disulfide_bonds( $mol->all_atoms );
876              
877             print $_->dump foreach @disulfide_bonds;
878              
879             See the above executed in this L<linked notebook|https://github.com/demianriccardi/p5-IPerl-Notebooks/blob/master/HackaMol/HackaMol-Synopsis.ipynb>
880              
881             =head1 SEE ALSO
882              
883             =over 4
884              
885             =item *
886              
887             L<HackaMol::Atom>
888              
889             =item *
890              
891             L<HackaMol::Bond>
892              
893             =item *
894              
895             L<HackaMol::Angle>
896              
897             =item *
898              
899             L<HackaMol::Dihedral>
900              
901             =item *
902              
903             L<HackaMol::AtomGroup>
904              
905             =item *
906              
907             L<HackaMol::Molecule>
908              
909             =item *
910              
911             L<HackaMol::X::Calculator>
912              
913             =item *
914              
915             L<HackaMol::X::Vina>
916              
917             =item *
918              
919             L<Protein Data Bank|http://pdb.org>
920              
921             =item *
922              
923             L<VMD|http://www.ks.uiuc.edu/Research/vmd/>
924              
925             =back
926              
927             =head1 EXTENDS
928              
929             =over 4
930              
931             =item * L<Moose::Object>
932              
933             =back
934              
935             =head1 CONSUMES
936              
937             =over 4
938              
939             =item * L<HackaMol::Roles::ExeRole>
940              
941             =item * L<HackaMol::Roles::FileFetchRole>
942              
943             =item * L<HackaMol::Roles::MolReadRole>
944              
945             =item * L<HackaMol::Roles::NERFRole>
946              
947             =item * L<HackaMol::Roles::NameRole>
948              
949             =item * L<HackaMol::Roles::NameRole|HackaMol::Roles::MolReadRole|HackaMol::Roles::PathRole|HackaMol::Roles::ExeRole|HackaMol::Roles::FileFetchRole|HackaMol::Roles::NERFRole|HackaMol::Roles::RcsbRole>
950              
951             =item * L<HackaMol::Roles::PathRole>
952              
953             =item * L<HackaMol::Roles::RcsbRole>
954              
955             =item * L<HackaMol::Roles::ReadPdbRole>
956              
957             =item * L<HackaMol::Roles::ReadPdbqtRole>
958              
959             =item * L<HackaMol::Roles::ReadPdbxRole>
960              
961             =item * L<HackaMol::Roles::ReadXyzRole>
962              
963             =item * L<HackaMol::Roles::ReadYAMLRole>
964              
965             =item * L<HackaMol::Roles::ReadYAMLRole|HackaMol::Roles::ReadZmatRole|HackaMol::Roles::ReadPdbRole|HackaMol::Roles::ReadPdbxRole|HackaMol::Roles::ReadPdbqtRole|HackaMol::Roles::ReadXyzRole>
966              
967             =item * L<HackaMol::Roles::ReadZmatRole>
968              
969             =back
970              
971             =head1 AUTHOR
972              
973             Demian Riccardi <demianriccardi@gmail.com>
974              
975             =head1 COPYRIGHT AND LICENSE
976              
977             This software is copyright (c) 2017 by Demian Riccardi.
978              
979             This is free software; you can redistribute it and/or modify it under
980             the same terms as the Perl 5 programming language system itself.
981              
982             =cut