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.052';
2             #ABSTRACT: HackaMol: Object-Oriented Library for Molecular Hacking
3             use 5.008;
4 11     11   1719356 use Moose;
  11         114  
5 11     11   5445 use HackaMol::AtomGroup;
  11         3835257  
  11         76  
6 11     11   79051 use HackaMol::Molecule;
  11         46  
  11         578  
7 11     11   6737 use HackaMol::Atom;
  11         41  
  11         493  
8 11     11   7506 use HackaMol::Bond;
  11         42  
  11         501  
9 11     11   6231 use HackaMol::Angle;
  11         47  
  11         484  
10 11     11   6452 use HackaMol::Dihedral;
  11         43  
  11         470  
11 11     11   6461 use Math::Vector::Real;
  11         47  
  11         504  
12 11     11   94 use namespace::autoclean;
  11         21  
  11         682  
13 11     11   63 use MooseX::StrictConstructor;
  11         22  
  11         91  
14 11     11   989 use Scalar::Util qw(refaddr);
  11         26  
  11         78  
15 11     11   35359 use Carp;
  11         31  
  11         605  
16 11     11   62  
  11         23  
  11         38526  
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 241 my ($file) = $self->getstore_pdbid($pdbid);
36 1   33     29 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 1659  
43 5         12 my @atoms = $self->read_file_atoms($file);
44 5 100       20 my @matoms = $mol->all_atoms;
45              
46 4         23 if ( scalar(@matoms) != scalar(@atoms) ) {
47 4         188 croak "file_push_coords_mol> number of atoms not same";
48             }
49 4 100       17 foreach my $i ( 0 .. $#atoms ) {
50 1         32 if ( $matoms[$i]->Z != $atoms[$i]->Z ) {
51             croak "file_push_coords_mol> atom mismatch";
52 3         12 }
53 117 100       2159 $matoms[$i]->push_coords($_) foreach ( $atoms[$i]->all_coords );
54 1         30 }
55             }
56 116         3608  
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 10 HackaMol::Molecule->new(
64 1         3 name => $file,
65 1         10 atoms => $atoms,
66             info => $header,
67 1         41 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 95 return ( HackaMol::Molecule->new( name => $name, atoms => [@atoms] ) );
78 6         16 }
79              
80 6         38 my $self = shift;
81 6         38 my $string = shift;
82 6         424 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 905 return ( HackaMol::Molecule->new( name => $name, atoms => [@atoms] ) );
87 6         12 }
88 6 50       21  
89              
90 6         36 #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 182 while ( $k + 1 <= $#atoms ) {
99 4         14 my $name =
100 4 100       21 join( "_", map { _name_resid( $_, 'B' ) } @atoms[ $k .. $k + 1 ] );
101 3         7 push @bonds,
102             HackaMol::Bond->new(
103             name => $name,
104 3         4 atoms => [ @atoms[ $k, $k + 1 ] ]
105 3         10 );
106             $k++;
107 177         304 }
  354         526  
108 177         3874 return (@bonds);
109             }
110              
111              
112             #take a list of n, atoms; walk down list and generate angles
113 177         380 my $self = shift;
114             my @atoms = @_;
115 3         31 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 165 while ( $k + 2 <= $#atoms ) {
122 4         12 my $name =
123 4 100       17 join( "_", map { _name_resid( $_, 'A' ) } @atoms[ $k .. $k + 2 ] );
124 3         7 push @angles,
125             HackaMol::Angle->new(
126             name => $name,
127 3         5 atoms => [ @atoms[ $k .. $k + 2 ] ]
128             );
129 3         10 $k++;
130             }
131 174         282 return (@angles);
  522         787  
132 174         3566 }
133              
134             my $atom = shift;
135             my $default = shift;
136             return ( $default . $atom->resid )
137 174         362 unless $atom->has_name; # this comes up when undefined atoms are passed
138             return ( $atom->name . $atom->resid );
139 3         37 }
140              
141              
142             #take a list of n, atoms; walk down list and generate dihedrals
143 1560     1560   1754 my $self = shift;
144 1560         1790 my @atoms = @_;
145 1560 100       36156 croak "<4 atoms passed to build_dihedrals" unless ( @atoms > 3 );
146             my @dihedrals;
147 1040         19761  
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 208 push @dihedrals,
154 4         12 HackaMol::Dihedral->new(
155 4 100       28 name => $name,
156 3         4 atoms => [ @atoms[ $k .. $k + 3 ] ]
157             );
158             $k++;
159 3         7 }
160 3         9 return (@dihedrals);
161             }
162 171         306  
  684         1039  
163 171         3768  
164             # group atoms by attribute
165             # Z, name, bond_count, etc.
166             my $self = shift;
167             my $attr = shift;
168 171         373 my @atoms = @_;
169              
170 3         37 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 24 keys(%group);
178 16         24  
179 16         72 return (@atomgroups);
180              
181 16         20 }
182 16         25  
183 1520         1648  
  1520         28569  
184             # group atoms by attributes
185             # Z, name, bond_count, etc.
186             # keep splitting the groups until there are no more attributes
187 16         94 my $self = shift;
  130         3023  
188             my @attrs = @{ +shift };
189             my @atoms = @_;
190 16         171  
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 3 $self->group_by_atom_attr( $attr, $group->all_atoms );
200 1         2 }
  1         5  
201 1         20 @groups = @local_groups;
202             }
203 1 50       4  
204             return (@groups);
205 1         50  
206             }
207 1         5  
208 2         2  
209 2         7 # take atom group
210 13         405 my $self = shift;
211             my $mol = shift;
212             my $fudge = shift;
213 2         58 $fudge = 0.15 unless defined($fudge);
214              
215             my @sulfs = $mol->select_group("Z 16")->all_atoms;
216 1         13 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 467 foreach my $js ( $is + 1 .. $#sulfs ) {
224 1         3 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       28 name => $nm . "_" . $count++,
230 1         26 atoms => [ $at_i, $at_j ],
231 1         3 );
232 1         3 }
233 1         2 }
234 1         4 }
235 27         34 return @bonds;
236 27         52 }
237 351         423  
238 351         584  
239 351 100       636 # to be deprecated
240 9         201 # 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         9 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         7  
  3009         53695  
259 1         13 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         9 my @init_bond_counts = map { $_->bond_count } ( @bond_atoms, @atoms );
266              
267             my @bonds;
268             my %name;
269 6     6 1 20  
270 6         37 foreach my $at_i (@bond_atoms) {
271 6         10 next if ( $at_i->bond_count >= $max_bonds );
  6         14  
272 6         9 my $cov_i = $at_i->covalent_radius;
  6         19  
273              
274 6         9 foreach my $at_j (@atoms) {
275 6         11 next if ( refaddr($at_i) == refaddr($at_j) );
276             next if ( $at_j->bond_count >= $max_bonds );
277 6 100       14 my $cov_j = $at_j->covalent_radius;
278 6 100       13 my $dist = $at_j->distance($at_i);
279              
280 6         15 if ( $dist <= $cov_i + $cov_j + $fudge ) {
  338         6212  
281             my $nm = $at_i->symbol . "-" . $at_j->symbol;
282 6         23 $name{$nm}++;
283             push @bonds,
284             HackaMol::Bond->new(
285 6         14 name => "$nm\_" . $name{$nm},
286 37 100       715 atoms => [ $at_i, $at_j ],
287 28         601 );
288             $at_i->inc_bond_count;
289 28         48 $at_j->inc_bond_count;
290 1030 100       2099 }
291 1002 100       19459  
292 844         16589 }
293 844         1599 }
294              
295 844 100       1837 my $i = 0;
296 33         707 foreach my $at ( @bond_atoms, @atoms ) {
297 33         68 $at->reset_bond_count;
298             $at->inc_bond_count( $init_bond_counts[$i] );
299             $i++;
300 33         737 }
301             return (@bonds);
302              
303 33         1002 }
304 33         845  
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         14 my $bond = shift;
311 6         13 my $iba = $bond->get_atoms(0)->iatom;
312 338         8804 my $ibb = $bond->get_atoms(1)->iatom;
313 338         8677  
314 338         414 my $init = {
315             $iba => 1,
316 6         91 $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 6  
371 1         3 my $gc1 = $g1->center;
372 1         2 my $gc2 = $g2->center; # these are MVRs
373              
374 1         30 my @mvr1 = map { $_->xyz - $gc1 } $g1->all_atoms;
375 1         28 my @mvr2 = map { $_->xyz - $gc2 } $g2->all_atoms;
376 1 50 33     7  
377             foreach my $i ( 0 .. $nrd1 - 1 ) {
378             ( $x1, $y1, $z1 ) = @{ $mvr1[$i] };
379 1         11 ( $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         6 $Sxpxp += $xp * $xp;
389 1         5 $Symym += $ym * $ym;
390             $Sypyp += $yp * $yp;
391 1         31 $Szmzm += $zm * $zm;
  7         16  
392 1         31 $Szpzp += $zp * $zp;
  7         15  
393              
394 1         4 $Sxmym += $xm * $ym;
395 7         6 $Sxmyp += $xm * $yp;
  7         13  
396 7         9 $Sxpym += $xp * $ym;
  7         9  
397 7         8 $Sxpyp += $xp * $yp;
398 7         8  
399 7         8 $Sxmzm += $xm * $zm;
400 7         8 $Sxmzp += $xm * $zp;
401 7         7 $Sxpzm += $xp * $zm;
402 7         8 $Sxpzp += $xp * $zp;
403              
404 7         9 $Symzm += $ym * $zm;
405 7         6 $Symzp += $ym * $zp;
406 7         8 $Sypzm += $yp * $zm;
407 7         8 $Sypzp += $yp * $zp;
408 7         8 }
409 7         8  
410             my @m;
411 7         7 $m[0] = $Sxmxm + $Symym + $Szmzm;
412 7         7 $m[1] = $Sypzm - $Symzp;
413 7         7 $m[2] = $Sxmzp - $Sxpzm;
414 7         8 $m[3] = $Sxpym - $Sxmyp;
415             $m[4] = $m[1];
416 7         7 $m[5] = $Sypyp + $Szpzp + $Sxmxm;
417 7         6 $m[6] = $Sxmym - $Sxpyp;
418 7         7 $m[7] = $Sxmzm - $Sxpzp;
419 7         9 $m[8] = $m[2];
420             $m[9] = $m[6];
421 7         8 $m[10] = $Sxpxp + $Szpzp + $Symym;
422 7         8 $m[11] = $Symzm - $Sypzp;
423 7         7 $m[12] = $m[3];
424 7         8 $m[13] = $m[7];
425             $m[14] = $m[11];
426             $m[15] = $Sxpxp + $Sypyp + $Szmzm;
427 1         2  
428 1         3 #compute the egienvectors and eigenvalues of the matrix
429 1         3 my ( $revec, $reval ) = &__diagonalize(@m);
430 1         2  
431 1         2 #the smallest eigenvalue is the rmsd for the optimal alignment
432 1         2 my $rmsd = sqrt( abs( $reval->[0] ) / $nrd1 );
433 1         3  
434 1         2 #fetch the optimal quaternion
435 1         3 my @q;
436 1         2 $q[0] = $revec->[0][0];
437 1         2 $q[1] = $revec->[1][0];
438 1         2 $q[2] = $revec->[2][0];
439 1         2 $q[3] = $revec->[3][0];
440 1         3  
441 1         1 #construct the rotation matrix given by the quaternion
442 1         2 my @mt;
443 1         3 $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         4  
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         4 $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         1 $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         1 #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         3 $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         2 return ( [ V( @mt[ 0, 1, 2 ] ), V( @mt[ 3, 4, 5 ] ), V( @mt[ 6, 7, 8 ] ) ],
465 1         3 V(@vt), $rmsd );
466 1         3 }
467              
468 1         4 my $self = shift;
469 1         2 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         2 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         4 unless ( $nrd1 == $nrd2 && $nrd1 > 0 );
477              
478 1         4 my @w;
479             if ( defined($w) ) {
480             @w = @{$w};
481 1         19 }
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   11  
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         4 }
563 4         6 last if ( ( $onorm / $dnorm ) <= 1.0e-12 );
564 16         21 for ( $j = 1 ; $j <= 3 ; $j++ ) {
565 16         27 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         4 if ( ( abs($dma) + abs($b) ) <= abs($dma) ) {
570 4         5 $t = $b / $dma;
571 4         8 }
572             else {
573             $q = 0.5 * $dma / $b;
574 1         4 $t = 1.0 / ( abs($q) + sqrt( 1.0 + $q * $q ) );
575 1         1 $t *= -1.0 if ( $q < 0.0 );
576 1         2 }
577 1         4 $c = 1.0 / sqrt( $t * $t + 1.0 );
578 4         6 $s = $t * $c;
579 4         8 $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       3 $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         3 }
630 1         4  
631 3         4 return ( \@v, \@d );
632 3         4 }
633 3         6  
634 6 50       13 __PACKAGE__->meta->make_immutable;
635 0         0  
636 0         0 1;
637              
638              
639             =pod
640 3 50       7  
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.052
648              
649             =head1 DESCRIPTION
650              
651 1         4 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