https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions tagged with Chemistry with no replies sorted by most likes. https://community.wolfram.com/groups/-/m/t/3638297 ![Simulating Plastic Polymer Degradation][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=7682image.png&userId=911151 [2]: https://www.wolframcloud.com/obj/cde0818d-a5d1-40b6-88d8-a26734298c8f Wolfram Education Programs 2026-02-11T16:24:46Z https://community.wolfram.com/groups/-/m/t/3094670 ![machine learning][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4889image.jpeg&userId=911151 [2]: https://www.wolframcloud.com/obj/29e809c2-c42c-4491-a69e-c1ca763ab6a1 Wolfram Education Programs 2024-01-02T17:07:26Z https://community.wolfram.com/groups/-/m/t/2818249 ![molecule][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=molecule.jpeg&userId=911151 [2]: https://www.wolframcloud.com/obj/edfbb4cb-2dca-4916-aa23-29cf3c6db1cf Wolfram Education Programs 2023-01-27T17:59:09Z https://community.wolfram.com/groups/-/m/t/3379964 ![Established and novel methods for protein analysis in Wolfram Language][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=proj-3-cover.jpeg&userId=911151 [2]: https://www.wolframcloud.com/obj/3d49b85d-7bab-4306-b2b4-2097e5314f66 Wolfram Education Programs 2025-02-04T15:26:07Z https://community.wolfram.com/groups/-/m/t/1135393 Predicting the properties of a chemical can be difficult and costly. Experiments are time consuming and expensive, and quantum mechanical simulations require a lot of computing time. It would be highly advantageous to predict properties from the structure alone. This method is known as QSPR or QSAR, and it is widely used in the pharmaceutical industry to predict properties of drugs. Here I will present a machine learning approach to QSAR. ChemicalData[] contains roughly 44,000 chemicals with a large amount of associated data. Given the sophisticated machine learning and neural network functions in Mathematica, it should be plausible to predict some of the data based on the structure. I selected chemicals containing nothing except Carbon, Hydrogen, Oxygen, and Nitrogen to get a simple subset of organic molecules. I removed compounds with insufficient data and compounds with non-standard isotopes. This created a subset of about 5500 chemicals. The properties predicted are melting point, boiling point, heat of vaporization, heat of fusion, and heat of combustion. The code used here can be found at GitHub: [https://github.com/MarcThomson/WSS2017_Project][1] # Downloading Data First, define the properties to get from the database. molecularProperties = {"SMILES", "BondCounts", "VaporizationHeat", "CombustionHeat", "FusionHeat", "FormalCharges", "NetCharge", "PartitionCoefficient", "TopologicalPolarSurfaceArea", "NonStandardIsotopeNumbers", "AtomPositions", "VertexTypes", "BoilingPoint", "MeltingPoint", "MolarMass", "AdjacencyMatrix", "RotatableBondCount", "HBondAcceptorCount", "HBondDonorCount", "BlackStructureDiagram", "Name"}; Once this is done, the data can be downloaded and formatted into an association of associations. The format is name->{property->value} totalSetRaw = RandomSample[ChemicalData[], molecularProperties]; // Timing propertiesExceptName = molecularProperties[[1 ;; -2]]; names = totalSetRaw[[;; , -1]]; totalSetBase = Association[Map[#1 -> propertiesExceptName &, names]]; totalSet = Association[ Table[names[[i]] -> Association[ Thread[totalSetBase[[names[[i]]]] -> totalSetRaw[[i, ;; -2]]]], {i, 1, Length[totalSetRaw]}]]; Finally, the set is filtered to make sure the chemicals satisfy the criteria. requiredProperties[A_] := And[Not[MissingQ[A["SMILES"]]], StringQ[A["SMILES"]], Not[MissingQ[A["AdjacencyMatrix"]]], ArrayQ[A["AdjacencyMatrix"]], Total[Total[A["AdjacencyMatrix"]]] > 0, Not[MissingQ[A["BoilingPoint"]]], QuantityQ[A["BoilingPoint"]], Not[MissingQ[A["MolarMass"]]], QuantityQ[A["MolarMass"]], Not[MissingQ[A["MeltingPoint"]]], QuantityQ[A["MeltingPoint"]], Not[MissingQ[A["AtomPositions"]]], ListQ[A["AtomPositions"]], Not[MissingQ[A["HBondDonorCount"]]], IntegerQ[A["HBondDonorCount"]], Not[MissingQ[A["HBondAcceptorCount"]]], IntegerQ[A["HBondAcceptorCount"]], Not[MissingQ[A["RotatableBondCount"]]], IntegerQ[A["RotatableBondCount"]], Not[MissingQ[A["TopologicalPolarSurfaceArea"]]], QuantityQ[A["TopologicalPolarSurfaceArea"]], Not[MissingQ[A["PartitionCoefficient"]]], NumberQ[A["PartitionCoefficient"]], Not[MissingQ[A["NetCharge"]]], NumberQ[A["NetCharge"]], Not[MissingQ[A["FormalCharges"]]], ListQ[A["FormalCharges"]], Not[MissingQ[A["BondCounts"]]], Not[MissingQ[A["VertexTypes"]]], SubsetQ[{"C", "O", "H", "N"}, DeleteDuplicates[A["VertexTypes"]]], Length[DeleteDuplicates[A["VertexTypes"]]] > 1, SubsetQ[A["VertexTypes"], {"C"}], Not[MissingQ[A["NonStandardIsotopeNumbers"]]], And @@ Map[Not[IntegerQ[#]] &, A["NonStandardIsotopeNumbers"]]] totalSet = Select[totalSet, requiredProperties[#] &]; At this point, it is useful to save this set. Downloading this data can take many hours, so it is best to do it only once. #Feature Extraction The heart of this project is selecting the proper features from each molecule. ## Subgraphs The first class of features is the subgraphs, which roughly correlates to functional groups. Molecular properties are generally dependent on these functional groups. Rather than look for functional groups directly, I chose to look for unique subgraphs of the molecule. Unique subgraphs have the same non-Hydrogen atoms and all their attached Hydrogens. The required code is: graphSize = {1, 2, 3, 4}; heavyVertices[g_, vertexTypes_] := Select[VertexList[g], vertexTypes[[#]] != "H" &] lightVertices[g_, vertexTypes_] := Select[VertexList[g], vertexTypes[[#]] == "H" &] bondsBetween[i_, j_, g_] := 0 /; Equal[i, j] bondsBetween[i_, j_, g_] := With[{vList = VertexList[g]}, Length[ Cases[ EdgeList[g], vList[[i]] <-> vList[[j]] ] ] + Length[ Cases[ EdgeList[g], vList[[j]] <-> vList[[i]] ] ] ] /; Not[Equal[i, j]] subgraphList[graph_, graphSize_, vertexTypes_] := Distribute[ NeighborhoodGraph[ graph, heavyVertices[graph, vertexTypes], graphSize ], List]; hydrogenSubgraphList[graph_, graphSize_, vertexTypes_] := Map[ Subgraph[ graph, ConnectedComponents[ Subgraph[ graph, {VertexList[#], lightVertices[graph, vertexTypes]} ] ][[1]]] &, subgraphList[graph, graphSize, vertexTypes]]; canonicalAdjM[g_, vertexTypes_] := { With[{ sortedList = SortBy[ Range[Length[VertexList[g]]], -KatzCentrality[g, 0.1][[#]] &]}, Table[ bondsBetween[i, j, g], {i, sortedList}, {j, sortedList}]], With[{ sortedList = SortBy[ Range[Length[VertexList[g]]], -KatzCentrality[g, 0.1][[#]] &]}, vertexTypes[[ VertexList[g][[sortedList]] ]] ] } subAdjMList[graph_, graphSize_, vertexTypes_] := Map[ canonicalAdjM[ Subgraph[graph, #], vertexTypes] &, DeleteDuplicatesBy[ hydrogenSubgraphList[graph, graphSize, vertexTypes], { {Sort[heavyVertices[#, vertexTypes]]}, Length[lightVertices[#, vertexTypes]] } & ] ] For example, take the molecule 2-Hydroxy-4-Methoxybenzoic Acid. ![2-Hydroxy-4-Methoxybenzoic Acid][2] g = AdjacencyGraph[ ChemicalData["2Hydroxy4MethoxybenzoicAcid", "AdjacencyMatrix"]]; vl = ChemicalData["2Hydroxy4MethoxybenzoicAcid", "VertexTypes"]; Graph[AdjacencyGraph[#[[1]]], VertexLabels -> Thread[Range[Length[#[[2]]]] -> #[[2]]]] & /@ subAdjMList[g, graphSize, vl] The unique substructures are found to be: ![2-Hydroxy-4-Methoxybenzoic Acid Structures][3] Some of these structures are carboxylic acids, alcohols, and ethers, whereas many others are unnamed. These features must be turned into numeric values for the machine learning algorithm. To do so, the subgraphs are turned into adjacency matrices. Adjacency matrices are not unique, so it is necessary to permute them into canonical form. This is done by ranking the vertices by Katz centrality, which seems to only return duplicate values if the nodes are identical. I would be interested to hear other methods of creating a canonical adjacency matrix. Once the adjacency matrices are created, they are grouped with a sorted list of atom types in the subgraph, and hashed to an integer. The subgraph is associated with the atom list to make sure that the features includes the atoms in each position. These hashes are arbitrary, but frequency of occurrence can be compared between molecules. The most commonly occurring hashes are found. Each molecule's feature list is a vector of the occurrence number of the most common hashes/functional groups. ## Topological Features Topological features can give insight into the connectivity and shape of the molecular graphs. I won't go into detail as to how these features are calculated, as the formula can be found at http://www.codessa-pro.com/descriptors/ The code can be found in the GitHub link, in the preprocessing file. ## Geometric Features Geometry affects how well molecules fit together and bond together. The atom positions of a molecule can be coupled with their van der Waals radii to construct a geometric mesh. For instance: rC = 170; rO = 152; rN = 155; rH = 120; chem = Entity["Chemical", "2Hydroxy4MethoxybenzoicAcid"]; atomPos1 = chem["AtomPositions"]; radii1 = chem["VertexTypes"] /. {"C" -> rC, "H" -> rH, "N" -> rN, "O" -> rO}; rgn = RegionUnion[ Table[Ball[atomPos1[[i]], radii1[[i]]], {i, 1, Length[atomPos1]}]]; mesh = DiscretizeRegion[rgn]; meshConvex = ConvexHullMesh[MeshCoordinates[mesh]]; vMol = Volume[rgn]; saMol = Area[RegionBoundary[mesh]]; PPList = (List @@ BoundingRegion[mesh, "MinOrientedCuboid"])[[2]]; vBox = Dot[Cross[PPList[[1]], PPList[[2]]], PPList[[3]]]; saBox = 2*Total[Norm /@ (Cross @@@ Subsets[PPList, {2}])]; edgesBox = Norm /@ ((List @@ BoundingRegion[mesh, "MinOrientedCuboid"])[[2]]); vConvex = Volume[meshConvex]; saConvex = Area[RegionBoundary[meshConvex]]; This extracts the volume and surface area of the mesh, minimum bounding box, and convex hull. These three meshes can be visualized. mesh !["2-Hydroxy-4-Methoxybenzoic Acid Mesh"][4] Show[RegionPlot3D[mesh, PlotStyle -> {LightBlue}, Boxed -> False], Graphics3D[{Opacity[0.4], Red, BoundingRegion[mesh, "MinOrientedCuboid"]}]] !["2-Hydroxy-4-Methoxybenzoic Acid Box Mesh"][5] Show[RegionPlot3D[mesh, PlotStyle -> {LightBlue}, Boxed -> False], RegionPlot3D[meshConvex, PlotStyle -> {Red, Opacity[0.4]}]] !["2-Hydroxy-4-Methoxybenzoic Acid Convex Mesh"][6] ## Other Features A number of other features are also extracted. Many of these are directly in ChemicalData[], such as molar mass, hydrogen bonding sites, rotatable bonds, bond tallies, etc. A more detailed list can be found in the preprocessing file on github. # Prediction ## Melting Point Primarily, I used these features to predict Melting Point, with mixed success. I used the predict function with random forest. The comparison plot is below: ![Melting Point Comparison][7] The mean average error is 30 K, outperforms the model of Karthikeyan & Glen. It is much higher than the error found by Lazzus, who used a small number of features both structural and quantum mechanical. ## Boiling Point Boiling point should be easier than melting point because the geometry of a molecule is less important. However, the random forest model performed fairly poorly, as shown in the comparison plot. ![Boiling Point Comparison][8] The data are not distributed randomly about the y=x line, indicating that there is likely another feature influencing the results. I'm interested to hear what features users suspect might be affecting boiling point. The MAE here is an outrageous 50 K. ## Heat of Fusion Using a similar prediction algorithm as above, the following comparison plot is produced. Because few compounds have heat of fusions measured, the sample size is smaller. Much like melting point predictions, there is a clear correlation, but the model does not fully explain the observations. ![Heat of Fusion Comparison][9] The MAE is mediocre, at around 6.18 KJ/Mol. ## Heat of Vaporization As enthalpy of vaporization is closely related to boiling point (See Trouton's Rule), it would be expected that the issues with boiling point would reappear in predicting heat of vaporization. However, this is not the case . Prediction is done using a random forest model. The comparison plot is below. The data is immediately marked by a very prominent outlier, N-methyl pyrrole, with an actual heat of vaporization of 407 KJ/mol. This seems to be incorrect data, as NIST lists the heat of vaporization as 40.7 KJ/mol (see sources.) Aside from this outlier, the data is fairly well correlated, but as in the previous cases, the model is insufficient to fully predict heat of vaporization. ![Heat of Vaporization Comparison][10] The MAE is once again mediocre, at 7.224 KJ/mol. ## Heat of Combustion Finally, heat of combustion is predicted using a similar model. The comparison plot resulting from the random forest algorithm shows fairly strong prediction, with a few significant outliers. Generally however, data points are very close to the perfect prediction line. ![Heat of Combustion Comparison][11] The MAE is 557.01 KJ/mol, but the data is generally much larger in magnitude. # Conclusion Generally, it seems reasonable to approximate chemical properties from the structure alone. It would be interesting to see whether a well designed neural network is able to preform better than the random forest algorithm. To further improve the model, different features should be examined to explain the failure of prediction of boiling point. Additionally, I am curious if the model can be broadened to apply to organic molecules with other constituent elements, such as sulfur, phosphorous, and the halogens. # References - Winter, Mark. "The Periodic Table of the Elements." The Periodic Table of the Elements by WebElements. N.p., n.d. Web. 04 July 2017. <https://www.webelements.com/>. - Karthikeyan, M., Robert C. Glen, and Andreas Bender. "General Melting Point Prediction Based on a Diverse Compound Data Set and Artificial Neural Networks." Journal of Chemical Information and Modeling, vol. 45, no. 3, 2005, pp. 581-590. - "Theory: QSAR+ Descriptors." Accelrys, n.d. Web. 04 July 2017. <http://www.ifm.liu.se/compchem/msi/doc/life/cerius46/qsar/theory_descriptors.html>. - Katritzky, Alan, Mati Karelson, and Ruslan Petrukhin. "CODESSA PRO Classes of Descriptors." CODESSA PRO. N.p., n.d. Web. <http://www.codessa-pro.com/descriptors/index.htm>. - Lazzús, Juan A."Neural Network Based on Quantum Chemistry for Predicting Melting Point of Organic Compounds." Chinese Journal of Chemical Physics, vol.22, no.1, 2009, pp.19 - 26. - Rogers, David, and Mathew Hahn. "Extended-Connectivity Fingerprints." Journal of Chemical Information and Modeling, vol. 50, no. 5, 2010, pp. 742. - Libretexts. "Trouton's Rule." Chemistry LibreTexts. Libretexts, 09 Apr. 2017. Web. 05 July 2017. <https://chem.libretexts.org/Core/Physical_and_Theoretical_Chemistry/Thermodynamics/Introduction_to_Thermodynamics/Trouton's_rule>. - Other thank you's: Peter Barendse, Mark Boyer, and Bob Nachbar [1]: https://github.com/MarcThomson/WSS2017_Project [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Structure.png&userId=1122694 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Subgraphs.png&userId=1122694 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mesh.png&userId=1122694 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=meshBox.png&userId=1122694 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=meshConvex.png&userId=1122694 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=MP.png&userId=1122694 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=BP.png&userId=1122694 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=HeatFus.png&userId=1122694 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=HeatVap.png&userId=1122694 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=HeatComb.png&userId=1122694 Marc Thomson 2017-07-05T18:28:19Z https://community.wolfram.com/groups/-/m/t/908722 ## Abstract ## Everyone needs to take care of their health and the most important thing is to be careful what you eat.You can find many interesting recipes and cook anything you want, but for health it is important to know what kind of influence it can have on you. In other words you need some nutrition information about meals.The goal of this project is to create a program which will give users such kind of information.You can import ingredients of meals and the program will give you some information such as total calories content, total sugar content etc ... ![example][1] ![enter image description here][2] The code of my project is CloudDeploy[FormFunction[ {"items", None} -> RepeatingElement[ CompoundElement[<| "food" -> <|"Label" -> "Foods", "Interpreter" -> "Food"|>, "quantity" -> <|"Label" -> "Quantity", "Interpreter" -> "Quantity"|> |>] ], With[{vals = Values@EntityGroup[ EntityInstance @@@ #items][{"AbsoluteTotalCaloriesContent", "AbsoluteTotalCarbohydratesContent", "AbsoluteTotalSugarContent", "AbsoluteTotalFatContent", "AbsoluteCholesterolContent", "AbsoluteTotalProteinContent"}, "PropertyAssociation"]}, If[FreeQ[vals, _Missing], Grid[ Prepend[Transpose[{{"Calories", "Carbs", "Sugar", "Fat", "Cholesterol", "Protein"}, vals}], {"Name", "Content"}], Background -> {None, {Lighter[Yellow, .9], {White, Lighter[Blend[{Red, Red}], .6]}}}, Dividers -> {{Darker[Gray, .6], {Lighter[Gray, .5]}, Darker[Gray, .6]}, {Darker[Gray, .6], Darker[Gray, .6], {False}, Darker[Gray, .6]}}, ItemSize -> {{20, 20}}, Frame -> Darker[Gray, .6], ItemStyle -> 15, Spacings -> {Automatic, .8}], "Sorry, Missing data"]] &, "PNG" ], Permissions -> "Public"] **Steps of work** - Get data from Wolfram - Set relations between items and their quantities - Count the total quantity of contents - Set condition for those items whose data are missing - Design page - Put it on web In Wolfram Alpha there are a lot of information about foods, including nutrition information.So I've used those ones to make my project. As the output of the program depends on items and their quantities, I've used `EntityInstance` function to set relations between items and their quantities ![enter image description here][3] Then to combine all entities I've used `EntityGroup` function. To count total quantity of contents I've used properties such as `"AbsoluteTotalCaloriesContent", "AbsoluteTotalCarbohydratesContent", "AbsoluteTotalSugarContent", "AbsoluteTotalFatContent", "AbsoluteCholesterolContent", "AbsoluteTotalProteinContent"` Property `"PropertyAssociation"` helped me to create association between properties and appropriate quantities. ![enter image description here][4] There are some foods about which there are no information in wolfram data, so for correct working of program I've used functions `With` and `If`. So as a result, if you input item about which there is no information the program will give this ![missing][5] For designing outputs I've used `Grid` function Grid[Prepend[ Transpose[{{"Calories", "Carbs", "Sugar", "Fat", "Cholesterol", "Protein"}, vals}], {"Name", "Content"}], Background -> {None, {Lighter[Yellow, .9], {White, Lighter[Blend[{Red, Red}], .6]}}}, Dividers -> {{Darker[Gray, .6], {Lighter[Gray, .5]}, Darker[Gray, .6]}, {Darker[Gray, .6], Darker[Gray, .6], {False}, Darker[Gray, .6]}}, ItemSize -> {{20, 20}}, Frame -> Darker[Gray, .6], ItemStyle -> 15, Spacings -> {Automatic, .8}] Then for creating web page I've used `CloudDeploy` ![enter image description here][6] In Quantity field you should import not only quantity but also a unit, otherwise it will show ![enter image description here][7] You can try to use this program [here][8] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=page1.PNG&userId=900573 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Out.PNG&userId=900573 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture.PNG&userId=900573 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Out.PNG&userId=900573 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=missing.PNG&userId=900573 [6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=webpage.PNG&userId=900573 [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture1.PNG&userId=900573 [8]: https://www.wolframcloud.com/objects/c70049b8-e54b-4a5f-b9c7-54e041232572 Astghik Saharyan 2016-08-19T13:44:42Z https://community.wolfram.com/groups/-/m/t/851429 Are there any chemists here? I've got something for you: My [multiple bonds Demonstration][1] is now also available [as a package][2]. You can plot molecules from `ChemicalData[]` or from your own MOL files. The source only needs to contain information about the positions and multiplicity of the bonds, and of course about the positions and types of the atoms. Here are a few examples of the finished result (the package itself contains more notes about the technical aspects). Needs["multiBondPlot`"] Multicolumn[Labeled[multiBondPlot[#],#]&/@{"Benzene","Caffeine","Acetonitrile","TNT"},2] ![enter image description here][3] [1]: http://demonstrations.wolfram.com/DisplayingMoleculesWithMultipleBonds/ [2]: http://library.wolfram.com/infocenter/MathSource/9430/ [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=molecules.png&userId=69107 Bianca Eifert 2016-05-04T20:21:42Z https://community.wolfram.com/groups/-/m/t/3379945 ![Analyzing and visualizing the human protein-protein interaction network][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=group-1-cover.jpeg&userId=911151 [2]: https://www.wolframcloud.com/obj/1e321c5c-40b1-4dac-b8ef-425ca6adbb2d Wolfram Education Programs 2025-02-04T15:13:26Z https://community.wolfram.com/groups/-/m/t/3094660 ![image of glucose molecule][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=image.jpeg&userId=911151 [2]: https://www.wolframcloud.com/obj/af8877e4-e217-434a-8ca6-f91935263102 Wolfram Education Programs 2024-01-02T16:55:44Z https://community.wolfram.com/groups/-/m/t/3095845 ![cellular automata oil spill][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=image.png&userId=911151 [2]: https://www.wolframcloud.com/obj/6dd02fe6-7313-415d-b69c-14b25ed88af4 Wolfram Education Programs 2024-01-03T16:48:52Z https://community.wolfram.com/groups/-/m/t/3094750 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/16a75f08-563e-4f8f-86f4-a1a4acf4354b Wolfram Education Programs 2024-01-02T19:31:24Z https://community.wolfram.com/groups/-/m/t/2562172 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/6c93ef77-be45-4dec-860c-c14c6720af30 J. M. 2022-07-02T14:56:03Z https://community.wolfram.com/groups/-/m/t/178634 [i]Note: This is an older post of mine that needed some housecleaning (I updated my website and subsequently broke the links). This project hasn't been changed, but since I just got hold of a new RPi2, I may have to break out the Legos again.[/i] I describe in a [url=http://www.bobthechemist.com/interactive-chemistry/15-wolfspec-version-1-0]blog entry on my website[/url] how I went about building a basic visible spectrophotometer using the Wolfram Language, a Raspberry Pi, a few Legos and a variety of tutorials found on the web. The spectrometer uses a white-light LED as a source. A reflective grating made out of a CD is mounted on a 512 step stepper motor to get variable wavelengths and a photoresistor is used as the detector. The setup looks like this: [img]http://www.bobthechemist.com/images/images/rpi/oldarticles/overview.jpg[/img] As with some of my other projects discussed in the Raspberry Pi forum, I am using MathLink and the WiringPi library to handle most of my GPIO communication with the RPi. Mathematica serves as a GUI to turn the source on/off, move the grating (and remember where the grating is positioned) and (naturally) plot and process the results: [img]http://www.bobthechemist.com/images/images/rpi/oldarticles/results.png[/img] It's not a terribly sophisticated interface - merely a palette with some buttons, but it does the trick. You'll see in the above image that there is much room for improvement with respect to my "spectra". The primary issues here are (a) my stepper motor only allows for about 32 steps across the visible spectrum and (b) the low-budget method for measuring the detector response results in a fair amount of noise. Still, (not shown) the reproducibility is decent given the lack of sophistication and the setup demonstrates how Wolfram/RPi can be used to make a basic instrument for learning and discovery. In addition to posting some improvements to the instrument, I'm hoping to show how it can be used for some DIY science experiments - it would be great to see a WolfSpec derivative in a future science fair project... BoB LeSuer 2014-01-04T16:26:29Z https://community.wolfram.com/groups/-/m/t/2669803 My daughter in high-school is learning about amino acids, peptides and proteins. I've been playing around with the new capability to symbolically represent molecules and reactions to see how far I get with amino acids. &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/bd8df71c-5635-46d2-b833-0d70a3b3011c Tamas Simon 2022-10-24T19:00:12Z https://community.wolfram.com/groups/-/m/t/3721709 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/27f0a4ee-141f-4d58-a5d5-957436b322f1 Housam Binous 2026-05-25T06:35:10Z https://community.wolfram.com/groups/-/m/t/3503212 ![A visual representation of cloud seeding, where the blue molecules represent Cloud Condensation Nuclei attracting water molecules][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2025-07-10at5.16.37%E2%80%AFPM.png&userId=3493403 [2]: https://www.wolframcloud.com/obj/000cbc2e-d168-471c-8489-81b07271772b Yuti Purohit 2025-07-10T22:12:48Z https://community.wolfram.com/groups/-/m/t/3359290 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/6e3750f7-a745-4c1e-ab2c-ce7ca0c9411e Housam Binous 2025-01-18T13:54:49Z https://community.wolfram.com/groups/-/m/t/3278492 ![enter image description here][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=6249hero.png&userId=20103 [2]: https://www.wolframcloud.com/obj/fc1f26f4-4c75-4fa8-b097-c8926551933a Arihant Gadgade 2024-09-20T16:36:50Z https://community.wolfram.com/groups/-/m/t/2925998 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/331f466f-9901-498d-9fc6-00610c892d78 Housam Binous 2023-05-26T19:45:33Z https://community.wolfram.com/groups/-/m/t/2176406 First we set up the elements: PSEelements[list_, col_] := Map[Item[Style[#, FontFamily -> "Ink Free"], Background -> col, Frame -> Black] &, list] s = LightRed; p = LightYellow; d = LightBlue; f = LightGreen; S1 = PSEelements[{"H", "He"}, s]; S2 = PSEelements[{"Li", "Be"}, s]; P2 = PSEelements[{"B", "C", "N", "O", "F", "Ne"}, p]; S3 = PSEelements[{"Na", "Mg"}, s]; P3 = PSEelements[{"Al", "Si", "P", "S", "Cl", "Ar"}, p]; S4 = PSEelements[{"K", "Ca"}, s]; P4 = PSEelements[{"Ga", "Ge", "As", "Se", "Br", "Kr"}, p]; S5 = PSEelements[{"Rb", "Sr"}, s]; P5 = PSEelements[{"In", "Sn", "Sb", "Te", "I", "Xe"}, p]; S6 = PSEelements[{"Cs", "Ba"}, s]; P6 = PSEelements[{"Tl", "Pb", "Bi", "Po", "At", "Rn"}, p]; S7 = PSEelements[{"Fr", "Ra"}, s]; P7 = PSEelements[{"Nh", "Fl", "Mc", "Lv", "Ts", "Og"}, p]; D3 = PSEelements[{"Sc", "Ti", "V", "Cr", "Mn", "Fe", "Co", "Ni", "Cu", "Zn"}, d]; D4 = PSEelements[{"Y", "Zr", "Nb", "Mo", "Tc", "Ru", "Rh", "Pd", "Ag", "Cd"}, d]; D5 = PSEelements[{"La", "Hf", "Ta", "W", "Re", "Os", "Ir", "Pt", "Au", "Hg"}, d]; D6 = PSEelements[{"Ac", "Rf", "Db", "Sg", "Bh", "Hs", "Mt", "Ds", "Rg", "Cn"}, d]; F4 = PSEelements[{"Ce", "Pr", "Nd", "Pm", "Sm", "Eu", "Gd", "Tb", "Dy", "Ho", "Er", "Tm", "Yb", "Lu"}, f]; F5 = PSEelements[{"Th", "Pa", "U", "Np", "Pu", "Am", "Cm", "Bk", "Cf", "Es", "Fm", "Md", "No", "Lr"}, f]; all = Join[S1, S2, P2, S3, P3, S4, D3, P4, S5, D4, P5, S6, D5, F4, P6, S7, D6, F5, P7]; Then a simple eight column PSE is constructed (highlighting H an He): Grid[PSE8 = {Join[{First[S1]}, Table["", 6], {Last[S1]}], Join[S2, P2], Join[S3, P3], Join[S4, P4], Join[S5, P5], Join[S6, P6]}, Spacings -> {1, 1}, ItemStyle -> {Automatic, Automatic, {{1, 1} -> Directive[Bold, Blue], {1, 8} -> Directive[Bold, Blue]}}] Which gives: ![enter image description here][1] And now highlighting the Alkaline earth elements: Grid[PSE8, ItemStyle -> {Automatic, Automatic, Table[{i, 2} -> Directive[Bold, Blue], {i, 2, 7}]}] Looks like: ![enter image description here][2] Here we have a standard 18 column PSE with ferromagnetic elements highlighted: Grid[PSE18 = {Join[{S1[[1]]}, Table["", 6 + 10], {S1[[2]]}], Join[S2, Table["", 10], P2], Join[S3, Table["", 10], P3], Join[S4, D3, P4], Join[S5, D4, P5], Join[S6, D5, P6], Join[S7, D6, P7]}, ItemStyle -> {Automatic, Automatic, Table[{4, i} -> Directive[Bold, Blue], {i, 8, 10}]}] gives: ![enter image description here][3] A full PSE with still 18 columns and all elements without stable isotope marked: Grid[PSE18full = Join[PSE18, {Table["", 6 + 10 + 14], Join[Table["", 3], F4], Join[Table["", 3], F5]}], ItemStyle -> {Automatic, Automatic, Join[{{5, 7} -> Directive[Red, Bold], {9, 7} -> Directive[Red, Bold]}, Table[{6, i} -> Directive[Red, Bold], {i, 15, 18}], Table[{7, i} -> Directive[Red, Bold], {i, 1, 18}], Table[{10, i} -> Directive[Red, Bold], {i, 4, 17}]]}] I never noticed before that there is no stable isotope for Pm: ![enter image description here][4] alternatively: Grid[{Join[{S1[[1]]}, Table["", 6 + 10], {S1[[2]]}], Join[S2, Table["", 10], P2], Join[S3, Table["", 10], P3], Join[S4, D3, P4], Join[S5, D4, P5], Join[S6, {""}, Rest[D5], P6], Join[S7, {""}, Rest[D6], P7], Table["", 6 + 10 + 14], Join[Table["", 2], {First[D5]}, F4], Join[Table["", 2], {First[D6]}, F5]}, ItemStyle -> {Automatic, Automatic, Join[{{5, 7} -> Directive[Red, Bold], {9, 7} -> Directive[Red, Bold]}, Table[{6, i} -> Directive[Red, Bold], {i, 15, 18}], Table[{7, i} -> Directive[Red, Bold], {i, 1, 18}], Table[{10, i} -> Directive[Red, Bold], {i, 3, 17}]]}] gives: ![enter image description here][5] and a 32 column layout: Grid[PSE32 = {Join[{S1[[1]]}, Table["", 6 + 10 + 14], {S1[[2]]}], Join[S2, Table["", 10 + 14], P2], Join[S3, Table["", 10 + 14], P3], Join[S4, {First[D3]}, Table["", 14], Rest[D3], P4], Join[S5, {First[D4]}, Table["", 14], Rest[D4], P5], Join[S6, {First[D5]}, F4, Rest[D5], P6], Join[S7, {First[D6]}, F5, Rest[D6], P7]}, Spacings -> {0.5, 0.5}, ItemStyle -> {Automatic, Automatic, Join[{{5, 21} -> Directive[Red, Bold], {6, 7} -> Directive[Red, Bold]}, Table[{6, i} -> Directive[Red, Bold], {i, 29, 32}], Table[{7, i} -> Directive[Red, Bold], {i, 1, 32}], Table[{10, i} -> Directive[Red, Bold], {i, 4, 17}]]}] gives: ![enter image description here][6] and finally a more artistic PSE view: r = 0.3; Graphics[{ (*n=1*) Circle[{0, 0}, 1], shell = CirclePoints[2]; {LightRed, EdgeForm[Black], Map[Disk[#, r] &, shell]}, {MapIndexed[Text[all[[#2[[1]]]], #1] &, shell]}, (*n=2*) Circle[{0, 0}, 2], shell = CirclePoints[{2, 0 \[Degree]}, 8]; {LightRed, EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, Map[Disk[#, r] &, Take[shell, -6]]}, {MapIndexed[ Text[all[[#2[[1]] + 2]], #1] &, shell]}, (*n=3*) Circle[{0, 0}, 3], shell = CirclePoints[{3, 0 \[Degree]}, 8]; {LightRed, EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, Map[Disk[#, r] &, Take[shell, -6]]}, {MapIndexed[ Text[all[[#2[[1]] + 2 + 8]], #1] &, shell]}, (*n=4*) Circle[{0, 0}, 4], shell = CirclePoints[{4, 0 \[Degree]}, 18]; {LightRed, EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, Map[Disk[#, r] &, Take[shell, -10]]}, {MapIndexed[ Text[all[[#2[[1]] + 2 + 2 8]], #1] &, shell]}, (*n=5*) Circle[{0, 0}, 5], shell = CirclePoints[{5, 0 \[Degree]}, 18]; {LightRed, EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, Map[Disk[#, r] &, Take[shell, -10]]}, {MapIndexed[ Text[all[[#2[[1]] + 2 + 2 8 + 18]], #1] &, shell]}, (*n=6*) Circle[{0, 0}, 6], shell = CirclePoints[{6, 0 \[Degree]}, 32]; {LightRed, EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, Map[Disk[#, r] &, Take[shell, {9, 18}]], LightGreen, Map[Disk[#, r] &, Take[shell, -14]]}, {MapIndexed[ Text[all[[#2[[1]] + 2 + 2 8 + 2 18]], #1] &, shell]}, (*n=7*) Circle[{0, 0}, 7], shell = CirclePoints[{7, 0 \[Degree]}, 32]; {LightRed, EdgeForm[Black], Map[Disk[#, r] &, Take[shell, 2]], LightYellow, Map[Disk[#, r] &, Take[shell, {3, 8}]], LightBlue, Map[Disk[#, r] &, Take[shell, {9, 18}]], LightGreen, Map[Disk[#, r] &, Take[shell, -14]]}, {MapIndexed[ Text[all[[#2[[1]] + 2 + 2 8 + 2 18 + 32]], #1] &, shell]}}] PSE in circles: ![enter image description here][7] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PSE8.png&userId=1094216 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PSE8b.png&userId=1094216 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PSE18.png&userId=1094216 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PSE18full.png&userId=1094216 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PSE18full2.png&userId=1094216 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PSE32.png&userId=1094216 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=pse.png&userId=1094216 Oliver Seipel 2021-01-27T13:49:52Z