File Coverage

blib/lib/HackaMol/Roles/ReadYAMLRole.pm
Criterion Covered Total %
statement 18 117 15.3
branch 0 20 0.0
condition n/a
subroutine 6 9 66.6
pod 0 2 0.0
total 24 148 16.2


line stmt bran cond sub pod time code
1             $HackaMol::Roles::ReadYAMLRole::VERSION = '0.053';
2             # ABSTRACT: Read files with molecular information
3             use Moose::Role;
4 11     11   6903 use HackaMol::PeriodicTable qw(%KNOWN_NAMES _trim);
  11         23  
  11         75  
5 11     11   48703 use Math::Vector::Real;
  11         27  
  11         1095  
6 11     11   85 use Carp;
  11         37  
  11         513  
7 11     11   64 use List::MoreUtils qw(singleton);
  11         25  
  11         587  
8 11     11   5831  
  11         122372  
  11         73  
9             with qw(
10             HackaMol::Roles::NERFRole
11             );
12              
13             # atoms:
14             #- N 0 0.483824 1.697569 -0.701935
15             #....
16             #- C 2 CC 3 CCC 4 CCCC
17             #vars:
18             #- CC : 1.54
19             #- CCC : 106.42
20             #- CCCC : [-81.90, 89, 09]
21              
22             # this is going to be the simplest implementation for now using the code from the zmatrix reader
23             # generate a zmatrix (or zmatrices if there are scans) and push on to the atoms
24             #xyz file and generate list of Atom object
25             #issue 16 on github
26             my $self = shift;
27             my $yaml = shift;
28 0     0 0   #use Data::Dumper;
29 0           #print Dumper $yaml;
30             my %vars = %{$yaml->{vars}};
31             my @atlines = @{$yaml->{atoms}};
32 0           my @atoms;
  0            
33 0           my ( $n, $t ) = ( 0, 0 );
  0            
34 0            
35 0           my @scan_vars = grep {ref($vars{$_}) eq 'ARRAY'} keys (%vars) ;
36             if (@scan_vars) {
37 0           my $scan_var = pop @scan_vars;
  0            
38 0 0         carp "scanning more than one coordinate not supported; ignoring scans for $scan_vars[0]" if @scan_vars ;
39 0           my $values_rh = delete $vars{$scan_var};
40 0 0          
41 0           foreach my $value (@{$values_rh}){
42             $vars{$scan_var} = $value;
43 0           my @atlines = _yaml_substitute_variables(\%vars, \@atlines);
  0            
44 0           @atoms = $self->parse_zmat_atoms(\@atlines, \@atoms, $t);
45 0           $t++;
46 0           }
47 0           }
48             else {
49              
50             my @atlines = _yaml_substitute_variables(\%vars, \@atlines);
51             @atoms = $self->parse_zmat_atoms(\@atlines, \@atoms, $t);
52 0           }
53 0            
54             $atoms[$_]->iatom($_) foreach ( 0 .. $#atoms );
55             #use Data::Dumper;
56 0           #print Dumper \@atoms;
57              
58             return (\@atoms);
59              
60 0           }
61              
62             my $self = shift;
63             my $zmat = shift;
64             my $atoms = shift;
65 0     0 0   my $t = shift;
66 0           my @zmat = @{ $zmat };
67 0           my @atoms = @{ $atoms };
68 0            
69 0           #use Data::Dumper;
  0            
70 0           #print Dumper $zmat;
  0            
71              
72             # we have 5 types of extensions
73             # A. SYM 0 x y z
74             # B. SYM
75             # C. SYM i R
76             # D. SYM i R j Ang
77             # E. SYM i R j Ang k Tors
78             # we need to filter the indices (can't lose the location)
79              
80             #type A
81             my @iA = grep { $zmat[$_] =~ m/^\s*\w+\s+0(\s+-*\d*\.*\d*){3}/ } 0 .. $#zmat;
82             my @inA = singleton( 0 .. $#zmat, @iA );
83              
84 0           #type B
  0            
85 0           my @iB = grep { $zmat[$_] =~ m/^\s*\w+\s*$/ } @inA;
86              
87             #type C
88 0           my @iC = grep { $zmat[$_] =~ m/^\s*\w+(\s+\d+\s+\d*\.*\d*)\s*$/ } @inA;
  0            
89              
90             #type D
91 0           my @iD = grep { $zmat[$_] =~ m/^\s*\w+(\s+\d+\s+\d*\.*\d*){2}\s*$/ } @inA;
  0            
92              
93             #type E
94 0           my @iE = grep {
  0            
95             $zmat[$_] =~ m/^\s*\w+(\s+\d+\s+\d*\.*\d*){2}\s+\d+\s+-*\d*\.*\d*\s*$/
96             } @inA;
97              
98 0           my $diff = @zmat - (@iA+@iB+@iC+@iD+@iE); #scalar context
  0            
99            
100             if ($diff){
101 0           print "Lines in Z-matrix: ", scalar (@zmat), " Number of lines to be processed: ", scalar (@zmat) - $diff, "\n";
102             print "Lines missed: ", $diff, "\n";
103 0 0         print "\n\nHere is your Z-matrix:\n";
104 0           print $_ . "\n" foreach @zmat;
105 0           print "Indices of lines to be processed: ", join("\n", @iA, @iB, @iC, @iD, @iE);
106 0           croak "\nThere is something funky with your zmatrix";
107 0           }
108 0            
109 0           foreach my $ia (@iA) {
110             my ( $sym, $iat1, @xyz ) = split( ' ', $zmat[$ia] );
111             if ($t) {
112 0           #print "$ia SHITSHIT $t\n";
113 0           #print Dumper $atoms[$ia];
114 0 0         $atoms[$ia]->set_coords($t, V(@xyz));
115             } else {
116             $atoms[$ia] = HackaMol::Atom->new(
117 0           name => $sym.$ia,
118             symbol => $sym,
119 0           coords => [V(@xyz)]
120             );
121             }
122             }
123            
124             foreach my $ib (@iB) {
125             my $sym = $zmat[$ib];
126             my $a = $self->init;
127 0           $sym =~ s/^\s+|\s+$//;
128 0           if ($t) {
129 0           $atoms[$ib]->set_coords($t, $a);
130 0           } else {
131 0 0         $atoms[$ib] = HackaMol::Atom->new(
132 0           name => $sym.$ib,
133             symbol => $sym,
134 0           coords => [$a]
135             );
136             }
137             }
138              
139             # print Dump 'B', \@atoms;
140              
141             foreach my $ic (@iC) {
142             my ( $sym, $iat1, $R ) = split( ' ', $zmat[$ic] );
143             my $a = $atoms[ $iat1 - 1 ]->xyz;
144 0           my $b = $self->extend_a( $a, $R );
145 0           if ($t) {
146 0           $atoms[$ic]->set_coords($t, $b);
147 0           } else {
148 0 0         $atoms[$ic] = HackaMol::Atom->new(
149 0           name => $sym.$ic,
150             symbol => $sym,
151 0           coords => [$b]
152             );
153             }
154             }
155              
156             # print Dump 'C', \@atoms;
157              
158             foreach my $id (@iD) {
159             my ( $sym, $iat1, $R, $iat2, $ang ) = split( ' ', $zmat[$id] );
160             my $a = $atoms[ $iat1 - 1 ]->get_coords($t);
161 0           my $b = $atoms[ $iat2 - 1 ]->get_coords($t);
162 0           my $c = $self->extend_ab( $b, $a, $R, $ang );
163 0           if ($t) {
164 0           $atoms[$id]->set_coords($t, $c);
165 0           } else {
166 0 0         $atoms[$id] = HackaMol::Atom->new(
167 0           name => $sym.$id,
168             symbol => _trim($sym),
169 0           coords => [$c]
170             );
171             }
172             }
173              
174             # print Dump 'D', \@atoms;
175              
176             foreach my $ie (@iE) {
177             my ( $sym, $iat1, $R, $iat2, $ang, $iat3, $tor ) =
178             split( ' ', $zmat[$ie] );
179 0           my $a = $atoms[ $iat1 - 1 ]->get_coords($t);
180 0           my $b = $atoms[ $iat2 - 1 ]->get_coords($t);
181             my $c = $atoms[ $iat3 - 1 ]->get_coords($t);
182 0           my $d = $self->extend_abc( $c, $b, $a, $R, $ang, $tor );
183 0           if ($t) {
184 0           $atoms[$ie]->set_coords($t, $d);
185 0           } else {
186 0 0         $atoms[$ie] = HackaMol::Atom->new(
187 0           name => $sym.$ie,
188             symbol => _trim($sym),
189 0           coords => [$d]
190             );
191             }
192             }
193             return @atoms;
194             }
195              
196 0           my ($var,$Zmat) = (shift,shift);
197             my %var = %{ $var };
198             my @Zmat = @{ $Zmat };
199              
200 0     0     foreach my $line (@Zmat){
201 0           my @vals = split (/ /, $line);
  0            
202 0           next unless @vals > 2;
  0            
203             $line = join(' ', $vals[0], map{ exists($var{$_}) ? $var{$_} : $_ } @vals[1 .. $#vals] );
204 0           }
205 0           return (@Zmat);
206 0 0         }
207 0 0          
  0            
208             no Moose::Role;
209 0            
210             1;
211              
212 11     11   23890  
  11         26  
  11         125  
213             =pod
214              
215             =head1 NAME
216              
217             HackaMol::Roles::ReadYAMLRole - Read files with molecular information
218              
219             =head1 VERSION
220              
221             version 0.053
222              
223             =head1 SYNOPSIS
224              
225             my @atoms = HackaMol->new
226             ->read_zmat_atoms("some.zmat");
227              
228             =head1 DESCRIPTION
229              
230             The HackaMol::Roles::ReadZmatRole provides read_zmat_atoms for the flexible reading of Z-matrix files.
231             It supports inline cartesian coordinates and variables as in the following example:
232              
233             N 0 -12.781 3.620 15.274
234              
235             C 0 -11.976 4.652 15.944
236              
237             C 0 -12.722 6.019 15.985
238              
239             O 0 -13.133 6.378 14.897
240              
241             C 2 CBCA 3 CBCAC 4 CBCACO
242              
243             C 5 CBCA 2 CBCAC 3 CG1CBCAC
244              
245             C 5 CBCA 2 CBCAC 3 CG2CBCAC
246              
247             CBCA = 1.54
248              
249             CBCAC = 113.4
250              
251             CBCACO = 71.85
252              
253             CG1CBCAC = 54.
254              
255             CG2CBCAC = 180.
256              
257             =head1 METHODS
258              
259             =head2 read_zmat_atoms
260              
261             One argument: the filename
262             Returns a list of HackaMol::Atom objects.
263              
264             =head1 SEE ALSO
265              
266             =over 4
267              
268             =item *
269              
270             L<HackaMol>
271              
272             =item *
273              
274             L<HackaMol::Atom>
275              
276             =item *
277              
278             L<HackaMol::Roles::MolReadRole>
279              
280             =item *
281              
282             L<Protein Data Bank|http://pdb.org>
283              
284             =back
285              
286             =head1 CONSUMES
287              
288             =over 4
289              
290             =item * L<HackaMol::Roles::NERFRole>
291              
292             =back
293              
294             =head1 AUTHOR
295              
296             Demian Riccardi <demianriccardi@gmail.com>
297              
298             =head1 COPYRIGHT AND LICENSE
299              
300             This software is copyright (c) 2017 by Demian Riccardi.
301              
302             This is free software; you can redistribute it and/or modify it under
303             the same terms as the Perl 5 programming language system itself.
304              
305             =cut