9
$\begingroup$

Consider:

MoleculePlot[Molecule[Entity["Chemical", "Theobromine"]]]

Structural diagram in a vertical orientation

How can I rotate and reflect it? This is my current method:

img=Image[MoleculePlot[Molecule[Entity["Chemical", "Theobromine"]]]];
ImageRotate[ImageReflect[img]]

The molecule is rotated, but the atom labels are now in the wrong orientation

I would like two improvements on my current method:

  1. The result is no longer a Graphics object. Instead I would like to retain the same Head (i.e., Graphics).
  2. I want to retain the orientation of the atom labels as they were in the first plot, i.e., the "right way up".
$\endgroup$
7
  • 2
    $\begingroup$ Is this for Graphics[] in general, or for MoleculePlot[] in particular? If the latter, you can do MoleculeModify[mol, "ComputeAtomDiagramCoordinates"] and then transform the coordinates of those before feeding to MoleculePlot[]. $\endgroup$ Jul 11, 2022 at 12:02
  • $\begingroup$ @J.M. It for MoleculePlot here. It's seem "TransformAtomCoordinates" can help. But it doesn't seem to work in 2D $\endgroup$
    – yode
    Jul 11, 2022 at 12:31
  • $\begingroup$ Yes, that would be a good suggestion to make to support. $\endgroup$ Jul 11, 2022 at 12:56
  • 1
    $\begingroup$ @user, report that to Support if you can reproduce it (I could not), making sure to include the version you are using and your OS. $\endgroup$ Jul 12, 2022 at 9:39
  • 1
    $\begingroup$ yode: user was (apparently) complaining right above my comment that the prompt for PlotTheme in MoleculePlot was not giving the right choices. $\endgroup$ Jul 12, 2022 at 10:02

2 Answers 2

9
$\begingroup$

enter image description here

MoleculeValue[m1, "AtomDiagramCoordinates"]

If the idea is to change the MoleculePlot (2D diagram) as described in the question after the edit, then one can use:

Block[
    {
        chem=Entity["Chemical", "Theobromine"],
        tr =  ReflectionTransform[{1, -1}],
        coords,
        m1,m2
    },
    m1 = Molecule[chem];
    coords=  MoleculeValue[m1, "AtomDiagramCoordinates"];
    m2 = Molecule[chem
            , AtomDiagramCoordinates->tr@coords
        ];
    MoleculePlot/@{m1,m2}
]

enter image description here


Credit goes to @J.M for inspiring this answer, and for the much more compact alternative offered in the comments
{mol,coords} = EntityValue[Entity["Chemical","Theobromine"]
                    ,{"Molecule","VertexCoordinates"}
                ];
MoleculePlot[
    Molecule[
        mol
        ,AtomDiagramCoordinates->ReflectionTransform[{1,-1}][coords]
    ]
]
$\endgroup$
4
  • 1
    $\begingroup$ Since this is coming from an Entity[], an alternative method goes like this: {mol, coords} = EntityValue[Entity["Chemical", "Theobromine"], {EntityProperty["Chemical", "Molecule"], EntityProperty["Chemical", "VertexCoordinates"]}]; coords = RotationTransform[Pi/2][Standardize[coords, Mean, 100 &]]; MoleculePlot[Molecule[mol, AtomDiagramCoordinates -> coords]]. The current version is of course more generically applicable. $\endgroup$ Jul 11, 2022 at 13:05
  • 1
    $\begingroup$ @J.M. More little concise:{mol,coords}=EntityValue[Entity["Chemical","Theobromine"],{"Molecule","VertexCoordinates"}];MoleculePlot[Molecule[mol,AtomDiagramCoordinates->ReflectionTransform[{1,-1}][coords]]] $\endgroup$
    – yode
    Jul 11, 2022 at 13:35
  • $\begingroup$ @J.M., no need for variables and lingering definitions if you do MoleculePlot[Molecule[#1,AtomDiagramCoordinates->ReflectionTransform[{1,-1}]@#2]]&@@EntityValue[Entity["Chemical","Theobromine"],{"Molecule","VertexCoordinates"}] $\endgroup$
    – rhermans
    Jul 11, 2022 at 13:43
  • $\begingroup$ Both @yode's and your method are good if the molecule is already "centered" at the origin, like in the case of most of the Entity[]-derived coordinates. Otherwise, you need the Standardize[] step. $\endgroup$ Jul 11, 2022 at 14:08
5
$\begingroup$

ReplaceAll

If the idea is to transform the Graphics, as described in the original wording of the question, then I use ReplaceAll

With[
    {
        gr = MoleculePlot[Molecule[Entity["Chemical", "Theobromine"]]],
        tr =  ReflectionTransform[{1, -1}]
    },
    ReplaceAll[gr
        ,{
            FilledCurve[a_,{b_}]:>FilledCurve[a,{TranslationTransform[Mean[tr[b]]- Mean[b] ][b]}],
            List[a_Real,b_Real]:> tr[{a,b}]
        }
    ]
]

enter image description here

$\endgroup$
0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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