5
$\begingroup$

I written some code to generate all partens of $\ \mathrm{C_2H_5O}$, but theres some isomerisms need to be deleted.

Here's the raw output after DeleteDuplicates.

(*del=DeleteDuplicates@raw*)
del={{{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",1}<->{"C",1},{"H",2}<->{"C",2},{"H",3}<->{"C",1},{"O",1}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",1}<->{"C",1},{"H",2}<->{"C",2},{"C",1}<->{"O",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",1}<->{"C",1},{"C",2}<->{"C",1},{"H",2}<->{"O",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"O",1}<->{"C",1},{"H",2}<->{"C",2},{"H",3}<->{"C",1},{"O",1}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"O",1}<->{"C",1},{"H",2}<->{"C",2},{"C",1}<->{"O",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"O",1}<->{"C",1},{"C",2}<->{"C",1},{"H",2}<->{"O",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"H",2}<->{"C",1},{"O",1}<->{"C",2},{"H",3}<->{"C",1},{"O",1}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"H",2}<->{"C",1},{"O",1}<->{"C",2},{"C",1}<->{"O",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"H",2}<->{"C",1},{"H",3}<->{"C",2},{"C",1}<->{"C",2},{"O",1}<->{"C",1},{"H",4}<->{"O",1}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"H",2}<->{"C",1},{"H",3}<->{"C",2},{"O",1}<->{"C",1},{"O",1}<->{"C",1},{"H",4}<->{"C",2}},{{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"H",2}<->{"C",1},{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",3}<->{"O",1},{"H",4}<->{"C",1}},{{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"O",1}<->{"C",2},{"H",1}<->{"C",1},{"H",2}<->{"C",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}},{{"O",1}<->{"C",1},{"H",1}<->{"C",1},{"H",2}<->{"C",1},{"C",2}<->{"O",1},{"H",3}<->{"C",2},{"C",2}<->{"C",1},{"H",4}<->{"C",2}},{{"O",1}<->{"C",1},{"H",1}<->{"C",1},{"C",1}<->{"O",1},{"C",2}<->{"C",1},{"H",2}<->{"C",2},{"H",3}<->{"C",2},{"H",4}<->{"C",2}},{{"O",1}<->{"C",1},{"H",1}<->{"C",1},{"C",2}<->{"C",1},{"C",2}<->{"C",1},{"H",2}<->{"C",2},{"H",3}<->{"O",1},{"H",4}<->{"C",2}},{{"H",1}<->{"C",1},{"C",2}<->{"C",1},{"H",2}<->{"C",2},{"H",3}<->{"C",2},{"C",1}<->{"C",2},{"O",1}<->{"C",1},{"H",4}<->{"O",1}},{{"H",1}<->{"C",1},{"C",2}<->{"C",1},{"H",2}<->{"C",2},{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",3}<->{"O",1},{"H",4}<->{"C",1}},{{"H",1}<->{"C",1},{"H",2}<->{"C",1},{"C",2}<->{"C",1},{"H",3}<->{"C",2},{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",4}<->{"O",1}},{{"H",1}<->{"C",1},{"H",2}<->{"C",1},{"C",2}<->{"C",1},{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",3}<->{"O",1},{"H",4}<->{"C",2}},{{"H",1}<->{"C",1},{"H",2}<->{"C",1},{"H",3}<->{"C",1},{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"C",2}<->{"O",1},{"H",4}<->{"C",2}}}
show=Graph[#, GraphLayout->"SpringEmbedding",
  VertexStyle->{{"C",_}->Lighter[Black],{"O",_}->Lighter[Red],{"H",_}->LightBlue,{"N",_}-> Lighter[Blue]},
  EdgeStyle-> Darker@Green,VertexSize->{{"C",_}->0.7,{"O",_}->0.5,{"H",_}->0.4,{"N",_}->0.6}, 
  ImageSize->{210,200}]&;
Multicolumn@DeleteDuplicates[show/@del]

enter image description here

The last one is the same as blue ones (not the red one) in 2D. And IsomorphicGraphQ would delete all but first one.

How can I delete these duplicates one?

Just consider planar isomerism, and I also glad to see if anyone solved the stereo isomerism.


Edit:

I don't know why you can't reproduce this.

I restarted my Kernels and got the same results.

enter image description here

$Version
show=Graph[#,GraphLayout->"SpringEmbedding",
    VertexStyle->{{"C",_}->Lighter[Black],{"O",_}->Lighter[Red],{"H",_}->LightBlue,{"N",_}->Lighter[Blue]},
    EdgeStyle->Darker@Green,VertexSize->{{"C",_}->0.7,{"O",_}->0.5,{"H",_}->0.4,{"N",_}->0.6},
    ImageSize->{210,200}]&;
del={
    {{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",1}<->{"C",1},{"H",2}<->{"C",2},{"H",3}<->{"C",1},{"O",1}<->{"C",2},{"H",4}<->{"C",1}},
    {{"C",2}<->{"C",1},{"H",1}<->{"C",2},{"O",1}<->{"C",1},{"H",2}<->{"C",2},{"C",1}<->{"O",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}},
    {{"C",2}<->{"C",1},{"O",1}<->{"C",2},{"H",1}<->{"C",1},{"H",2}<->{"C",2},{"C",1}<->{"O",1},{"H",3}<->{"C",2},{"H",4}<->{"C",1}}
};
Quiet@DeleteDuplicatesBy[show/@del,CanonicalGraph]
DeleteDuplicatesBy[show/@del,IsomorphicGraphQ]

These are {1,2,5} of last del.

If still have problems I may need to reinstall my Mathematica :).

$\endgroup$
  • $\begingroup$ I cannot reproduce your result by your code $\endgroup$ – yode Jan 3 '18 at 6:34
  • $\begingroup$ 1. at the start of the code snippet you use del=DeleteDuplicates@raw but in the end you use Multicolumn@DeleteDuplicates[show/@raw]; what are we seeing raw or del? 2. del[[{1, 2, 9, 12, 18, 20}] does not match the presented output 3. there are rules about "N" which doesn't seem to be present - but that's not so important $\endgroup$ – user42582 Jan 3 '18 at 8:59
  • $\begingroup$ DeleteDuplicates operates on lists but your del is not a simple list; perhaps you might be interested in DeleteDuplicatesBy $\endgroup$ – user42582 Jan 3 '18 at 9:08
  • 1
    $\begingroup$ @user42582 ,sry, that's del... and I think Multicolumn should be read by column (at least in my mathematica). I've tried again and used DeleteDuplicatesBy. $\endgroup$ – GalAster Jan 3 '18 at 9:46
  • 1
    $\begingroup$ Some notes about your update to the question, which I didn't read before commenting. 1. That should be DeleteDuplicatesBy[graphs, CanonicalGraph] or alternatively DeleteDuplicates[graphs, IsomorphicGraphQ]. Note the difference between DeleteDuplicates and DeleteDuplicatesBy. 2. Mathematica 11.2 has a very nasty bug where all isomorphism functionality is broken on Windows (Mac/Linux are fine). How this could have gotten through Wolfram's testing is beyond me. The good news is that my package IGraph/M can fully replace the built-in isomorphism stuff ... $\endgroup$ – Szabolcs Jan 3 '18 at 12:57
3
$\begingroup$

The answer below requires IGraph/M 0.3.96 or later. If you have an earlier version, please upgrade.

If we only consider the connectivity of the atoms, not their spatial arrangements, we can remove duplicates based on graph isomorphism. This can be done in one of two ways:

DeleteDuplicatesBy[graphs, CanonicalGraph]

or

DeleteDuplicates[graphs, IsomorphicGraphQ]

The first solution is preferable because it has linear complexity in the number of graphs/molecules, while the second is quadratic.

Unfortunately, in Mathematica 11.2 for Windows most of the isomorphism functionality is broken. (Earlier versions and Linux/Mac are not affected.)

There is also the major problem that the builtin isomorphism functionality does not currently support either multigraphs (multiple bonds between the same atoms) or vertex colouring (i.e. restricting mappings to between identical types of atoms).


IGraph/M provides some, but not all of this functionality. Out of the box, it supports either isomorphism with vertex colouring (i.e. distinguishing atom types) or multigraph isomorphism, but not both simultaneously. If you need both, you can map edge multiplicity to edge colours, and use IGVF2IsomorphicQ.

However, it seems to me that for this application, edge multiplicity can be ignored. Let us thus focus only on vertex colours now.

IGraph/M requires vertex colours to be integers. Let us start by transforming the atom names to integers, and storing the result in the "Color" vertex property. The following vertex map operator does this:

atomToNumber = <|"H" -> 1, "C" -> 6, "O" -> 8|>;

IGVertexMap[atomToNumber @* First, "Color" -> VertexList]

Before applying it, we need to get rid of multi-edges. We can use SimpleGraph for that. It needs to be applied before the above function because, unfortunately, it discards vertex properties.

Finally, we will use IGBlissCanonicalGraph instead of CanonicalGraph. It supports vertex colouring. We need to tell it which property contains the colours.

Putting all of it together,

graphs = show /@ del

atomToNumber = <|"H" -> 1, "C" -> 6, "O" -> 8|>;

DeleteDuplicatesBy[
 graphs,
 IGBlissCanonicalGraph[{#, "VertexColors" -> "Color"}] & @*
  IGVertexMap[atomToNumber @* First, "Color" -> VertexList] @*
  SimpleGraph
]

enter image description here

A slightly different way to accomplish the same is to forget about vertex properties and specify the colours as a plain list.

DeleteDuplicatesBy[
 graphs,
 IGBlissCanonicalGraph[{SimpleGraph[#], "VertexColors" -> atomToNumber /@ First /@ VertexList[#]}] &
]
$\endgroup$
5
$\begingroup$

It is true that the built-in function IsomorphicGraphQ does not consider vertex color (atom types) or multi-edges (double and triple bonds). It would be nice if there were an IsomorphicMoleculeQ function, but we can make do with an external library.

The CDK java library is easy to use, and well-documented. JLink makes it easy to use a java library without writing any java code.

Here is an example of how to use it for deleting duplicates based on chemical isomorphism. In the code below, I first convert a bond list into an AtomContainer, then use the UniversalIsomorphismTester class to compare the molecules.

First download the latest release of CDK. Change the file path below to the downloaded location for your system.

<< JLink`

AddToClassPath["~/Downloads/cdk-2.1.jar"];
(* necessary to load this enum class separately *)
LoadJavaClass["org.openscience.cdk.interfaces.IBond$Order"];

$bondPattern = (UndirectedEdge | TwoWayRule)[{_String, _Integer}, {_String, _Integer}];

bondListToAtomContainer[bondList : {$bondPattern ..}] := 
  bondListToAtomContainer[bondList] =
   Block[{bonds, atomList, mol},
    (* convert each bond into a list of {{id1, id2}, bondorder} *)
    (* and make a list of atomic symbols for the atoms *)
    bonds = List @@@ bondList;
    bonds = Sort /@ bonds;
    atomList = Flatten[bonds, 1] // Union;
    atomList = Thread[atomList -> Range[0, Length@atomList - 1]];
    bonds = bonds /. atomList;
    bonds = 
     Tally[bonds] /. {{a1_, a2_}, n_} :> {{a1, a2}, 
        n /. {1 -> IBond$Order`SINGLE, 2 -> IBond$Order`DOUBLE}};
    atomList = atomList[[All, 1, 1]];
    (* now create an empty molecule, then add the atoms and bonds *)
    mol = JavaNew["org.openscience.cdk.AtomContainer"];
    Do[
     mol@addAtom[JavaNew["org.openscience.cdk.Atom", atom]],
     {atom, atomList}];
    Do[ 
     mol@addBond[ bond[[1, 1]], bond[[1, 2]], bond[[2]]],
     {bond, bonds}
     ];
    (* return the molecule *)
    mol];
(* now instantiate a UniversalIsomorphismTester *)
isomorphismTester := 
  isomorphismTester = 
   JavaNew["org.openscience.cdk.isomorphism.UniversalIsomorphismTester"];

(* Finally a function to test if two molecules, 
   represented by bond lists, are isomorphic *)
isomorphicMoleculeQ[bondList1 : {$bondPattern ..}, 
  bondList2 : {$bondPattern ..}] :=
 isomorphismTester@isIsomorph[
   bondListToAtomContainer@bondList1, 
   bondListToAtomContainer@bondList2]

If I define del and show as the list in the OP, I can use the 2-argument form of DeleteDuplicates,

DeleteDuplicates[del,
 isomorphicMoleculeQ
 ]
(* {{{"C", 2} <-> {"C", 1}, {"O", 1} <-> {"C", 2}, {"H", 
    1} <-> {"C", 1}, {"H", 2} <-> {"C", 2}, {"H", 3} <-> {"C", 
    1}, {"O", 1} <-> {"C", 2}, {"H", 4} <-> {"C", 1}}, {{"C", 
    2} <-> {"C", 1}, {"O", 1} <-> {"C", 2}, {"H", 1} <-> {"C", 
    1}, {"H", 2} <-> {"C", 2}, {"C", 1} <-> {"O", 1}, {"H", 
    3} <-> {"C", 2}, {"H", 4} <-> {"C", 1}}, {{"C", 2} <-> {"C", 
    1}, {"O", 1} <-> {"C", 2}, {"H", 1} <-> {"C", 1}, {"C", 
    2} <-> {"C", 1}, {"H", 2} <-> {"O", 1}, {"H", 3} <-> {"C", 
    2}, {"H", 4} <-> {"C", 1}}} *)

show /@ %

enter image description here

A more efficient way to do this might be to convert each molecule into a canonical SMILES string, which the CDK can do quite well.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.