https://community.wolfram.com RSS Feed for Wolfram Community showing ideas tagged with Chemistry sorted by most viewed. https://community.wolfram.com/groups/-/m/t/2411604 A new study group devoted to Differential Equations begins next Monday! A list of daily topics can be found on our [Daily Study Groups][1] page. This group will be led by one of our outstanding Wolfram certified instructors, Luke Titus, and will meet daily, Monday to Friday, over the next three weeks. Luke will share the excellent lesson videos created by him for the upcoming Wolfram U course "[Introduction to Differential Equations][2]". Study group sessions include time for exercises, discussion and Q&A. This study group will help you achieve the "Course Completion" certificate for the "Introduction to Differential Equations" course after you complete the course quizzes. Sign up: [Study group registration page][3] [1]: https://www.wolfram.com/wolfram-u/special-event/study-groups/ [2]: https://www.wolfram.com/wolfram-u/introduction-to-differential-equations/ [3]: https://www.bigmarker.com/series/daily-study-group-intro-to-differential-equations/series_details?utm_bmcr_source=community Devendra Kapadia 2021-11-22T16:35:30Z https://community.wolfram.com/groups/-/m/t/787142 ## General information and download links ## If you're interested in crystal structures, you can now download the Crystallica application from the Wolfram Library Archive, and then you can do things like this: Needs["Crystallica`"]; CrystalPlot[ {{5.4,0,0},{0,5.4,0},{0,0,5.4}}, {{0,0,0},{0,0,.5},{0,.5,0},{.5,0,0},{.24,.24,.24},{.24,.76,.76},{.76,.24,.76},{.76,.76,.24}}, {1,2,2,2,3,3,3,3}, AtomCol->{"Firebrick","YellowGreen",White},AtomRad->.4, BondStyle->2,BondDist->3, CellLineStyle->False,AddQ->True,Lighting->{{"Directional",White,ImageScaled[{0,0,1}]}},Background->Black] ![enter image description here][1] Here are the download links for Crystallica and two other packages you may need: [Crystallica][2] - contains the functions `CrystalPlot` and `CrystalChange` [CifImport][3] - contains an import function for CIF files [VaspImport][4] - contains an import function for files related to [VASP][5] Once you've installed Crystallica (by saving the entire Crystallica folder - not the zip archive - to `$USerBaseDirectory/Applications` and re-starting the Kernel), you can enter Crystallica into the Documentation Center and you'll find lots of useful examples. Most of the examples in this post are taken from the Documentation. For the other two packages, just install them and evaluate this: ?CifImport ?VaspImport I'll first show you a few things the `CrystalPlot` function can do when you already have crystal structure data inside Mathematica, wherever it may have come from. Then we'll take a look at how to get the data into Mathematica in the first place, which is where `CifImport` and `VaspImport` will come into play - but we'll get data from other sources as well. I'll cover the different import solutions in separate replies to this thread, because I have a feeling that I'll be rambling on and on and on... ## Simple plot ## Traditional ball-and-stick plots are usually just fine, so the simplest thing you can do is this: CrystalPlot[ {{4.5,0,0},{0,4.5,0},{0,0,3}}, {{0,0,0},{.5,.5,.5},{.2,.8,.5},{.3,.3,0},{.7,.7,0},{.8,.2,.5}}, {1,1,2,2,2,2}] ![enter image description here][6] As you can see, `CrystalPlot` expects three arguments. The first one contains the lattice vectors, which are simply the three vectors that create the parallelepiped that constitutes the cell. The second argument contains the atomic coordinates, but they're given in the basis of the lattice vectors (which is quite useful in crystallography). The third argument is a list of integers that gives the atom types, with one entry for each atom. If you want to plot a molecule instead, you can call `CrystalPlot` with just two arguments: A list of atom coordinates in cartesian space, and a list of atom types. Everything else you see in the plot - the atoms, bonds, colours, arrows etc. - represents the default settings of various layout options. ## Advanced atoms and bonds ## Let's take a look at some more advanced options just for fun. For instance, atoms and bonds can look any way you need them to, because you can specify your own functions for them. You can also fine-tune where to put bonds and what to do with their thickness and colour in a physically (or chemically) meaningful way, but I won't show that here. So here are some customized atoms and bonds: Row[Table[ CrystalPlot[{{4,0,0},{0,4,0},{0,0,4}},{{0,0,0},{.4,.4,.4},{.8,.8,.8}},{1,2,3}, AtomRad->{.4,1.2,.7},AtomFunction->style,ImageSize->400], {style,{ (Ball[#1,#2]&), (Scale[Sphere[#1,#2],{1,1,.5}]&), ({EdgeForm[Thick],Opacity[.7],Cuboid[#1-.5*#2,#1+.5*#2]}&) }}]] ![enter image description here][7] Row[Table[ CrystalPlot[{{0,0,0},{5,0,0},{2.5,4,0}},{1,2,3},BondDist->6,BondStyle->style,ImageSize->400], {style,{ 1, Function[{bonds,partcol},Table[{If[ii<.5,partcol[#,1],partcol[#,2]],Sphere[bonds[[#,1]]+ii*(bonds[[#,2]]-bonds[[#,1]]),.15]},{ii,0,1,1/9}]&/@Range[Length[bonds]]], Function[{bonds,partcol},Module[{spiral,points,rad=.05}, spiral[atoms_]:=Module[{scale=.5,dist=atoms[[2]]-atoms[[1]],curls=60,normal,rot,scaled}, normal=Table[{scale*Cos[ii],scale*Sin[ii],.1*ii},{ii,0,curls,\[Pi]/10}]; scaled={#[[1]],#[[2]],10*Norm[dist]/curls*#[[3]]}&/@normal; rot=scaled.Quiet[RotationMatrix[{dist,{0,0,1}}]]; Join[{atoms[[1]]},#+atoms[[1]]&/@(rot[[25;;-25]]),{atoms[[2]]}]]; points=spiral/@bonds; {partcol[#,1],Tube[BSplineCurve[points[[#,;;Round[Length[points[[#]]]/2]]],rad]],partcol[#,2],Tube[BSplineCurve[points[[#,Round[Length[points[[#]]]/2];;]],rad]]}&/@Range[Length[bonds]] ]] }}]] ![enter image description here][8] ## Lattice planes ## Crystallica can also add lattice planes to the plot. You can specify them using [h,k,l] Miller indices and distance to the origin. CrystalPlot[{{3,0,0},{0,3,0},{0,0,3}},{{0,0,0}},{1}, AddQ->True,AtomRad->.3,AtomCol->"CadmiumYellow",Sysdim->2,CellLineStyle->2, LatticePlanes->Table[{{1,1,1},dist},{dist,1,5}],ContourStyle->{"TerreVerte",Opacity[.7]},BoundaryStyle->Thick] ![enter image description here][9] ## Coordination polyhedra ## You can automatically search for and plot coordination polyhedra. This is not limited to the commonly occurring tetrahedra and octahedra - you can actually look for polyhedra with arbitrary numbers of corners. There are also options to fine-tune both the searching and the rendering. plot[corners_,mixed_]:=CrystalPlot[{{0,0,0},{0,0,1.8},{-.9,-1.5,-.6},{-.9,1.5,-.6},{1.7,0,-.6},{.8,.8,.8}},{1,2,2,2,2,3}, BondStyle->False,ImageSize->250, PolyMode[corners]->{"Show"->All,"AllowMixed"->mixed},PolyStyle[corners]->Directive[Opacity[.5],EdgeForm[Thick]]]; Grid[{{ "", "Search for polyhedra with \n4 corners", "Search for polyhedra with \n5 corners" },{ "Allow \nmixed corners", plot[4,True], plot[5,True] },{ "Don't allow \nmixed corners", plot[4,False], plot[5,False] }},Dividers->All] ![enter image description here][10] CrystalPlot[{{2.5,-4.3,0},{2.5,4.3,0},{0,0,5.5}}, {{.5,0,0},{0,.5,.7},{.5,.5,.3},{.2,.4,.5},{.6,.8,.2},{.2,.8,.8},{.8,.6,.5},{.4,.2,.2},{.8,.2,.8}},{1,1,1,2,2,2,2,2,2}, PolyMode[4]->True,PolyStyle[4]->EdgeForm[None],AddQ->True, Sysdim->2,AtomRad->0,CellLineStyle->False,AtomCol->{"SlateGray","Firebrick"}, ViewAngle->.4,ViewPoint->{3.2,0,1.1},ViewVertical->{.5,0,1.2}] ![enter image description here][11] ## Other things ## Visualization aside, you can also build supercells, change cell shapes, or add, remove and sort atoms... but that's a bit boring to read, so I'll refer you to the Documentation page of the `CrystalChange` function instead. If you're interested, we can use this thread to talk about any questions you may have, or you can share your use of the package (if you decide to use it). I'm not offering full support here, but I'll be floating around, and I'd like to hear your feedback. We don't have any intentions to be involved in further development. But if you have a good idea and some time, then by all means, work on it for yourself, or host it on your favourite code collaboration site. Bianca Eifert and Christian Heiliger [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=teaser.png&userId=69107 [2]: http://library.wolfram.com/infocenter/MathSource/9372/ [3]: http://library.wolfram.com/infocenter/MathSource/9373/ [4]: http://library.wolfram.com/infocenter/MathSource/9375/ [5]: http://vasp.at/ [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=9692simple.png&userId=69107 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=atoms.png&userId=69107 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=bonds.png&userId=69107 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=planes.png&userId=69107 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=polys.png&userId=69107 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=polys2.png&userId=69107 [12]: http://rruff.geo.arizona.edu/AMS/CIF_text_files/13532_cif.txt [13]: http://cms.mpi.univie.ac.at/vasp/vasp/POSCAR_file.html [14]: http://wiki.jmol.org/index.php/File:Caffeine.mol Bianca Eifert 2016-02-05T18:43:18Z https://community.wolfram.com/groups/-/m/t/131302 I am reposting this here from the [url=http://mathematica.blogoverflow.com/]Stackexchange Mathematica blog[/url] so that more people might see it.  I'd be very happy to get some feedback on this plotting function.  If anyone can use the function, let me know how it works out for you, and if you'd recommend any changes.  If so, I can edit this post to have to most up-to-date version. As a chemist it is often useful to plot electronic orbitals. These are used to describe the wave function of electrons in atoms or molecules. Typically, these are output from electronic structure software in the form of a cube file, first developed by Gaussian. These files contain volumetric data for a given orbital on a three-dimensional grid. There exist many applications to visualize cube files, such as [url=http://www.ks.uiuc.edu/Research/vmd/plugins/molfile/cubeplugin.html]VMD [/url]or [url=http://www.gaussian.com/g_tech/gv5ref/results.htm]GaussView[/url], but I wanted to take advantage of Mathematica‘s capability to easily combine graphics, as well as the ability to automate the process in order to efficiently create frames for a [url=http://www.pnas.org/content/suppl/2013/09/05/1308604110.DCSupplemental/sm01.mp4]movie[/url]. First off, we need a function to extract the data from the cube file. In the process, we will create the text for an XYZ file, a format also developed by Gaussian. The function [b]OutForm[/b] is used here to mimic the printf function found in other programming languages. [mcode]OutForm[num_?NumericQ, width_Integer, ndig_Integer, OptionsPattern[]] := Module[{mant, exp, val}, {mant, exp} = MantissaExponent[num]; mant = ToString[NumberForm[mant, {ndig, ndig}]]; exp = If[Sign[exp] == -1, "-", "+"] <> IntegerString[exp, 10, 2]; val = mant <> "E" <> exp; StringJoin@PadLeft[Characters[val], width, " "] ]; ReadCube[cubeFileName_?StringQ] := Module[ {moltxt, nAtoms, lowerCorner, nx, ny, nz, xstep, ystep, zstep, atoms, desc1, desc2, xyzText, cubeDat, xgrid, ygrid, zgrid, dummy1, dummy2, atomicNumber, atomx, atomy, atomz, tmpString, headerTxt,bohr2angstrom}, bohr2angstrom = 0.529177249; moltxt = OpenRead[cubeFileName]; desc1 = Read[moltxt, String]; desc2 = Read[moltxt, String]; lowerCorner = {0, 0, 0}; {nAtoms, lowerCorner[[1]], lowerCorner[[2]], lowerCorner[[3]]} = Read[moltxt, String] // ImportString[#, "Table"][[1]] &; xyzText = ToString[nAtoms] <> "\n"; xyzText = xyzText <> desc1 <> desc2 <> "\n"; {nx, xstep, dummy1, dummy2} = Read[moltxt, String] // ImportString[#, "Table"][[1]] &; {ny, dummy1, ystep, dummy2} = Read[moltxt, String] // ImportString[#, "Table"][[1]] &; {nz, dummy1, dummy2, zstep} = Read[moltxt, String] // ImportString[#, "Table"][[1]] &; Do[ {atomicNumber, dummy1, atomx, atomy, atomz} = Read[moltxt, String] // ImportString[#, "Table"][[1]] &; xyzText = If[Sign[lowerCorner[[1]]] == 1, xyzText <> ElementData[atomicNumber, "Abbreviation"] <> OutForm[atomx, 17, 7] <> OutForm[atomy, 17, 7] <> OutForm[atomz, 17, 7] <> "\n", xyzText <> ElementData[atomicNumber, "Abbreviation"] <> OutForm[bohr2angstrom atomx, 17, 7] <> OutForm[bohr2angstrom atomy, 17, 7] <> OutForm[bohr2angstrom atomz, 17, 7] <> "\n"]; , {nAtoms}]; cubeDat = Partition[Partition[ReadList[moltxt, Number, nx ny nz], nz], ny]; Close[moltxt]; moltxt = OpenRead[cubeFileName]; headerTxt = Read[moltxt, Table[String, {2 + 4 + nAtoms}]]; Close[moltxt]; headerTxt = StringJoin@Riffle[headerTxt, "\n"]; xgrid = Range[lowerCorner[[1]], lowerCorner[[1]] + xstep (nx - 1), xstep]; ygrid = Range[lowerCorner[[2]], lowerCorner[[2]] + ystep (ny - 1), ystep]; zgrid = Range[lowerCorner[[3]], lowerCorner[[3]] + zstep (nz - 1), zstep]; {cubeDat, xgrid, ygrid, zgrid, xyzText, headerTxt} ];[/mcode] If you need to create a cube file, then the following function can be used: [mcode]WriteCube[cubeFileName_?StringQ, headerTxt_?StringQ, cubeData_] := Module[{stream}, stream = OpenWrite[cubeFileName, FormatType -> FortranForm]; WriteString[stream, headerTxt, "\n"]; Map[WriteString[stream, ##, "\n"] & @@ Riffle[ScientificForm[#, {3, 4}, NumberFormat -> (Row[{#1, "E", If[#3 == "", "+00", #3], "\t"}] &), NumberPadding -> {"", "0"}, NumberSigns -> {"-", " "}] & /@ #, "\n", {7, -1, 7}] &, cubeData, {2}]; Close[stream];][/mcode]Next we need the function to plot the orbital, [mcode]CubePlot[{cub_, xg_, yg_, zg_, xyz_}, plotopts : OptionsPattern[]] := Module[{xyzplot, bohr2picometer, datarange3D, pr}, bohr2picometer = 52.9177249; datarange3D = bohr2picometer {{xg[[1]], xg[[-1]]}, {yg[[1]], yg[[-1]]}, {zg[[1]], zg[[-1]]}}; xyzplot = ImportString[xyz, "XYZ"]; Show[xyzplot, ListContourPlot3D[Transpose[cub, {3, 2, 1}], Evaluate[FilterRules[{plotopts}, Options[ListContourPlot3D]]], Contours -> {-.02, .02}, ContourStyle -> {Blue, Red}, DataRange -> datarange3D, MeshStyle -> Gray, Lighting -> {{"Ambient", White}}], Evaluate[ FilterRules[{plotopts}, {ViewPoint, ViewVertical, ImageSize}]]] ]; [/mcode]Let’s look at an example. First we need to read in a cube file, download this cube file and place it in your base directory:  [url=https://dl.dropboxusercontent.com/s/rdsxcnqudn1s76n/cys-MO35.cube]cys-MO35cube[/url] [mcode]{cubedata,xg,yg,zg,xyz,header}= ReadCube["cys-MO35.cube"];[/mcode]Then plot it via[mcode]CubePlot[{cubedata, xg, yg, zg, xyz}][/mcode][img=width: 300px; height: 291px;]http://mathematica.blogoverflow.com/files/2013/09/pizCq-300x291.jpg[/img] When I want to create a movie file, I want all the images to have exactly the same [b]ViewAngle[/b], [b]ViewPoint[/b], and [b]ViewCenter[/b]. When you give these options to [b]CubePlot[/b], it feeds them directly to the [b]Show[/b] function [mcode]vp = {ViewCenter -> {0.5, 0.5, 0.5}, ViewPoint -> {1.072, 0.665, -3.13}, ViewVertical -> {0.443, 0.2477, 1.527}}; CubePlot[{cubedata, xg, yg, zg, xyz}, vp][/mcode][img=width: 280px; height: 300px;]http://mathematica.blogoverflow.com/files/2013/09/Q1mjs-280x300.jpg[/img] Finally, you can also give any options that normally go to [b]ListContourPlot3D[/b][mcode]CubePlot[{cubedata, xg, yg, zg, xyz}, vp, ContourStyle -> {Texture[ExampleData[{"ColorTexture", "Vavona"}]], Texture[ExampleData[{"ColorTexture", "Amboyna"}]]}, Contours -> {-.015, .015}][/mcode][img=width: 288px; height: 300px;]http://mathematica.blogoverflow.com/files/2013/09/fLyJ7-288x300.jpg[/img] Many thanks to Daniel Healion for the [b]ReadCube[/b] and [b]WriteCube[/b] functions. Jason Biggs 2013-09-27T18:35:45Z https://community.wolfram.com/groups/-/m/t/2026904 ![frontimage][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=imagefront.jpg&userId=1316061 [2]: https://www.wolframcloud.com/obj/88bd85e6-8a15-4fe1-ab85-7da71b0ce10b Claudio Chaib 2020-07-14T02:04:22Z https://community.wolfram.com/groups/-/m/t/2068787 This work is part of series of other posts avaialble here: - 1st post: [Organic Chemistry 1: Modeling Synthesis as Graphs][1] - 3rd post: [Organic Chemistry 3: Progress in Multi-Step Chemical Synthesis][2] ---- I post this in case anyone is interested in experimenting further along these lines, or in collaborating with me on an organic synthesis related project. This notebook shows my representation of various organic chemical reactions in Wolfram Language. &[Wolfram Notebook][3] [Original]: https://www.wolframcloud.com/obj/wolfram-community/Published/OrgSynProject.nb [1]: https://community.wolfram.com/groups/-/m/t/2073460 [2]: https://community.wolfram.com/groups/-/m/t/2071550 [3]: https://www.wolframcloud.com/obj/d25cd622-0699-461b-8652-425dc974e99d Leonardo Cabana 2020-09-01T13:44:29Z https://community.wolfram.com/groups/-/m/t/2115501 # Proposal: *Wolfram's mineral database is an interesting resource. In this work I will explore and account for the different chemical elements that are part of each mineral to perform an analysis as a whole. Here, the quantities of each element in each mineral will not be addressed, but only the different atomic elements in each mineral. Also, here in this work I exclude minerals that are formed by only 1 chemical element, that is, I consider only compound minerals. The analysis is done in two parts, the first part is an analysis without taking into account the water that may or may not be in the mineral, that is, the mineral completely dehydrated (only its composition that is linked by covalent bonds etc), the second part I analyze the minerals together with the water. In addition to having obtained a ranking of chemical elements in relation to all available minerals, in the end I get a percentage of how many minerals have oxygen and how many minerals have associated water in their composition.* # Database: Of course, Wolfram's minerals database does not have all the minerals that exist, but it has a very decent amount, where we can make a very representative analysis. First we take the list of minerals in the database and calculate the number of entities: minerals = EntityList[Entity["Mineral"]]; Length@minerals ![im1][1] Now we will associate each mineral with its chemical formula and, also obtain all the atomic symbols. This operation can take 2 to 3 hours to complete the download from Wolfram's servers: formulas = Map[#["Formula"] &, minerals]; symbols = Map[#["AtomicSymbol"] &, EntityList[EntityClass["Element", All]]]; To quickly make this information available for later use, we can save the data as an .mx file with the help of DumpSave: filepath = FileNameJoin[{NotebookDirectory[], "formulas.mx"}]; filepath2 = FileNameJoin[{NotebookDirectory[], "symbols.mx"}]; DumpSave[filepath, {formulas}]; DumpSave[filepath2, {symbols}]; Quit[] That way we can retrieve the data for fast use whenever we want, using Get: SetDirectory[NotebookDirectory[]]; Get["formulas.mx"] Get["symbols.mx"] The definition of “symbols” below: symbols ![im2][2] Below is a simple function to have each mineral associated with its chemical formula in an easy way to visualize: threadFormula[m_, n_] := Thread[minerals[[m ;; n]] -> formulas[[m ;; n]]] // Grid[Partition[#, 1], Frame -> All, Alignment -> Left] &; threadFormula[1000, 1010] ![im3][3] # Data Excluding Water: Unfortunately the mineral formulas in the database are in a very complicated format to manipulate, as part is in String, part in Superscript, etc ... so we need to modify and alter the data in an intelligent way to obtain the formulas in a more computable form, at the same time we exclude water associated with minerals that have it: a1 = {StringDelete[StringDelete[ToString[#], "{"], "}"]} & /@ Table[Flatten@Apply[List, i, All], {i, formulas}]; a2 = Table[ StringDelete[ a1[[x]], {"(, H, 2, O, )", "H, 2, O", " ScriptBaselineShifts" ~~ __}], {x, 1, Length@a1}]; a2[[;; 10]] ![im4][4] Now extracting the different chemical elements for each mineral and excluding the minerals formed by just one chemical element. Note that the number of minerals went from 3878 to 3778: a3 = Union[#] & /@ Flatten[StringCases[#, ReverseSortBy[symbols, Length]] & /@ a2, 1]; a4 = Table[If[Length@a3[[z]] > 1, a3[[z]], Nothing], {z, 1, Length@a3}] Length@a4 ![im5][5] Finally, we can count the composition of different atomic elements that are part of all the minerals in the database. We can see that there are 70 different elements in this list: a5 = Association[Reverse@SortBy[Normal@Counts@Flatten@a4, Last]] Length@a5 ![im6][6] We can set up a Dataset with the elements and their position (ranking) that are part of all minerals for better visualization: Transpose[ Partition[ Keys@# -> Quantity[Position[Normal@a5, #][[1, 1]], IndependentUnit["position"]] & /@ Normal@a5 , 10]] // Dataset ![im7][7] For the next parts of this work we have to define the two rules below: rule1 = Thread[Flatten[Position[symbols, #] & /@ symbols] -> symbols]; rule2 = Join[{0 -> "Water"}, rule1]; With some manipulation of the data, we can for example reorganize the elements in the order they are in the periodic table, that is, in the order of the atomic number, as well as other useful lists to create some graphs and analyzes: b1 = Table[{Sort[Thread[{Keys@a5, Values@a5}]][[x, 1]], {Sort[Thread[{Keys@a5, Values@a5}]][[x, 2]]}}, {x, 1, Length@a5}]; b2 = Table[ Entity["Element", b1[[x, 1]]]["AtomicNumber"], {x, 1, Length@b1}]; b3 = SortBy[Table[{b2[[x]], b1[[x, 2, 1]]}, {x, 1, Length@b2}], First]; b4 = Association@ Table[(b3[[x, 1]] /. rule1) -> b3[[x, 2]], {x, 1, Length@b3}]; b5 = Table[{b3[[x, 1]] /. rule1, b3[[x, 2]]}, {x, 1, Length@b3}]; b4 ![im8][8] The first plot we have is the different chemical elements that form all the minerals in decreasing order of quantity in which they appear in the whole: ListPlot[Tooltip /@ a5, ImageSize -> 1000, PlotRange -> All, Axes -> {None, Automatic}, GridLines -> {None, Automatic}] ![im9][9] The next plot is the different chemical elements that make up all the mineral samples, but in the order of atomic number. This visualization is interesting because it relates to the periodic table: ListLinePlot[ Callout[#[[2]], Style[{#}, 10, Red, Bold], CalloutStyle -> Red] & /@ b5, ImageSize -> 1000, PlotRange -> All, PlotMarkers -> {Automatic, Scaled[0.01]}, GridLines -> {Table[{x, Dashed}, {x, 1, 70}], None}, PlotStyle -> Thin] ![im10][10] We can view it also in the form of WordCloud: WordCloud[b5, ImageSize -> Large] ![im11][11] # Result of Oxygen: To conclude the initial analysis, we can see in how many percent of the minerals that there is oxygen attached to the molecular structure in relation to all minerals. We see that this value can reach up to 80%: "OxygenInTotal" -> Quantity[N[100*b4["O"]/Length@a4], "Percent"] ![im12][12] # Data with Water: With some differences in relation to the first part of this work, instead of excluding water, we can define a new water entity to be included in the formula of the minerals that contain it: a2W = Table[ StringReplace[ a1[[x]], {"(, H, 2, O, )" -> "Water", "H, 2, O" -> "Water", " ScriptBaselineShifts" ~~ __ -> ""}], {x, 1, Length@a1}]; a2W[[;; 10]] ![im13][13] With a similar code, with only a few differences, we do the same extraction of atomic symbols plus water in each mineral. Again, we exclude minerals formed by only 1 chemical element: a3W = Union[#] & /@ Flatten[StringCases[#, ReverseSortBy[Join[symbols, {"Water"}], Length]] & /@ a2W, 1]; a4W = Table[ If[Length@a3W[[z]] > 1, a3W[[z]], Nothing], {z, 1, Length@a3W}] Length@a4W ![im14][14] And, again with some manipulation of the data, we created lists and associations to have the result in quantities (including water). Some of these definitions will also be used below to have some plots: a5W = Association[Reverse@SortBy[Normal@Counts@Flatten@a4W, Last]]; a5W Length@a5W b1W = Table[{Sort[Thread[{Keys@a5W, Values@a5W}]][[x, 1]], {Sort[Thread[{Keys@a5W, Values@a5W}]][[x, 2]]}}, {x, 1, Length@a5W}]; b2W = Table[ Entity["Element", b1W[[x, 1]]]["AtomicNumber"], {x, 1, Length@b1W}] /. {Missing[ "UnknownEntity", {"Element", "Water"}] -> 0}; b3W = SortBy[Table[{b2W[[x]], b1W[[x, 2, 1]]}, {x, 1, Length@b2W}], First]; b4W = Association@ Table[(b3W[[x, 1]] /. rule2) -> b3W[[x, 2]], {x, 1, Length@b3W}]; b5W = Table[{b3W[[x, 1]] /. rule2, b3W[[x, 2]]}, {x, 1, Length@b3W}]; ![im15][15] The water being included together with the decreasing order of the amounts of different chemical elements that are part of all minerals: ListPlot[Tooltip /@ a5W, ImageSize -> 1000, PlotRange -> All, Axes -> {None, Automatic}, GridLines -> {None, Automatic}] ![im16][16] A plot similar to that of the first part of the work, in ascending order of atomic number, but including water and it appears before hydrogen (water defined as position 0) just for viewing: ListLinePlot[ Callout[#[[2]], Style[{#}, 10, Red, Bold], CalloutStyle -> Red] & /@ b5W, ImageSize -> 1000, PlotRange -> All, PlotMarkers -> {Automatic, Scaled[0.01]}, GridLines -> {Table[{x, Dashed}, {x, 1, 71}], None}, PlotStyle -> Thin] ![im17][17] Visualization using WordCloud including water: WordCloud[a5W, ImageSize -> Large] ![im18][18] # Result of Water: In the way below we calculate how many percent of minerals have water associated with its composition in relation to all available minerals. We can see that an expressive part of them have water (hydrated minerals), more than 1/3 of them: "WaterInTotal" -> Quantity[N[100*a5W["Water"]/Length@a4W], "Percent"] ![im19][19] # Conclusion and Notes: - A significant amount of minerals have some oxygen in the chemical composition: 80% of them. - A good part of minerals have water associated with its molecule: 35% of them. It is worth mentioning that there may be some flaws in the exclusion and inclusion of water in the calculations, as for example, some organic minerals and some others may be erroneously influenced by the rules stipulated in this work. But it is a minority of these minerals, so although there is some variation in these percentages the value is satisfactorily approximate. In the future it would be interesting to also analyze the amounts of each chemical element in minerals and not only an analysis as presented here that only counts the different chemical elements. It proved difficult to do this type of analysis because the mineral formulas are in a complex format for computability. My personal opinion is: it is very interesting that in most minerals we can extract oxygen and water (more from the first than the second) with some physical-chemical treatment, sometimes this can be done in a simple way, sometimes in a complex way, but it demonstrates how there is enough oxygen and water inside the earth's crust, and not only coming from the oceans, from the very formation of our planet. Thanks. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1513im1.png&userId=1316061 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=9107im2.png&userId=1316061 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=7916im3.png&userId=1316061 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4965im4.png&userId=1316061 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=7193im5.png&userId=1316061 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=8332im6.png&userId=1316061 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1159im7.png&userId=1316061 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=7568im8.png&userId=1316061 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2146im9.png&userId=1316061 [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1588im10.png&userId=1316061 [11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2712im11.png&userId=1316061 [12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2750im12.png&userId=1316061 [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=7119im13.png&userId=1316061 [14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3232im14.png&userId=1316061 [15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4654im15.png&userId=1316061 [16]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im16.png&userId=1316061 [17]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im17.png&userId=1316061 [18]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im18.png&userId=1316061 [19]: https://community.wolfram.com//c/portal/getImageAttachment?filename=im19.png&userId=1316061 Claudio Chaib 2020-11-15T23:14:04Z https://community.wolfram.com/groups/-/m/t/1098055 Recently, I've been working on a project called Mandy, an interactive periodic table that displays different element trends depending on what the user says to her. The Raspberry Pi/Mathematica duo has played a very strong role in all aspects of the project design and implementation. I'm not allowed to provide too many details about the project (not because it's secret, but because I am moving in a month and my wife has ordered that all of my toys and hobbies get packed or I risk them being left behind). Therefore, I [created a teaser trailer][2] showcasing the design with a promise to provide more details when I get settled in my new location. [![enter image description here][3]][2] [![enter image description here][4]][2] That said, I wanted to highlight a couple of areas where Mathematica played a pivotal role in the the project. My goal was to create a periodic table display (approximately 24x18") that has a RGB LED for each element. The color of the element would then be based on a given periodic trend (atomic radius, weight, ionization energy, etc.). Controlling 118 3-color LEDs turns out to be very easy when the LEDs are Neopixels and the controller is an Arduino. Because I envisioned a wall display, I wanted the user to interact with the piece in some fashion other than a mouse or keyboard. I have started working on a voice recognition system based on pocketsphinx which I call [Simplified Command and Control - SCAC](https://bobthechemist.com/2015/12/prelude-to-simplified-command-and-control/) but since it is a C/Python project, I'll leave that component for another forum. In summary, the final project requires that SCAC (a python script) interact with Mathematica (data manipulation) that then speaks to an Arduino via a serial connection. But Mathematica played a big role prior to the implementation as well: ## Design - With access to `ElementData`, I was able to very quickly create an image that could be sent to a laser cutter for carving the birch-wood frame and the acrylic element pieces. o = Table[ Map[ElementData[i, #] &, {"AtomicNumber", "Symbol", "Period", "Group"}], {i, 118}]; (* Need to massage the f-block elements,giving them fake groups and \ periods.Making their periods 9 and 10 with their groups 3 through 16 \ works nicely *) o[[57 ;; 70]] = Module[{i = 1, rep = Range[3, 16], tmp}, tmp = Select[o, 57 <= #[[1]] <= 70 &] /. {6 -> 9}; tmp /. {Missing["NotApplicable"] :> rep[[i++]]}]; o[[89 ;; 102]] = Module[{i = 1, rep = Range[3, 16], tmp}, tmp = Select[o, 89 <= #[[1]] <= 102 &] /. {7 -> 10}; tmp /. {Missing["NotApplicable"] :> rep[[i++]]}]; o = o /. {"Uut" -> "Nh", "Uup" -> "Mc", "Uus" -> "Ts", "Uuo" -> "Og"}; piece = Polygon[{{0, 0}, {1, 0}, {1, 1}, {0, 1}, {0, 0}}]; Clear[box] box[array_] := Module[{x, y, m = 10}, {x, y} = array[[{4, 3}]]; {FaceForm[None], EdgeForm[Thin], Rectangle[{m x, m (10 - y)}, {m (x + 1), m (11 - y)}] (*Inset[Style[array[[2]],10,Bold],{m (x+0.5),m(10.7-y)}], Inset[Style[array[[1]],8],{m(x+0.5),m(10.2-y)}]*)} ] makePiece[pt_] := GeometricTransformation[ GeometricTransformation[piece, {pt[[1]], 10 - pt[[2]]}*{1.2, 1.2}], ScalingTransform[{10, 10}]]; ptpuzzle = Graphics[{EdgeForm[Thin], FaceForm[None], makePiece /@ o[[All, {4, 3}]]}]; Clear[letters2] letters2[array_] := Module[{x, y, m = 10}, {x, y} = array[[{4, 3}]]; {FaceForm[None], EdgeForm[Thin], (*Rectangle[{m x,m(10-y)},{m(x+1),m(11-y)}]*) Inset[Style[array[[2]], 8, Bold, FontFamily -> "Cambria Math"], {m (x + 0.45), m (10.55 - y)}*{1.2, 1.2}], Inset[Style[array[[1]], 6, FontFamily -> "Cambria Math"], {m (x + 0.45), m (10.2 - y)}*{1.2, 1.2}]} ] ptpuzzlelt = letters2 /@ o // Graphics; Show[ptpuzzlelt, ptpuzzle, ImageSize -> 600] ![enter image description here][5] There are easier ways to create a periodic table, but the above method allowed me to create SVG images suitable for tweaking in vector graphics software and cut with the laser cutter. ## Data Naturally, `ElementData` can provide the physical and chemical properties of the elements that I want to display on Mandy. There's nothing inspiring about this code (grabbing the data, rescaling it and converting values to a corresponding color scheme). Mathematica provided a useful platform for sandboxing what the trends would look like: ![enter image description here][6] ## Implementation Since speech recognition (SCAC) is written in Python, I needed to control a Mathematica Kernel from within Python. I've [played with this idea before](https://github.com/bobthechemist/python-mathlink) which results in a functioning platform that is error-intolerant (READ: not ready for prime time). Communication with the Arduino is done through a "Serial" device instead of the "Arduino" device because I started this project before the latter was working. That said, it was pretty straightforward to create a Mathematica Package that (a) opens serial communication with the Arduino, (b) Reads in the element-LED data (c) sends a command to the Arduino to light the LEDs. I plan to post more details about the project, including code and design pictures, in due time. See [my website](https://bobthechemist.com/2017/05/mandy-the-periodic-table-teaser/) for updates. RIght now, it sounds like I've used up my daily allocation of blogging time and have to go pack some boxes. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trends.gif&userId=61884 [2]: https://www.youtube.com/watch?v=eI-IgJ3n_RU [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-08-04at7.37.04AM.png&userId=11733 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-08-04at7.37.59AM.png&userId=11733 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture.JPG&userId=61884 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trends.gif&userId=61884 BoB LeSuer 2017-05-18T15:11:29Z https://community.wolfram.com/groups/-/m/t/3217184 ![Analyzing Protein Shape Characteristics][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2024-07-11at5.58.59%E2%80%AFPM.png&userId=3216761 [2]: https://www.wolframcloud.com/obj/d7874cb2-0b6f-4451-8c73-67bb1a147a12 Annie Zhu 2024-07-11T22:06:58Z https://community.wolfram.com/groups/-/m/t/201504 Recently, I tried making a visible spectrometer using the Raspberry pi, the camera module and Mathematica.  Details are posted [url=http://www.bobthechemist.com/interactive-chemistry/16-wolfspec-2-0]here[/url], but here's a brief summary.  The spectrometer is built out of legos and a few components found around my house (and since I'm a Chemistry professor, diffraction gratings and cuvettes are really found around my house). [img=width: 350px; height: 311px;]http://www.bobthechemist.com/images/images/rpi/oldarticles/wolfspec2inst1.png[/img] The light source (in the upper right hand corner) is a white RGB LED.  Immediate to the left is the sample compartment (which unfortunately is just a little too big for a standard sized cuvette).  Next comes a transmission diffraction grating which is a common supply in general physics classes.  I then use a 10x magnifying lens to condense the light onto a business card.  At the bottom right in the picture is the camera module (connected by the white ribbon to my Raspberry Pi and mounted using a hodge-podge of Legos).  The camera is pointed towards the business card. Unlike [url=http://www.bobthechemist.com/interactive-chemistry/15-wolfspec-version-1-0]my first version of a spectrometer[/url], this version doesn't require any additional GPIO interfacing or MathLink programming; everything can be done within a typical Mathematica notebook without additional packages.  I acquire images using Import and then use ImageTake to grab just the region of interest.  Here are some example images of the empty spectrometer and with three samples: water, green food coloring and red food coloring. [img=width: 500px; height: 61px;]http://www.bobthechemist.com/images/images/rpi/oldarticles/spectrographs.png[/img]   In order to get spectra out of these images, I do 3 things: 1. Convert the images into data with ImageData and then average each of the rows 2. Convert the y axis into absorbance. 3. Calibrate the x axis by assuming that the RGB LED emits red, green and blue light at the expected wavelengths. The code for these steps is fairly straightforward, and demonstrates how easy it is to manipulate Images, process array data rapidly, and perform linear fitting statistics with just a few lines of code.  For the samples above, I ended up with the following spectra: [img=width: 460px; height: 239px;]http://www.bobthechemist.com/images/images/rpi/oldarticles/calibrated.png[/img] The results are decent, given the quick and dirty calibration, the limitations of my source and the lack of any robust alignment of my "optical bench".  With some modifications, I suspect I can improve the wavelength resolution, although I will probably be limited by the source, which doesn't have a continuous emission across the visible region of the electromagnetic spectrum.  The system is easy enough to build at home, however, to serve as a spectroscopic tool for science fair experiments or other kitchen chemistry projects.   BoB LeSuer 2014-02-17T02:48:24Z https://community.wolfram.com/groups/-/m/t/1732535 ![Predicted vs Experimental Silver XRD Pattern. Experimental plot obtained from: Koohpeima, Fatemeh & Mokhtari, Mohammad & Samaneh, KHALAFI. (2017). The effect of silver nanoparticles on composite shear bond strength to dentin with different adhesion protocols. Journal of Applied Oral Science. 25. 367-373. 10.1590/1678-7757-2016-0391. ][1] ## A Computational Method to Predict X Ray Diffraction (XRD) Patterns ## ---------- ## Background ## Ever wondered how DNA's double helix structure was discovered? How drugs are investigated? Well, welcome to the world of X-ray diffraction! 13 Nobel prizes were awarded for developments involving this old but effective technique, in fields ranging from physics to medicine. But, how is it so effective? XRD is a powerful technique employed in various domains of science to determine the chemical makeup and thereby physical properties of various structures. Each lattice structure has its own "XRD fingerprint" which keys scientists in to its chemical makeup. This fingerprint is characterized by peaks with different intensities at different angles. Here is a sample for a face-centered cubic copper lattice structure: ![Copper XRD pattern: From X-Ray Diffraction Studies of Copper Nanopowder (arXiv:1003.6068v1 [physics.gen-ph])][2] The first image in this post is a comparison of experimental and predicted results for a Silver crystal structure. However, predicting these fingerprints given little experimental data is a mathematically involved procedure. This summer, as part of the Wolfram High School Summer Camp, I implemented a framework for predicting these fingerprints for various cubic lattice structures. ## Creating the Program ## ---------- ## Getting the Bragg Peak Positions ## You might be wondering what the numbers on the top of the peaks mean. These numbers are Miller indices, which are descriptions of the planes in a unit cell that are producing the peaks. The first step is to use these planes to generate the Bragg peak positions: $$d=\frac{a}{\sqrt{h^2+k^2+l^2}}$$ $$ \theta =2\arcsin{\left(\frac{\lambda}{2 d}\right)} $$ Here, $a$ denotes the lattice constant (length of a side in a cubic unit cell), $(h,k,l)$ denote the Miller indices, and $\lambda$ denotes the wavelength of the X-ray used. This is based on Bragg's law, see https://demonstrations.wolfram.com/BraggsLaw/ . However, certain $(h,k,l)$ are forbidden in some structures. For example, in a body-centered cubic structure, $ h+k+l$ has to be even. The function `PossiblePlanes` accounts for these and has access to an extensive dataset of compounds and their structures. To make coding easier, a list of associations was made with a certain $\theta$ being the key for a list of $hkl$ values. grouped[elementlist_, n_] := GroupBy[ PossiblePlanes[elementlist, n], 1/Sqrt[(#[[1]]^2 + #[[2]]^2 + #[[3]]^2)] &] association[elementlist_, n_, wavelength_] := Sort[MapThread[#1 -> #2 &, {ToTheta[wavelength, elementlist, n], grouped[elementlist, n] // Values}]] ## Atomic Form Factor ## To account for different electron densities, atomic form factors were calculated using a dataset tabulated by the International Tables for Crystallography: http://it.iucr.org/Cb/ch6o1v0001/. These form factors vary by angle; shown below is copper: ![Copper's Atomic Form Factor][3] These atomic form factors are then used in the structure factor calculation, which is directly proportional to the square root of intensity. For unary systems, the structure factor calculation is relatively easy. For binary systems, however, the parity of the Miller indices must be taken into account. evenodd[b_, elementlist_, theta_, w_] := If[b, Total[atomdata[#, theta, w] & /@ elementlist], Differences[atomdata[#, theta, w] & /@ elementlist] // First] Here, `atomdata` gives the atomic form factor at a specific point. This function is mapped to a set of True/False (Even or not) values and returns the structure factor. For a face-centered cubic cell, if the parity of $hkl$ is even, then the atomic form factors are summed, but if the parity is odd, the atomic form factors are subtracted. ## Multiplicities ## Now, back to the Miller indices. Take a look at the following graphic: ![Miller Indices Felix Kling.svg. (n.d.). Retrieved from WikiMedia ][4] You might notice that if we reflect $(100)$ we can get $(010)$ and $(001)$ . We can also get negative indices, usually denoted $\overline{1}$ instead of $-1$. This gives us 6 total planes that are symmetry-equivalent, and correspond to the same peak. Hence, we say that the class of Miller indices $(h00)$ has a multiplicity of 6. These multiplicities range from 6 to 48 for a cubic lattice structure, but can get as low as 2 with less symmetric structures. Therefore, instead of calculating the contributed intensity of each plane, we count them as one plane and multiply the resultant intensity by a specific multiplicity. This multiplicity is then used to calculate peak intensity. ## Intensity Calculation ## $$I_{hkl}=\underbrace{\frac{1+\cos^2 (2\theta)}{\sin^2(\theta)}}_{\text{Lorentz Polarization Correction}} \times \ \ \ \ \ \text{Multiplicity}_{hkl} \ \ \ \times \underbrace{F_{hkl}^2}_{\text{Structure Factor}}$$ The Lorentz polarization correction was introduced to improve accuracy and match experimental conditions as X-rays will not be completely polarized at every angle. intensity[w_, elementlist_, n_] := Transpose@{(association[Flatten @ elementlist, n, w] // Keys), (.5 (1 + (Cos[#])^2)/(Sin[#/2]^2 * Cos[#/2])) & /@ (association[Flatten @ elementlist, n, w] // Keys) * (multiplicity /@ (Last /@ (association[Flatten @ elementlist, n, w] // Values)))*(structurefactor[elementlist, w, (association[Flatten @ elementlist, n, w])]) ^2 } `intensity` gives a list of Bragg peak positions and their respective intensities using the aforementioned formula. This intensity function is then inputed in a function which finally plots the diffraction pattern. peak[{theta_, intensity_}] := intensity * Exp[-10000 Pi (t - theta)^2] Where $t$ is the variable to be plotted against. Here is a comparison of the predicted XRD pattern vs the real diffracted pattern for a Copper FCC structure: ![Experimental vs. Predicted XRD Pattern][5] The absolute intensities have little use, as relative intensities are primarily used to analyze these patterns. ---------- ## Future Research ## For future research, I have many ideas I want to implement. Thanks to Mr. Wolfram, I certainly have a lot to do this summer! Perhaps the most ambitious of my future plans is doing the inverse problem: predicting the lattice structure from a given XRD pattern. ## Acknowledgements ## I would like to thank my mentor, Eryn Gillam, for helping me throughout my project. I would also like to thank the other mentors for their help, and Mohammad Bahrami for his lectures. Wolfram Summer Camp truly gave me an outlet to express my creativity in novel ways, and the two weeks I spent here were invaluable. Wolfram Summer Camp gave me a novel perspective on how to approach all aspects of life, and key insight into how computational thinking can change the world. For these reasons and more, I am beyond grateful to have been a part of this camp, and am looking forward to apply my new skills. ## Computational Essay ## https://github.com/hamza314/WSS-Template/blob/master/Final%20Project/Final%20Submission/Hamza%20Alsamraee%20WSC19.nb [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=main.PNG&userId=1725111 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=copperrealxrd.png&userId=1725111 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Capture.PNG&userId=1725111 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=360px-Miller_Indices_Felix_Kling.svg.png&userId=1725111 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=dual.PNG&userId=1725111 Hamza Alsamraee 2019-07-12T00:56:45Z https://community.wolfram.com/groups/-/m/t/188575 ***Note: I have updated this thread with newer installation instructions. I've kept the original post untouched just for reference.*** My latest experiement has been to read from the vast array of analog sensors that are made available from [url=http://www.vernier.com/]Vernier[/url].  The company distributes an SDK that makes a lot of the device interaction straightforward, although compiling the SDK on a Raspberry Pi required a little bit of work which I described in a bit more detail here [dead link removed].  As with some of the other projects I've played around with, I find it easiest to interact with hardware devices through MathLink and a bit of c code, so I made a few functions that grab device information and make a measurement (in this case, an average of up to 25 measurements within 1 second).   What makes this approach interesting, in my opinion, is that it utilizes what Vernier calls the [url=http://www.vernier.com/products/interfaces/go-link/]Go!Link interface[/url] with provides a USB connection from the Vernier probe to the (in this case) Raspberry Pi.  The Go!Link allows one to make hot-swapable devices; with a Dynamic call to the MathLink functions, I get. [img=width: 400px; height: 190px;]/c/portal/getImageAttachment?filename=golink.gif&userId=61884[/img] Here is a simple interface where I'm swapping out a thermometer, barometer and a CO2 sensor.  The SDK knows the identity of the sensor, the units it uses and has calibration information already set up so getting the sensors up and running in Mathematica was easy (the tricky part was the MathLink code). Naturally, we can make dynamic plots of sensor readings as well: [img=width: 400px; height: 281px;]/c/portal/getImageAttachment?filename=luxplot.gif&userId=61884[/img] Here I'm using Clock to poll a light sensor every 2 seconds and then shining a light source on the sensor.  The 0-value readings are not conditions of no light, but rather times when the sensor reading failed.  At the moment, I'm not sure if that's a Mathematica or c problem. BoB LeSuer 2014-01-22T13:30:39Z https://community.wolfram.com/groups/-/m/t/1190717 I have just released a package entitled ["MoleculeViewer"][1], whose functionality is exactly what it says on the tin. This package was inspired in part by previous efforts by [@BoB LeSuer][at0] and [@Bianca Eifert][at1]. I took the best parts of [their][2] [packages][3], along with some of the good parts of the built-in molecule renderer, and added a few of my own tweaks. One noticeable tweak would be the depiction of multiple bonds (just like what is done in some physical models), as in the following image: MoleculeViewer["thiacloprid"] ![thiacloprid][4] The package has a number of other nifty features and auxiliary functions, like highlighting: MoleculeViewer["caffeine", Highlighted -> {"O", "N" -> Orange}] ![caffeine][5] and legends: MoleculeViewer[RunOpenBabel[GetChemSpider["calicheamicin", "InChI"]], PlotLegends -> True] ![calicheamicin][6] Before using the package, you will need to install [Open Babel][7] for some of its conversion functionality. Additionally, to use the [ChemSpider][8] search functionality, you will need to [register][9] to obtain an API key. Download the paclet from GitHub and [install in the usual manner][10]. Alternatively, using the technique featured [here][11], evaluate PacletInstall["MoleculeViewer", "Site" -> "http://raw.githubusercontent.com/tpfto/MoleculeViewer/master"] Documentation and a gallery are given as separate notebooks. [at0]: http://community.wolfram.com/web/bobthechemist [at1]: http://community.wolfram.com/web/biancaeifert [1]: https://github.com/tpfto/MoleculeViewer/releases [2]: https://github.com/biancaeifert/multi-bond-plot [3]: https://github.com/bobthechemist/molviewer [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=zotu8.png&userId=520181 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=eTaCP.png&userId=520181 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=nlZ63.png&userId=520181 [7]: http://openbabel.org/ [8]: http://www.chemspider.com/ [9]: http://www.chemspider.com/Register.aspx [10]: https://mathematica.stackexchange.com/a/141888 [11]: https://mathematica.stackexchange.com/questions/155123 J. M. 2017-09-23T15:31:37Z https://community.wolfram.com/groups/-/m/t/2927764 ![Introducing the Wolfram ProteinVisualization paclet!][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Main2.bmp&userId=20103 [2]: https://www.wolframcloud.com/obj/353c8f22-23af-4a49-b43c-b0b0f1645249 Soutick Saha 2023-05-31T14:38:54Z https://community.wolfram.com/groups/-/m/t/1733124 ![Bismuth-212 Decaying][1] ##Abstract## The goal behind this project was to find a way to successfully showcase the processes behind nuclear decay reactions. Given an isotope, an algorithm was written to generate an automated interactive nuclear decay cascade chart with nodes to represent different isotopes. These nodes also provided the user with a method of visualizing the decay process by analyzing the selected isotopes' branching ratios with respect to half-life as seen above for example. Additionally, a chart was formed that provided information on all of the isotopes present in the nuclear decay cascade outputted. The user is able to use any known isotope compatible with Wolfram's [IsotopeData][2] function using [natural language inputs][3]. ## I. Computing Ratios ## The mathematical foundations of nuclear decay lie in the [Bateman equation][4], proposed and solved by physicists Ernest Rutherford and Harry Bateman respectively. This model utilizes a set of differential equations in order to calculate the shape of exponential graphs that represent how the parent isotope mass gets converted, whether that be for alternative decay modes or chain decays as seen below. $$N_{D}={\frac {N_{1}(0)}{\lambda _{D}}}\sum _{i=1}^{D}\lambda _{i}c_{i}e^{-\lambda _{i}t}\text{ where } c_{i}=\prod _{j=1,i\neq j}^{D}{\frac {\lambda _{j}}{\lambda _{j}-\lambda _{i}}}$$ While this solution describes a chain reaction for an *n* amount of chain reactions in a row, the program only utilizes a more specific version to describe chain reactions for specifically two-decay chains: $$ {\frac {\mathrm {d} N_{B}}{\mathrm {d} t}}=-\lambda _{B}N_{B}+\lambda _{A}N_{A0}e^{-\lambda _{A}t}$$ For the alternate decay modes, I used a set of three equations to derive the correct ratios based on the parent isotope. 1. $N_{A}=N_{A0}e^{-\lambda t}$ 2. $N_{B}=\frac{\lambda_B}{\lambda}N_{A0} \left(1-e^{-\lambda t} \right) $ 3. $N_{C}={\frac {\lambda _{C}}{\lambda }}N_{A0}\left(1-e^{-\lambda t}\right) $, where $\lambda =\lambda _{B}+\lambda _{C}$. I changed the units of the axes to create a more clear visualization that was in terms of percentages and number of half-lives rather than the number of atoms. Later, you can also notice how the branching ratios were used to construct the elegant lines displayed in the graphs. halfLife[isotope_] := IsotopeData[isotope, "HalfLife"] // QuantityMagnitude; decayConstant[isotope_] := Log[2.]/ IsotopeData[isotope, "HalfLife"] // QuantityMagnitude; parentDecay[isotope_, t_] := If[halfLife[isotope] == Infinity, 1, E^(-decayConstant[isotope] t*halfLife[isotope])] parentDecay2[isotope1_Entity, t_] := If[(halfLife[isotope1] == Infinity), 1, E^(-Log[2] t)] parentDecay4[isotope1_Entity, isotope2_Entity, isotope3_Entity, isotope4_, t_] := If[(halfLife[isotope1] == Infinity), 1, E^(-Log[2] t)] oneDecayA[isotope_, t_] := If[halfLife[isotope] == Infinity, 0, 1 - E^(-decayConstant[isotope] t*halfLife[isotope])] oneDecayB[isotope1_, x_, t_] := IsotopeData[isotope1, "BranchingRatios"][[x]]*(1 - E^(-Log[2] t)) ##II. Generating Graphics ## There are three major decay patterns that are demonstrated in the program. The first one is one parent radionuclide decaying to two daughter nuclides, another is one parent radionuclide decaying to three daughter nuclides, and the final one models a nuclear decay. We can use the code for the second one as an example to show how the graphic is formed. decayChart3[isotope_] := Manipulate[ Style[Row[{ Module[{ y = parentDecay2[isotope, NumberOfHalfLifes], z = oneDecayB[isotope, 1, NumberOfHalfLifes], w = oneDecayB[isotope, 2, NumberOfHalfLifes], x = oneDecayB[isotope, 3, NumberOfHalfLifes]}, Plot[{ parentDecay2[isotope, t], oneDecayB[isotope, 1, t], oneDecayB[isotope, 2, t], oneDecayB[isotope, 3, t]}, {t, 0, 10}, PlotRange -> {0, 1}, PlotLegends -> Placed[{"Parent Isotope", "Child Isotope1", "Child Isotope2", "Child Isotope3"}, Below], Epilog -> {PointSize[Large], Point[{NumberOfHalfLifes, y}], Point[{NumberOfHalfLifes, z}], Point[{NumberOfHalfLifes, w}], Point[{NumberOfHalfLifes, x}]}, PlotLabel -> {"Parent Amount: " <> ToString@ (y*100) <> "%", "Child1 Amount: " <> ToString@ (z*100) <> "%", "Child2 Amount: " <> ToString@ (w*100) <> "%", "Child3 Amount: " <> ToString@ (x*100) <> "%"}, ImageSize -> 500]], blueList[[ Round[100*parentDecay2[isotope, NumberOfHalfLifes]] + 1]], yellowList[[ Round[100*oneDecayB[isotope, 1, NumberOfHalfLifes]] + 1]], purpleList[[ Round[100*oneDecayB[isotope, 2, NumberOfHalfLifes]] + 1]], greenList[[ Round[100*oneDecayB[isotope, 3, NumberOfHalfLifes]] + 1]], }], ImageSizeMultipliers -> {0.34, 0.34}], {NumberOfHalfLifes, 0, 10}]] Here, we can see the code behind the plots. However, still, need to still generate the graphics that represent the masses behind each of the particles. The different colors represent the parent radionuclides and the daughter nuclides, with the protons and neutrons of the isotopes represented by a collection of spheres at the vertices of dodecaisocahdroncompounds in a three-dimensional volume. vc = PolyhedronData["DodecahedronIcosahedronCompound", "Vertices"]; molecule1 = {RGBColor[0, 68, 105], GraphicsComplex[#, Table[Sphere[i], {i, Length[#]}]]} &@vc; molecule2 = {RGBColor[120, 48, 0], GraphicsComplex[#, Table[Sphere[i], {i, Length[#]}]]} &@vc; molecule3 = {Hue[0.81, 0.5, 0.84], GraphicsComplex[#, Table[Sphere[i], {i, Length[#]}]]} &@vc; molecule4 = {Hue[0.28, 0.85, 0.79], GraphicsComplex[#, Table[Sphere[i], {i, Length[#]}]]} &@vc; The shapes were then placed in these boxes at random. Because I chose to analyze the amounts in term of percentages, I made a list of 100 elements for each color, ranging from graphics with isotopes of each color in increments ranging to a hundred. isotopeParent[x_] := Graphics3D[ Table[GeometricTransformation[#, transform[{0, 0, 0}]] &@ molecule1, x], Boxed -> False, PlotRange -> {-30, 30}]; isotopeChild[x_] := Graphics3D[ Table[GeometricTransformation[#, transform[{0, 0, 0}]] &@ molecule2, x], Boxed -> False, PlotRange -> {-30, 30}]; isotopePurple[x_] := Graphics3D[ Table[GeometricTransformation[#, transform[{0, 0, 0}]] &@ molecule3, x], Boxed -> False, PlotRange -> {-30, 30}]; isotopeGreen[x_] := Graphics3D[ Table[GeometricTransformation[#, transform[{0, 0, 0}]] &@ molecule4, x], Boxed -> False, PlotRange -> {-30, 30}]; Now, the plot generator will output the images correlating to the percentage at a given half-life. Using the example from before, the diagram for a one-parent to a three-child relationship can be modeled as seen below for Bismuth-212: ![enter image description here][5] ##III. Charts## ###Relation Graphs### A relation graph can be used to represent the decay chains. This is because the Wolfram language has the ability to automatically construct charts that have vector connections with the parent isotopes and their respective child isotopes. Writing functions that utilize the Wolfram IsotopeData function helped to write functions that could be used by each node to identify the children isotopes. DaughterNuclides[s_List] := DeleteCases[ Union[Apply[Join, Map[IsotopeData[#, "DaughterNuclides"] &, DeleteCases[s, _Missing]]]], _Missing]; ReachableNuclides[s_List] := FixedPoint[Union[Join[#, DaughterNuclides[#]]] &, s]; DaughterNuclidesQ[s1_, s2_] := (s1 =!= s2 && MemberQ[DaughterNuclides[{s1}], s2]); children[x_Entity] := ReachableNuclides[{x}] getSymbol[isotope_] := IsotopeData[isotope, "Symbol"] decaySymbols[isotope_] := getSymbol[#] & /@ children[isotope] Next, I created an autogenerating vertex label system which takes an isotope makes connections between different nodes. makeVertexLabels[isotope_] := Table[children[isotope][[i]] -> decaySymbols[isotope][[i]], {i, 1, Length@decaySymbols[isotope]}] By combing these methods, the below function makes the decay chart with any given isotope in the Wolfram database. RelationGraph[DaughterNuclidesQ, children[isotope], Sequence[VertexLabels -> makeVertexLabels[isotope], PlotRangePadding -> 0.65, ImageSize -> 300, PlotTheme -> "Scientific"]] ###Information Chart### The information chart works along with the relation tree in the same overall function. It is a table that uses the IsotopeData function to post decay statistics and type for all child isotopes of the parent molecule. makeChart[isotope_] := Text[Grid[ Prepend[Table[ IsotopeData[#, prop], {prop, {"Symbol", "HalfLife", "BindingEnergy", "DecayModes"}}] & /@ children[isotope], {"symbol", "half-life", "binding energy", "decay modes"}], Frame -> All, Background -> {None, {{{LightBlue, White}}, {1 -> LightYellow}}}]] The below function puts everything together and generates an output. We can use the Uranium-232 as an example isotope entity. makeDecayGraphSample[isotope_] := Row[{RelationGraph[DaughterNuclidesQ, children[isotope], Sequence[VertexLabels -> makeVertexLabels[isotope], PlotRangePadding -> 0.65, ImageSize -> 300, PlotTheme -> "Scientific"]], makeChart[isotope]}] ![enter image description here][6] ##IV. Button Integration## The buttons at the place of the nodes serve to integrate part two with the rest of the program. I made a function that looks at each isotope and then decides what type of chart it should be used it depending on the number of children isotopes. graphf[isotope_] := If[Length@DeleteMissing@IsotopeData[isotope, "DaughterNuclides"] == 1, decayChart4[isotope], If[Length@DeleteMissing@IsotopeData[isotope, "DaughterNuclides"] == 2, decayChart2[isotope], If[Length@DeleteMissing@IsotopeData[isotope, "DaughterNuclides"] == 3, decayChart3[isotope], Return[""]]]] vertexGenerate[{xc_, yc_}, vertex_, {w_, h_}] := Inset[ Button[ vertex, currentChart = graphf[vertex]], {xc, yc}]; Using this, I modified the original relationship graph function to depict the updated *vertexGenerate* function to combine all the different sections of the code in one function. makeDecayGraph[isotope_] := Module[{graph, currentChart = {}}, vertexGenerate[{xc_, yc_}, vertex_, {w_, h_}] := Inset[ Button[ vertex, currentChart = graphf[vertex]], {xc, yc}]; graph = RelationGraph[DaughterNuclidesQ, children[isotope], Sequence[VertexLabels -> None, PlotRangePadding -> 0.65, ImageSize -> 800, PlotTheme -> "Scientific", VertexShapeFunction -> vertexGenerate]]; Column[{graph, Dynamic[currentChart]}] ] This resulted in a final output that, for demonstration, inputs the Uranium-232 isotope (with the Bismuth-212 button pressed). ![enter image description here][7] ##Future Extensions## Some possible extensions that this program could have is making n-chain reaction functions. The program currently doesn’t fully exploit the differential recursive functions outlined in the Bateman model. This way, for any potential given chain process, all the successive decays would be calculated. The graphical representations of the decay shown with the molecules’ behavior over a certain number of half-lives could be updated to showcase a variety of more animations that help explain the behavior of the decay pattern. ###Github### ---------- [https://github.com/srangan24/WSS-Template][8] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=bismut212.gif&userId=1725131 [2]: https://reference.wolfram.com/language/ref/IsotopeData.html [3]: http://www.wolfram.com/language/fast-introduction-for-programmers/en/natural-language-input/ [4]: https://web-docs.gsi.de/~wolle/TELEKOLLEG/KERN/LECTURE/Fraser/L4.pdf [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-11at10.49.30AM.png&userId=1725131 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-11at7.43.48PM.png&userId=1725131 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-07-11at11.54.22AM.png&userId=1725131 [8]: https://github.com/srangan24/WSS-Template Srinath Rangan 2019-07-12T01:53:33Z https://community.wolfram.com/groups/-/m/t/828033 You may remember that I've already posted [packages for crystal structure plots][1]. I just wanted to dump a piece of code here that's based on these packages and will let you plot crystal structures from [VASP][2] input/output files on a webpage... in case anyone else is using VASP. For anyone who wants to try the app but doesn't have a VASP file handy, here's a sample you can copy and paste into a plain text file: Rutile 1.00000000000000 4.5937300000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 4.5937300000000000 0.0000000000000000 0.0000000000000000 0.0000000000000000 2.9581200000000000 Ti O 2 4 Direct 0.0000000000000000 0.0000000000000000 0.0000000000000000 0.5000000000000000 0.5000000000000000 0.5000000000000000 0.3053000000000000 0.3053000000000000 0.0000000000000000 0.6947000000000000 0.6947000000000000 0.0000000000000000 0.8053000000000000 0.1947000000000000 0.5000000000000000 0.1947000000000000 0.8053000000000000 0.5000000000000000 The actual code is below the image. Have fun! ![enter image description here][3] CloudDeploy[FormFunction[{ {{"file", "Upload a VASP POSCAR or CONTCAR file here:"} -> <| "Interpreter" -> "UploadedFile"|>}, { {"sysdim", "Periodic repetitions"} -> <| "Interpreter" -> Restricted[ DelimitedSequence["Integer", " " | "," | ";" | "/" | "x" | "X"], 3], "Input" -> "1x1x1"|>, {"retractq", "Retract atoms to cell?"} -> <| "Interpreter" -> "Boolean", "Input" -> False|>, {"addq", "Add periodic duplicates of atoms?"} -> <| "Interpreter" -> "Boolean", "Input" -> False|>, {"atomrad", "Atom radius"} -> <|"Interpreter" -> "ComputedReal", "Input" -> 0.4|>, {"bonddist", "Maximum bond length"} -> <| "Interpreter" -> "ComputedReal", "Input" -> 2.1|>, {"monobond", "Want to pick your own bond color?"} -> <| "Interpreter" -> "Boolean", "Input" -> False|>, {"bondcol", "Bond color"} -> <|"Interpreter" -> "ComputedColor", "Input" -> GrayLevel[.8]|>, {"bondrad", "Bond radius"} -> <|"Interpreter" -> "ComputedReal", "Input" -> 0.1|>, {"linecol", "Cell outline color"} -> <| "Interpreter" -> "ComputedColor", "Input" -> Black|>, {"linerad", "Cell outline radius"} -> <| "Interpreter" -> "ComputedReal", "Input" -> 0.02|> }}, Module[{file, sysdim, retractq, addq, atomrad, bonddist, monobond, bondcol, bondrad, linecol, linerad, data, speciesQ, atomcol, chemoffset, chgoffset, lattscale, lattvec, coord, conf, coordP, confP, new, tubearrow, lines, atoms, tuples, bonds}, file = #file; sysdim = #sysdim; retractq = #retractq; addq = #addq; atomrad = #atomrad; bonddist = #bonddist; monobond = #monobond; bondcol = #bondcol; bondrad = #bondrad; linecol = #linecol; linerad = #linerad; (*import: *) data = Import[file, "Table"]; (*offset if chemical species are given: *) speciesQ = MatchQ[data[[6]], {_String ..}]; atomcol[type_] := If[speciesQ, ColorData["Atoms", data[[6, type]]], ColorData[97, type]]; chemoffset = If[speciesQ, 1, 0]; (*offset for missing "Selective Dynamics" line as is common in \ CHG/CHGCAR: *) chgoffset = If[TrueQ[Length[data[[chemoffset + 8]]] > 0] && MatchQ[data[[chemoffset + 8, 1]], _?NumericQ], -1, 0]; (*lattice vectors and atoms: *) lattvec = data[[3 ;; 5]]; lattscale = data[[2]]; If[TrueQ[Length[lattscale] == 1], lattscale = lattscale[[1]]]; If[TrueQ[Sign[lattscale] == -1], lattscale = (-lattscale/Det[lattvec])^(1/3)]; lattvec = If[TrueQ[Length[lattscale] == 3], N[lattscale[[#]]*lattvec[[#]]] & /@ Range[3], N[lattscale*lattvec]]; conf = Flatten[Join[ ConstantArray[#, data[[chemoffset + 6, #]]] & /@ Range[Length[data[[chemoffset + 6]]]]]]; coord = N[data[[chemoffset + chgoffset + 9 ;; (chemoffset + chgoffset + 8 + Total[data[[chemoffset + 6]]]), 1 ;; 3]]]; (*reprojection for cartesian coordinates: *) If[TrueQ[Length[data[[chemoffset + chgoffset + 8]]] > 0] && StringMatchQ[ToString[data[[chemoffset + chgoffset + 8, 1]]], "c*" | "k*", IgnoreCase -> True], If[TrueQ[Length[lattscale] == 3], coord = #*lattscale & /@ coord, coord = coord*lattscale]; coord = coord.Inverse[lattvec]]; {coordP, confP} = {coord, conf}; (*retraction, moving all atoms back into the cell: *) If[retractq, With[{retracttol = 10^-4}, coordP = Partition[ If[# > (1 - retracttol), # - 1, #] & /@ Flatten[# - Floor[#] & /@ coordP], 3]; new = DeleteDuplicates[Transpose[{coordP, confP}], (Norm[ Round[#1[[1]], retracttol] - Round[#2[[1]], retracttol] - Floor[Round[#1[[1]], retracttol]] + Floor[Round[#2[[1]], retracttol]]] < retracttol) && (#1[[2]] == #2[[2]]) &]; {coordP, confP} = Transpose[new]]]; (*periodic repetition: *) coordP = Flatten[Table[(# + {a, b, c}) & /@ coordP, {a, 0, sysdim[[1]] - 1}, {b, 0, sysdim[[2]] - 1}, {c, 0, sysdim[[3]] - 1}], 3]; confP = Flatten[ConstantArray[confP, Times @@ sysdim]]; (*add peridic duplicates if desired: *) If[TrueQ[addq], new = Transpose[{coordP, confP}]; new = Join[new, # + {{sysdim[[1]], 0, 0}, 0} & /@ Select[new, Abs[#[[1, 1]]] < 0.01 &], # + {{-sysdim[[1]], 0, 0}, 0} & /@ Select[new, Abs[#[[1, 1]]] > 0.99*sysdim[[1]] &]]; new = Join[new, # + {{0, sysdim[[2]], 0}, 0} & /@ Select[new, Abs[#[[1, 2]]] < 0.01 &], # + {{0, -sysdim[[2]], 0}, 0} & /@ Select[new, Abs[#[[1, 2]]] > 0.99*sysdim[[2]] &]]; new = Join[new, # + {{0, 0, sysdim[[3]]}, 0} & /@ Select[new, Abs[#[[1, 3]]] < 0.01 &], # + {{0, 0, -sysdim[[3]]}, 0} & /@ Select[new, Abs[#[[1, 3]]] > 0.99*sysdim[[3]] &]]; {coordP, confP} = Transpose[new]; ]; (*cell lines: *) tubearrow[{tail_, head_}] := With[{scale = .5*Sqrt[Mean[Norm /@ lattvec]*linerad]}, Tube[{tail, head - 4*scale*Normalize[head - tail], head - 4*scale*Normalize[head - tail], head}, {linerad, linerad, scale, 0}]]; lines = {linecol, Tube[#.lattvec, linerad] & /@ { {{0, 0, #}, {1, 0, #}, {1, 1, #}, {0, 1, #}, {0, 0, #}} & /@ {0, 1}, {{0, 0, #} & /@ {0, 1}, {1, 0, #} & /@ {0, 1}, {1, 1, #} & /@ {0, 1}, {0, 1, #} & /@ {0, 1}} }, tubearrow[{{0, 0, 0}, #}] & /@ lattvec}; (*atoms: *) atoms = Tooltip[{atomcol[confP[[#]]], Sphere[coordP[[#]].lattvec, atomrad]}, #] & /@ Range[Length[confP]]; (*bonds: *) tuples = Select[Subsets[Range[Length[confP]], {2}], Norm[(coordP[[#]].lattvec)[[1]] - (coordP[[#]].lattvec)[[2]]] < bonddist &]; bonds = If[TrueQ[tuples == {}], {}, If[monobond, {bondcol, Tube[coordP[[#]].lattvec, bondrad]}, Table[{atomcol[confP[[#[[ii]]]]], Tube[{coordP[[#[[ii]]]].lattvec, Total[coordP[[#]].lattvec]*.5}, bondrad]}, {ii, 1, 2}] ] & /@ tuples]; (*return the plot: *) Graphics3D[{lines, bonds, atoms}, ImageSize -> Large, BaseStyle -> {Specularity[Gray, 100]}, Boxed -> False, SphericalRegion -> True, Lighting -> "Neutral"] ] &, "PNG", AppearanceRules -> <| "Title" -> "Crystal Structure Viewer for VASP"|>], Permissions -> "Public"] [at0]: http://community.wolfram.com/web/chrishaydock137 [1]: http://community.wolfram.com/groups/-/m/t/787142 [2]: http://vasp.at/ [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sdf4562y4thrwbdfva.gif&userId=11733 Bianca Eifert 2016-03-23T08:59:33Z https://community.wolfram.com/groups/-/m/t/1052348 #Introduction Perhaps there are already Mma-Procedures to calculate NMR-spectra, but I did not do a literature research. I post a notebook to calculate NMR-Spectra of simple spin I = 1/2 systems. The notebook comes in two parts. Part one uses a spin-product function approach, where the spin-product function a, a ,...b is used as e.g. phi [ 1, 1, ,...., -1 ]. The Hamiltonian is constructed according to different mT-values and the spectrum is calculated. Part two uses the "brute force" approach where all operators are mapped unto matrices (Kronecker-Products of individual matrix-operators) in the total spin-space. So here products of operators are matrix-products (in part 1 they are functions of functions) .Having the Hamiltonian and its Eigensystem the spectrum is calculated. Note that the number of lines of even small systems are growing rapidly. So it may well be that there is not enough memory to cope with a system you would like to consider. If you omit giving numbers to frequencies and coupling-constants you may get pure theoretical results. That works fine for two spins, but already for three spins - although here you will still get the Hamiltonian - very large outputs are generated, especially in the Eigensystems, So you should avoid that. It seems to be not too complicated to modify the approach in part two to include spins with I > 1/2. And certainly it is well possible to modify the code as to get an iterative procedure to fit data to spectra. I am aware that there are "professional" systems to do all this, but I just wanted to see how it could be done in Mathematica. #Part 1# Number of Spins nsp = 3; Input of Parameters freqs = {372.2, 364.4, 342, 6.083, 5.8}; JJ = ( { {0, .91, 17.9, 1, 1, 1}, {0, 0, 11.75, 1, 1, 1}, {0, 0, 0, 1, 1, 1}, {0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0} } ); Do[\[Nu][i] = freqs[[i]], {i, 1, nsp}]; Do[J[i, k] = JJ[[i, k]], {i, 1, nsp - 1}, {k, i + 1, nsp}]; Basevectors base = Apply[\[CurlyPhi], IntegerDigits[#, 2, nsp] + 1 & /@ Table[j, {j, 0, 2^nsp - 1}] /. 2 -> -1, {1}] ![enter image description here][1] mT - Values mT = Table[-nsp/2 + j, {j, 0, nsp}] ![enter image description here][2] Number of lines in the spectrum ( = Sum[Binomial[nsp, k] Binomial[nsp, k + 1], {k, 0, nsp - 1}], because only transitions between states of different mT's give lines on non-zero intensity ) numberoflines = Binomial[2 nsp, nsp - 1] > 15 Rule for scalar products rscp = {\[CurlyPhi][x__]^2 -> 1, \[CurlyPhi][x__] \[CurlyPhi][y__] -> 0} ![enter image description here][3] SpinOperators cs[a_, j_] := Module[{t}, t = a; b = t[[j]]; t[[j]] = -b; t] Ix[v_, j_] := v/2 /. \[CurlyPhi][x___] :> \[CurlyPhi] @@ cs[{x}, j] Iy[v_, j_] := I v/2 /. \[CurlyPhi][x___] :> {x}[[j]] \[CurlyPhi] @@ cs[{x}, j] Iz[v_, j_] := v/2 /. \[CurlyPhi][x___] :> {x}[[j]] \[CurlyPhi][x] Example {Ix[\[CurlyPhi][4], 1], Ix[\[CurlyPhi][-1], 1], Iy[\[CurlyPhi][5], 1], Iy[\[CurlyPhi][-1], 1], Iz[\[CurlyPhi][6], 1], Iz[\[CurlyPhi][-1], 1]} ![enter image description here][7] Hamiltonian - Matrixelements Subscript[H, i,j] for (sub-)base b HH[b_, i_, j_] := (Sum[\[Nu][m] b[[j]] Iz[b[[i]], m], {m, 1, nsp}] + Sum[J[m, k] b[[ j]] (Ix[Ix[b[[i]], k], m] + Iy[Iy[b[[i]], k], m] + Iz[Iz[b[[i]], k], m]), {m, 1, nsp - 1}, {k, m + 1, nsp}] // Expand) /. rscp Example HH[base, 1, 1] > 546.94 HH[base, 1, 2] > 0 HH[base, 3, 5] > 0.455 Spinfunctions according to mT - value wf = Function[x, Select[base, Total[List @@ #] == 2 x &]] /@ mT ![enter image description here][8] Hamilton - Submatrices HSM[j_] := (nn = Length[wf[[j]]]; Table[HH[wf[[j]], m, n], {m, 1, nn}, {n, 1, nn}]) HSM[2]; % // MatrixForm ![enter image description here][9] HSM[2] /. {\[Nu][10] -> -\[Nu], \[Nu][11] -> 0, \[Nu][12] -> \[Nu], J[1, 2] -> J, J[1, 3] -> J, J[2, 3] -> J}; % // MatrixForm ![enter image description here][13] Get Eigenstates \[Congruent] all sets { freq, eigenvector } for different spin-states (mT values) frevec[n_] := Module[{es}, es = Eigensystem[HSM[n]]; {#[[1]], #[[2]].wf[[n]]} & /@ Transpose[es] ] eigenstates = frevec /@ Range[nsp + 1] ![enter image description here][14] Operator for calculating relative intensities IOP[x_] := Sum[Ix[x, n], {n, 1, nsp}] Calculating a spectral line = difference of eigenvalues and intensity line[a_, b_] := Module[{}, freq = Abs[a[[1]] - b[[1]]]; m2 = (Expand[a[[2]] IOP[b[[2]]]] /. rscp)^2; {freq, Sqrt[m2]}] Lorentzfunction LF[x_, x0_, a_, h_] := Module[{}, If[h == 0, h = 1]; 1/Sqrt[Pi] (a h/2)/(h^2/4 + Pi (x - x0)^2)] Calculating the spectrum spec = Table[0, {numberoflines}]; nL = 0; Do[ lk = Length[eigenstates[[i]]]; lk1 = Length[eigenstates[[i + 1]]]; Do[ Do[ nL = nL + 1; spec[[nL]] = line[eigenstates[[i, m]], eigenstates[[i + 1, n ]]], {n, 1, lk1} ], {m, 1, lk} ], {i, 1, Length[eigenstates] - 1}]; normalizer = Max[Transpose[spec][[2]]]; bb = {.95 Min[Transpose[spec][[1]]], 1.05 Max[Transpose[spec][[1]]]}; spec = {#[[1]], #[[2]]/normalizer} & /@ spec; spec pl1 = ListPlot[spec, Filling -> Axis] ![enter image description here][15] Show the spectrum with lines pl2 = Plot[ Plus @@ (LF[x, #[[1]], #[[2]], 1.5] & /@ spec), {x, bb[[1]], bb[[2]]}, PlotRange -> All, AxesOrigin -> {320, 0}] ![enter image description here][16] For some physical reason spectra are recorded so that frequencies grow from right to left. So the plot is reversed and compared to the experimental spectrum ( see http://www.users.csbsju.edu/~frioux/nmr/Speclab4.htm ) which is given below the plot. pl3 = Plot[ Plus @@ (LF[-x, #[[1]], #[[2]], 1.5] & /@ spec), {x, -bb[[2]], -bb[[ 1]]}, PlotRange -> All] ![enter image description here][17] #Part 2# nsp = 3; Input of Parameters freqs = {372.2, 364.4, 342, 6.083, 5.8}; JJ = ( { {0, .91, 17.9, 1, 1, 1}, {0, 0, 11.75, 1, 1, 1}, {0, 0, 0, 1, 1, 1}, {0, 0, 0, 0, 1, 1}, {0, 0, 0, 0, 0, 1}, {0, 0, 0, 0, 0, 0} } ); Do[\[Nu][i] = freqs[[i]], {i, 1, nsp}]; Do[J[i, k] = JJ[[i, k]], {i, 1, nsp - 1}, {k, i + 1, nsp}]; number of lines to be expected and dimension ot (total) spin - space (at least for spin 1/2 ) numberoflines = Binomial[2 nsp, nsp - 1] dimspsp = 2^nsp > 15 > 8 spin operators for spin I = 1/2 ix = ( { {0, 1}, {1, 0} } )/2; iy = ( { {0, -I}, {I, 0} } )/2; iz = ( {{1, 0}, {0, -1} } )/2; this function constructs the spin operator of particle j as matrix in the spin space of n particles Op[op_, n_, j_] := Module[{x, m}, x = Join[Table[{{1, 0}, {0, 1}}, {j - 1}], {op}, Table[{{1, 0}, {0, 1}}, {n - j}]]; m = SparseArray[KroneckerProduct[Sequence @@ x]] ] oIx[j_] := Op[ix, nsp, j] oIy[j_] := Op[iy, nsp, j] oIz[j_] := Op[iz, nsp, j] Hamiltonian HH = \!\( \*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(nsp\)]\(\[Nu][i] oIz[ i]\)\) + \!\( \*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(nsp - 1\)]\( \*UnderoverscriptBox[\(\[Sum]\), \(j = i + 1\), \(nsp\)]J[i, j] \((oIx[i] . oIx[j] + oIy[i] . oIy[j] + oIz[i] . oIz[j])\)\)\) > SparseArray[SequenceForm["<", 32, ">"], {8, 8}] Eigensystem for the Hamilton - Operator est = Transpose[Eigensystem[HH]] ![enter image description here][18] Intensity operator IOP1 = \!\( \*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(nsp\)]\(oIx[j]\)\) > SparseArray[SequenceForm["<", 24, ">"], {8, 8}] line1[a_, b_] := Module[{}, freq = Abs[a[[1]] - b[[1]]]; m2 = (a[[2]].IOP1.b[[2]])^2; {freq, Sqrt[m2]}] Calculate spectrum, show it and display result from part 1 spec1 = Table[0, {Binomial[dimspsp, 2]}]; nL = 0; Do[ Do[ nL = nL + 1; spec1[[nL]] = line1[est[[u]], est[[v]]], {u, v + 1, dimspsp} ], {v, 1, dimspsp - 1} ] spec1 = Select[spec1, #[[2]] > 0. &]; normalizer = Max[Transpose[spec1][[2]]]; bb = {.95 Min[Transpose[spec][[1]]], 1.05 Max[Transpose[spec][[1]]]}; spec1 = {#[[1]], #[[2]]/normalizer} & /@ spec1; spec1 ListPlot[spec1, Filling -> Axis, FillingStyle -> Directive[Red, Thick]] Show[pl1] ![enter image description here][19] Plot the spectrum and compare with the result of the 1 st part pl4 = Plot[ Plus @@ (LF[x, #[[1]], #[[2]], 1.5] & /@ spec1), {x, bb[[1]], bb[[2]]}, PlotRange -> All, PlotStyle -> Red] Show[pl2] ![enter image description here][20] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.23.20.png&userId=95400 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.25.36.png&userId=95400 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.28.10.png&userId=95400 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.32.12.png&userId=95400 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.33.44.png&userId=95400 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.21.45.png&userId=95400 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.23.20.png&userId=95400 [12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.25.36.png&userId=95400 [13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.34.56.png&userId=95400 [14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.37.59.png&userId=95400 [15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.41.13.png&userId=95400 [16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.42.24.png&userId=95400 [17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.43.26.png&userId=95400 [18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.50.48.png&userId=95400 [19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.53.45.png&userId=95400 [20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-04-25at16.55.25.png&userId=95400 Hans Dolhaine 2017-04-04T08:36:27Z https://community.wolfram.com/groups/-/m/t/830644 *Note: This post is originally from [my website](https://bobthechemist.com/2016/03/a-vernier-golink-package-for-mathematica/), but I thought it might be of interest to some WC readers as well.* The [Go! Link](http://www.vernier.com/products/interfaces/go-link/) from Vernier Software & Technology (Vernier), is a USB adapter for their proprietary sensors which also provides some basic features such as a buffer, sensor auto-identification and raw voltage reading conversion. ![enter image description here][1] Vernier provides a [software development kit](http://www.vernier.com/downloads/software-development-kits/go-sdk/) which allows programmers to use Go! devices in their own systems. I often think about how one can build a flexible sensor system using Vernier's products and based on the inexpensive Raspberry Pi computer and the powerful data analysis and visualization tools of *Mathematica*. This project isn't new, and my [earlier attempts](https://www.raspberrypi.org/blog/vernier-sensors-and-the-wolfram-language/) were highlighted on the Raspberry Pi blog and I [recently announced](https://bobthechemist.com/2016/03/goiolink-release-candidate-1/) a previous version of this software package. What I'm presenting now is a more user-friendly system that makes data collection easy through the [device driver framework](http://reference.wolfram.com/language/tutorial/DevelopingDeviceDrivers.html) incorporated into *Mathematica*. ##Getting Started In addition to the [Go! Link](http://www.vernier.com/products/interfaces/go-link/) adapter, you'll need at least one of the 66 sensors that are compatible with the adapter. I do most of my Raspberry Pi work on a v2 unit, so I know it works on this version.  The graphical interface for *Mathematica* is very clunky on RPi's earlier than a v2, but sensor reading can be done with the command line interface (via *wolfram*) using this package as well. The source code can be downloaded from my [project page on Github](https://github.com/bobthechemist/goiolink) and since this post is based on version 1.1 of the software, it is probably best to download the relevant files directly from the [release page](https://github.com/bobthechemist/goiolink/releases/tag/v1.1.0) for this version. Installation instructions are provided there, so I won't repeat it here. ##Basic Operation There are two basic methods for accessing sensor information: one is through the device *framework* and the other is through the device *properties*. I assume most users will jump back and forth between these two methods. The framework consists of the `Device*` functions in *Mathematica*: `DeviceOpen`, `DeviceRead`, `DeviceReadBuffer`, and `DeviceConfigure`. (There are a few other `Device*` commands, but I don't use them in this package.) Once the software has been installed, starting a sensor session is as easy as starting *Mathematica* and in a new notebook running: <<GoIO` d = DeviceOpen["GoIO"] ![enter image description here][2] Once a connection is established, `DeviceRead["GoIO"]` can be used to read an average of all the sensor readings currently in the buffer or `DeviceReadBuffer["GoIO"]` will print a list containing all values currently in the buffer. The default measurement period is 0.040 seconds and the buffer can store 1000 values. If you want to change the measurement period, it can be done with `DeviceConfigure["GoIO", {"MeasurementPeriod" -> 1}]`. Presently, the software does not automatically detect if the user changes the sensor, and a call to `DeviceConfigure["GoIO"]` is necessary when the sensor is switched. The device has several properties, which can be found using the commands `d["Properties"]` and `d["NativeProperties"]`. (Note. `d` is the symbol used in the `DeviceOpen` command mentioned above, and could be something different if you desire.) Properties such as `d["Read"]` and `d["ReadAll"]` do the same as the framework functions, but with properties, it is possible to figure out the name of the sensor (`d["Name"]`) and what units the sensor readings are in (`d["Units"]`). The "NativeProperties" (of which, there are one at present) are properties that can be changed, so the user can also change the "MeasurementPeriod" with `d["MeasurementPeriod"] = 1`. Finally, there is a simple interface that allows for real-time charting of the sensor data. Running `goioRTInterface[d]` yields: ![enter image description here][3] ##Data collection A major feature of v1.1 is the ability to conduct an experiment and easily store the sensor information. Running an experiment involves two steps. The first is to create an experiment with `tsk = goioExperiment[<spp>,<np>,"Title"-> <title>,"Comment"-> <comment>]`, where *spp* is the seconds per point and *np* is the number of points that will be acquired. Both "Title" and "Comment" are optional, but "Title" should be filled in as it is used in other features of the package. This function returns what is called a `ScheduledTaskObject` which we have to start when the experiment is supposed to begin. Starting a task is done with `StartScheduledTask[tsk]` and a message (a terse 'Done') will be printed when the experiment is over. Once completed (well, not technically true, since you can run these commands during the experiment), a list of all experiments run during this session can be obtained with `goioDataTable`: ![enter image description here][4] The experiment number is used as an identifier; for example, to plot the first set of data, one would use `goioPlot[1]`. ![enter image description here][5] This function uses all of the options of `DateListPlot`, which allows for a fair amount of customization if the end user desires. For further customization or analysis, the sensor data can be extracted as a list with `goioDataList[1]`, which returns a list of {x,y} pairs where the time is now in seconds as opposed to dates. Finally, the user can store the data by saving the packages session symbol with a command `Save["<filename>", $GoIOSessionData]`. All of the experiments are stored in that one symbol and can be restored (via `Get`) at a later date. ##Conclusion Version 1.1 is reasonably stable and in my opinion provides end users with a functional data acquisition system using Vernier sensors, a Raspberry Pi and *Mathematica*. My intent is to add features and functionality, along with error-checking and documentation, in subsequent v1.x releases. My goal is to have a solid foundation in place so that v2.0 will come with suitable functionality and documentation that can be used to create laboratory experiments in the high school and undergraduate teaching environments. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=go-link_home.896.279.jpg&userId=11733 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=starting_goio.PNG&userId=61884 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=goiointerface.gif&userId=61884 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=goiotable.PNG&userId=61884 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=goioplot.PNG&userId=61884 BoB LeSuer 2016-03-27T19:47:49Z https://community.wolfram.com/groups/-/m/t/1390630 A couple of weeks ago I experimented with automating inputs and visualizing results from the [CP2K][1] quantum chemistry software via Mathematica. My goal was to visualize the formation of a water molecule. I knew just enough about computational chemistry to stumble my way to making an animation that sort of looked like I wanted, although I'm sure it's horribly inaccurate. Are there any other people in the community who have worked on projects like this? [Video][3] ![enter image description here][2] [1]: https://www.cp2k.org/ [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=temp.jpg&userId=64737 [3]: https://www.youtube.com/watch?v=foG5LgFYb2o Michael Hale 2018-07-23T22:58:36Z https://community.wolfram.com/groups/-/m/t/1874816 *MODERATOR NOTE: coronavirus resources & updates:* https://wolfr.am/coronavirus ---------- ![enter image description here][1] I want to show a few ways in which Mathematica can be used to do various types of analysis on gene sequences. The application will of course be to the recent novel coronavirus 2019-nCoV. But the methods are generally applicable. &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Fold_Image.png&userId=20103 [2]: https://www.wolframcloud.com/obj/389949f6-7b32-43d3-a094-1a10edf61ef4 Daniel Lichtblau 2020-02-07T23:49:44Z https://community.wolfram.com/groups/-/m/t/963198 There was a [recent question][1] on the stack exchange was about how to find dihedral angles from an XYZ file, which contains atom types and 3D coordinates for a molecule or group of molecules. A dihedral angle is the angle between two intersecting planes. In chemistry, we define the dihedral among four atoms as the angle between the plane containing the first three atoms and the last three atoms. I got to wishing that I could do it interactively like you can in other chemistry-specific software. This is my attempt at such a tool, code below. You can query for bond lengths, bond angles, and dihedral angles. You could look at the angles found in our 3D model of ibuprofen, ![enter image description here][2] or compare the bond angles in five-memebered and six-membered rings in buckminsterfullerene, ![enter image description here][3] Here is the code to generate these plots. We use `EventHandler` along with `MousePosition["Graphics3DBoxIntercepts"]` to correlate mouse-clicks with atom selection, borrowing from [this post](http://mathematica.stackexchange.com/a/28004/9490) 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 ] ] ]; [1]: http://mathematica.stackexchange.com/q/130929/9490 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5686mol1.gif&userId=130877 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2300mol2.gif&userId=130877 Jason Biggs 2016-11-14T23:43:52Z