Chemistry-Mol-0.39/0000775000175000017500000000000014263501714014042 5ustar andriusandriusChemistry-Mol-0.39/META.json0000644000175000017500000000270214263501714015462 0ustar andriusandrius{ "abstract" : "Molecule object toolkit", "author" : [ "Ivan Tubert-Brohman " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Chemistry-Mol", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "recommends" : { "Chemistry::InternalCoords" : "0", "Chemistry::Isotope" : "0", "Clone" : "0", "Compress::Zlib" : "0" }, "requires" : { "IO::String" : "0", "Math::VectorReal" : "1.0", "Scalar::Util" : "1.01", "Text::Balanced" : "0" } }, "test" : { "requires" : { "Clone" : "0", "Test::Simple" : "0" } } }, "release_status" : "stable", "resources" : { "homepage" : "https://search.cpan.org/dist/Chemistry-Mol", "repository" : { "type" : "git", "url" : "git://github.com/perlmol/chemistry-mol.git", "web" : "https://github.com/perlmol/chemistry-mol" } }, "version" : "0.39", "x_generated_by_perl" : "v5.30.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.19" } Chemistry-Mol-0.39/Tutorial.pod0000644000175000017500000002675414263501714016365 0ustar andriusandrius=head1 NAME Chemistry::Tutorial - PerlMol Quick Tutorial =head1 Introduction The modules in the PerlMol toolkit are designed to simplify the handling of molecules from Perl programs in a general and extensible way. These modules are object-oriented; however, this tries to assume little or no knowledge of object-oriented programming in Perl. For a general introduction about how to use object-oriented modules, see L. This document shows some of the more common methods included in the PerlMol toolkit, in a reasonable order for a quick introduction. For more details see the perldoc pages for each module. =head1 How to read a molecule from a file The following code will read a PDB file: use Chemistry::Mol; use Chemistry::File::PDB; my $mol = Chemistry::Mol->read("test.pdb"); The first two lines (which only need to be used once in a given program) tell Perl that you want to C the specified modules The third line reads the file and returns a molecule object. To read other formats such as MDL molfiles, you need to C the corresponding module, such as L. Readers for several formats are under development. =head1 The molecule object C<< Chemistry::Mol->read >> returns a L object. An I is a data structure of a given I that has I (i.e. subroutines) associated with it. To access or modify an object's properties, you call the methods on the object through "arrow syntax": my $name = $mol->name; # return the name of the molecule $mol->name("water"); # set the name of the molecule to "water" Note that these so-called accessor methods return the molecule object when they are used to set a property. A consequence of that if you want, you can "chain" several methods to set several options in one line: $mol->name("water")->type("wet"); A L object contains essentially a list of atoms, a list of bonds, and a few generic properties such as name, type, and id. The atoms and bonds themselves are also objects. =head1 Writing a molecule file To write a molecule to a file, just use the C method: $mol->write("test.pdb"); Make sure you Cd the right file I/O module. If you want to load all the available file I/O modules, you can do it with use Chemistry::File ':auto'; =head1 Selecting atoms in a molecule You can get an array of all the atoms by calling the atoms method without parameters, or a specific atom by giving its index: @all_atoms = $mol->atoms; $atom3 = $mol->atoms(3); B: Atom and bond indices are counted from 1, not from 0. This deviation from common Perl usage was made to be consistent with the way atoms are numbered in most common file formats. You can select atoms that match an arbitrary expression by using Perl's built-in C function: # get all oxygen atoms within 3.0 Angstroms of atom 37 @close_oxygens = grep { $_->symbol eq 'O' and $_->distance($mol->atoms(37)) < 3.0 } $mol->atoms; The C function loops through all the atoms returned by C<< $mol->atoms >>, aliasing each to $_ at each iteration, and returns only those for which the expression in braces is true. Using C is a general way of finding atoms; however, since finding atoms by name is common, a convenience method is available for that purpose. $HB1 = $mol->atoms_by_name('HB1'); @H_atoms = $mol->atoms_by_name('H.*'); # name treated as a regex Since the atom name is not generally unique, even the first example above might match more than one atom. In that case, only the first one found is returned. In the second case, since you are assigning to an array, all matching atoms are returned. =head1 The atom object Atoms are usually the most interesting objects in a molecule. Some of their main properties are Z, symbol, and coords. $atom->Z(8); # set atomic number to 8 $symbol = $atom->symbol; $coords = $atom->coords; =head2 Atom coordinates The coordinates returned by C<< $atom->coords >> are a L object. You can print these objects and use them to do vector algebra: $c1 = $atom1->coords; $c2 = $atom2->coords; $dot_product = $c1 . $c2; # returns a scalar $cross_product = $c1 x $c2; # returns a vector $delta = $c2 - $c1; # returns a vector $distance = $delta->length; # returns a scalar ($x, $y, $z) = $c1->array; # get the components of $c1 print $c1; # prints something like "[ 1.0E0 2.0E0 3.0E0 ]" Since one is very often interested in calculating the distance between atoms, Atom objects provide a C method to save some typing: $d = $atom1->distance($atom2); $d2 = $atom1->distance($molecule2); In the second case, the value obtained is the minimum distance between the atom and the molecule. This can be useful for things such as finding the water molecules closest to a given atom. Atoms may also have internal coordinates, which define the position of an atom relative to the positions of other atoms by means of a distance, an angle, and a dihedral angle. Those coordinates can be accessed through the $atom->internal_coords method, which uses L objects. =head1 The Bond object A L object is a list of atoms with an associated bond order. In most cases, a bond has exactly two atoms, but we don't want to exclude possibilities such as three-center bonds. You can get the list of atoms in a bond by using the C method; the bond order is accessed trough the C method; @atoms_in_bond = $bond->atoms; $bond_order = $bond->order; The other interesting method for Bond objects is C, which returns the distance between the two atoms in a bond (this method requires that the bond have two atoms). my $bondlength = $bond->length; In addition to these properties, Bond objects have the generic properties described below. The most important of these, as far as bonds are concerned, is C. =head1 Generic properties There are three generic properties that all PerlMol objects have: =over 4 =item id Each object must have a unique ID. In most cases you don't have to worry about it, because it is assigned automatically unless you specify it. You can use the C method to select an object contained in a molecule: $atom = $mol->by_id("a42"); In general, ids are preferable to indices because they don't change if you delete or move atoms or other objects. =item name The name of the object does not have any meaning from the point of view of the core modules, but most file types have the concept of molecule name, and some (such as PDB) have the concept of atom names. =item type Again, the meaning of type is not universally defined, but it would likely be used to specify atom types and bond orders. =back Besides these, the user can specify arbitrary attributes, as discussed in the next section. =head1 User-specified attributes The core PerlMol classes define very few, very generic properties for atoms and molecules. This was chosen as a "minimum common denominator" because every file format and program has different ideas about the names, values and meaning of these properties. For example, some programs only allow bond orders of 1, 2, and 3; some also have "aromatic" bonds; some use calculated non-integer bond orders. PerlMol tries not to commit to any particular convention, but it allows you to specify whatever attributes you want for any object (be it a molecule, an atom, or a bond). This is done through the C method. $mol->attr("melting point", "273.15"); # set m.p. $color = $atom->attr("color"); # get atom color The core modules store these values but they don't know what they mean and they don't care about them. Attributes can have whatever name you want, and they can be of any type. However, by convention, non-core modules that need additional attributes should prefix their name with a I, followed by a slash. (This is done to avoid modules fighting over the same attribute name.) For example, atoms created by the PDB reader module (Chemistry::File::PDB) have the "pdb/residue" attribute. $mol = Chemistry::Mol->read("test.pdb"); $atom = $mol->atoms(1234); print $atom->attr("pdb/residue_name"); # prints "ALA123" =head1 Molecule subclasses You can do lots of interesting thing with plain molecules. However, for some applications you may want to extend the features of the main Chemistry::Mol class. There are several subclasses of Chemistry::Mol available already: =over =item L Used for macromolecules. =item L Used for substructure matching. =item L Used for representing rings (cycles) in molecules. =item L Used for representing and applying chemical transformations. =back As an example we'll discuss macromolecules. Future versions of this tutorial may also include a discussion about patterns and rings. =head1 Macromolecules So far we have assumed that we are dealing with molecules of the L class. However, one of the interesting things about object-oriented programming is that classes can be extended. For dealing with macromolecules, we have the MacroMol class, which extends the L class. This means that in practice you can use a L object exactly as you would use a L object, but with some added functionality. In fact, the PDB reader can return L instead of L objects just by changing the first example like this: use Chemistry::MacroMol; use Chemistry::File::PDB; my $macromol = Chemistry::MacroMol->read("test.pdb"); Now the question is, what is the "added functionality" that MacroMol objects have on top of the original Chemistry::Mol object? =head2 The MacroMol object For the purposes of this module, a macromolecule is considered to be a big molecule where atoms are divided in I. A domain is just a subset of the atoms in the molecule; in a protein, a domain would be just a residue. You can select domains in a molecule in a way similar to that used for atoms and bonds, in this case through the C method: my @all_domains = $macromol->domains; my $domain = $macromol->domains(57); =head2 The Domain object A domain is a substructure of a larger molecule. Other than having a I molecule, a domain is just like a molecule. In other words, the Domain class extends the Chemistry::Mol class; it is basically a collection of atoms and bonds. my @atoms_in_domain = $domain->atoms; my $atom5_in_domain = $domain->atoms(5); If you want to get at a given atom in a given domain in a macromolecule, you can "chain" the method calls without having to save the Domain object in a temporary variable: my $domain57_atom5 = $macromol->domains(57)->atoms(5); my $res233_HA = $macromol->domains(233)->atoms_by_name('HA'); The second example is a good way of selecting an atom from a PDB file when you know the residue number and atom name. =head1 VERSION 0.38 =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L, L, L, L, L, L. =head1 AUTHOR Ivan Tubert-Brohman Eitub@cpan.orgE =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/Changes0000644000175000017500000001202714263501714015335 0ustar andriusandriusRevision history for Perl extension Chemistry::Mol. 0.39 Jul 13 2022 - Implemented choice of backend for Chemistry::Mol::clone(). 0.38 Apr 9 2021 - Fixed Chemistry::File doc bug (David Westbrook, bug 20067). - Fixed unescaped left brace in regex (Jim Keenan, bug 115215). - Switched to Dist::Zilla. - Adjusted URLs in documentation, as the source has been hosted on GitHub. - New co-maintainer Andrius Merkys . 0.37 May 10 2009 - Parse non-integer formulas (Daniel Scott). - Fixed some typos. - Fixed bug in Chemistry::File, where $self->mols wasn't updated during the read loop. - Fixed bug where $atom->symbol tried to modify the symbol given (which crashed when the symbol was a constant!) - Added an undocumented "next_id" method (Liliana Felix Avila). - Documented the descriptor methods that existed since 0.36 but were undocumented. 0.36 Sep 20 2005 - Sort formulas in Hill order. - Fixed calc_implicit_hydrogens for halides. 0.35 May 20 2005 - Added formal_radical atom property. - Compatibility with Storable-2.14, which already takes care of weak references. - calc_implicit_hydrogens, add_implicit_hydrogens 0.34 May 16 2005 - Fixed $atom->bonds duplication on $mol->separate (bug 1173237) - New method: safe_clone 0.33 Mar 29 2005 - Fixed spurious warnings in sprout_hydrogens (bug 1157393) - Added a test for incompatible Chemistry::File::SMILES versions. 0.32 Feb 24 2005 - Fixed spurious warnings in separate(). - Fixed division by zero for ill-defined angles. - Fixed bond deletion/addition bug #1076503. 0.31 Nov 10 2004 - Fixed an error in t/zlib.t (forgot to create t/tmp directory) - Fixed some typos in the documentation 0.30 Nov 9 2004 - New Chemistry::File interface - Added gzip support for reading and writing - New Atom methods: sprout_hydrogens, collapse_hydrogens, mass_number - New Mol methods: sprout_hydrogens, collapse_hydrogens - Added support for Chemistry::Isotope - Extended the Chemistry::Obj::attr method - New Obj methods: new() - Fixed backward compatibility bug in File/Dumper.pm - Fixed inconsistency when an object id was changed - Improved the testing suite 0.26 Aug 6 2004 - Added %S option to $mol->printf - Atom.pm: added total_hydrogens, implicit_hydrogens, explicit_valence, and deprecated hydrogens. 0.25 Jun 30 2004 - Fixed Chemistry::File :auto so that it looks in every @INC directory. - Added internal coordinates for atoms. - Updated the tutorial a little bit. 0.24 Jun 16 2004 - Mol:: _weaken, sort_atoms, atom_class, bond_class - Atom:: sprintf, printf, hydrogens, valence - Added the Chemistry::File::Dumper module. 0.23 May 19 2004 - New methods: Mol::printf, sprintf, charge; Atom::aromatic, formal_charge; Bond::aromatic - Fixed POD bug. 0.22 May 17 2004 - Fixed bug in bonds($from) - Added add_atom_np, add_bond_np, bonds_neighbors - Fixed another memory leak - Added Atom::formal_charge 0.21 May 13 2004 - Fixed bug where $/ was undef'ed in a nonlocal way in File.pm. - Added formula parser contributed by Brent Gregersen. - Added %j and %% formats to Formula.pm. 0.20 May 06 2004 - Use Scalar::Util::weaken to avoid strong cyclic references and ensure garbage collection. - New methods for Chemistry::Mol: delete_atom, delete_bond, clone, combine, separate, distance - New methods for Chemistry::Atom: angle, dihedral, angle_deg, dihedral_deg, delete - New methods for Chemistry::Bond: delete - Chemistry::Mol can export read_mol - Chemistry::Atom can export distance, angle, dihedral 0.11 Feb 22 2004 - New methods for Chemistry::Mol: mass, formula, formula_hash - New methods for Chemistry::Atom: mass - New module: Chemistry::File::Formula 0.10 Nov 03 2003 - New methods for Chemistry::Atom: distance - New methods for Chemistry::Obj: del_attr - New subroutines for Chemistry::Mol: read_mol, register_format - New class method for Mol, Atom, and Bond: reset_id - Incompatible changes: - Changed File I/O API. It should be more stable now, but it's certainly not frozen yet. - Chemistry::Mol->atoms() and bonds() now use 1-based indexing instead of zero-based. - Now Chemistry::Obj overloads cmp instead of ==. Note that this overloading behavior was undocumented, so it shouldn't cause a problem. 0.06 Sep 26 2003 - New methods for Chemistry::Mol - atoms() - bonds() - by_id() - atoms_by_name() 0.05 Sep 23 2003 - First release Chemistry-Mol-0.39/META.yml0000644000175000017500000000150314263501714015310 0ustar andriusandrius--- abstract: 'Molecule object toolkit' author: - 'Ivan Tubert-Brohman ' build_requires: Clone: '0' Test::Simple: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Chemistry-Mol recommends: Chemistry::InternalCoords: '0' Chemistry::Isotope: '0' Clone: '0' Compress::Zlib: '0' requires: IO::String: '0' Math::VectorReal: '1.0' Scalar::Util: '1.01' Text::Balanced: '0' resources: homepage: https://search.cpan.org/dist/Chemistry-Mol repository: git://github.com/perlmol/chemistry-mol.git version: '0.39' x_generated_by_perl: v5.30.0 x_serialization_backend: 'YAML::Tiny version 1.73' Chemistry-Mol-0.39/README0000644000175000017500000000236314263501714014724 0ustar andriusandriusChemistry/Mol version 0.39 ========================== This toolkit includes basic objects and methods to describe molecules. It consists of several modules: Chemistry::Mol, Chemistry::Atom, Chemistry::Bond, and Chemistry::File. These are the core modules of the PerlMol toolkit. CHANGES SINCE VERSION 0.38 - Implemented choice of backend for Chemistry::Mol::clone(). INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: - perl-5.6.0 or more recent (5.8.0+ recommended) - Math::VectorReal - Scalar::Util (already a core module since perl 5.7.3) - Test::More (already a core module since perl 5.7.3) - Text::Balanced (already a core module since perl 5.7.3) - IO::String (required only for versions of perl prior to 5.8.0) The following modules are optional, but are required by certain functions: - Chemistry::InternalCoords - Chemistry::Isotope - Clone - Compress::Zlib COPYRIGHT AND LICENSE Copyright (C) 2009 Ivan Tubert-Brohman This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Chemistry-Mol-0.39/MANIFEST0000644000175000017500000000112614263501714015171 0ustar andriusandrius# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. Changes MANIFEST META.json META.yml Makefile.PL README Tutorial.pod dist.ini lib/Chemistry/Atom.pm lib/Chemistry/Bond.pm lib/Chemistry/File.pm lib/Chemistry/File/Dumper.pm lib/Chemistry/File/Formula.pm lib/Chemistry/Mol.pm lib/Chemistry/Obj.pm t/Atom.t t/Bond.t t/Dumper.t t/File.t t/Formula.t t/Mol.t t/Obj.t t/add_implicit_h.t t/change_id.t t/compat.t t/delete.t t/descriptor.t t/empty.mol t/exception.t t/formula_tests.txt t/geom.t t/graph.t t/list.txt t/mem.t t/mol.pl t/mol.pl.gz t/pod.t t/safe_clone.t t/zlib.t Chemistry-Mol-0.39/lib/0000775000175000017500000000000014263501714014610 5ustar andriusandriusChemistry-Mol-0.39/lib/Chemistry/0000775000175000017500000000000014263501714016557 5ustar andriusandriusChemistry-Mol-0.39/lib/Chemistry/Mol.pm0000644000175000017500000006437314263501714017657 0ustar andriusandriuspackage Chemistry::Mol; our $VERSION = '0.39'; # VERSION # $Id$ =head1 NAME Chemistry::Mol - Molecule object toolkit =head1 SYNOPSIS use Chemistry::Mol; $mol = Chemistry::Mol->new(id => "mol_id", name => "my molecule"); $c = $mol->new_atom(symbol => "C", coords => [0,0,0]); $o = $mol->new_atom(symbol => "O", coords => [0,0,1.23]); $mol->new_bond(atoms => [$c, $o], order => 3); print $mol->print; =head1 DESCRIPTION This package, along with Chemistry::Atom and Chemistry::Bond, includes basic objects and methods to describe molecules. The core methods try not to enforce a particular convention. This means that only a minimal set of attributes is provided by default, and some attributes have very loosely defined meaning. This is because each program and file type has different idea of what each concept (such as bond and atom type) means. Bonds are defined as a list of atoms (typically two) with an arbitrary type. Atoms are defined by a symbol and a Z, and may have 3D and internal coordinates (2D coming soon). =cut use 5.006; use strict; use warnings; use Chemistry::Atom; use Chemistry::Bond; use Carp; use base qw(Chemistry::Obj Exporter); use Storable 'dclone'; our @EXPORT_OK = qw(read_mol); our @EXPORT = (); our %EXPORT_TAGS = ( all => [@EXPORT, @EXPORT_OK], ); our $clone_backend = 'Storable'; my %FILE_FORMATS = (); =head1 METHODS See also L for generic attributes. =over 4 =item Chemistry::Mol->new(name => value, ...) Create a new Mol object with the specified attributes. $mol = Chemistry::Mol->new(id => 'm123', name => 'my mol') is the same as Chemistry::Mol->new() $mol->id('m123') $mol->name('my mol') =cut sub new { my $class = shift; my %args = @_; my $self = bless { id => $class->nextID, byId => {}, atoms => [], bonds => [], name => "", }, ref $class || $class; $self->$_($args{$_}) for (keys %args); return $self; } my $N = 0; # molecule ID counter sub nextID { "mol".++$N; } sub reset_id { $N = 0; } sub next_id { $N = $_[1] } =item $mol->add_atom($atom, ...) Add one or more Atom objects to the molecule. Returns the last atom added. =cut sub add_atom { my $self = shift; for my $atom (@_){ #if ($self->by_id($atom->id)) { #croak "Duplicate ID when adding atom '$atom' to mol '$self'"; #} push @{$self->{atoms}}, $atom; $self->{byId}{$atom->id} = $atom; $atom->parent($self); } $_[-1]; } sub add_atom_np { my $self = shift; for my $atom (@_){ push @{$self->{atoms}}, $atom; $self->{byId}{$atom->id} = $atom; } $_[-1]; } =item $mol->atom_class Returns the atom class that a molecule or molecule class expects to use by default. L objects return "Chemistry::Atom", but subclasses will likely override this method. =cut sub atom_class { "Chemistry::Atom"; } =item $mol->new_atom(name => value, ...) Shorthand for C<< $mol->add_atom($mol->atom_class->new(name => value, ...)) >>. =cut sub new_atom { my $self = shift; $self->add_atom($self->atom_class->new(@_)); } =item $mol->delete_atom($atom, ...) Deletes an atom from the molecule. It automatically deletes all the bonds in which the atom participates as well. $atom should be a Chemistry::Atom reference. This method also accepts the atom index, but this use is deprecated (and buggy if multiple indices are given, unless they are in descending order). =cut sub delete_atom { my $self = shift; for my $i (@_) { my ($atom); if (ref $i) { $atom = $i; } else { $atom = $self->atoms($i) or croak "$self->delete_atom: no such atom $i\n"; } $atom->delete($i); } } # takes an atom ref to delete and optionally the atom index # 1) deletes bonds that belonged to atom # 2) deletes atom sub _delete_atom { my ($self, $atom) = @_; my $index = $self->get_atom_index($atom) or croak "$self->delete_atom: no such atom $atom\n"; my $id = $atom->id; $self->delete_bond($atom->bonds); delete $self->{byId}{$id}; splice @{$self->{atoms}}, $index - 1, 1; } =item $mol->add_bond($bond, ...) Add one or more Bond objects to the molecule. Returns the last bond added. =cut sub add_bond { my $self = shift; for my $bond (@_){ #if ($self->by_id($bond->id)) { #croak "Duplicate ID when adding bond '$bond' to mol '$self'"; #} push @{$self->{bonds}}, $bond; $self->{byId}{$bond->id} = $bond; if ($bond->{deleted}) { $_->add_bond($bond) for $bond->atoms; $bond->{deleted} = 0; } $bond->parent($self); } $_[-1]; } sub add_bond_np { my $self = shift; for my $bond (@_){ push @{$self->{bonds}}, $bond; $self->{byId}{$bond->id} = $bond; } $_[-1]; } =item $mol->bond_class Returns the bond class that a molecule or molecule class expects to use by default. L objects return "Chemistry::Bond", but subclasses will likely override this method. =cut sub bond_class { "Chemistry::Bond"; } =item $mol->new_bond(name => value, ...) Shorthand for C<< $mol->add_bond($mol->bond_class->new(name => value, ...)) >>. =cut sub new_bond { my $self = shift; $self->add_bond($self->bond_class->new(@_)); } sub get_bond_index { my ($self, $bond) = @_; my $i; for ($self->bonds) { ++$i; return $i if ($_ eq $bond); } undef; } sub get_atom_index { my ($self, $atom) = @_; my $i; for ($self->atoms) { ++$i; return $i if ($_ eq $atom); } undef; } =item $mol->delete_bond($bond, ...) Deletes a bond from the molecule. $bond should be a L object. =cut # mol deletes bond # bond tells atoms involved to forget about it sub delete_bond { my $self = shift; for my $i (@_){ my ($bond); if (ref $i) { $bond = $i; } else { $bond = $self->bonds($i) or croak "$self->delete_bond($i): no such bond $i\n"; } $bond->delete; } } sub _delete_bond { my ($self, $bond) = @_; my $index = $self->get_bond_index($bond) #or croak "$self->delete_bond: no such bond $bond\n"; or return; my $id = $bond->id; delete $self->{byId}{$id}; splice @{$self->{bonds}}, $index - 1, 1; $bond->delete_atoms; } =item $mol->by_id($id) Return the atom or bond object with the corresponding id. =cut sub by_id { my $self = shift; my ($id) = @_; $self->{byId}{$id}; } sub _change_id { my ($self, $old_id, $new_id) = @_; my $ref = $self->{byId}{$old_id}; $self->{byId}{$new_id} = $ref; delete $self->{byId}{$old_id}; } =item $mol->atoms($n1, ...) Returns the atoms with the given indices, or all by default. Indices start from one, not from zero. =cut sub atoms { my $self = shift; if (@_) { my @ats = map {$_ - 1} @_; @{$self->{atoms}}[@ats]; } else { @{$self->{atoms}}; } } =item $mol->atoms_by_name($name) Returns the atoms with the given name (treated as an anchored regular expression). =cut sub atoms_by_name { my $self = shift; my $re = qr/^$_[0]$/; no warnings; my @ret = grep {$_->name =~ $re} $self->atoms; wantarray ? @ret : $ret[0]; } =item $mol->sort_atoms($sub_ref) Sort the atoms in the molecule by using the comparison function given in $sub_ref. This function should take two atoms as parameters and return -1, 0, or 1 depending on whether the first atom should go before, same, or after the second atom. For example, to sort by atomic number, you could use the following: $mol->sort_atoms( sub { $_[0]->Z <=> $_[1]->Z } ); Note that the atoms are passed as parameters and not as the package variables $a and $b like the core sort function does. This is because $mol->sort will likely be called from another package and we don't want to play with another package's symbol table. =cut sub sort_atoms { my ($self, $sub) = @_; my @a = $self->atoms; @a = sort { $sub->($a,$b) } @a; $self->{atoms} = \@a; $self; } =item $mol->bonds($n1, ...) Returns the bonds with the given indices, or all by default. Indices start from one, not from zero. =cut sub bonds { my $self = shift; if (@_) { my @bonds = map {$_ - 1} @_; @{$self->{bonds}}[@bonds]; } else { @{$self->{bonds}}; } } =item $mol->print(option => value...) Convert the molecule to a string representation. If no options are given, a default YAML-like format is used (this may change in the future). Otherwise, the format should be specified by using the C option. =cut sub print { my $self = shift; my (%opts) = @_; my $ret; local $" = ""; #" if ($opts{format}) { return $self->formats($opts{format})->write_string($self, %opts); } # else use default printout $ret = <{id}: name: $self->{name} END $ret .= " attr:\n"; $ret .= $self->print_attr(2); $ret .= " atoms:\n"; for my $a (@{$self->{atoms}}) { $ret .= $a->print(2) } $ret .= " bonds:\n"; for my $b (@{$self->{bonds}}) { $ret .= $b->print(2) } $ret; } =item $s = $mol->sprintf($format) Format interesting molecular information in a concise way, as specified by a printf-like format. %n - name %f - formula %f{formula with format} - (note: right braces within the format should be escaped with a backslash) %s - SMILES representation %S - canonical SMILES representation %m - mass %8.3m - mass, formatted as %8.3f with core sprintf %q - formal charge %a - atom count %b - bond count %t - type %i - id %% - % For example, if you want just about everything: $mol->sprintf("%s - %n (%f). %a atoms, %b bonds; " . "mass=%m; charge =%q; type=%t; id=%i"); Note that you have to C before using C<%s> or C<%S> on C<< $mol->sprintf >>. =cut sub sprintf { my ($mol, $format) = @_; no warnings 'uninitialized'; # don't care if some properties are undefined $format ||= "%f"; $format =~ s/%%/\\%/g; # escape %% with a \ $format =~ s/(?formula($1)/eg; # %f{} $format =~ s/(?formula/eg; # %f $format =~ s/(?print(format=>'smiles')/eg; # %s $format =~ s/(?print(format=>'smiles', unique => 1)/eg; # %s $format =~ s/(?name/eg; # %n $format =~ s/(?mass : $mol->mass/eg; # %m $format =~ s/(?charge/eg; # %q $format =~ s/(?atoms/eg; # %a $format =~ s/(?bonds/eg; # %b $format =~ s/(?type/eg; # %t $format =~ s/(?id/eg; # %i $format =~ s/\\(.)/$1/g; # other \ escapes $format; } =item $mol->printf($format) Same as C<< $mol->sprintf >>, but prints to standard output automatically. Used for quick and dirty molecular information dumping. =cut sub printf { my ($mol, $format) = @_; print $mol->sprintf($format); } =item Chemistry::Mol->parse($string, option => value...) Parse the molecule encoded in C<$string>. The format should be specified with the the C option; otherwise, it will be guessed. =cut sub parse { my $self = shift; my $s = shift; my %opts = (mol_class => $self, @_); if ($opts{format}) { return $self->formats($opts{format})->parse_string($s, %opts); } else { croak "Parse does not support autodetection yet.", "Please specify a format."; } return; } =item Chemistry::Mol->read($fname, option => value ...) Read a file and return a list of Mol objects, or croaks if there was a problem. The type of file will be guessed if not specified via the C option. Note that only registered file readers will be used. Readers may be registered using C; modules that include readers (such as L) usually register them automatically when they are loaded. Automatic decompression of gzipped files is supported if the L module is installed. Files ending in .gz are assumed to be compressed; otherwise it is possible to force decompression by passing the gzip => 1 option (or no decompression with gzip => 0). =cut sub read_mol { # for backwards compatibility my ($fname, $type) = shift; __PACKAGE__->read($fname, format => $type); } sub read { my $self = shift; my $fname = shift; my %opts = (mol_class => $self, @_); if ($opts{format}) { return $self->formats($opts{format})->parse_file($fname, %opts); } else { # guess format for my $type ($self->formats) { if ($self->formats($type)->file_is($fname)) { return $self->formats($type)->parse_file($fname, %opts); } } } croak "Couldn't guess format of file '$fname'"; } =item $mol->write($fname, option => value ...) Write a molecule file, or croak if there was a problem. The type of file will be guessed if not specified via the C option. Note that only registered file formats will be used. Automatic gzip compression is supported if the IO::Zlib module is installed. Files ending in .gz are assumed to be compressed; otherwise it is possible to force compression by passing the gzip => 1 option (or no compression with gzip => 0). Specific compression levels between 2 (fastest) and 9 (most compressed) may also be used (e.g., gzip => 9). =cut sub write { my ($self, $fname, %opts) = (@_); if ($opts{format}) { return $self->formats($opts{format})->write_file(@_); } else { # guess format for my $type ($self->formats) { if ($self->formats($type)->name_is($fname)) { return $self->formats($type)->write_file(@_); } } } croak "Couldn't guess format for writing file '$fname'"; } =item Chemistry::Mol->file($file, option => value ...) Create a L-derived object for reading or writing to a file. The object can then be used to read the molecules or other information in the file. This has more flexibility than calling C<< Chemistry::Mol->read >> when dealing with multi-molecule files or files that have higher structure or that have information that does not belong to the molecules themselves. For example, a reaction file may have a list of molecules, but also general information like the reaction name, yield, etc. as well as the classification of the molecules as reactants or products. The exact information that is available will depend on the file reader class that is being used. The following is a hypothetical example for reading MDL rxnfiles. # assuming this module existed... use Chemistry::File::Rxn; my $rxn = Chemistry::Mol->file('test.rxn'); $rxn->read; $name = $rxn->name; @reactants = $rxn->reactants; # mol objects @products = $rxn->products; $yield = $rxn->yield; # a number Note that only registered file readers will be used. Readers may be registered using register_format(); modules that include readers (such as Chemistry::File::PDB) usually register them automatically. =cut sub file { my ($self, $file, %opts) = @_; %opts = (mol_class => $self, %opts); if ($opts{format}) { return $self->formats($opts{format})->new(file => $file, opts => \%opts); } else { # guess format for my $type ($self->formats) { if ($self->formats($type)->file_is($file)) { return $self->formats($type)->new(file => $file, opts => \%opts); } } } croak "Couldn't guess format of file '$file'"; } =item Chemistry::Mol->register_format($name, $ref) Register a file type. The identifier $name must be unique. $ref is either a class name (a package) or an object that complies with the L interface (e.g., a subclass of Chemistry::File). If $ref is omitted, the calling package is used automatically. More than one format can be registered at a time, but then $ref must be included for each format (e.g., Chemistry::Mol->register_format(format1 => "package1", format2 => package2). The typical user doesn't have to care about this function. It is used automatically by molecule file I/O modules. =cut sub register_format { my $class = shift; if (@_ == 1) { $FILE_FORMATS{$_[0]} = caller; return; } my %opts = @_; $FILE_FORMATS{$_} = $opts{$_} for keys %opts; } =item Chemistry::Mol->formats Returns a list of the file formats that have been installed by register_format() =cut sub formats { my $self = shift; if (@_) { my ($type) = @_; my $file_class = $FILE_FORMATS{$type}; unless ($file_class) { croak "No class installed for type '$type'"; } return $file_class; } else { return sort keys %FILE_FORMATS; } } =item $mol->mass Return the molar mass. This is just the sum of the masses of the atoms. See L::mass for details such as the handling of isotopes. =cut sub mass { my ($self) = @_; my $mass = 0; for my $atom ($self->atoms) { $mass += $atom->mass; } $mass; } =item $mol->charge Return the charge of the molecule. By default it returns the sum of the formal charges of the atoms. However, it is possible to set an arbitrary charge by calling C<< $mol->charge($new_charge) >> =cut sub charge { my ($self) = shift; if (@_) { $self->{charge} = shift; $self; } else { return $self->{charge} if defined $self->{charge}; my $charge = 0; $charge += $_->formal_charge || 0 for $self->atoms; $charge; } } =item $mol->formula_hash Returns a hash reference describing the molecular formula. For methane it would return { C => 1, H => 4 }. =cut sub formula_hash { my ($self) = @_; my $formula = {}; for my $atom ($self->atoms) { $formula->{$atom->symbol}++; $formula->{H} += $atom->hydrogens if $atom->hydrogens; } $formula; } =item $mol->formula($format) Returns a string with the formula. The format can be specified as a printf-like string with the control sequences specified in the L documentation. =cut sub formula { my ($self, $format) = @_; require Chemistry::File::Formula; $self->print(format => "formula", formula_format => $format); } =item my $mol2 = $mol->clone; Makes a copy of a molecule. Note that this is a B copy; if your molecule has a pointer to the rest of the universe, the entire universe will be cloned! By default, clone() uses L to copy the Perl data structure. L can be used instead by setting variable C<$Chemistry::Mol::clone_backend> to C (default is C). The documentation of Storable claims L is less memory-intensive. =cut sub clone { my ($self) = @_; my $clone; if ($clone_backend eq "Storable") { $clone = dclone $self; $clone->_weaken if Storable->VERSION < 2.14; } elsif ($clone_backend eq "Clone") { require Clone; $clone = Clone::clone $self; } else { croak "Unknown clone backend '$clone_backend'"; } $clone; } =item my $mol2 = $mol->safe_clone; Like clone, it makes a deep copy of a molecule. The difference is that the copy is not "exact" in that new molecule and its atoms and bonds get assigned new IDs. This makes it safe to combine cloned molecules. For example, this is an error: # XXX don't try this at home! my $mol2 = Chemistry::Mol->combine($mol1, $mol1); # the atoms in $mol1 will clash But this is ok: # the "safe clone" of $mol1 will have new IDs my $mol2 = Chemistry::Mol->combine($mol1, $mol1->safe_clone); =cut sub safe_clone { my ($mol) = @_; my $clone = $mol->clone; for ($clone, $clone->atoms, $clone->bonds) { $_->id($_->nextID); } $clone; } sub _weaken { my ($self) = @_; for ($self->atoms, $self->bonds) { $_->_weaken; } $self; } =item ($distance, $atom_here, $atom_there) = $mol->distance($obj) Returns the minimum distance to $obj, which can be an atom, a molecule, or a vector. In scalar context it returns only the distance; in list context it also returns the atoms involved. The current implementation for calculating the minimum distance between two molecules compares every possible pair of atoms, so it's not efficient for large molecules. =cut sub distance { my ($self, $other) = @_; if ($other->isa("Chemistry::Mol")) { my @atoms = $self->atoms; my $atom = shift @atoms or return; # need at least one atom my $closest_here = $atom; my ($min_length, $closest_there) = $atom->distance($other); for $atom (@atoms) { my ($d, $o) = $atom->distance($other); if ($d < $min_length) { ($min_length, $closest_there, $closest_here) = ($d, $o, $atom); } } return wantarray ? ($min_length, $closest_here, $closest_there) : $min_length; } elsif ($other->isa("Chemistry::Atom")) { return $other->distance($self); } elsif ($other->isa("Math::VectorReal")) { return Chemistry::Atom->new(coords => $other)->distance($self); } } =item my $bigmol = Chemistry::Mol->combine($mol1, $mol2, ...) =item $mol1->combine($mol2, $mol3, ...) Combines several molecules in one bigger molecule. If called as a class method, as in the first example, it returns a new combined molecule without altering any of the parameters. If called as an instance method, as in the second example, all molecules are combined into $mol1 (but $mol2, $mol3, ...) are not altered. B: Make sure you don't combine molecules which contain atoms with duplicate IDs (for example, if they were cloned). =cut # joins several molecules into one sub combine { my ($self, @others) = @_; my $mol; if (ref $self) { $mol = $self; } else { $mol = $self->new; } for my $other (@others) { my $mol2 = $other->clone; for my $atom ($mol2->atoms) { $mol->add_atom($atom); } for my $bond ($mol2->bonds) { $mol->add_bond($bond); } } $mol; } =item my @mols = $mol->separate Separates a molecule into "connected fragments". The original object is not modified; the fragments are clones of the original ones. Example: if you have ethane (H3CCH3) and you delete the C-C bond, you have two CH3 radicals within one molecule object ($mol). When you call $mol->separate you get two molecules, each one with a CH3. =cut # splits a molecule into connected fragments # returns a list of molecules. Does not touch the original copy. sub separate { my ($self) = @_; $self = $self->clone; $self->{_paint_tab} = {}; my $color = 0; for my $atom ($self->atoms) { next if defined $self->{_paint_tab}{$atom->id}; $self->_paint($atom, $color++); } my @mols; push @mols, $self->new for (1 .. $color); for my $atom ($self->atoms) { $mols[$self->{_paint_tab}{$atom->id}]->add_atom($atom); } for my $bond ($self->bonds) { $mols[$self->{_paint_tab}{$bond->id}]->add_bond($bond); } @mols; } # this method fills the _paint_tab attribute for every atom connected # to the given start atom $atom with $color. Used for separating # connected fragments. Uses a depth-first search sub _paint { my ($self, $atom, $color) = @_; return if defined $self->{_paint_tab}{$atom->id}; $self->{_paint_tab}{$atom->id} = $color; $self->{_paint_tab}{$_->id} = $color for ($atom->bonds); for my $neighbor ($atom->neighbors) { $self->_paint($neighbor, $color); } } =item $mol->sprout_hydrogens Convert all the implicit hydrogen atoms in the molecule to explicit atoms. It does B generate coordinates for the atoms. =cut sub sprout_hydrogens { my ($self) = @_; $_->sprout_hydrogens for $self->atoms; } =item $mol->collapse_hydrogens Convert all the explicit hydrogen atoms in the molecule to implicit hydrogens. (Exception: hydrogen atoms that are adjacent to a hydrogen atom are not collapsed.) =cut sub collapse_hydrogens { my ($self) = @_; for my $atom (grep { $_->symbol ne 'H' } $self->atoms) { $atom->collapse_hydrogens; } } =item $mol->add_implicit_hydrogens Use heuristics to figure out how many implicit hydrogens should each atom in the molecule have to satisfy its normal "organic" valence. =cut sub add_implicit_hydrogens { my ($self) = @_; $_->add_implicit_hydrogens for $self->atoms; } my %DESCRIPTORS = (); =item Chemistry::Mol->register_descriptor($name => $sub_ref) Adds a callback that can be used to add functionality to the molecule class (originally meant to add custom molecule descriptors.) A descriptor is a function that takes a molecule object as its only argument and returns a value or values. For example, to add a descriptor function that computes the number of atoms: Chemistry::Mol->register_descriptor( number_of_atoms => sub { my $mol = shift; return scalar $mol->atoms; } ); The descriptor is accessed by name via the C instance method: my $n = $mol->descriptor('number_of_atoms'); =cut sub register_descriptor { my ($self, %opts) = @_; $DESCRIPTORS{$_} = $opts{$_} for keys %opts; } =item my $value = $mol->descriptor($descriptor_name) Calls a previously registered descriptor function giving it $mol as an argument, as shown above for C. =cut sub descriptor { my ($self, $descriptor) = @_; my $sub = $DESCRIPTORS{$descriptor} or croak "unknown descriptor '$descriptor'"; return $sub->($self); } 1; =back =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L, L, L, L =head1 AUTHOR Ivan Tubert-Brohman Eitub@cpan.orgE =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/lib/Chemistry/File/0000775000175000017500000000000014263501714017436 5ustar andriusandriusChemistry-Mol-0.39/lib/Chemistry/File/Formula.pm0000644000175000017500000002541214263501714021403 0ustar andriusandriuspackage Chemistry::File::Formula; our $VERSION = '0.39'; # VERSION # $Id$ use strict; use base "Chemistry::File"; use Chemistry::Mol; use Carp; use Text::Balanced qw(extract_bracketed); =head1 NAME Chemistry::File::Formula - Molecular formula reader/formatter =head1 SYNOPSIS use Chemistry::File::Formula; my $mol = Chemistry::Mol->parse("H2O"); print $mol->print(format => formula); print $mol->formula; # this is a shorthand for the above print $mol->print(format => formula, formula_format => "%s%d{%d}); =cut Chemistry::Mol->register_format('formula'); =head1 DESCRIPTION This module converts a molecule object to a string with the formula and back. It registers the 'formula' format with Chemistry::Mol. Besides its obvious use, it is included in the Chemistry::Mol distribution because it is a very simple example of a Chemistry::File derived I/O module. =head2 Writing formulas The format can be specified as a printf-like string with the following control sequences, which are specified with the formula_format parameter to $mol->print or $mol->write. =over =item %s symbol =item %D number of atoms =item %d number of atoms, included only when it is greater than one =item %d{substr} substr is only included when number of atoms is greater than one =item %j{substr} substr is inserted between the formatted string for each element. (The 'j' stands for 'joiner'.) The format should have only one joiner, but its location in the format string doesn't matter. =item %% a percent sign =back If no format is specified, the default is "%s%d". Some examples follow. Let's assume that the formula is C2H6O, as it would be formatted by default. =over =item C<< %s%D >> Like the default, but include explicit indices for all atoms. The formula would be formatted as "C2H6O1" =item C<< %s%d{EsubE%dE/subE} >> HTML format. The output would be "CEsubE2E/subEHEsubE6E/subEO". =item C<< %D %s%j{, } >> Use a comma followed by a space as a joiner. The output would be "2 C, 6 H, 1 O". =back =head3 Symbol Sort Order The elements in the formula are sorted by default in the "Hill order", which means that: 1) if the formula contains carbon, C goes first, followed by H, and the rest of the symbols in alphabetical order. For example, "CH2BrF". 2) if there is no carbon, all the symbols (including H) are listed alphabetically. For example, "BrH". It is possible to supply a custom sorting subroutine with the 'formula_sort' option. It expects a subroutine reference that takes a hash reference describing the formula (similar to what is returned by parse_formula, discussed below), and that returns a list of symbols in the desired order. For example, this will sort the symbols in reverse asciibetical order: my $formula = $mol->print( format => 'formula', formula_sort => sub { my $formula_hash = shift; return reverse sort keys %$formula_hash; } ); =head2 Parsing Formulas Formulas can also be parsed back into Chemistry::Mol objects. The formula may have parentheses and square or triangular brackets, and it may have the following abbreviations: Me => '(CH3)', Et => '(CH3CH2)', Bu => '(C4H9)', Bn => '(C6H5CH2)', Cp => '(C5H5)', Ph => '(C6H5)', Bz => '(C6H5CO)', The formula may also be preceded by a number, which multiplies the whole formula. Some examples of valid formulas: =over Formula Equivalent to -------------------------------------------------------------- CH3(CH2)3CH3 C5H12 C6H3Me3 C9H12 2Cu[NH3]4(NO3)2 Cu2H24N12O12 2C(C[C5]4)3 C152 2C(C(C(C)5)4)3 C152 C 1 0 H 2 2 C10H22 (whitespace is completely ignored) =back When a formula is parsed, a molecule object is created which consists of the set of the atoms in the formula (no bonds or coordinates, of course). The atoms are created in alphabetical order, so the molecule object for C2H5Br would have the atoms in the following sequence: Br, C, C, H, H, H, H, H. If you don't want to create a molecule object, but would rather have a simple hash with the number of atoms for each element, use the C method: my %formula = Chemistry::File::Formula->parse_formula("C2H6O"); use Data::Dumper; print Dumper \%formula; which prints something like $VAR1 = { 'H' => 6, 'O' => 1, 'C' => 2 }; The C method is called internally by the C method. =head3 Non-integer numbers in formulas The C method can also accept formulas that contain floating-point numbers, such as H1.5N0.5. The numbers must be positive, and numbers smaller than one should include a leading zero (e.g., 0.9, not .9). When formulas with non-integer numbers of atoms are turned into molecule objects as described in the previous section, the number of atoms is always B. For example, H1.5N0.5 will produce a molecule object with two hydrogen atoms and one nitrogen atom. There is currently no way of I formulas with non-integer numbers; perhaps a future version will include an "occupancy" property for atoms that will result in non-integer formulas. =cut sub parse_string { my ($self, $string, %opts) = @_; my $mol_class = $opts{mol_class} || "Chemistry::Mol"; my $atom_class = $opts{atom_class} || "Chemistry::Atom"; my $bond_class = $opts{bond_class} || "Chemistry::Bond"; my $mol = $mol_class->new; my %formula = $self->parse_formula($string); for my $sym (sort keys %formula) { for (my $i = 0; $i < $formula{$sym}; ++$i) { $mol->add_atom($atom_class->new(symbol => $sym)); } } return $mol; } sub write_string { my ($self, $mol, %opts) = @_; my @formula_parts; my $format = $opts{formula_format} || "%s%d"; # default format my $fh = $mol->formula_hash; $format =~ s/%%/\\%/g; # escape %% with a \ my $joiner = ""; $joiner = $1 if $format =~ s/(?sort_symbols($fh); } for my $sym (@symbols) { my $s = $format; my $n = $fh->{$sym}; $s =~ s/(? 1 ? $1 : ''/eg; # %d{} $s =~ s/(? 1 ? $n : ''/eg; # %d $s =~ s/\\(.)/$1/g; # other \ escapes push @formula_parts, $s; } return join($joiner, @formula_parts); } sub sort_symbols { my ($self, $formula_hash) = @_; my @symbols = keys %$formula_hash; if ($formula_hash->{C}) { # C and H first, followed by alphabetical order s/^([CH])$/\0$1/ for @symbols; @symbols = sort @symbols; s/^\0([CH])$/$1/ for @symbols; return @symbols; } else { # simple alphabetical order return sort @symbols; } } sub file_is { return 0; # no files are identified automatically as having this format } ### Code derived from formula.pl by Brent Gregersen follows my %macros = ( Me => '(CH3)', Et => '(CH3CH2)', Bu => '(C4H9)', Bn => '(C6H5CH2)', Cp => '(C5H5)', Ph => '(C6H5)', Bz => '(C6H5CO)', # Ac is an element # Pr is an element ); sub parse_formula { my ($self, $formula) = @_; my (%elements); #check balancing return %elements if (!ParensBalanced($formula)); # replace other grouping with normal parens $formula =~ tr/<>{}[]/()()()/; # get rid of any spaces $formula =~ s/\s+//g; # perform macro expansion foreach (keys(%macros)) { $formula =~ s/$_/$macros{$_}/g; } # determine initial compound coeficent my $coef = ($formula =~ s/^(\d+\.?\d*)//) ? $1 : 1.0; # recursively process rest of formula return internal_formula_parser($formula, $coef, %elements); } sub internal_formula_parser { my ($formula, $coef, %form) = @_; my $tmp_coef; my ($extract, $remainder, $prefix) = extract_bracketed($formula, '()', '[^(]*'); if (defined($extract) and $extract ne '') { $extract =~ s/^\((.*)\)$/$1/; if ($remainder =~ s/^(\d+\.?\d*)(.*)$/$2/) { $tmp_coef = $1 * $coef; } else { $tmp_coef = $coef; } # get formula of prefix ( it has no parens) %form = add_formula_strings($prefix, $coef, %form) if ($prefix ne ''); # check remainder for more parens %form = internal_formula_parser($remainder, $coef, %form) if ($remainder ne ''); # check extract for more parens %form = internal_formula_parser($extract, $tmp_coef, %form); ## we already know this is ne '' } else { # get formula of complete string %form = add_formula_strings($remainder, $coef, %form) if ($remainder ne ''); } return %form; } sub add_formula_strings { my ($formula, $coef, %elements) = @_; # print "Getting Formula of $formula\n"; $formula =~ /^(?:([A-Z][a-z]*)(\d+\.?\d*)?)+$/o # XXX new or croak "Invalid Portion of Formula $formula"; while ($formula =~ m/([A-Z][a-z]*)(\d+\.?\d*)?/go) { # XXX new my ($elm, $count) = ($1, $2); $count = 1 unless defined $count; if (defined $elements{$elm}) { $elements{$elm} += $count * $coef; } else { $elements{$elm} = $count * $coef; } } return %elements; } sub ParensBalanced { my ($form) = @_; my @stack = (); my %pairs = ( '<' => '>', '{' => '}', '[' => ']', '(' => ')' ); while ($form =~ m/([<>(){}\]\[])/go) { my $current = $1; if ($current =~ /[<({\[]/) { push(@stack, $current); next; } return 0 if (scalar(@stack) == 0); return 0 if ($current ne $pairs{ pop @stack}); } return @stack ? 0 : 1; } 1; =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L, L For discussion about Hill order, just search the web for C. The original reference is I B<1900>, I<22>, 478-494. L. =head1 AUTHOR Ivan Tubert-Brohman . Formula parsing code contributed by Brent Gregersen. Patch for non-integer formulas by Daniel Scott. =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/lib/Chemistry/File/Dumper.pm0000644000175000017500000000522214263501714021227 0ustar andriusandriuspackage Chemistry::File::Dumper; our $VERSION = '0.39'; # VERSION require 5.006; use strict; use warnings; use base "Chemistry::File"; use Chemistry::Mol; # should I use it? use Data::Dumper; use Carp; =head1 NAME Chemistry::File::Dumper - Read and write molecules via Data::Dumper =head1 SYNOPSIS use Chemistry::File::Dumper; my $mol = Chemistry::Mol->read("mol.pl"); print $mol->print(format => dumper); $mol->write("mol.pl", format => "dumper"); =cut =head1 DESCRIPTION This module hooks the Data::Dumper Perl core module to the Chemistry::File API, allowing you to dump and undump Chemistry::Mol objects easily. This module automatically registers the "dumper" format with Chemistry::Mol. For purposes of automatic file type guessing, this module assumes that dumped files end in C<.pl>. This module is useful mainly for debugging purposes, as it dumps I the information available in an object, in a reproducible way (so you can use it to compare molecule objects). However, it wouldn't be a good idea to use it to read untrusted files, because they may contain arbitrary Perl code. =cut Chemistry::Mol->register_format(dumper => __PACKAGE__); =head1 OPTIONS The following options can be used when writing a molecule either as a file or as a string. =over 4 =item dumper_indent Value to give to Data::Dumper::Indent. Default is 1. =item dumper_purity Value to give to Data::Dumper::Purity. Default is 1. =back There are no special options for reading. =cut sub write_mol { my ($self, $fh, $mol, %opts) = @_; my $d = Data::Dumper->new([$mol],['$mol']); # sort the keys if this version of Data::Dumper supports it $d->Sortkeys(1) if $d->can('Sortkeys'); print $fh $d ->Indent(exists $opts{dumper_indent} ? $opts{dumper_indent} : 1) ->Purity(exists $opts{dumper_purity} ? $opts{dumper_purity} : 1) ->Dump; } sub read_mol { my ($self, $fh, %opts) = @_; my $mol; my $s = do { local $/; <$fh> }; return unless $s; eval $s; if ($@) { croak "Dumper eval error: $@" if $opts{fatal}; return; } $mol->_weaken; $mol; } sub name_is { my ($self, $name, %opts) = @_; $name =~ /\.pl$/i; } sub string_is { my ($self, $s, %opts) = @_; $s =~ /^\$mol/; } 1; =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L, L, L =head1 AUTHOR Ivan Tubert-Brohman =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/lib/Chemistry/File.pm0000644000175000017500000004111314263501714017772 0ustar andriusandriuspackage Chemistry::File; our $VERSION = '0.39'; # VERSION =head1 NAME Chemistry::File - Molecule file I/O base class =head1 SYNOPSIS # As a convenient interface for several mol readers: use Chemistry::File qw(PDB MDLMol); # load PDB and MDL modules # or try to use every file I/O module installed in the system: use Chemistry::File ':auto'; my $mol1 = Chemistry::Mol->read("file.pdb"); my $mol2 = Chemistry::Mol->read("file.mol"); # as a base for a mol reader: package Chemistry::File::Myfile; use base qw(Chemistry::File); use Chemistry::Mol; Chemistry::Mol->register_format("myfile", __PACKAGE__); # override the read_mol method sub read_mol { my ($self, $fh, %opts) = shift; my $mol_class = $opts{mol_class} || "Chemistry::Mol"; my $mol = $mol_class->new; # ... do some stuff with $fh and $mol ... return $mol; } # override the write_mol method sub write_mol { my ($self, $fh, $mol, %opts) = shift; print $fh $mol->name, "\n"; # ... do some stuff with $fh and $mol ... } =head1 DESCRIPTION The main use of this module is as a base class for other molecule file I/O modules (for example, Chemistry::File::PDB). Such modules should override and extend the Chemistry::File methods as needed. You only need to care about the methods here if if you are writing a file I/O module or if you want a finer degree of control than what is offered by the simple read and write methods in the Chemistry::Mol class. From the user's point of view, this module can also be used as shorthand for using several Chemistry::File modules at the same time. use Chemistry::File qw(PDB MDLMol); is exactly equivalent to use Chemistry::File::PDB; use Chemistry::File::MDLMol; If you use the :auto keyword, Chemistry::File will autodetect and load all the Chemistry::File::* modules installed in your system. use Chemistry::File ':auto'; =head1 FILE I/O MODEL Before version 0.30, file I/O modules typically used only parse_string, write_string, parse_file, and write_file, and they were generally used as class methods. A file could contain one or more molecules and only be read or written whole; reading it would return every molecule on the file. This was problematic when dealing with large multi-molecule files (such as SDF files), because all the molecules would have to be loaded into memory at the same time. While version 0.30 retains backward compatibility with that simple model, it also allows a more flexible interface that allows reading one molecule at a time, skipping molecules, and reading and writing file-level information that is not associated with specific molecules. The following diagram shows the global structure of a file according to the new model: +-----------+ | header | +-----------+ | molecule | +-----------+ | molecule | +-----------+ | ... | +-----------+ | footer | +-----------+ In cases where the header and the footer are empty, the model reduces to the pre-0.30 version. The low-level steps to read a file are the following: $file = Chemistry::File::MyFormat->new(file => 'xyz.mol'); $file->open('<'); $file->read_header; while (my $mol = $self->read_mol($file->fh, %opts)) { # do something with $mol... } $self->read_footer; The C method does all the above automatically, and it stores all the molecules read in the mols property. =head1 STANDARD OPTIONS All the methods below include a list of options %opts at the end of the parameter list. Each class implementing this interface may have its own particular options. However, the following options should be recognized by all classes: =over =item mol_class A class or object with a C method that constructs a molecule. This is needed when the user want to specify a molecule subclass different from the default. When this option is not defined, the module may use Chemistry::Mol or whichever class is appropriate for that file format. =item format The name of the file format being used, as registered by Chemistry::Mol->register_format. =item fatal If true, parsing errors should throw an exception; if false, they should just try to recover if possible. True by default. =back =head1 CLASS METHODS The class methods in this class (or rather, its derived classes) are usually not called directly. Instead, use Chemistry::Mol->read, write, print, parse, and file. These methods also work if called as instance methods. =over =cut use strict; use warnings; no warnings qw(uninitialized); use Carp; use FileHandle; use base qw(Chemistry::Obj); # don't blame our problems in the Chemistry::Mol module ;-) our @CARP_NOT = qw(Chemistry::Mol); # This subroutine implements the :auto functionality sub import { my $pack = shift; for my $param (@_){ if ($param eq ':auto') { for my $pmfile (map {glob "$_/Chemistry/File/*.pm"} @INC) { my ($pm) = $pmfile =~ m|(Chemistry/File/.*\.pm)$|; #warn "requiring $pm\n"; eval { require $pm }; die "Error in Chemistry::File: '$@'; pmfile='$pmfile'; pm='$pm'\n" if $@; } } else { eval "use ${pack}::$param"; die "$@" if $@; } } } =item $class->parse_string($s, %options) Parse a string $s and return one or more molecule objects. This is an abstract method, so it should be provided by all derived classes. =cut sub parse_string { my ($self, $s, %opts) = @_; if ($opts{_must_override}) { my $class = ref $self || $self; croak "parse_string() is not implemented for $class"; } $self->new(file => \$s, opts => \%opts)->read; } =item $class->write_string($mol, %options) Convert a molecule to a string. This is an abstract method, so it should be provided by all derived classes. =cut sub write_string { my ($self, $mol, %opts) = @_; if ($opts{_must_override}) { my $class = ref $self || $self; croak "write_string() is not implemented for $class"; } my $s; $self->new(file => \$s, mols => [$mol], opts => \%opts)->write; $s; } =item $class->parse_file($file, %options) Reads the file $file and returns one or more molecules. The default method slurps the whole file and then calls parse_string, but derived classes may choose to override it. $file can be a filehandle, a filename, or a scalar reference. See C for details. =cut sub parse_file { my ($self, $file, %opts) = @_; $self->new(file => $file, opts => \%opts)->read; } =item $class->write_file($mol, $file, %options) Writes a file $file containing the molecule $mol. The default method calls write_string first and then saves the string to a file, but derived classes may choose to override it. $file can be either a filehandle or a filename. =cut sub write_file { my ($self, $mol, $file, %opts) = @_; $self->new(file => $file, mols => [$mol], opts => \%opts)->write; } =item $class->name_is($fname, %options) Returns true if a filename is of the format corresponding to the class. It should look at the filename only, because it may be called with non-existent files. It is used to determine with which format to save a file. For example, the Chemistry::File::PDB returns true if the file ends in .pdb. =cut sub name_is { 0; } =item $class->string_is($s, %options) Examines the string $s and returns true if it has the format of the class. =cut sub string_is { 0; } =item $class->file_is($file, %options) Examines the file $file and returns true if it has the format of the class. The default method slurps the whole file and then calls string_is, but derived classes may choose to override it. =cut sub file_is { my ($self, $file, %opts) = @_; my $s = eval { $self->open('<'); $self->slurp; }; if ($s) { $self->string_is($s, %opts); } elsif (! ref $file) { $self->name_is($file, %opts); } } =item $class->slurp Reads a file into a scalar. Automatic decompression of gzipped files is supported if the Compress::Zlib module is installed. Files ending in .gz are assumed to be compressed; otherwise it is possible to force decompression by passing the gzip => 1 option (or no decompression with gzip => 0). =cut # slurp a file into a scalar, with transparent decompression sub slurp { my ($self) = @_; my $fh = $self->fh; local $/; <$fh>; } =item $class->new(file => $file, opts => \%opts) Create a new file object. This method is usually called indirectly via the Chemistry::Mol->file method. $file may be a scalar with a filename, an open filehandle, or a reference to a scalar. If a reference to a scalar is used, the string contained in the scalar is used as an in-memory file. =cut sub new { my $self = shift->SUPER::new(@_); $self->{opts}{fatal} = 1 unless exists $self->{opts}{fatal}; $self; } Chemistry::Obj::accessor(qw(file fh opts mols mode)); =back =head1 INSTANCE METHODS =head2 Accessors Chemistry::File objects are derived from Chemistry::Obj and have the same properties (name, id, and type), as well as the following ones: =over =item file The "file" as described above under C. =item fh The filehandle used for reading and writing molecules. It is opened by C. =item opts A hashref containing the options that are passed through to the old-style class methods. They are also passed to the instance method to keep a similar interface, but they could access them via $self->opts anyway. =item mode '>' if the file is open for writing, '<' for reading, and false if not open. =item mols C stores all the molecules that were read in this property as an array reference. C gets the molecules to write from here. =back =head2 Abstract methods These methods should be overridden, because they don't really do much by default. =over =item $file->read_header Read whatever information is available in the file before the first molecule. Does nothing by default. =cut sub read_header { } =item $file->read_footer Read whatever information is available in the file after the last molecule. Does nothing by default. =cut sub read_footer { } =item $self->slurp_mol($fh) Reads from the input string until the end of the current molecule and returns the "slurped" string. It does not parse the string. It returns undefined if there are no more molecules in the file. This method should be overridden if needed; by default, it slurps until the end of the file. =cut sub slurp_mol { my ($self, $fh) = @_; local $/; <$fh>; } =item $self->skip_mol($fh) Similar to slurp_mol, but it doesn't need to return anything except true or false. It should also be overridden if needed; by default, it just calls slurp_mol. =cut sub skip_mol { shift->slurp_mol(@_) } =item $file->read_mol($fh, %opts) Read the next molecule in the input stream. It returns false if there are no more molecules in the file. This method should be overridden by derived classes; otherwise it will call slurp_mol and parse_string (for backwards compatibility; it is recommended to override read_mol directly in new modules). Note: some old file I/O modules (written before the 0.30 interface) may return more than one molecule anyway, so it is recommended to call read_mol in list context to be safe: ($mol) = $file->read_mol($fh, %opts); =cut sub read_mol { my ($self, $fh, %opts) = @_; my $s = $self->slurp_mol($fh); return unless defined $s and length $s; $self->parse_string($s, %opts, _must_override => 1); } =item $file->write_header Write whatever information is needed before the first molecule. Does nothing by default. =cut sub write_header { } =item $file->write_footer Write whatever information is needed after the last molecule. Does nothing by default. =cut sub write_footer { } =item $self->write_mol($fh, $mol, %opts) Write one molecule to $fh. By default and for backward compatibility, it just calls C and prints its return value to $self->fh. New classes should override it. =cut sub write_mol { my ($self, $fh, $mol, %opts) = @_; print $fh $self->write_string($mol, %opts, _must_override => 1); } ########################## OTHER ################################## =back =head2 Other methods =over =item $self->open($mode) Opens the file (held in $self->file) for reading by default, or for writing if $mode eq '>'. This method sets $self->fh transparently regardless of whether $self->file is a filename (compressed or not), a scalar reference, or a filehandle. =cut sub open { my ($self, $mode) = @_; my $fh; my $s; $mode ||= '<'; $self->mode($mode); my $file = $self->file; croak "Chemistry::File::open: no file supplied" unless defined $file; if (ref $file eq 'SCALAR') { croak "decompression only supported for files" if $self->{opts}{gzip}; if ($] >= 5.008) { open $fh, $mode, $file; } else { require IO::String; $fh = IO::String->new($$file); } } elsif (ref $file) { croak "decompression only supported for files" if $self->{opts}{gzip}; $fh = $file; } elsif ($self->{opts}{gzip} or !defined $self->{opts}{gzip} and $file =~ /.gz$/) { eval { require Compress::Zlib } # Carp or croak "Compress::Zlib not installed!"; require File::Temp; $fh = File::Temp::tempfile(); $self->{opts}{gzip} ||= 1; unless ($mode eq '>') { my $gz = Compress::Zlib::gzopen($file, "rb") or croak "Cannot open compressed $file: " . "$Compress::Zlib::gzerrno\n"; my $buffer; print $fh $buffer while $gz->gzread($buffer) > 0; if ($Compress::Zlib::gzerrno != Compress::Zlib::Z_STREAM_END()) { croak "Error reading from $file: $Compress::Zlib::gzerrno" . ($Compress::Zlib::gzerrno+0) . "\n"; } $gz->gzclose(); seek $fh, 0, 0; } } else { $fh = FileHandle->new("$mode$file") or croak "Could not open file $file: $!"; } $self->fh($fh); $self; } =item $self->close Close the file. For regular files this just closes the filehandle, but for gzipped files it does some additional postprocessing. This method is called automatically on object destruction, so it is not mandatory to call it explicitly. =cut sub close { my ($self) = @_; my $fh = $self->fh; if ($fh and $self->mode eq '>' and $self->{opts}{gzip}) { my $level = $self->{opts}{gzip} || 6; $level = 6 if $level == 1; my $file = $self->file; if (ref $file) { croak "compression only supported for files"; } else { seek $fh, 0, 0; my $gz = Compress::Zlib::gzopen($file, "wb$level") or croak "Cannot open $file $Compress::Zlib::gzerrno\n"; local $_; while (<$fh>) { $gz->gzwrite($_) or croak "error writing: $Compress::Zlib::gzerrno\n"; } $gz->gzclose; } } if ($self->mode) { if ($fh) { $fh->close or croak "$!" }; $self->mode(''); } } sub DESTROY { shift->close } =item $file->read Read the whole file. This calls open, read_header, read_mol until there are no more molecules left, read_footer, and close. Returns a list of molecules if called in list context, or the first molecule in scalar context. =cut sub read { my ($self) = @_; $self->open('<'); $self->read_header; my @all_mols; $self->mols(\@all_mols); while (my @mols = $self->read_mol($self->fh, %{$self->{opts}})) { push @all_mols, @mols; } $self->read_footer; $self->close; wantarray ? @all_mols : $all_mols[0]; } =item $self->write Write all the molecules in $self->mols. It just calls open, write_header, write_mol (per each molecule), write_footer, and close. =cut sub write { my ($self) = @_; $self->open('>'); $self->write_header; for my $mol (@{$self->mols}) { $self->write_mol($self->fh, $mol, %{$self->{opts}}); } $self->write_footer; $self->close; } 1; =back =head1 CAVEATS The :auto feature may not be entirely portable, but it is known to work under Unix and Windows (either Cygwin or ActiveState). =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L =head1 AUTHOR Ivan Tubert-Brohman-Brohman =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/lib/Chemistry/Atom.pm0000644000175000017500000005557114263501714020030 0ustar andriusandriuspackage Chemistry::Atom; our $VERSION = '0.39'; # VERSION # $Id$ =head1 NAME Chemistry::Atom - Chemical atoms as objects in molecules =head1 SYNOPSIS use Chemistry::Atom; my $atom = new Chemistry::Atom( id => 'a1', coords => [$x, $y, $z], symbol => 'Br' ); print $atom->print; =head1 DESCRIPTION This module includes objects to describe chemical atoms. An atom is defined by its symbol and its coordinates, among other attributes. Atomic coordinates are described by a Math::VectorReal object, so that they can be easily used in vector operations. =head2 Atom Attributes In addition to common attributes such as id, name, and type, atoms have the following attributes, which are accessed or modified through methods defined below: bonds, coords, internal_coords, Z, symbol, etc. In general, to get the value of a property, use $atom->method without any parameters. To set the value, use $atom->method($new_value). When setting an attribute, the accessor returns the atom object, so that accessors can be chained: $atom->symbol("C")->name("CA")->coords(1,2,3); =cut # Considering to add the following attributes: # mass_number (A) use 5.006; use strict; use warnings; use Scalar::Util 'weaken'; use Math::VectorReal qw(O vector); use Math::Trig; use Carp; use base qw(Chemistry::Obj Exporter); use List::Util qw(first); our @EXPORT_OK = qw(distance angle dihedral angle_deg dihedral_deg); our %EXPORT_TAGS = ( all => \@EXPORT_OK, ); my $N = 0; # Number of atoms created so far, used to generate default IDs. our @ELEMENTS = qw( n H He Li Be B C N O F Ne Na Mg Al Si P S Cl Ar K Ca Sc Ti V Cr Mn Fe Co Ni Cu Zn Ga Ge As Se Br Kr Rb Sr Y Zr Nb Mo Tc Ru Rh Pd Ag Cd In Sn Sb Te I Xe Cs Ba La Ce Pr Nd Pm Sm Eu Gd Tb Dy Ho Er Tm Yb Lu Hf Ta W Re Os Ir Pt Au Hg Tl Pb Bi Po At Rn Fr Ra Ac Th Pa U Np Pu Am Cm Bk Cf Es Fm Md No Lr Rf Db Sg Bh Hs Mt Ds Uuu Uub Uut Uuq Uup Uuh Uus Uuo ); our %ELEMENTS; for (my $i = 1; $i < @ELEMENTS; ++$i){ $ELEMENTS{$ELEMENTS[$i]} = $i; } $ELEMENTS{D} = $ELEMENTS{T} = 1; my %Atomic_masses = ( "H" => 1.00794, "D" => 2.014101, "T" => 3.016049, "He" => 4.002602, "Li" => 6.941, "Be" => 9.012182, "B" => 10.811, "C" => 12.0107, "N" => 14.00674, "O" => 15.9994, "F" => 18.9984032, "Ne" => 20.1797, "Na" => 22.989770, "Mg" => 24.3050, "Al" => 26.981538, "Si" => 28.0855, "P" => 30.973761, "S" => 32.066, "Cl" => 35.4527, "Ar" => 39.948, "K" => 39.0983, "Ca" => 40.078, "Sc" => 44.955910, "Ti" => 47.867, "V" => 50.9415, "Cr" => 51.9961, "Mn" => 54.938049, "Fe" => 55.845, "Co" => 58.933200, "Ni" => 58.6934, "Cu" => 63.546, "Zn" => 65.39, "Ga" => 69.723, "Ge" => 72.61, "As" => 74.92160, "Se" => 78.96, "Br" => 79.904, "Kr" => 83.80, "Rb" => 85.4678, "Sr" => 87.62, "Y" => 88.90585, "Zr" => 91.224, "Nb" => 92.90638, "Mo" => 95.94, "Tc" => 98, "Ru" => 101.07, "Rh" => 102.90550, "Pd" => 106.42, "Ag" => 107.8682, "Cd" => 112.411, "In" => 114.818, "Sn" => 118.710, "Sb" => 121.760, "Te" => 127.60, "I" => 126.90447, "Xe" => 131.29, "Cs" => 132.90545, "Ba" => 137.327, "La" => 138.9055, "Ce" => 140.116, "Pr" => 140.90765, "Nd" => 144.24, "Pm" => 145, "Sm" => 150.36, "Eu" => 151.964, "Gd" => 157.25, "Tb" => 158.92534, "Dy" => 162.50, "Ho" => 164.93032, "Er" => 167.26, "Tm" => 168.93421, "Yb" => 173.04, "Lu" => 174.967, "Hf" => 178.49, "Ta" => 180.9479, "W" => 183.84, "Re" => 186.207, "Os" => 190.23, "Ir" => 192.217, "Pt" => 195.078, "Au" => 196.96655, "Hg" => 200.59, "Tl" => 204.3833, "Pb" => 207.2, "Bi" => 208.98038, "Po" => 209, "At" => 210, "Rn" => 222, "Fr" => 223, "Ra" => 226, "Ac" => 227, "Th" => 232.038, "Pa" => 231.03588, "U" => 238.0289, "Np" => 237, "Pu" => 244, "Am" => 243, "Cm" => 247, "Bk" => 247, "Cf" => 251, "Es" => 252, "Fm" => 257, "Md" => 258, "No" => 259, "Lr" => 262, "Rf" => 261, "Db" => 262, "Sg" => 266, "Bh" => 264, "Hs" => 269, "Mt" => 268, "Ds" => 271, ); =head1 METHODS =over 4 =item Chemistry::Atom->new(name => value, ...) Create a new Atom object with the specified attributes. =cut sub new { my $class = shift; my %args = @_; my $self = bless { id => $class->nextID(), coords => vector(0, 0, 0), Z => 0, symbol => '', bonds => [], }, $class; $self->$_($args{$_}) for (keys %args); $self; } sub nextID { "a".++$N; } sub reset_id { $N = 0; } =item $atom->Z($new_Z) Sets and returns the atomic number (Z). If the symbol of the atom doesn't correspond to a known element, Z = undef. =cut sub Z { my $self = shift; if(@_) { $self->{symbol} = $ELEMENTS[$_[0]]; $self->{Z} = $_[0]; return $self; } else { return $self->{Z}; } } =item $atom->symbol($new_symbol) Sets and returns the atomic symbol. =cut sub symbol { my $self = shift; if(@_) { my $symbol = shift; $symbol =~ s/ //g; $self->{Z} = $ELEMENTS{$symbol}; $self->{symbol} = $symbol; return $self; } else { return $self->{symbol}; } } =item $atom->mass($new_mass) Sets and returns the atomic mass in atomic mass units. Any arbitrary mass may be set explicitly by using this method. However, if no mass is set explicitly and this method is called as an accessor, the return value is the following: 1) If the mass number is undefined (see the mass_number method below), the relative atomic mass from the 1995 IUPAC recommendation is used. (Table stolen from the Chemistry::MolecularMass module by Maksim A. Khrapov). 2) If the mass number is defined and the L module is available and it knows the mass for the isotope, the exact mass of the isotope is used; otherwise, the mass number is returned. =cut sub mass { my $self = shift; if (@_) { $self->{mass} = shift; return $self; } else { if (defined $self->{mass}) { return $self->{mass}; } elsif (defined $self->{mass_number}) { if (eval { require Chemistry::Isotope } and my $m = Chemistry::Isotope::isotope_mass( $self->{mass_number}, $self->{Z}) ) { return $m; } else { return $self->{mass_number}; } } else { return $Atomic_masses{$self->symbol}; } } } =item $atom->mass_number($new_mass_number) Sets or gets the mass number. The mass number is undefined unless is set explicitly (this module does not try to guess a default mass number based on the natural occurring isotope distribution). =cut Chemistry::Obj::accessor('mass_number'); =item $atom->coords my $vector = $atom->coords; # get a Math::VectorReal object $atom->coords($vector); # set a Math::VectorReal object $atom->coords([$x, $y, $z]); # also accepts array refs $atom->coords($x, $y, $z); # also accepts lists Sets or gets the atom's coordinates. It can take as a parameter a Math::VectorReal object, a reference to an array, or the list of coordinates. =cut sub coords { my $self = shift; if(@_) { if (UNIVERSAL::isa($_[0], "Math::VectorReal")) { $self->{coords} = $_[0]; } elsif (ref $_[0] eq "ARRAY") { $self->{coords} = vector(@{$_[0]}); } else { $self->{coords} = vector(@_); } } else { return $self->{coords}; } $self; } =item $atom->internal_coords # get a Chemistry::InternalCoords object my $ic = $atom->internal_coords; # set a Chemistry::InternalCoords object $atom->internal_coords($vic); # also accepts array refs $atom->internal_coords([8, 1.54, 7, 109.47, 6, 120.0]); # also accepts lists $atom->internal_coords(8, 1.54, 7, 109.47, 6, 120.0); Sets or gets the atom's internal coordinates. It can take as a parameter a Chemistry::InternalCoords object, a reference to an array, or the list of coordinates. In the last two cases, the list elements are the following: atom number or reference for distance, distance, atom number or reference for angle, angle in degrees, atom number or reference for dihedral, dihedral in degrees. =cut sub internal_coords { my $self = shift; if(@_) { if (UNIVERSAL::isa($_[0], "Chemistry::InternalCoords")) { $self->{internal_coords} = $_[0]; } elsif (ref $_[0] eq "ARRAY") { require Chemistry::InternalCoords; $self->{internal_coords} = Chemistry::InternalCoords->new($self, @{$_[0]}); } else { require Chemistry::InternalCoords; $self->{internal_coords} = Chemistry::InternalCoords->new($self, @_); } } else { return $self->{internal_coords}; } $self; } =item $atom->x3, $atom->y3, $atom->z3 Get the x, y or z 3D coordinate of the atom. This methods are just accessors that don't change the coordinates. $atom->x3 is short for ($atom->coords->array)[0], and so on. =cut sub x3 { ($_[0]->coords->array)[0] } sub y3 { ($_[0]->coords->array)[1] } sub z3 { ($_[0]->coords->array)[2] } =item $atom->formal_charge($charge) Set or get the formal charge of the atom. =cut Chemistry::Obj::accessor('formal_charge'); =item $atom->formal_radical($radical) Set or get the formal radical multiplicity for the atom. =cut Chemistry::Obj::accessor('formal_radical'); =item $atom->implicit_hydrogens($h_count) Set or get the number of implicit hydrogen atoms bonded to the atom. =cut sub implicit_hydrogens { shift->hydrogens(@_) } =item $atom->hydrogens($h_count) Set or get the number of implicit hydrogen atoms bonded to the atom (DEPRECATED: USE C INSTEAD). =cut Chemistry::Obj::accessor('hydrogens'); =item $atom->total_hydrogens($h_count) Get the total number of hydrogen atoms bonded to the atom (implicit + explicit). =cut sub total_hydrogens { my ($self) = @_; no warnings 'uninitialized'; $self->hydrogens + grep { $_->symbol eq 'H' } $self->neighbors; } =item $atom->sprout_hydrogens Convert all the implicit hydrogens for this atom to explicit hydrogens. Note: it does B generate coordinates for the new atoms. =cut sub sprout_hydrogens { my ($self) = @_; for (1 .. $self->implicit_hydrogens || 0) { $self->parent->new_bond( atoms => [$self, $self->parent->new_atom(symbol => 'H')]); } $self->implicit_hydrogens(0); } =item $atom->collapse_hydrogens Delete neighboring hydrogen atoms and add them as implicit hydrogens for this atom. =cut sub collapse_hydrogens { my ($self) = @_; no warnings 'uninitialized'; my $implicit = $self->implicit_hydrogens; for my $nei ($self->neighbors) { $nei->delete, $implicit++ if $nei->symbol eq 'H'; } $self->implicit_hydrogens($implicit); } my %VALENCE_TABLE = ( Br => 1, Cl => 1, B => 3, C => 4, N => 3, O => 2, P => 3, S => 2, F => 1, I => 1, ); # to make it easier to test sub _calc_implicit_hydrogens { my ($self, $symbol, $valence, $charge, $radical) = @_; no warnings 'uninitialized'; my $h_count = $VALENCE_TABLE{$symbol} - $valence; # should account for non-kekulized aromatic bonds # some common charge situations if (($symbol =~ /^(?:[NOSFI]|Cl|Br)$/) && $charge == -1) { $h_count--; } elsif ($symbol =~ /^[NOSP]$/ && $charge == 1) { $h_count++; } elsif ($symbol eq 'C' && $charge) { $h_count--; } elsif ($symbol eq 'B' && $charge == -1) { $h_count++; } # some common radical situations if ($radical == 1 or $radical == 3) { # carbene, singlet or triplet $h_count -= 2; } elsif ($radical == 2) { # radical (doublet) $h_count--; } $h_count = 0 if $h_count < 0; $h_count; } =item $atom->calc_implicit_hydrogens Use heuristics to figure out how many implicit hydrogens should the atom have to satisfy its normal "organic" valence. Returns the number of hydrogens but does not affect the atom object. =cut sub calc_implicit_hydrogens { my ($self) = @_; $self->_calc_implicit_hydrogens( $self->symbol, $self->explicit_valence, $self->formal_charge, $self->formal_radical, ); } =item $atom->add_implicit_hydrogens Similar to calc_implicit_hydrogens, but it also sets the number of implicit hydrogens in the atom to the new calculated value. Equivalent to $atom->implicit_hydrogens($atom->calc_implicit_hydrogens); It returns the atom object. =cut sub add_implicit_hydrogens { my ($self) = @_; my $h_count = $self->calc_implicit_hydrogens; $self->implicit_hydrogens($h_count); } =item $atom->aromatic($bool) Set or get whether the atom is considered to be aromatic. This property may be set arbitrarily, it doesn't imply any kind of "intelligent aromaticity detection"! (For that, look at the L module). =cut Chemistry::Obj::accessor('aromatic'); =item $atom->valence Returns the sum of the bond orders of the bonds in which the atom participates, including implicit hydrogens (which are assumed to have bond orders of one). =cut sub valence { my ($self) = @_; my $valence = 0; $valence += $_->order for $self->bonds; $valence += $self->hydrogens || 0; $valence; } =item $atom->explicit_valence Like C, but excluding implicit hydrogen atoms. To get the raw number of bonds, without counting bond orders, call $atom->bonds in scalar context. =cut sub explicit_valence { my ($self) = @_; my $valence = 0; $valence += $_->order for $self->bonds; $valence; } # this method is for internal use only; called by $mol->add_bond sub add_bond { my $self = shift; my $bond = shift; my %seen; #return if first { $_ eq $bond } @{$self->{bonds}}; for my $atom (@{$bond->{atoms}}){ #for each atom... if ($atom ne $self) { my $b = {to=>$atom, bond=>$bond}; weaken($b->{to}); weaken($b->{bond}); push @{$self->{bonds}}, $b; } } } # make sure the atom doesn't cause circular references sub _weaken { my $self = shift; for my $b (@{$self->{bonds}}) { weaken($b->{to}); weaken($b->{bond}); } weaken($self->{parent}); } # This method is private. Bonds should be deleted from the # mol object. These methods should only be called by # $bond->delete_atoms, which is called by $mol->delete_bond sub delete_bond { my ($self, $bond) = @_; $self->{bonds} = [ grep { $_->{bond} ne $bond } @{$self->{bonds}} ]; } =item $atom->delete Calls $mol->delete_atom($atom) on the atom's parent molecule. =cut sub delete { my ($self) = @_; $self->{parent}->_delete_atom($self); } =item $atom->parent Returns the atom's containing object (the molecule to which the atom belongs). An atom can only have one parent. =cut sub parent { my $self = shift; if (@_) { ($self->{parent}) = @_; weaken($self->{parent}); $self; } else { $self->{parent}; } } =item $atom->neighbors($from) Return a list of neighbors. If an atom object $from is specified, it will be excluded from the list (this is useful if an atom wants to know who its neighbor's neighbors are, without counting itself). =cut sub neighbors { my $self = shift; my $from = shift; my @ret = (); for my $b (@{$self->{bonds}}) { push @ret, $b->{to} unless $from && $b->{to} eq $from; } @ret; } =item $atom->bonds($from) Return a list of bonds. If an atom object $from is specified, bonds to that atom will be excluded from the list. =cut sub bonds { my $self = shift; my $from = shift; my @ret = (); for my $b (@{$self->{bonds}}) { push @ret, $b->{bond} unless $from && $b->{to} eq $from; } @ret; } =item $atom->bonds_neighbors($from) Return a list of hash references, representing the bonds and neighbors from the atom. If an atom object $from is specified, it will be excluded from the list. The elements of the hash are 'to', and atom reference, and 'bond', a bond reference. For example, for my $bn ($atom->bonds_neighbors) { print "bond $bn->{bond} point to atom $bn->{to}\n"; } =cut sub bonds_neighbors { my $self = shift; my $from = shift; my @ret = (); for my $b (@{$self->{bonds}}) { push @ret, {%$b} unless $from && $b->{to} eq $from; } @ret; } =item ($distance, $closest_atom) = $atom->distance($obj) Returns the minimum distance to $obj, which can be an atom, a molecule, or a vector. In scalar context it returns only the distance; in list context it also returns the closest atom found. It can also be called as a function, Chemistry::Atom::distance (which can be exported). =cut sub distance { my $self = shift; my $obj = shift; my $min_length; my $closest_atom = $obj; if ($obj->isa('Chemistry::Atom')) { my $v = $self->coords - $obj->coords; $min_length = $v->length; } elsif ($obj->isa('Math::VectorReal')) { my $v = $self->coords - $obj; $min_length = $v->length; } elsif ($obj->isa('Chemistry::Mol')) { my @atoms = $obj->atoms; my $a = shift @atoms or return undef; # ensure there's at least 1 atom $min_length = $self->distance($a); $closest_atom = $a; for $a (@atoms) { my $l = $self->distance($a); $min_length = $l, $closest_atom = $a if $l < $min_length; } } else { croak "atom->distance() undefined for objects of type '", ref $obj,"'"; } wantarray ? ($min_length, $closest_atom) : $min_length; } =item $atom->angle($atom2, $atom3) Returns the angle in radians between the atoms involved. $atom2 is the atom in the middle. Can also be called as Chemistry::Atom::angle($atom1, $atom2, $atom3). This function can be exported. Note: if you override this method, you may also need to override angle_deg or strange things may happen. =cut # $a2 is the one in the center sub angle { @_ == 3 or croak "Chemistry::Atom::angle requires three atoms!\n"; my @c; for my $a (@_) { # extract coordinates ref $a or croak "Chemistry::Atom::angle: $a is not an object"; push @c, $a->isa("Chemistry::Atom") ? $a->coords : $a->isa("Math::VectorReal") ? $a : croak "angle: $a is neither an atom nor a vector!\n"; } my $v1 = $c[0] - $c[1]; my $v2 = $c[2] - $c[1]; my $l = ($v1->length * $v2->length) or return 0; acos(($v1 . $v2) / $l); } =item $atom->angle_deg($atom2, $atom3) Same as angle(), but returns the value in degrees. May be exported. =cut sub angle_deg { rad2deg(angle(@_)); } =item $atom->dihedral($atom2, $atom3, $atom4) Returns the dihedral angle in radians between the atoms involved. Can also be called as Chemistry::Atom::dihedral($atom1, $atom2, $atom3, $atom4). May be exported. Note: if you override this method, you may also need to override dihedral_deg and angle or strange things may happen. =cut sub dihedral { @_ == 4 or croak "Chemistry::Atom::dihedral requires four atoms!\n"; my @c; for my $a (@_) { # extract coordinates push @c, $a->isa("Chemistry::Atom") ? $a->coords : $a->isa("Math::VectorReal") ? $a : croak "angle: $a is neither an atom nor a vector!\n"; } my $v1 = $c[0] - $c[1]; my $v2 = $c[2] - $c[1]; my $v3 = $c[3] - $c[2]; my $x1 = $v1 x $v2; my $x2 = $v3 x $v2; my $abs_dih = angle($x1, O(), $x2); $v1 . $x2 > 0 ? $abs_dih : -$abs_dih; } =item $atom->dihedral_deg($atom2, $atom3, $atom4) Same as dihedral(), but returns the value in degrees. May be exported. =cut sub dihedral_deg { rad2deg(dihedral(@_)); } =item $atom->print Convert the atom to a string representation (used for debugging). =cut sub print { my $self = shift; my ($indent) = @_; no warnings; $indent ||= 0; my $bonds = join " ", map {$_->id} $self->bonds; my $neighbors = join " ", map {$_->id} $self->neighbors; my $coords = $self->{coords}->stringify( 'x3: %g y3: %g z3: %g' ); my $ret = <{id}: symbol: $self->{symbol} name : $self->{name} $coords formal_charge: $self->{formal_charge} bonds: "$bonds" neighbors: "$neighbors" EOF $ret .= " attr:\n"; $ret .= $self->print_attr($indent+2); $ret =~ s/^/" "x$indent/gem; $ret; } =item my $info = $atom->sprintf($format) Format interesting atomic information in a concise way, as specified by a printf-like format. %s - symbol %Z - atomic number %n - name %q - formal charge %h - implicit hydrogen count %v - valence %i - id %8.3m - mass, formatted as %8.3f with core sprintf %8.3x - x coordinate, formatted as %8.3f with core sprintf %8.3y - y coordinate, formatted as %8.3f with core sprintf %8.3z - z coordinate, formatted as %8.3f with core sprintf %% - % =cut sub sprintf { my ($atom, $format) = @_; no warnings 'uninitialized'; # don't care if some properties are undefined $format ||= "%f"; $format =~ s/%%/\\%/g; # escape %% with a \ $format =~ s/(?formal_charge || 0/eg; # %q $format =~ s/(?symbol/eg; # %s $format =~ s/(?Z/eg; # %Z $format =~ s/(?name/eg; # %n $format =~ s/(?hydrogens/eg; # %h $format =~ s/(?valence/eg; # %v $format =~ s/(?mass : $atom->mass/eg; # %m $format =~ s/(?x3 : $atom->x3/eg; # %x $format =~ s/(?y3 : $atom->y3/eg; # %y $format =~ s/(?z3 : $atom->z3/eg; # %z $format =~ s/(?id/eg; # %i $format =~ s/\\(.)/$1/g; # other \ escapes $format; } =item $atom->printf($format) Same as $atom->sprintf, but prints to standard output automatically. Used for quick and dirty atomic information dumping. =cut sub printf { my ($atom, $format) = @_; print $atom->sprintf($format); } 1; =back =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L, L, L, L, L =head1 AUTHOR Ivan Tubert-Brohman Eitub@cpan.orgE =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/lib/Chemistry/Obj.pm0000644000175000017500000001320514263501714017626 0ustar andriusandriuspackage Chemistry::Obj; our $VERSION = '0.39'; # VERSION # $Id$ use 5.006; use strict; use Carp; =head1 NAME Chemistry::Obj - Abstract chemistry object =head1 SYNOPSIS package MyObj; use base "Chemistry::Obj"; Chemistry::Obj::accessor('color', 'flavor'); package main; my $obj = MyObj->new(name => 'bob', color => 'red'); $obj->attr(size => 42); $obj->color('blue'); my $color = $obj->color; my $size = $obj->attr('size'); =head1 DESCRIPTION This module implements some generic methods that are used by L, L, L, L, etc. =head2 Common Attributes There are some common attributes that may be found in molecules, bonds, and atoms, such as id, name, and type. They are all accessed through the methods of the same name. For example, to get the id, call C<< $obj->id >>; to set the id, call C<< $obj->id('new_id') >>. =over 4 =item id Objects should have a unique ID. The user has the responsibility for uniqueness if he assigns ids; otherwise a unique ID is assigned sequentially. =item name An arbitrary name for an object. The name doesn't need to be unique. =item type The interpretation of this attribute is not specified here, but it's typically used for bond orders and atom types. =item attr A space where the user can store any kind of information about the object. The accessor method for attr expects the attribute name as the first parameter, and (optionally) the new value as the second parameter. It can also take a hash or hashref with several attributes. Examples: $color = $obj->attr('color'); $obj->attr(color => 'red'); $obj->attr(color => 'red', flavor => 'cherry'); $obj->attr({color => 'red', flavor => 'cherry'}); =cut sub attr { my $self = shift; my ($attr) = @_; if (ref $attr eq 'HASH') { $self->{attr} = { %$attr }; } elsif (@_ == 1) { return $self->{attr}{$attr}; } elsif (@_ == 0) { return {%{$self->{attr}}}; } else { while (@_ > 1) { $attr = shift; $self->{attr}{$attr} = shift; } } $self; } =back =head1 OTHER METHODS =over =item $obj->del_attr($attr_name) Delete an attribute. =cut sub del_attr { my $self = shift; my $attr = shift; delete $self->{attr}{$attr}; } # A generic class attribute set/get method generator sub accessor { my $pkg = caller; no strict 'refs'; for my $attribute (@_) { *{"${pkg}::$attribute"} = sub { my $self = shift; return $self->{$attribute} unless @_; $self->{$attribute} = shift; return $self; }; } } sub print_attr { my $self = shift; my ($indent) = @_; my $ret = ''; for my $attr (keys %{$self->{attr}}) { $ret .= "$attr: ".$self->attr($attr)."\n"; } $ret and $ret =~ s/^/" "x$indent/gem; $ret; } my $N = 0; # atom ID counter sub nextID { "obj".++$N; } sub reset_id { $N = 0; } =item $class->new(name => value, name => value...) Generic object constructor. It will automatically call each "name" method with the parameter "value". For example, $bob = Chemistry::Obj->new(name => 'bob', attr => {size => 42}); is equivalent to $bob = Chemistry::Obj->new; $bob->name('bob'); $bob->attr({size => 42}); =cut sub new { my $class = shift; my %args = @_; my $self = bless { id => $class->nextID, #$class->default_args, }, ref $class || $class; $self->$_($args{$_}) for (keys %args); return $self; } #sub default_args { (id => shift->nextID) } =back =head1 OPERATOR OVERLOADING Chemistry::Obj overloads a couple of operators for convenience. =over =cut use overload '""' => "stringify", 'cmp' => "obj_cmp", '0+', => "as_number", fallback => 1, ; =item "" The stringification operator. Stringify an object as its id. For example, If an object $obj has the id 'a1', print "$obj" will print 'a1' instead of something like 'Chemistry::Obj=HASH(0x810bbdc)'. If you really want to get the latter, you can call C. See L for details. =cut sub stringify { my $self = shift; $self->id; } sub as_number { $_[0]; } =item cmp Compare objects by ID. This automatically overloads C, C, C, C, C, and C as well. For example, C<$obj1 eq $obj2> returns true if both objects have the same id, even if they are different objects with different memory addresses. In contrast, C<$obj1 == $obj2> will return true only if C<$obj1> and C<$obj2> point to the same object, with the same memory address. =cut sub obj_cmp { my ($a, $b) = @_; no warnings; return $a->{id} cmp $b->{id}; } =back =cut accessor(qw(name type)); sub id { my $self = shift; return $self->{id} unless @_; if ($self->{parent}) { my $new_id = shift; my $old_id = $self->{id}; $self->{id} = $new_id; $self->{parent}->_change_id($old_id, $new_id); } else { $self->{id} = shift; } } # this is an experimental method and shouldn't be used! sub use { my ($pack, $module, @args) = @_; $pack = ref $pack || $pack; my $args = @args ? "(@args)" : ''; eval "package $pack; use $module $args"; } 1; =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L, L, L =head1 AUTHOR Ivan Tubert-Brohman Eitub@cpan.orgE =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/lib/Chemistry/Bond.pm0000644000175000017500000001100714263501714017774 0ustar andriusandriuspackage Chemistry::Bond; our $VERSION = '0.39'; # VERSION # $Id$ =head1 NAME Chemistry::Bond - Chemical bonds as objects in molecules =head1 SYNOPSIS use Chemistry::Bond; # assuming we have molecule $mol with atoms $a1 and $a2 $bond = Chemistry::Bond->new( id => "b1", type => '=', atoms => [$a1, $a2] order => '2', ); $mol->add_bond($bond); # simpler way of doing the same: $mol->new_bond( id => "b1", type => '=', atoms => [$a1, $a2] order => '2', ); =head1 DESCRIPTION This module includes objects to describe chemical bonds. A bond is defined as a list of atoms (typically two), with some associated properties. =head2 Bond Attributes In addition to common attributes such as id, name, and type, bonds have the order attribute. The bond order is a number, typically the integer 1, 2, 3, or 4. =cut use 5.006; use strict; use Scalar::Util 'weaken'; use base qw(Chemistry::Obj); my $N = 0; =head1 METHODS =over 4 =item Chemistry::Bond->new(name => value, ...) Create a new Bond object with the specified attributes. Sensible defaults are used when possible. =cut sub new { my $class = shift; my %args = @_; my $self = bless { id => $class->nextID(), type => '', atoms => [], order => 1, } , $class; $self->$_($args{$_}) for (keys %args); $self; } sub nextID { "b".++$N; } sub reset_id { $N = 0; } =item $bond->order() Sets or gets the bond order. =cut Chemistry::Obj::accessor('order'); =item $bond->length Returns the length of the bond, i.e., the distance between the two atom objects in the bond. Returns zero if the bond does not have exactly two atoms. =cut sub length { my $self = shift; if (@{$self->{atoms}} == 2) { my $v = $self->{atoms}[1]{coords} - $self->{atoms}[0]{coords}; return $v->length; } else { return 0; } } =item $bond->aromatic($bool) Set or get whether the bond is considered to be aromatic. =cut sub aromatic { my $self = shift; if (@_) { ($self->{aromatic}) = @_; return $self; } else { return $self->{aromatic}; } } =item $bond->print Convert the bond to a string representation. =cut sub print { my $self = shift; my ($indent) = @_; $indent ||= 0; my $l = sprintf "%.4g", $self->length; my $atoms = join " ", map {$_->id} $self->atoms; my $ret = <{id}: type: $self->{type} order: $self->{order} atoms: "$atoms" length: $l EOF $ret .= " attr:\n"; $ret .= $self->print_attr($indent); $ret =~ s/^/" "x$indent/gem; $ret; } =item $bond->atoms() If called with no parameters, return a list of atoms in the bond. If called with a list (or a reference to an array) of atom objects, define the atoms in the bond and call $atom->add_bond for each atom in the list. Note: changing the atoms in a bond may have strange side effects; it is safer to treat bonds as immutable except with respect to properties such as name and type. =cut sub atoms { my $self = shift; if (@_) { $self->{atoms} = ref $_[0] ? $_[0] : [@_]; for my $a (@{$self->{atoms}}) { weaken($a); $a->add_bond($self); } } else { return (@{$self->{atoms}}); } } sub _weaken { my $self = shift; for my $a (@{$self->{atoms}}) { weaken($a); } weaken($self->{parent}); } # This method is private and should only be called from $mol->delete_bond sub delete_atoms { my $self = shift; for my $a (@{$self->{atoms}}) { # delete bond from each atom $a->delete_bond($self); } } =item $bond->delete Calls $mol->delete_bond($bond) on the bond's parent molecule. Note that a bond should belong to only one molecule or strange things may happen. =cut sub delete { my ($self) = @_; $self->parent->_delete_bond($self); $self->{deleted} = 1; } sub parent { my $self = shift; if (@_) { ($self->{parent}) = @_; weaken($self->{parent}); $self; } else { $self->{parent}; } } 1; =back =head1 SOURCE CODE REPOSITORY L =head1 SEE ALSO L, L, L =head1 AUTHOR Ivan Tubert-Brohman Eitub@cpan.orgE =head1 COPYRIGHT Copyright (c) 2005 Ivan Tubert-Brohman. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Chemistry-Mol-0.39/dist.ini0000644000175000017500000000123014263501714015500 0ustar andriusandriusname = Chemistry-Mol author = Ivan Tubert-Brohman license = Perl_5 copyright_holder = Ivan Tubert-Brohman copyright_year = 2005 version = 0.39 [@Filter] -bundle = @Basic -remove = License -remove = Readme [AutoMetaResources] homepage = https://search.cpan.org/dist/%{dist} repository.github = user:perlmol [MetaJSON] [OurPkgVersion] [Prereqs] IO::String = 0 Math::VectorReal = 1.0 Scalar::Util = 1.01 Text::Balanced = 0 [Prereqs / RuntimeRecommends] -phase = runtime -relationship = recommends Chemistry::InternalCoords = 0 Chemistry::Isotope = 0 Clone = 0 Compress::Zlib = 0 [Prereqs / Test] -phase = test Clone = 0 Test::Simple = 0 Chemistry-Mol-0.39/Makefile.PL0000644000175000017500000000225614263501714016017 0ustar andriusandrius# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Molecule object toolkit", "AUTHOR" => "Ivan Tubert-Brohman ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "Chemistry-Mol", "LICENSE" => "perl", "NAME" => "Chemistry::Mol", "PREREQ_PM" => { "IO::String" => 0, "Math::VectorReal" => "1.0", "Scalar::Util" => "1.01", "Text::Balanced" => 0 }, "TEST_REQUIRES" => { "Clone" => 0, "Test::Simple" => 0 }, "VERSION" => "0.39", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Clone" => 0, "IO::String" => 0, "Math::VectorReal" => "1.0", "Scalar::Util" => "1.01", "Test::Simple" => 0, "Text::Balanced" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); Chemistry-Mol-0.39/t/0000775000175000017500000000000014263501714014305 5ustar andriusandriusChemistry-Mol-0.39/t/safe_clone.t0000644000175000017500000000170214263501714016566 0ustar andriusandriususe Test::More; # this tests make sure that safe_clone actually increments the ids for the # objects in the new (cloned) molecule use strict; use warnings; #plan 'no_plan'; plan tests => 9; use Chemistry::File::Dumper; my $mol = Chemistry::Mol->new; $mol->new_atom(symbol => 'C'); $mol->new_atom(symbol => 'C'); $mol->new_bond(atoms => [$mol->atoms(1,2)]); is( $mol->atoms(1)->id, 'a1', 'atom(1) before clone'); is( $mol->bonds(1)->id, 'b1', 'bond(1) before clone'); is( $mol->id, 'mol1', 'mol->id before clone'); my $mol2 = $mol->clone; is( $mol2->atoms(1)->id, 'a1', 'atom(1) after clone'); is( $mol2->bonds(1)->id, 'b1', 'bond(1) after clone'); is( $mol2->id, 'mol1', 'mol->id after clone'); $mol2 = $mol->safe_clone; is( $mol2->atoms(1)->id, 'a3', 'atom(1) after safe_clone'); is( $mol2->bonds(1)->id, 'b2', 'bond(1) after safe_clone'); is( $mol2->id, 'mol2', 'mol->id after safe clone'); Chemistry-Mol-0.39/t/mem.t0000644000175000017500000000204614263501714015250 0ustar andriusandriususe Test::More; # These tests try to make sure that objects are destroyed when they # fall out of scope; these requires avoiding circular strong references use strict; use warnings; #plan 'no_plan'; plan tests => 8; use Chemistry::File::Dumper; my $dead_atoms = 0; my $dead_bonds = 0; my $dead_mols = 0; { my $mol = Chemistry::Mol->read("t/mol.pl"); isa_ok( $mol, 'Chemistry::Mol' ); is( scalar $mol->atoms, 8, 'atoms before'); # make sure cloned molecules are also gc'ed my $mol2 = $mol->clone; # atom deletion garbage collection test $mol->atoms(2)->delete; is( $dead_atoms, 1, "delete one atom - atoms" ); is( $dead_bonds, 4, "delete one atom - bonds" ); is( $dead_mols, 0, "delete one atom - mols" ); } is( $dead_atoms, 16, "out of scope - atoms" ); is( $dead_bonds, 14, "out of scope - bonds" ); is( $dead_mols, 2, "out of scope - mols" ); sub Chemistry::Mol::DESTROY { $dead_mols++ } sub Chemistry::Atom::DESTROY { $dead_atoms++ } sub Chemistry::Bond::DESTROY { $dead_bonds++ } Chemistry-Mol-0.39/t/File.t0000644000175000017500000000411514263501714015350 0ustar andriusandriususe strict; use warnings; use Test::More; BEGIN { #plan 'no_plan'; plan tests => 15; use_ok('Chemistry::File'); } # simple constructor test my $f = Chemistry::File->new; isa_ok($f, "Chemistry::File"); require Chemistry::File::Dumper; # file reader test my $fname = 't/mol.pl'; my $file = Chemistry::File::Dumper->new(file => $fname); isa_ok($file, "Chemistry::File::Dumper"); my $mol = $file->read(format => 'dumper'); isa_ok($mol, "Chemistry::Mol", 'read file'); is(scalar $mol->atoms, 8, "atoms"); # string reader test open F, "<$fname" or die; my $s = do {local $/; }; $file = Chemistry::File::Dumper->new(file => \$s); $mol = $file->read; isa_ok($mol, "Chemistry::Mol", 'read string'); is(scalar $mol->atoms, 8, "atoms"); # subclass test package MolList; use base qw(Chemistry::File); sub read_header { my ($self) = @_; my $fh = $self->fh; my $name = <$fh>; chomp $name; $self->name($name); } sub read_footer { my ($self) = @_; my $fh = $self->fh; my $footer = join '', <$fh>; chomp $footer; $self->attr('list/footer', $footer); } sub slurp_mol { my ($self) = @_; my $fh = $self->fh; my $s = <$fh>; chomp $s; return if $s eq '--END--'; $s; } sub parse_string { my ($self, $s) = @_; my $fh = $self->fh; my ($name, $price) = split "\t", $s; my $mol = Chemistry::Mol->new(name => $name); $mol->attr('list/price', $price); push @{$self->{mol_list}}, $mol; $mol; } package main; my $list = MolList->new(file => 't/list.txt'); my @mols = $list->read; is(scalar @mols, 3, "read mollist"); is($list->name, "This is a list of molecules", "list name"); is($list->attr('list/footer'), "As you can see, \neverything you need \nis on this list.", "list footer"); is($mols[1]->name, "ethane", "mol name"); is($mols[1]->attr('list/price'), '$200', "mol price"); # Chemistry::Mol->file $file = Chemistry::Mol->file($fname); isa_ok($file, "Chemistry::File::Dumper"); $mol = $file->read(format => 'dumper'); isa_ok($mol, "Chemistry::Mol", 'Chemistry::Mol->read'); is(scalar $mol->atoms, 8, "atoms"); Chemistry-Mol-0.39/t/delete.t0000644000175000017500000000130114263501714015725 0ustar andriusandriususe Test::More; #plan 'no_plan'; plan tests => 8; use Chemistry::File::Dumper; my $mol = Chemistry::Mol->read("t/mol.pl"); isa_ok( $mol, 'Chemistry::Mol' ); is( scalar $mol->atoms, 8, 'atoms before'); is( scalar $mol->bonds, 7, 'bonds before'); # delete bond $mol->bonds(6)->delete; is( scalar $mol->bonds, 6, 'delete bond'); # delete atom by giving an atom object $mol->delete_atom($mol->atoms(1)); is( scalar $mol->bonds, 6, 'delete atom obj - bonds'); is( scalar $mol->atoms, 7, 'delete atom obj - atoms'); # delete atom by giving an atom index $mol->delete_atom(1); is( scalar $mol->bonds, 3, 'delete atom index - bonds'); is( scalar $mol->atoms, 6, 'delete atom index - atoms'); Chemistry-Mol-0.39/t/exception.t0000644000175000017500000000267614263501714016501 0ustar andriusandriususe strict; use warnings; use Test::More; use Chemistry::Mol; use Chemistry::File::Dumper; BEGIN { if (eval 'use Test::Exception; 1') { plan tests => 10; #plan 'no_plan'; } else { plan skip_all => "You don't have Test::Exception installed"; } } # make sure that we throw some expected exceptions ###### MOL ###### throws_ok { Chemistry::Mol->read('t/empty.mol') } qr/guess format/, "unknown format (read)"; throws_ok { Chemistry::Mol->read('no_file.mol', format => 'mdl') } qr/No class installed/, "no class installed"; throws_ok { Chemistry::Mol->read('no_file.mol', format => 'dumper') } qr/open file/, "can't open"; throws_ok { Chemistry::Mol->write('no_file.mol') } qr/guess format/, "unknown format (write)"; throws_ok { Chemistry::Mol->descriptor('bogus') } qr/unknown descriptor/, "unknown descriptor (bogus)"; ###### ATOM ###### my $mol = Chemistry::Mol->read('t/mol.pl'); my ($a1, $a2, $a3) = $mol->atoms; throws_ok { Chemistry::Atom::angle($a1, $a2) } qr/three/, "three atoms needed for angle"; throws_ok { Chemistry::Atom::dihedral($a1, $a2, $a3) } qr/four/, "four atoms needed for dihedral"; throws_ok { $a1->distance('xyz') } qr/undefined for objects of type/, "distance to non-object"; throws_ok { $a1->angle(1, 2) } qr/not an object/, "angle to non-object"; throws_ok { $a1->angle(bless({}), bless({})) } qr/neither an atom/, "angle to funny object"; Chemistry-Mol-0.39/t/geom.t0000644000175000017500000000234714263501714015425 0ustar andriusandrius# Tests for geometry-related methods such as distance, angle, and dihedral use strict; use warnings; use Test::More; use Chemistry::File::Dumper; use Math::VectorReal; #plan 'no_plan'; plan tests => 10; my $mol = Chemistry::Mol->read("t/mol.pl"); isa_ok( $mol, 'Chemistry::Mol' ); my (@a); # angle @a = $mol->atoms(1,2,3); is( scalar @a, 3, 'three atoms'); is_float( Chemistry::Atom::angle_deg(@a), 110.7, 0.1, "angle" ); # dihedral @a = $mol->atoms(1,2,3,4); is_float( Chemistry::Atom::dihedral_deg(@a), -85.6, 0.1, "dihedral" ); # ill-defined angles and dihedrals my $v0 = vector(0,0,0); my $v1 = vector(1,0,0); my $v2 = vector(2,0,0); my $v3 = vector(3,0,0); is( Chemistry::Atom::angle($v0, $v1, $v0), 0, "zero angle" ); is( Chemistry::Atom::angle($v0, $v0, $v0), 0, "bad angle" ); is( Chemistry::Atom::angle($v0, $v0, $v1), 0, "bad angle" ); is_float( Chemistry::Atom::angle_deg($v0, $v1, $v2), 180, 0.1, "linear angle" ); is( Chemistry::Atom::dihedral($v0, $v0, $v0, $v0), 0, "bad dihedral" ); is( Chemistry::Atom::dihedral($v0, $v1, $v2, $v3), 0, "bad dihedral" ); ############# sub is_float { my ($got, $expected, $tol, $name) = @_; ok( abs($got - $expected) < $tol, $name ) or diag "got $got, expected $expected"; } Chemistry-Mol-0.39/t/compat.t0000644000175000017500000000053714263501714015760 0ustar andriusandriususe Test::More; plan tests => 1; ok(1); eval { require Chemistry::File::SMILES; my $v = Chemistry::File::SMILES->VERSION; if ($v < 0.43) { diag "You have Chemistry::File::SMILES version $v installed. It is not compatible with this version of Chemistry::Mol. Please upgrade to Chemistry::File::SMILES 0.43 or higher.\n"; } }; Chemistry-Mol-0.39/t/mol.pl0000644000175000017500000005041214263501714015431 0ustar andriusandrius$mol = bless( { 'atoms' => [ bless( { 'Z' => 17, 'bonds' => [ { 'bond' => bless( { 'atoms' => [ {}, bless( { 'Z' => 6, 'bonds' => [ { 'bond' => bless( { 'atoms' => [ bless( { 'Z' => 1, 'bonds' => [ { 'bond' => {}, 'to' => {} } ], 'coords' => bless( [ [ [ ' 2.0860', ' -0.5229', ' -0.9277' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a6', 'parent' => {}, 'symbol' => 'H' }, 'Chemistry::Atom' ), {} ], 'id' => 'b3', 'order' => '1', 'parent' => {}, 'type' => '1' }, 'Chemistry::Bond' ), 'to' => {} }, { 'bond' => bless( { 'atoms' => [ bless( { 'Z' => 1, 'bonds' => [ { 'bond' => {}, 'to' => {} } ], 'coords' => bless( [ [ [ ' 2.0837', ' -0.5492', ' 0.9128' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a7', 'parent' => {}, 'symbol' => 'H' }, 'Chemistry::Atom' ), {} ], 'id' => 'b4', 'order' => '1', 'parent' => {}, 'type' => '1' }, 'Chemistry::Bond' ), 'to' => {} }, { 'bond' => {}, 'to' => {} }, { 'bond' => bless( { 'atoms' => [ {}, bless( { 'Z' => 6, 'bonds' => [ { 'bond' => bless( { 'atoms' => [ {}, bless( { 'Z' => 8, 'bonds' => [ { 'bond' => {}, 'to' => {} }, { 'bond' => bless( { 'atoms' => [ {}, bless( { 'Z' => 1, 'bonds' => [ { 'bond' => {}, 'to' => {} } ], 'coords' => bless( [ [ [ ' 2.9125', ' 2.7823', ' 1.1712' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a8', 'parent' => {}, 'symbol' => 'H' }, 'Chemistry::Atom' ) ], 'id' => 'b2', 'order' => '1', 'parent' => {}, 'type' => '1' }, 'Chemistry::Bond' ), 'to' => {} } ], 'coords' => bless( [ [ [ ' 2.5849', ' 1.8697', ' 1.2392' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a5', 'parent' => {}, 'symbol' => 'O' }, 'Chemistry::Atom' ) ], 'id' => 'b1', 'order' => '1', 'parent' => {}, 'type' => '1' }, 'Chemistry::Bond' ), 'to' => {} }, { 'bond' => bless( { 'atoms' => [ bless( { 'Z' => 8, 'bonds' => [ { 'bond' => {}, 'to' => {} } ], 'coords' => bless( [ [ [ ' 2.4777', ' 2.1483', ' -0.9572' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a4', 'parent' => {}, 'symbol' => 'O' }, 'Chemistry::Atom' ), {} ], 'id' => 'b5', 'order' => '2', 'parent' => {}, 'type' => '2' }, 'Chemistry::Bond' ), 'to' => {} }, { 'bond' => {}, 'to' => {} } ], 'coords' => bless( [ [ [ ' 2.2735', ' 1.4000', ' 0.0000' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a3', 'parent' => {}, 'symbol' => 'C' }, 'Chemistry::Atom' ) ], 'id' => 'b7', 'order' => '1', 'parent' => {}, 'type' => '1' }, 'Chemistry::Bond' ), 'to' => {} } ], 'coords' => bless( [ [ [ ' 1.7451', ' 0.0000', ' 0.0000' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a2', 'parent' => {}, 'symbol' => 'C' }, 'Chemistry::Atom' ) ], 'id' => 'b6', 'order' => '1', 'parent' => {}, 'type' => '1' }, 'Chemistry::Bond' ), 'to' => {} } ], 'coords' => bless( [ [ [ ' 0.0000', ' 0.0000', ' 0.0000' ] ], 1, 3 ], 'Math::VectorReal' ), 'id' => 'a1', 'parent' => {}, 'symbol' => 'Cl' }, 'Chemistry::Atom' ), {}, {}, {}, {}, {}, {}, {} ], 'attr' => { 'mdlmol/comment' => '', 'mdlmol/line2' => ' perlmol ' }, 'bonds' => [ {}, {}, {}, {}, {}, {}, {} ], 'byId' => { 'a1' => {}, 'a2' => {}, 'a3' => {}, 'a4' => {}, 'a5' => {}, 'a6' => {}, 'a7' => {}, 'a8' => {}, 'b1' => {}, 'b2' => {}, 'b3' => {}, 'b4' => {}, 'b5' => {}, 'b6' => {}, 'b7' => {} }, 'id' => 'mol1', 'name' => '' }, 'Chemistry::Mol' ); $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[0] = $mol->{'atoms'}[0]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[0]{'bonds'}[0]{'bond'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[0]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[0]{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[0]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]{'bonds'}[0]{'bond'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[2]{'bond'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[2]{'to'} = $mol->{'atoms'}[0]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[0] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[0] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1]{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]{'bonds'}[0]{'bond'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[2]{'bond'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[2]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'parent'} = $mol; $mol->{'atoms'}[0]{'bonds'}[0]{'to'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[0]{'parent'} = $mol; $mol->{'atoms'}[1] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[2] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[3] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]; $mol->{'atoms'}[4] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'atoms'}[5] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[0]; $mol->{'atoms'}[6] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]; $mol->{'atoms'}[7] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1]; $mol->{'bonds'}[0] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}; $mol->{'bonds'}[1] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'bonds'}[2] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}; $mol->{'bonds'}[3] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'bonds'}[4] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'bonds'}[5] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}; $mol->{'bonds'}[6] = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}; $mol->{'byId'}{'a1'} = $mol->{'atoms'}[0]; $mol->{'byId'}{'a2'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'byId'}{'a3'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]; $mol->{'byId'}{'a4'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]; $mol->{'byId'}{'a5'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]; $mol->{'byId'}{'a6'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[0]; $mol->{'byId'}{'a7'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[0]; $mol->{'byId'}{'a8'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}{'atoms'}[1]; $mol->{'byId'}{'b1'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}; $mol->{'byId'}{'b2'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'byId'}{'b3'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[0]{'bond'}; $mol->{'byId'}{'b4'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'byId'}{'b5'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}{'atoms'}[1]{'bonds'}[1]{'bond'}; $mol->{'byId'}{'b6'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}; $mol->{'byId'}{'b7'} = $mol->{'atoms'}[0]{'bonds'}[0]{'bond'}{'atoms'}[1]{'bonds'}[3]{'bond'}; Chemistry-Mol-0.39/t/zlib.t0000644000175000017500000000215514263501714015433 0ustar andriusandriususe strict; use warnings; use Test::More; use Chemistry::Mol; use Chemistry::File::Dumper; if (eval 'use Compress::Zlib; 1') { plan tests => 6; #plan 'no_plan'; } else { plan skip_all => "You don't have Compress::Zlib installed"; } my $mol; my $in = 't/mol.pl.gz'; my $out = 't/tmp/mol.pl.gz'; my $na = 8; # expected number of atoms ####### read tests $mol = Chemistry::Mol->read($in, gzip => 1, format => 'dumper'); isa_ok($mol, "Chemistry::Mol", "explicit decompressed read"); ok($mol->atoms == $na, "has $na atoms"); $mol = Chemistry::Mol->read($in, format => 'dumper'); isa_ok($mol, "Chemistry::Mol", "implicit decompressed read"); ok($mol->atoms == $na, "has $na atoms"); ####### write tests mkdir 't/tmp'; $mol->write($out, format => 'dumper', gzip => 1); is_gzipped($out); unlink $out; $mol->write($out, format => 'dumper'); is_gzipped($out, "implicit compression on output"); unlink $out; rmdir 't/tmp'; sub is_gzipped { my ($fname, $comment) = @_; my $header; open F, $fname or die; read F, $header, 2; ok($header eq "\x1f\x8b", $comment || "compressed ok"); close F; } Chemistry-Mol-0.39/t/formula_tests.txt0000644000175000017500000000026214263501714017733 0ustar andriusandriusCH3(CH2)3CH3 C5H12 C6H3Me3 C9H12 2Cu[NH3]4(NO3)2 Cu2H24N12O12 2C(C[C5]4)3 C152 2C(C(C(C)5)4)3 C152 C 1 0 H 2 2 C10H22 CH3Br CH3Br CH3.1Br0.9 CH4Br 1.5H2O H3O2 H(CH2)3.5H C4H9 Chemistry-Mol-0.39/t/Formula.t0000644000175000017500000000303614263501714016077 0ustar andriusandriususe Test::More; my @lines; open F, "<", "t/formula_tests.txt" or die "couldn't open t/formula_tests.txt; $!"; @lines = ; close F; plan tests => 8 + @lines; use_ok('Chemistry::File::Formula'); # Constructors my $mol = Chemistry::Mol->parse("CH4O", format => "formula"); isa_ok($mol, 'Chemistry::Mol', 'parse isa mol'); ok($mol->atoms == 6, "enough atoms"); my $formula = $mol->formula("%s%d{%d}"); is($formula, "CH4O", "formula format"); $mol = Chemistry::Mol->parse("1[Ph(Me)3]2", format => "formula"); my $fh = $mol->formula_hash; is_deeply($fh, {C => 18, H => 28}, "formula hash 1[Ph(Me)3]2"); # test various parsing issues for my $line (@lines) { chomp $line; my ($test_formula, $expected) = split /\t/, $line; my $got = Chemistry::Mol->parse($test_formula, format => "formula") ->print(format=>'formula'); is($got, $expected, "$test_formula = $expected"); } # parse_formula my %formula_hash = Chemistry::File::Formula->parse_formula("C2H6O"); is_deeply(\%formula_hash, {H => 6, O => 1, C => 2}, 'parse_formula'); # parse_formula with non-integers %formula_hash = Chemistry::File::Formula->parse_formula("C2.1H6.5O0.9"); is_deeply(\%formula_hash, {H => 6.5, O => 0.9, C => 2.1}, 'parse_formula (non-integer)'); # a formula with custom sort $mol = Chemistry::Mol->parse("C2H6Br", format => "formula"); $formula = $mol->print( format => 'formula', formula_sort => sub { my $f = shift; reverse sort keys %$f; } ); is ($formula, 'H6C2Br', 'formula_sort'); Chemistry-Mol-0.39/t/mol.pl.gz0000644000175000017500000000165614263501714016056 0ustar andriusandriusŠ@mol.pl՘oHW5;?fH(JNUR%1JUU'N؋Cfwnhթgo궧T2, 6; BEGIN { use_ok('Chemistry::File::Dumper') }; my $mol = Chemistry::Mol->read("t/mol.pl", format => 'dumper'); isa_ok($mol, "Chemistry::Mol", 'read'); my $mol_auto = Chemistry::Mol->read("t/mol.pl"); isa_ok($mol, "Chemistry::Mol", 'read (autodetect)'); my $s = $mol->print(format=>'dumper'); my $s2 = $mol_auto->print(format=>'dumper'); is($s, $s2, 'dump and compare'); $mol->write('t/test1.pl'); my $mol3 = Chemistry::Mol->read("t/test1.pl"); my $s3 = $mol->print(format=>'dumper'); is($s, $s3, 'write and read and compare'); is_deeply($mol, $mol3, 'deep compare'); unlink 't/test1.pl'; Chemistry-Mol-0.39/t/change_id.t0000644000175000017500000000116714263501714016376 0ustar andriusandriususe Test::More; # These tests make sure that if the id of e.g. an atom changes, the containing # object is notified #plan 'no_plan'; plan tests => 5; use Chemistry::File::Dumper; my $mol = Chemistry::Mol->read("t/mol.pl"); isa_ok( $mol, 'Chemistry::Mol' ); is( $mol->atoms(1)->id, 'a1', 'id before' ); ok( $mol->atoms(1) == $mol->by_id('a1'), 'id matches before' ); $mol->atoms(1)->id('xyz123'); is( $mol->atoms(1)->id, 'xyz123', 'id after' ); ok( $mol->atoms(1) == $mol->by_id('xyz123'), 'id matches after' ) or diag sprintf "got %s, expected %s", $mol->atoms(1), $mol->by_id('xyz123'); Chemistry-Mol-0.39/t/Mol.t0000644000175000017500000000330414263501714015217 0ustar andriusandrius#use Test::More "no_plan"; use Test::More tests => 20; BEGIN { use_ok('Chemistry::Mol'); }; # Constructors my $mol = Chemistry::Mol->new; isa_ok($mol, 'Chemistry::Mol', '$mol'); isa_ok($mol, 'Chemistry::Obj', '$mol'); my $atom = Chemistry::Atom->new(Z => 6, coords => [0, 0, 3], name => "carbon"); isa_ok($atom, 'Chemistry::Atom', '$atom'); isa_ok($atom, 'Chemistry::Obj', '$atom'); my $atom2 = Chemistry::Atom->new(Z => 8, coords => [4, 0, 0], id => 'xyz'); my $bond = Chemistry::Bond->new(atoms => [$atom, $atom2], type => '='); isa_ok($bond, 'Chemistry::Bond', '$bond'); isa_ok($bond, 'Chemistry::Obj', '$bond'); # Mol methods $mol->add_atom($atom, $atom2); is(scalar $mol->atoms, 2, '$mol->atoms'); ok($mol->atoms(1) eq $atom, '$mol->atoms(1) eq $atom'); ok($mol->by_id('xyz') eq $atom2, '$mol->by_id'); ok($mol->atoms_by_name('carbon') eq $atom, '$mol->atoms_by_name'); $mol->add_bond($bond); is(scalar $mol->bonds, 1, '$mol->bonds'); ok($mol->bonds(1) eq $bond, '$mol->bonds(1) eq $bond'); my $atom3; ok($atom3 = $mol->new_atom(symbol => "N"), '$mol->new_atom'); # mass $mol = Chemistry::Mol->new; $mol->new_atom(symbol => 'O'); $mol->new_atom(symbol => 'H'); $mol->new_atom(symbol => 'H'); ok(abs($mol->mass - 18.01528) < 0.0001, '$mol->mass'); $mol->atoms(1)->mass(18); ok(abs($mol->mass - 20.015) < 0.01, '$mol->mass'); # sprout_hydrogens $mol = Chemistry::Mol->new; $mol->new_atom(symbol => 'O', implicit_hydrogens => 2); is( 0+$mol->atoms, 1, 'before sprout_hydrogens' ); $mol->sprout_hydrogens; is( 0+$mol->atoms, 3, 'after sprout_hydrogens' ); $mol->collapse_hydrogens; is( 0+$mol->atoms, 1, 'before sprout_hydrogens' ); # Bond methods is($bond->length, 5, '$bond->length'); Chemistry-Mol-0.39/t/graph.t0000644000175000017500000000256714263501714015603 0ustar andriusandriususe Test::More; # Tests for miscelaneous methods that play around with the molecular graph # as a whole, such as clone, combine, and separate use strict; use warnings; #plan 'no_plan'; plan tests => 12; use Chemistry::File::Dumper; my $mol = Chemistry::Mol->read("t/mol.pl"); $mol->bonds(7)->delete; # clone test for my $backend ('Clone', 'Storable') { $Chemistry::Mol::clone_backend = $backend; my $mol2 = $mol->clone; is_deeply( $mol, $mol2, "clone by $backend" ); } # separate test my @mols = $mol->separate; is ( scalar @mols, 2, 'got 2 things' ); is ( scalar (grep $_->isa('Chemistry::Mol'), @mols), 2, 'separate: two mols' ); is ( $mols[0]->formula, 'CH2Cl', 'mol 1 is CClH2' ); is ( $mols[1]->formula, 'CHO2', 'mol 2 is CHO2' ); my $a1 = $mol->atoms(2); my $a2 = $mols[0]->atoms(2); my $nb_before = $a1->neighbors; my $nb_after = $a2->neighbors; is ( $nb_after, $nb_before, "bond count for $a2 equal to $a1 ($nb_before)?" ); # combine - new my $comb_new = Chemistry::Mol->combine(@mols); isa_ok($comb_new, 'Chemistry::Mol'); for my $method (qw(atoms bonds formula)) { is ( scalar $comb_new->$method, scalar $mol->$method, "combine-new; $method" ); } # combine - in place my $comb_inplace = $mols[0]->combine($mols[1]); is_deeply ( $comb_inplace, $mol, "combine-in place" ); #use Chemistry::File::SMILES; $mol->printf("%S\n"); #$_->printf("%f\n") for @mols; Chemistry-Mol-0.39/t/Bond.t0000644000175000017500000000231714263501714015355 0ustar andriusandriususe strict; use warnings; use Chemistry::Mol; use Chemistry::File::Formula; #use Test::More "no_plan"; use Test::More tests => 17; my $mol = Chemistry::Mol->parse('CC', format => 'formula'); my $bond = $mol->new_bond(atoms => [ $mol->atoms ] ); my ($a1, $a2) = $mol->atoms; is ( scalar $mol->atoms, 2, "mol atom count" ); is ( scalar $mol->bonds, 1, "mol bond count" ); is ( scalar $bond->atoms, 2, "bond atom count" ); is ( scalar $a1->bonds, 1, "atom bond count" ); is ( scalar $a2->bonds, 1, "atom bond count" ); $bond->delete; ok ( 1, "deleted the bond" ); is ( scalar $mol->atoms, 2, "mol atom count" ); is ( scalar $mol->bonds, 0, "mol bond count" ); is ( scalar $bond->atoms, 2, "bond atom count" ); is ( scalar $a1->bonds, 0, "atom bond count" ); is ( scalar $a2->bonds, 0, "atom bond count" ); $mol->add_bond($bond); ok ( 1, "readded the bond" ); is ( scalar $mol->atoms, 2, "mol atom count" ); is ( scalar $mol->bonds, 1, "mol bond count" ); is ( scalar $bond->atoms, 2, "bond atom count" ); is ( scalar $a1->bonds, 1, "atom bond count" ); is ( scalar $a2->bonds, 1, "atom bond count" ); Chemistry-Mol-0.39/t/list.txt0000644000175000017500000000020114263501714016010 0ustar andriusandriusThis is a list of molecules methane $100 ethane $200 propane $300 --END-- As you can see, everything you need is on this list. Chemistry-Mol-0.39/t/Obj.t0000644000175000017500000000304014263501714015177 0ustar andriusandriususe strict; use warnings; #use Test::More "no_plan"; use Test::More tests => 19; BEGIN { use_ok('Chemistry::Obj'); }; my ($obj, $obj2, $obj3); # constructor $obj = Chemistry::Obj->new; isa_ok( $obj, 'Chemistry::Obj', 'blank obj' ); # obj using standard attributes $obj = Chemistry::Obj->new(name => 'joe', id => 'joe01', type => 'funny'); is( $obj->name, 'joe', 'name' ); is( $obj->id, 'joe01', 'joe01' ); is( $obj->type, 'funny', 'type' ); is( "$obj", 'joe01', 'stringify' ); # relational operators $obj2 = Chemistry::Obj->new(name => 'joe', id => 'joe01', type => 'funny'); $obj3 = $obj; is( $obj, $obj2, 'eq' ); ok( $obj != $obj2, '!=' ); ok( $obj == $obj3, '==' ); $obj2->id('joe02'); ok( $obj ne $obj2, 'ne' ); # user attributes $obj->attr(color => 123); is ($obj->attr('color'), 123, 'attr'); # attr(list) $obj->attr(1,2,3,4); is ($obj->attr(3), 4, 'attr list'); is ($obj->attr('color'), 123, 'attr list'); # attr(hashref) $obj->attr({ a => 1, b => 2 }); is ($obj->attr('a'), 1, 'attr hashref'); is ($obj->attr('color'), undef, 'attr hashref'); # attr() my $attr = $obj->attr; is ($attr->{b}, 2, 'attr get hashref'); # del_attr $obj->del_attr('b'); $attr = $obj->attr; ok( ! exists $attr->{b}, 'del_attr'); # accessor package _test; our @ISA = ('Chemistry::Obj'); Chemistry::Obj::accessor(qw(a b c d)); package main; $obj = _test->new(a => 1, b => 2); is ($obj->a, 1, 'accessor'); $obj->a(3)->c(4); is ($obj->c, 4, 'chained accessor'); Chemistry-Mol-0.39/t/empty.mol0000644000175000017500000000000014263501714016140 0ustar andriusandriusChemistry-Mol-0.39/t/add_implicit_h.t0000644000175000017500000000247214263501714017426 0ustar andriusandriususe strict; use warnings; use Test::More; use Chemistry::Mol; #plan 'no_plan'; plan tests => 21; # low-level test # some typical cases my @tests = ( #symbol, explicit valence, charge, radical, expected result [ C => 1, 0, 0, 3 ], [ C => 4, 0, 0, 0 ], [ C => 1, 1, 0, 2 ], [ C => 1, -1, 0, 2 ], [ C => 1, 0, 1, 1 ], [ C => 1, 0, 3, 1 ], [ C => 1, 0, 2, 2 ], [ O => 1, -1, 0, 0 ], [ O => 1, 1, 0, 2 ], [ N => 4, 1, 0, 0 ], [ N => 2, 1, 0, 2 ], [ N => 2, -1, 0, 0 ], [ N => 1, 0, 3, 0 ], [ B => 1, -1, 0, 3 ], [ Cl => 0, -1, 0, 0 ], [ Cl => 0, 0, 0, 1 ], [ Cl => 0, 0, 2, 0 ], [ Cl => 0, +1, 0, 1 ], ); for my $test (@tests) { my $expected = pop @$test; my $got = Chemistry::Atom->_calc_implicit_hydrogens(@$test); is ($got, $expected, "_calc_implicit_hydrogens(@$test) == $expected"); } # functional test my $mol = Chemistry::Mol->new; my $a1 = $mol->new_atom(symbol => 'C'); my $a2 = $mol->new_atom(symbol => 'O', formal_charge => -1); my $a3 = $mol->new_atom(symbol => 'N', formal_charge => 1); $mol->new_bond(atoms => [$a1, $a2]); $mol->new_bond(atoms => [$a1, $a3], order => 2); $mol->add_implicit_hydrogens; is ( $a1->implicit_hydrogens, 1, 'C==1'); is ( $a2->implicit_hydrogens, 0, 'O==0'); is ( $a3->implicit_hydrogens, 2, 'N==2'); Chemistry-Mol-0.39/t/pod.t0000644000175000017500000000043714263501714015256 0ustar andriusandriususe Test::More; my @files = (glob("*.pm"), glob("*.pod"), glob("*/*.pm")); my $n = @files; eval 'use Test::Pod'; if ($@) { plan skip_all => "You don't have Test::Pod installed"; } else { plan tests => $n; } for my $file (@files) { pod_file_ok($file, "POD for '$file'"); } Chemistry-Mol-0.39/t/Atom.t0000644000175000017500000000702214263501714015371 0ustar andriusandriususe strict; use warnings; #use Test::More "no_plan"; use Test::More tests => 49; BEGIN { use_ok('Chemistry::Atom'); use_ok('Chemistry::Mol'); use_ok('Math::VectorReal'); }; my ($atom, $atom2, $atom3); # constructor $atom = Chemistry::Atom->new; isa_ok( $atom, 'Chemistry::Atom', 'blank atom' ); isa_ok( $atom, 'Chemistry::Obj', 'blank atom' ); # symbol $atom = Chemistry::Atom->new(symbol => 'C'); is( $atom->symbol, 'C', 'symbol -> symbol' ); is( $atom->Z, 6, 'symbol -> Z' ); # Z $atom->Z(8); is( $atom->Z, 8, 'Z -> Z' ); is( $atom->symbol, 'O', 'Z -> symbol' ); # mass ok( abs($atom->mass-16.00)<0.01, 'default mass'); $atom->mass(18.012); is( $atom->mass, 18.012, 'arbitrary mass' ); # aromatic ok( ! $atom->aromatic, 'aromatic default' ); $atom->aromatic(1); ok( $atom->aromatic, 'aromatic' ); # default hydrogens ok( ! $atom->hydrogens, 'hydrogens default' ); ok( ! $atom->total_hydrogens, 'total_hydrogens default' ); ok( ! $atom->implicit_hydrogens, 'implicit_hydrogens default' ); # set hydrogens $atom->hydrogens(1); is( $atom->hydrogens, 1, 'hydrogens' ); is( $atom->implicit_hydrogens, 1, 'implicit_hydrogens' ); is( $atom->total_hydrogens, 1, 'total_hydrogens' ); # set implicit_hydrogens $atom->implicit_hydrogens(2); is( $atom->hydrogens, 2, 'hydrogens' ); is( $atom->implicit_hydrogens, 2, 'implicit_hydrogens' ); is( $atom->total_hydrogens, 2, 'total_hydrogens' ); is( $atom->explicit_valence, 0, 'explicit_valence' ); is( $atom->valence, 2, 'valence' ); # sprout_hydrogens my $mol = Chemistry::Mol->new; $mol->add_atom($atom); $atom->sprout_hydrogens; is( $atom->hydrogens, 0, 'hydrogens' ); is( $atom->implicit_hydrogens, 0, 'implicit_hydrogens' ); is( $atom->total_hydrogens, 2, 'total_hydrogens' ); is( $atom->explicit_valence, 2, 'explicit_valence' ); is( $atom->valence, 2, 'valence' ); # collapse_hydrogens $atom->collapse_hydrogens; is( $atom->hydrogens, 2, 'hydrogens' ); is( $atom->implicit_hydrogens, 2, 'implicit_hydrogens' ); is( $atom->total_hydrogens, 2, 'total_hydrogens' ); is( $atom->explicit_valence, 0, 'explicit_valence' ); is( $atom->valence, 2, 'valence' ); # coords $atom2 = Chemistry::Atom->new(coords => [3,0,4]); is( $atom->distance($atom2), 5, 'distance(coords(arrayref))' ); my $v1 = $atom2->coords; isa_ok( $v1, 'Math::VectorReal'); my $v = vector(0,10,0); $atom2->coords($v); is( $atom->distance($atom2), 10, 'distance(coords(vector))' ); $atom2->coords(3,0,0); is( $atom->distance($atom2), 3, 'distance(coords(list))' ); # x3, y3, z3 accessors $atom2->coords($v1); my $x = $atom2->x3; is($x, 3, 'x3'); my $y = $atom2->y3; is($y, 0, 'y3'); my $z = $atom2->z3; is($z, 4, 'z3'); # distance is( $atom->distance($v1), 5, 'distance(vector)' ); # sprintf is( $atom->sprintf("%s"), 'O', 'sprintf - %s' ); is( $atom->sprintf("%Z"), 8, 'sprintf - %Z' ); is( $atom2->sprintf("%x,%y,%z"), '3,0,4', 'sprintf - %x,%y,%z' ); # mass_number $atom = Chemistry::Atom->new(Z => 1); ok( abs($atom->mass-1.008)<0.001, '1H mass'); $atom->mass_number(2); is( $atom->mass_number, 2, '2H mass number' ); my $got_m2H = $atom->mass; my $m_2H = $INC{'Chemistry/Isotope.pm'} ? 2.014 : 2; ok( abs($got_m2H - $m_2H)<0.001, '2H mass' ) or diag(sprintf "expected %s, got %s", $m_2H, $atom->mass); $atom->mass_number(10); is( $atom->mass, 10, '10H mass' ); Chemistry-Mol-0.39/t/descriptor.t0000644000175000017500000000060514263501714016647 0ustar andriusandriususe strict; use warnings; use Test::More; use Chemistry::Mol; use Chemistry::File::Dumper; plan 'no_plan'; #plan tests => 21; Chemistry::Mol->register_descriptor( number_of_atoms => sub { my $mol = shift; return scalar $mol->atoms; } ); my $mol = Chemistry::Mol->read("t/mol.pl"); my $n = $mol->descriptor('number_of_atoms'); is ($n, 8, 'number_of_atoms == 8');