互動式查詢化學鍵信息

█ 本文譯自 WolframAlpha 化學組開發人員 Jason.Biggs 在 Wolfram 社區發表的文章：Interactively query bond information

最近在Stack Exchange問答網站上有一個關於如何從 XYZ 文件求二面角的問題，文件中含有分子或分子群的原子類型及三維坐標。二面角是兩個相交平面之間的夾角。在化學中, 我們將四原子的二面角定義為含有前三個原子的平面和含有後三原子的平面之間的夾角。希望這裡我能像你們用其他化學專業軟體一樣互動式地來求二面角。

這是我嘗試開發的一個工具，代碼如下。您可以查詢鍵長、鍵角和二面角。還可以查看三維布洛芬模型中的角。

GIF/2K

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

GIF/2K

下面是生成上述圖形的代碼。我們使用 EventHandler 和 MousePosition["Graphics3DBoxIntercepts"] 使滑鼠點擊與原子選擇關聯。

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}===,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,{,}]];findAtomNearestToLine[None,pts_]:=Nothing;bondInfoBox[pts_]:=Grid[{{"atom (atom number)",Grid@Thread[{atomLabels[[pts]],pts,[[;;(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[{[[;;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]]];

喜歡這篇文章嗎？立刻分享出去讓更多人知道吧！