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