交互式查询化学键信息

█ 本文译自 Wolfram|Alpha 化学组开发人员 Jason.Biggs 在 Wolfram 社区发表的文章:Interactively query bond information

最近在Stack Exchange问答网站上有一个关于如何从 XYZ 文件求二面角的问题,文件中含有分子或分子群的原子类型及三维坐标。二面角是两个相交平面之间的夹角。在化学中, 我们将四原子的二面角定义为含有前三个原子的平面和含有后三原子的平面之间的夹角。希望这里我能像你们用其他化学专业软件一样交互式地来求二面角。

这是我尝试开发的一个工具,代码如下。您可以查询键长、键角和二面角。还可以查看三维布洛芬模型中的角。

或者比较巴克敏斯特富勒烯的五元环和六元环。

下面是生成上述图形的代码。我们使用 EventHandler 和 MousePosition["Graphics3DBoxIntercepts"] 使鼠标点击与原子选择关联。

代码语言:javascript
复制
interactiveBondTool[chemical_String]:= Module[{plot, coords, atomLabels, bonds},
    {plot, coords, atomLabels, bonds} = EntityValue[
       Entity["Chemical",chemical],
       {"MoleculePlot", "AtomPositions", "VertexTypes", "EdgeRules"}
    ];
    If[
       Head /@ {plot, coords, atomLabels, bonds} === {Graphics3D, List, List, List},
       interactiveBondTool[ {plot, coords, atomLabels, bonds} ],
       Missing["NotAvailable"]
    ]];interactiveBondTool[{plot_, coords_, atomLabels_, bonds_}] := Module[
    {dihedralFromVectors, dihedralFromAtomNumbers, bondLength, bondAngle,
    findAtomNearestToLine, bondInfoBox},
dihedralFromVectors[{b1_, b2_, b3_}] := Module[{n1, n2}, 
   (*http://math.stackexchange.com/a/47084/210969*)
   n1 = Normalize@Cross[b1, b2];
   n2 = Normalize@Cross[b2, b3];
   ArcTan[n1.n2, Cross[n1, Normalize@b2].n2]
];

dihedralFromAtomNumbers[{a1_,a2_,a3_,a4_}]:=dihedralFromVectors[
   (Subtract@@coords[[#]])&/@{{a1,a2},{a2,a3},{a3,a4}}
];

bondLength[{a1_,a2_}]:=EuclideanDistance@@coords[[{a1,a2}]];

bondAngle[{a1_,a2_,a3_}]:=VectorAngle @@ ((Subtract@@coords[[#]]) &/@ {{a2,a1},{a2,a3}});  

findAtomNearestToLine[{v1_,v2_},pts_]:=Module[{nearestFunc},

   (* adapted from this answer: http://mathematica.stackexchange.com/a/28004/9490 *)

   nearestFunc=Function[{u},Norm/@({#/10,u-v1-#}&@Projection[u-v1,v2-v1])];

   First@Nearest[(nearestFunc/@pts)->pts,{0,0}]
];

findAtomNearestToLine[None,pts_]:=Nothing;

bondInfoBox[pts_]:=
   Grid[{
     {"atom (atom number)",Grid@
     Thread[{atomLabels[[pts]],pts,{Red,Yellow,Green,Blue}[[;;(Length@pts)]]}]},
     {"bond length", If[Length@Union@pts>1,
     (bondLength@pts[[;;2]])/100,""]},
     {"bond angle", If[Length@Union@pts>2,
     (bondAngle@pts[[;;3]])/Degree,""]},
     {"dihedral angle", If[Length@Union@pts>3,
     (dihedralFromAtomNumbers@pts[[;;4]])/Degree,""]}
     },
     Frame->All
   ];

DynamicModule[
   {clicked={},atoms={},spheres={},atomlabels={}},

   atoms =Dynamic[Flatten[Position[coords,#]&/@clicked]];
   atomlabels:=With[
     {pos=atoms},
     If[pos==={},
      {},
      atomLabels[[#]]&/@pos         ]
   ];

   spheres=Dynamic[
     Transpose[{
      {Red,Yellow,Green,Blue}[[;;Length@clicked]],
      Sphere[#,40]&/@clicked }
     ]
   ];
   EventHandler[
     Row[{
      MouseAppearance[
          Show[
             plot,
             Graphics3D[spheres],
             ImageSize->500
          ],
      "Arrow"],

      Dynamic@bondInfoBox[Setting[atoms]]

     }],
     {"MouseClicked":>
      If[
          Length@clicked===4,
          clicked={},
          AppendTo[clicked,
             findAtomNearestToLine[MousePosition["Graphics3DBoxIntercepts"],coords]
          ]
      ]

     },PassEventsDown->True
   ]
]];</code></pre></div></div><p>温馨小提示:您可以在浏览器中阅读本文并复制代码或点击“阅读原文”查看英文原文。</p>