line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Chemistry::Ring; |
2
|
|
|
|
|
|
|
$VERSION = '0.20'; |
3
|
|
|
|
|
|
|
#$Id: Ring.pm,v 1.2 2009/05/10 21:12:44 itubert Exp $ |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
=head1 NAME |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
Chemistry::Ring - Represent a ring as a substructure of a molecule |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
=head1 SYNOPSIS |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use Chemistry::Ring; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
# already have a molecule in $mol... |
14
|
|
|
|
|
|
|
# create a ring with the first six atoms in $mol |
15
|
|
|
|
|
|
|
my $ring = Chemistry::Ring->new; |
16
|
|
|
|
|
|
|
$ring->add_atom($_) for $mol->atoms(1 .. 6); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# find the centroid |
19
|
|
|
|
|
|
|
my $vector = $ring->centroid; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# find the plane that fits the ring |
22
|
|
|
|
|
|
|
my ($normal, $distance) = $ring->plane; |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# is the ring aromatic? |
25
|
|
|
|
|
|
|
print "is aromatic!\n" if $ring->is_aromatic; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# "aromatize" a molecule |
28
|
|
|
|
|
|
|
Chemistry::Ring::aromatize_mol($mol); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
# get the rings involving an atom (after aromatizing) |
31
|
|
|
|
|
|
|
my $rings = $mol->atoms(3)->attr('ring/rings'); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
=head1 DESCRIPTION |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
This module provides some basic methods for representing a ring. A ring is |
36
|
|
|
|
|
|
|
a subclass of molecule, because it has atoms and bonds. Besides that, it |
37
|
|
|
|
|
|
|
has some useful geometric methods for finding the centroid and the ring plane, |
38
|
|
|
|
|
|
|
and methods for aromaticity detection. |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
This module does not detect the rings by itself; for that, look at |
41
|
|
|
|
|
|
|
L. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
This module is part of the PerlMol project, L. |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
=cut |
46
|
|
|
|
|
|
|
|
47
|
5
|
|
|
5
|
|
89590
|
use strict; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
161
|
|
48
|
5
|
|
|
5
|
|
23
|
use warnings; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
140
|
|
49
|
5
|
|
|
5
|
|
2947
|
use Math::VectorReal qw(:axis vector); |
|
5
|
|
|
|
|
19954
|
|
|
5
|
|
|
|
|
1025
|
|
50
|
5
|
|
|
5
|
|
5207
|
use Statistics::Regression; |
|
5
|
|
|
|
|
28082
|
|
|
5
|
|
|
|
|
193
|
|
51
|
5
|
|
|
5
|
|
3593
|
use Chemistry::Mol; |
|
5
|
|
|
|
|
131496
|
|
|
5
|
|
|
|
|
319
|
|
52
|
5
|
|
|
5
|
|
47
|
use base 'Chemistry::Mol', 'Exporter'; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
603
|
|
53
|
5
|
|
|
5
|
|
34
|
use Scalar::Util 'weaken'; |
|
5
|
|
|
|
|
11
|
|
|
5
|
|
|
|
|
2996
|
|
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
our @EXPORT_OK = qw(aromatize_mol); |
56
|
|
|
|
|
|
|
our %EXPORT_TAGS = ( all => \@EXPORT_OK ); |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
our $N = 0; |
59
|
|
|
|
|
|
|
our $DEBUG = 0; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=head1 METHODS |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
=over 4 |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=item Chemistry::Ring->new(name => value, ...) |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
Create a new Ring object with the specified attributes. Same as |
68
|
|
|
|
|
|
|
C<< Chemistry::Mol->new >>. |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
=cut |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub nextID { |
73
|
42
|
|
|
42
|
0
|
501
|
"ring".++$N; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
# make sure we don't become parent of the atoms added to us |
78
|
42
|
|
|
42
|
1
|
170
|
sub add_atom { shift->SUPER::add_atom_np(@_) } |
79
|
42
|
|
|
42
|
1
|
161
|
sub add_bond { shift->SUPER::add_bond_np(@_) } |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub print { |
82
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
83
|
0
|
|
|
|
|
0
|
return <
|
84
|
|
|
|
|
|
|
ring: |
85
|
0
|
|
|
|
|
0
|
id: $self->{id} |
86
|
0
|
|
|
|
|
0
|
atoms: @{$self->{atoms}} |
87
|
|
|
|
|
|
|
bonds: @{$self->{bonds}} |
88
|
|
|
|
|
|
|
EOF |
89
|
|
|
|
|
|
|
} |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
=item $ring->centroid |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
Returs a vector with the centroid, defined as the average of the coordinates |
94
|
|
|
|
|
|
|
of all the atoms in the ring. The vecotr is a L object. |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=cut |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
sub centroid { |
99
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
100
|
0
|
|
|
|
|
0
|
my $c = O; # origin |
101
|
0
|
|
|
|
|
0
|
my $n = 0; |
102
|
0
|
|
|
|
|
0
|
for my $a ($self->atoms) { |
103
|
0
|
|
|
|
|
0
|
$c += $a->coords; |
104
|
0
|
|
|
|
|
0
|
++$n; |
105
|
|
|
|
|
|
|
} |
106
|
0
|
|
|
|
|
0
|
$c = $c / $n; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item my ($norm, $d) = $ring->plane |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
Returns the normal and distance to the origin that define the plane that best |
112
|
|
|
|
|
|
|
fits the atoms in the ring, by using multivariate regression. The normal |
113
|
|
|
|
|
|
|
vector is a L object. |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
=cut |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub plane { |
118
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
119
|
0
|
|
|
|
|
0
|
my $reg = Statistics::Regression->new(3, "plane for $self", [qw(b mx my)]); |
120
|
0
|
|
|
|
|
0
|
for my $atom ($self->atoms) { |
121
|
0
|
|
|
|
|
0
|
my ($x, $y, $z) = $atom->coords->array; |
122
|
0
|
|
|
|
|
0
|
$reg->include($z, [1.0, $x, $y]); |
123
|
|
|
|
|
|
|
} |
124
|
0
|
0
|
|
|
|
0
|
$reg->print if $DEBUG; |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# convert the theta vector (z = a + bx + cy) to a normal vector and |
127
|
|
|
|
|
|
|
# distance to the origin |
128
|
0
|
|
|
|
|
0
|
my @coef = (@{$reg->theta}, -1.0); # -1 is d in a + bx + cx + dz = 0 |
|
0
|
|
|
|
|
0
|
|
129
|
0
|
|
|
|
|
0
|
my $d = shift @coef; # distance (not normalized) |
130
|
0
|
|
|
|
|
0
|
my $sum_sq = 0; # normalization constant |
131
|
0
|
|
|
|
|
0
|
$sum_sq += $_*$_ for @coef; |
132
|
0
|
|
0
|
|
|
0
|
$sum_sq ||= 1; |
133
|
0
|
|
|
|
|
0
|
($d, @coef) = map { $_ / $sum_sq } ($d, @coef); # normalize |
|
0
|
|
|
|
|
0
|
|
134
|
0
|
|
|
|
|
0
|
return (vector(@coef)->norm, $d); |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=item $ring->is_aromatic |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
Naively guess whether ring is aromatic from the molecular graph, with a method |
140
|
|
|
|
|
|
|
based on Huckel's rule. This method is not very accurate, but works for simple |
141
|
|
|
|
|
|
|
molecules. Returns true or false. |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
=cut |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
sub is_aromatic { |
146
|
33
|
|
|
33
|
1
|
2173
|
my ($self) = @_; |
147
|
33
|
|
|
|
|
54
|
my $n_pi = 0; |
148
|
|
|
|
|
|
|
|
149
|
33
|
|
|
|
|
90
|
for my $atom ($self->atoms) { |
150
|
5
|
|
|
5
|
|
32
|
no warnings 'uninitialized'; |
|
5
|
|
|
|
|
12
|
|
|
5
|
|
|
|
|
2358
|
|
151
|
76
|
100
|
|
|
|
400
|
return 0 if ($atom->bonds + $atom->hydrogens > 3); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
# build bond order histogram |
154
|
51
|
|
|
|
|
941
|
my @order_freq = (0,0,0,0); |
155
|
51
|
|
|
|
|
147
|
for my $bond ($atom->bonds) { |
156
|
104
|
|
|
|
|
1072
|
$order_freq[$bond->order]++; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
51
|
50
|
33
|
|
|
457
|
return 0 if ($order_freq[3] or $order_freq[2] > 1); |
160
|
51
|
100
|
|
|
|
122
|
if ($order_freq[2] == 1) { |
|
|
100
|
|
|
|
|
|
161
|
46
|
|
|
|
|
97
|
$n_pi += 1; |
162
|
|
|
|
|
|
|
} elsif ($atom->symbol =~ /^[NOS]$/) { |
163
|
2
|
|
|
|
|
27
|
$n_pi += 2; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
#print "n_pi = $n_pi\n"; |
167
|
8
|
100
|
|
|
|
47
|
return ($n_pi % 4 == 2) ? 1 : 0; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
1; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=back |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
=head1 EXPORTABLE SUBROUTINES |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
Nothing is exported by default, but you can export these subroutines |
177
|
|
|
|
|
|
|
explicitly, or all of them by using the ':all' tag. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=over |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=item aromatize_mol($mol) |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Finds all the aromatic rings in the molecule and marks all the atoms and bonds |
184
|
|
|
|
|
|
|
in those rings as aromatic. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
It also adds the 'ring/rings' attribute to the molecule and to all ring atoms |
187
|
|
|
|
|
|
|
and bonds; this attribute is an array reference containing the list of rings |
188
|
|
|
|
|
|
|
that involve that atom or bond (or all the rings in the case of the molecule). |
189
|
|
|
|
|
|
|
NOTE (the ring/rings attribute is experimental and might change in future |
190
|
|
|
|
|
|
|
versions). |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
=cut |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub aromatize_mol { |
195
|
1
|
|
|
1
|
1
|
2780
|
my ($mol) = @_; |
196
|
|
|
|
|
|
|
|
197
|
1
|
|
|
|
|
824
|
require Chemistry::Ring::Find; |
198
|
|
|
|
|
|
|
|
199
|
1
|
|
|
|
|
7
|
$_->aromatic(0) for ($mol->atoms, $mol->bonds); |
200
|
|
|
|
|
|
|
|
201
|
1
|
|
|
|
|
69
|
my @rings = Chemistry::Ring::Find::find_rings($mol); |
202
|
1
|
|
|
|
|
14
|
$mol->attr("ring/rings", \@rings); |
203
|
1
|
|
|
|
|
14
|
$_->attr("ring/rings", []) for ($mol->atoms, $mol->bonds); |
204
|
|
|
|
|
|
|
|
205
|
1
|
|
|
|
|
86
|
for my $ring (@rings) { |
206
|
1
|
50
|
|
|
|
5
|
if ($ring->is_aromatic) { |
207
|
0
|
|
|
|
|
0
|
$_->aromatic(1) for ($ring->atoms, $ring->bonds); |
208
|
|
|
|
|
|
|
} |
209
|
1
|
|
|
|
|
11
|
for ($ring->atoms, $ring->bonds) { |
210
|
6
|
|
50
|
|
|
75
|
my $ringlist = $_->attr("ring/rings") || []; |
211
|
6
|
|
|
|
|
48
|
push @$ringlist, $ring; |
212
|
6
|
|
|
|
|
17
|
weaken($ringlist->[-1]); |
213
|
6
|
|
|
|
|
14
|
$_->attr("ring/rings", $ringlist); |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
1
|
|
|
|
|
14
|
@rings; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=back |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=head1 VERSION |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
0.20 |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head1 SEE ALSO |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
L, L, L, |
228
|
|
|
|
|
|
|
L. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 AUTHOR |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Ivan Tubert-Brohman |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head1 COPYRIGHT |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Copyright (c) 2009 Ivan Tubert-Brohman. All rights reserved. This program is |
237
|
|
|
|
|
|
|
free software; you can redistribute it and/or modify it under the same terms as |
238
|
|
|
|
|
|
|
Perl itself. |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=cut |
241
|
|
|
|
|
|
|
|