https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions 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/1551098 ***NOTE: Download Full Article as a Notebook from the Attachment Below*** ---------- ![enter image description here][1] Interphase mass transfer operations such as gas absorption or liquid-liquid extraction pose a modeling challenge because the molar species concentration can jump between 2 states at the interface as shown below (from [here][2]). ![enter image description here][3] I wanted to see if I could create a Finite Element Method (FEM) model of jump conditions in the Wolfram Language. I found the results to be reasonable, aesthetically pleasing, and somewhat mesmerizing. The remainder of this post documents my workflow for those that might be interested. I have attached a notebook to reproduce the results. ## Preamble on analytical solutions to PDE's There seems to be quite a few posts where people are trying to find the analytical solution to a system of PDE's. Generally, closed formed analytical solutions only exist in rare-highly symmetric cases. Let us consider the heat equation below. $$\frac{\partial T}{\partial t}=\alpha \frac{\partial^2 T}{\partial x^2}$$ For the case of a semi-infinite bar subjected to a unit step change in temperature at $x=0$, Mathematica's DSolve\[\] handles this readily. u[x, t] /. First@DSolve[{ D[u[x, t], t] == alpha D[u[x, t], {x, 2}], u[x, 0] == 0, u[0, t] == UnitStep[t]}, u[x, t], {x, t}, Assumptions -> alpha > 0 && 0 < x] (*Erfc[x/(2*Sqrt[alpha]*Sqrt[t])]*) So far so good. Now, let us break symmetry by making it a finite bar of length $l$ (See [Documentation][4]). heqn = D[u[x, t], t] == alpha D[u[x, t], {x, 2}]; bc = {u[0, t] == 1, u[l, t] == 0}; ic = u[x, 0] == 0; sol = DSolve[{heqn, bc, ic}, u[x, t], {x, t}] (*{{u[x, t] -> 1 - x/l - (2*Inactive[Sum][Sin[(Pi*x*K[1])/l]/(E^((alpha*Pi^2*t*K[1]^2)/l^2)* K[1]), {K[1], 1, Infinity}])/Pi}}*) This little change going from a semi-infinite to finite domain has turned the solution into an unwieldy infinite sum. We should expect that it will only go down hill from here if we add additional complexity to the equation or system of equations. My advice is to abandon the search for an analytical solution quickly because it will likely take great effort and will be unlikely to yield a result. Instead, focus efforts on more productive avenues such as dimensional analysis and numerical solutions. # Introduction >"All models are wrong, some are useful." -- George E. P. Box >"However, many systems are highly complex, so that valid mathematical models of them are themselves complex, precluding any possibility of an analytical solution. In this case, the model must be studied by means of simulation, i.e. , numerically exercising the model for the inputs in question to see how they affect the output measures of performance." -- Dr. Averill Law, Simulation Modeling and Analysis I find the quotes above help me overcome inertia when starting a modeling and simulation project. Create your wrong model. Calibrate how wrong it is versus a known standard. If it is not too bad, put the model through its paces. One thing that I appreciate about the Wolfram Language is that I can document a modeling workflow development process from beginning to end in a single notebook. The typical model workflow development process includes: * A sketch of the system of interest. * Equations. * Initial development. * Simplification. * Non-dimensionalization for better scaling and reducing parameter space. * Mathematica implementation. * Mesh * Boundaries * Refinement * NDSolve set-up * Post-process results * Verification/Validation Mathematica notebooks tend to age well. I routinely resurrect notebooks that are over a decade old and they generally still work. ## Absorption I did a quick Google search on absorption and came across this figure describing gas absorption in an open access article by [Danish _et al_][5]. ![enter image description here][6] This image looked very similar to an image that I produced in a [related post](http://community.wolfram.com/groups/-/m/t/1470252) to the Wolfram community regarding porous media energy transport. ![enter image description here][7] The systems look so similar, that we ought to be able to reuse much of the modeling. An area of concern would be for gas absorption where the ratio of the gas diffusion coefficient to liquid diffusion coefficient can exceed 4 orders of magnitude. Such differences often can cause instability in numerical approaches. # Modeling ## System description For clarity, I always like to begin with a system description. Typically, absorption processes utilize gravity to create a thin liquid film to contact the gas. To reuse the modeling that we did for porous media, we will assume that gravity is in the positive $x$ direction leading us to the image below. ![enter image description here][8] We will assume that the liquid film is a uniform thickness and is laminar (note that for gas liquid contact the liquid velocity is fastest at the interface leading to the parabolic profile shown). We will assume that the gas has a uniform velocity. Further, we will assume that the incoming concentrations of the absorbing species are zero and we will impose a concentration of $C=C_0$ at the lower boundary. The basic dimensions of the box are shown below. For simplicity, we will make the height and length unit dimensions and set $R$ to be $\frac{1}{2}$. ![enter image description here][9] ## Balance equations ### Dilute species balance For the purposes of this exercise, we will consider the system to be dilute such that diffusion does not affect the overall flow velocities. Within a single phase, the molar balance of concentration is given by equation (1). We will assume steady-state operation with no reactions so that we can eliminate the red terms. $${\color{Red}{\frac{{\partial {C}}}{{\partial t}}}} + \mathbf{v} \cdot \nabla C - \nabla \cdot \mathcal{D} \nabla C - {\color{Red}{r^{'''}}} = 0 \qquad (1)$$ ### Species balance in each phase For convenience, I will denote the phases by a subscript G and L for gas and liquid with the understanding that these equations could also apply to a liquid-liquid extraction problem. This leads to the following concentration balance equations for the liquid and gas phases. $$\begin{gathered} \begin{matrix} \mathbf{v}_L \cdot \nabla C_L + \nabla \cdot \left(-\mathcal{D}_L \nabla C_L\right) = 0 & x,y\in \Omega_L & (2*) \\ \mathbf{v}_G \cdot \nabla C_G + \nabla \cdot \left(-\mathcal{D}_G \nabla C_G\right) = 0 & x,y\in \Omega_G & (3*) \\ \end{matrix} \end{gathered}$$ Or in Laplacian form $$\begin{gathered} \begin{matrix} \mathbf{v}_L \cdot \nabla C_L -\mathcal{D}_L \nabla^2 C_L = 0 & x,y\in \Omega_L & (2*) \\ \mathbf{v}_G \cdot \nabla C_G -\mathcal{D}_G \nabla^2 C_G = 0 & x,y\in \Omega_G & (3*) \\ \end{matrix} \end{gathered}$$ #### Creating a No-Flux Boundary Condition at the Interface To prevent the gas species diffusing into the liquid layer and _vice versa_, I will set the velocities to zero and the diffusion coefficients to a very small value in the other phase. From a visualization standpoint, it will appear that the gas species has diffused into the liquid layer and _vice versa_, but the flux is effectively zero. To clean up the visualization, we will define plot ranges by gas, interphase, and liquid regions. ### Species balance including a thin interphase region We will define a thin Interphase region between the 2 phases that will allow us to couple the phases in the interphase region via a source term creating the jump discontinuity in concentration as shown in the figure below. ![enter image description here][10] We will modify (2\*) and (3\*) with the coupling source term as shown below. $$\begin{gathered} \begin{matrix} \mathbf{v}_L \cdot \nabla C_L -\mathcal{D}_L \nabla^2 C_L - \sigma\left(\Omega \right )k\left(K C_G-C_L \right ) = 0 & x,y\in \Omega & (2) \\ \mathbf{v}_G \cdot \nabla C_G -\mathcal{D}_G \nabla^2 C_G + \sigma\left(\Omega \right )k\left(K C_G-C_L \right ) = 0 & x,y\in \Omega & (3) \\ \end{matrix} \end{gathered}$$ Where $K$ is a vapor-liquid equilibrium constant, $k$ is in interphase mass transfer coefficient (we will make this large because we want a fast approach to equilibrium), and $\sigma$ is a switch that turns on (=1) in the interface region and 0 otherwise. ## Dimensional analysis We will multiply equations (2) and (3) by $\frac{{R^2}}{C_0 \mathcal{D}_G}$ to obtain their non-dimensionalized forms (4) and (5). $$\begin{gathered} \begin{matrix} C_0\left (\frac{\mathbf{v}_L}{R} \cdot \nabla^* C_{L}^{*} -\frac{\mathcal{D}_L}{R^2} \nabla^{*2} C_{L}^{*} - \sigma\left(\Omega \right )k\left(K C_{G}^{*}-C_{L}^{*} \right ) \right ) = 0\left\| {\frac{{R^2}}{C_0 \mathcal{D}_G}} \right. \\ C_0\left (\frac{\mathbf{v}_G}{R} \cdot \nabla^* C_{G}^{*} -\frac{\mathcal{D}_G}{R^2} \nabla^{*2} C_{G}^{*} + \sigma\left(\Omega \right )k\left(K C_{G}^{*}-C_{L}^{*} \right ) \right ) = 0\left\| {\frac{{R^2}}{C_0 \mathcal{D}_G}} \right. \\ \end{matrix} \end{gathered}$$ $$\begin{gathered} \begin{matrix} \frac{\mathcal{D}_L}{\mathcal{D}_G} \frac{R\mathbf{v}_L}{\mathcal{D}_L} \cdot \nabla^* C_{L}^{*} -\delta \nabla^{*2} C_{L}^{*} - \sigma\left(\Omega \right )\kappa\left(K C_{G}^{*}-C_{L}^{*} \right ) = 0 \\ \frac{R\mathbf{v}_G}{\mathcal{D}_G} \cdot \nabla^* C_{G}^{*} - \nabla^{*2} C_{G}^{*} + \sigma\left(\Omega \right )\kappa\left(K C_{G}^{*}-C_{L}^{*} \right ) = 0\\ \end{matrix} \end{gathered}$$ $$\begin{gathered} \begin{matrix} \delta{Pe}_L\mathbf{v}_{L}^* \cdot \nabla^* C_{L}^{*} -\delta \nabla^{*2} C_{L}^{*} - \sigma\left(\Omega \right )\kappa\left(K C_{G}^{*}-C_{L}^{*} \right ) = 0 & (4) \\ {Pe}_G\mathbf{v}_{G}^* \cdot \nabla^* C_{G}^{*} - \nabla^{*2} C_{G}^{*} + \sigma\left(\Omega \right )\kappa\left(K C_{G}^{*}-C_{L}^{*} \right ) = 0 &(5)\\ \end{matrix} \end{gathered}$$ Where $$\delta=\frac{\mathcal{D}_L}{\mathcal{D}_G}$$ $$Pe_L=\frac{R\mathbf{v}_L}{\mathcal{D}_L}$$ $$Pe_G=\frac{R\mathbf{v}_G}{\mathcal{D}_G}$$ With a good dimensionless model in place, we can start with our Wolfram Language implementation. # Wolfram Language Implementation ## Mesh creation We start by loading the FEM package. Needs["NDSolve`FEM`"] When I started this effort, I considered co-current flow only. I realized that converting the model to counter-current flow was a simple matter of changing boundary markers. I wrapped the process up in a module that returns an association whose parameters can be used to set up an NDSolve solution. In the counter-current case, I changed the bottom boundary to a wall and the gas inlet concentration to 1. makeMesh[h_, l_, rat_, gf_, cf_] := Module[{bR, tp, bt, lf, rt, th, interfacel, interfaceg, buf, bnds, rgs, crds, lelms, boundaryMarker, bcEle, bmsh, liquidCenter, liquidReg, interfaceCenter, interfaceReg, gasCenter, gasReg, meshRegs, msh, mDic}, (* Domain Dimensions *) bR = rat h; tp = bR; bt = bR - h; lf = 0; rt = l; th = h/gf; interfacel = 0; interfaceg = interfacel - th; buf = 2.5 th; (* Use associations for clearer assignment later *) bnds = <|liquidinlet -> 1, gasinlet -> 2, bottom -> 3|>; rgs = <|gas -> 10, liquid -> 20, interface -> 15|>; (* Meshing Definitions *) (* Coordinates *) crds = {{lf, bt}(*1*), {rt, bt}(*2*), {rt, tp}(*3*), {lf, tp}(*4*), {lf, interfacel}(*5*), {rt, interfacel}(*6*), {lf, interfaceg}(*7*), {rt, interfaceg}(*8*)}; (* Edges *) lelms = {{1, 7}, {7, 5}, {5, 4}, {1, 2}, {2, 8}, {8, 6}, {6, 3}, {3, 4}, {5, 6}, {7, 8}}; (* Conditional Boundary Markers depending on configuration *) boundaryMarker := {bnds[gasinlet], bnds[liquidinlet], bnds[liquidinlet], bnds[bottom], 4, 4, 4, 4, 4, 4} /; cf == "Co"; boundaryMarker := {4, 4, bnds[liquidinlet], bnds[bottom], bnds[gasinlet], 4, 4, 4, 4, 4} /; cf == "Counter"; (* Create Boundary Mesh *) bcEle = {LineElement[lelms, boundaryMarker]}; bmsh = ToBoundaryMesh["Coordinates" -> crds, "BoundaryElements" -> bcEle]; (* 2D Regions *) (* Identify Center Points of Different Material Regions *) liquidCenter = {(lf + rt)/2, (tp + interfacel)/2}; liquidReg = {liquidCenter, rgs[liquid], 0.0005}; interfaceCenter = {(lf + rt)/2, (interfacel + interfaceg)/2}; interfaceReg = {interfaceCenter, rgs[interface], 0.5*0.000005}; gasCenter = {(lf + rt)/2, (bt + interfaceg)/2}; gasReg = {gasCenter, rgs[gas], 0.0005}; meshRegs = {liquidReg, interfaceReg, gasReg}; msh = ToElementMesh[bmsh, "RegionMarker" -> meshRegs, MeshRefinementFunction -> Function[{vertices, area}, Block[{x, y}, {x, y} = Mean[vertices]; If[ (y > interfaceCenter[[2]] - buf && y < interfaceCenter[[2]] + buf) || (y < bt + 1.5 buf && x < lf + 1.5 buf) , area > 0.0000125, area > 0.01 ] ] ] ]; mDic = <| height -> h, length -> l, ratio -> rat, gapfactor -> gf, r -> bR, top -> tp, bot -> bt, left -> lf, right -> rt, intl -> interfacel, intg -> interfaceg, intcx -> interfaceCenter[[1]], intcy -> interfaceCenter[[2]], buffer -> buf, mesh -> msh, bmesh -> bmsh, bounds -> bnds, regs -> rgs, cfg -> cf |>; mDic] Options[meshfn] = {height -> 1, length -> 1, ratio -> 0.5, gapfactor -> 100, config -> "Co"}; meshfn[OptionsPattern[]] := makeMesh[OptionValue[height], OptionValue[length], OptionValue[ratio], OptionValue[gapfactor], OptionValue[config]] We can create a mesh instance of a co-current flow case by invoking the meshfn\[\]. I will color the liquid inlet $\color{Green}{Green}$, the gas inlet $\color{Red}{Red}$ and the bottom boundary $\color{Orange}{Orange}$ (the rest of the boundaries are default). mDicCo = meshfn[config -> "Co"]; mDicCo[bmesh][ "Wireframe"["MeshElementMarkerStyle" -> Blue, "MeshElementStyle" -> {Green, Red, Orange, Black}, ImageSize -> Large]] ![enter image description here][11] By setting the optional config parameter to "Counter", we can easily generate a counter-current case as shown below (note how the gas inlet shifted to the right side. mDic = meshfn[config -> "Counter"]; mDic[bmesh][ "Wireframe"["MeshElementMarkerStyle" -> Blue, "MeshElementStyle" -> {Green, Red, Orange, Black}, ImageSize -> Large]] ![enter image description here][12] For the co-current case, the bottom wall and the gas inlet have inconsistent Dirichlet conditions. To reduce the effect, I refined the mesh in the lower left corner as shown below. ![enter image description here][13] I also meshed the interface region finely. ![enter image description here][14] Sometimes it can get confusing to setup alternative boundaries. To visualize the coordinate IDs, you could use something like: With[{pts = mDic[bmesh]["Coordinates"]}, Graphics[{Opacity[1], Black, GraphicsComplex[pts, Text[Style[ToString[#], Background -> White, 12], #] & /@ Range[Length[pts]]]}]] ![enter image description here][15] ## Solving and Visualization I have created a module that will solve and visualize depending on the mesh type (co-flow or counter-flow). Hopefully, it is well enough commented that further discussion is not needed. model[md_, kequil_, d_, pel_, peg_, title_] := Module[{n, pecletgas, por, vl, vg, fac, facg, coefl, coefg, dcliquidinletliquid, dcliquidinletgas, dcinletgas, dcgasinletliquid, dcgasinletgas, dcbottomliquid, dcbottomgas, eqnliquid, eqngas, eqns, ifun, pltl, pltint, pltg, pltarr, sz, grid, lf, rt, tp, bt, interfaceg, interfacel, interfaceCenterY, plrng, arrequil, arrdiff, arrgas, arrliq}, (*localize Mesh Dict Values*)lf = md[left]; rt = md[right]; tp = md[top]; bt = md[bot]; interfaceg = md[intg]; interfacel = md[intl]; interfaceCenterY = md[intcy]; (*Must swtich gas flow direction for counter-flow*) pecletgas = If[md[cfg] == "Co", peg, -peg]; (*Dimensionless Mass Transfer Coefficient in Interphase Region*) n = 10000; (*"Porosity" to weight concentration in interphase*) por[y_, intg_, intl_] := (y - intg)/(intl - intg); (*Region Dependent Properties with Piecewise \ Functions*)(*velocity*)(*Liquid parabolic profile*) vl = Evaluate[ Piecewise[{{{pel d (1 - (y/md[r])^2), 0}, ElementMarker == md[regs][liquid]}, {{pecletgas, 0}, ElementMarker == md[regs][gas]}, {{0, 0}, True}}]]; (*Gas Uniform Velocity*) vg = Evaluate[ Piecewise[{{{pecletgas, 0}, ElementMarker == md[regs][gas]}, {{pel d (1 - (y/md[r])^2), 0}, ElementMarker == md[regs][liquid]}, {{0, 0}, True}}]]; (*fac switches on mass transfer coefficient in interphase*) fac = Evaluate[If[ElementMarker == md[regs][interface], n, 0]]; (*diffusion coefficients*)(*Liquid*) coefl = Evaluate[ Piecewise[{{d, ElementMarker == md[regs][liquid]}, {1, ElementMarker == md[regs][interface]}, {d/1000000, True} (*Effectively No Flux at Interface*)}]]; (*Gas*)coefg = Evaluate[ Piecewise[{{1, ElementMarker == md[regs][gas]}, {1, ElementMarker == md[regs][interface]}, {d/1000000, True} (*Effectively No Flux at Interface*)}]]; (*Dirichlet Conditions for Liquid at Inlets*) dcliquidinletliquid = DirichletCondition[cl[x, y] == 0, ElementMarker == md[bounds][liquidinlet]]; dcliquidinletgas = DirichletCondition[cg[x, y] == 0, ElementMarker == md[bounds][liquidinlet]]; dcgasinletliquid = DirichletCondition[cl[x, y] == 0, ElementMarker == md[bounds][gasinlet]]; (*Conditional BCs for gas dependent on configuration*) dcgasinletgas := DirichletCondition[cg[x, y] == 0, ElementMarker == md[bounds][gasinlet]] /; md[cfg] == "Co"; dcgasinletgas := DirichletCondition[cg[x, y] == 1, ElementMarker == md[bounds][gasinlet]] /; md[cfg] == "Counter"; (*Dirichlet Conditions for the Bottom Wall*) dcbottomliquid = DirichletCondition[cl[x, y] == 0, ElementMarker == md[bounds][bottom]]; dcbottomgas = DirichletCondition[cg[x, y] == 1, ElementMarker == md[bounds][bottom]]; (*Balance Equations for Gas and Liquid Concentrations*) eqnliquid = vl.Inactive[Grad][cl[x, y], {x, y}] - coefl Inactive[Laplacian][cl[x, y], {x, y}] - fac (kequil cg[x, y] - cl[x, y]) == 0; eqngas = vg.Inactive[Grad][cg[x, y], {x, y}] - coefg Inactive[Laplacian][cg[x, y], {x, y}] + fac (kequil cg[x, y] - cl[x, y]) == 0; (*Equations to be solved depending on configuration*) eqns := {eqnliquid, eqngas, dcliquidinletliquid, dcliquidinletgas, dcgasinletliquid, dcgasinletgas, dcbottomliquid, dcbottomgas} /; md[cfg] == "Co"; eqns := {eqnliquid, eqngas, dcliquidinletliquid, dcliquidinletgas, dcgasinletliquid, dcgasinletgas} /; md[cfg] == "Counter"; (*Solve the PDE*) ifun = NDSolveValue[eqns, {cl, cg}, {x, y} \[Element] md[mesh]]; (*Visualizations*)(*Create Arrows to represent magnitude of \ dimensionless groups*)(*Equilibrium Arrow*) arrequil = {CapForm["Square"], Red, Arrowheads[0.03], Arrow[Tube[{{1 - 0.0125, 0.025, 1}, {1 - 0.0125, 0.025, kequil}}, 0.005], -0.03]}; (*Diffusion Arrow*) arrdiff = {Darker[Green, 1/2], Arrowheads[0.03, Appearance -> "Flat"], Arrow[Tube[{{-0.025, 0.0, 0.0 .025}, {-0.025, 0.5 (1 + Log10[d]/4), 0.025}}, 0.005], -0.03]}; (*Liquid Peclet Arrow*) arrliq = {Blue, Dashed, Arrowheads[1.5 0.03], Arrow[Tube[{{0.0, mDic[top] + 0.025, 0.035}, {pel/50, mDic[top] + 0.025, 0.035}}, 1.5 0.005], -0.03 1.5]}; (*Conditional Gas Peclet Arrow*) arrgas := {Black, Dashed, Arrowheads[1.5 0.03], Arrow[Tube[{{0.0, mDic[bot], 1.035}, {peg/50, mDic[bot], 1.035}}, 1.5 0.005], -0.03 1.5]} /; md[cfg] == "Co"; arrgas := {Black, Dashed, Arrowheads[1.5 0.03], Arrow[Tube[{{mDic[right], mDic[bot], 1.035}, {mDic[right] - peg/50, mDic[bot], 1.035}}, 1.5 0.005], -0.03 1.5]} /; md[cfg] == "Counter"; (*Set up plots*)(*Common plot options*) plrng = {{lf, rt}, {bt, tp}, {0, 1}}; SetOptions[Plot3D, PlotRange -> plrng, PlotPoints -> {200, 200}, ColorFunction -> Function[{x, y, z}, Directive[ColorData["DarkBands"][z]]], ColorFunctionScaling -> False, MeshFunctions -> {#3 &}, Mesh -> 18, AxesLabel -> Automatic, ImageSize -> Large]; (*Liquid Plot*) pltl = Plot3D[ifun[[1]][x, y], {x, lf, rt}, {y, interfacel, tp}, MeshStyle -> {Black, Thick}]; (*Interface region Plot*) pltint = Plot3D[ifun[[2]][x, y] (1 - por[y, interfaceg, interfacel]) + por[y, interfaceg, interfacel] ifun[[1]][x, y], {x, lf, rt}, {y, interfaceg, interfacel}, MeshStyle -> {DotDashed, Black, Thick}]; (*Gas Plot*) pltg = Plot3D[ifun[[2]][x, y], {x, lf, rt}, {y, bt, interfaceg}, MeshStyle -> {Dashed, Black, Thick}]; (*Grid Plot*)sz = 300; grid = Grid[{{Show[{pltl, pltint, pltg}, ViewProjection -> "Orthographic", ViewPoint -> Front, ImageSize -> sz, Background -> RGBColor[0.84`, 0.92`, 1.`], Boxed -> False], Show[{pltl, pltint, pltg}, ViewProjection -> "Orthographic", ViewPoint -> Left, ImageSize -> sz, Background -> RGBColor[0.84`, 0.92`, 1.`], Boxed -> False]}, {Show[{pltl, pltint, pltg}, ViewProjection -> "Orthographic", ViewPoint -> Top, ImageSize -> sz, Background -> RGBColor[0.84`, 0.92`, 1.`], Boxed -> False], Show[{pltl, pltint, pltg}, ViewProjection -> "Perspective", ViewPoint -> {Above, Left, Back}, ImageSize -> sz, Background -> RGBColor[0.84`, 0.92`, 1.`], Boxed -> False]}}, Dividers -> Center]; (*Reset Plot Options to Default*) SetOptions[Plot3D, PlotStyle -> Automatic]; pltarr = Grid[{{Text[Style[title, Blue, Italic, 24]]}, {Style[ StringForm[ "\!\(\*SubscriptBox[\(K\), \(C\)]\)=``, \[Delta]=``, \ \!\(\*SubscriptBox[\(Pe\), \(L\)]\)=``, and \ \!\(\*SubscriptBox[\(Pe\), \(G\)]\)=``", NumberForm[kequil, {3, 2}, NumberPadding -> {" ", "0"}], NumberForm[d, {5, 4}, NumberPadding -> {" ", "0"}], NumberForm[pel, {2, 1}, NumberPadding -> {" ", "0"}], NumberForm[peg, {2, 1}, NumberPadding -> {" ", "0"}]], 18]}, {Show[{pltl, pltint, pltg, Graphics3D[{arrequil, arrdiff, arrliq, arrgas}](*,arrequil, arrdiff,arrliq,arrgas*)}, ViewProjection -> "Perspective", ViewPoint -> {Above, Left, Back}, ImageSize -> 640, Background -> RGBColor[0.84`, 0.92`, 1.`], Boxed -> False, PlotRange -> {{md[left] - 0.05, md[right]}, {md[bot], md[top] + 0.05}, {0, 1 + 0.1}}]}}]; (*Return values*){ifun, {pltl, pltint, pltg}, pltarr, grid}]; Options[modelfn] = {md -> mDic, k -> 0.5, dratio -> 1, pel -> 50, peg -> 50, title -> "Test"}; modelfn[OptionsPattern[]] := model[OptionValue[md], OptionValue[k], OptionValue[dratio], OptionValue[pel], OptionValue[peg], OptionValue[title]] ## Testing of Meshing and Solving Modules Now, that we wrapped our meshing and solving work flow into modules, I will demonstrate how to create an instance of a simulation. (* Create a Co-Flow Mesh *) mDic = meshfn[config -> "Co"]; (* Simulate and return results *) res = modelfn[md -> mDic, k -> 0.5, dratio -> 0.1, pel -> 10, peg -> 5, title -> "Co-Flow"]; To visualize a 3D plot with arrows representing the magnitude of dimensionless parameters, we access the third part of the results list. res[[3]] ![enter image description here][16] The solid lines, dashed lines, and dashed-dotted lines represent contours of species concentration in the liquid, gas, and interphase regions, respectively. The $\color{Red}{Red}$ arrow is proportional to (1-K), the $\color{Green}{Green}$ arrow is proportional to the log of the diffusion ratio $\delta$, the $\color{Blue}{Blue}$ arrow is proportional to $Pe_L$, and the $\color{Black}{Black}$ arrow is proportional to $Pe_G$. Multiple views are contained in part 4 of the results list. res[[4]] ![enter image description here][17] ## Validation (Comparison to another code) Before continuing, it is always good practice to validate your model versus experiment or at least another code. The other code supports a partition conditions for the concentration jump so that I do not need to create an interface layer. The results are shown below: ![enter image description here][18] The contour plots look very similar to the image in the lower left corner of the grid plot. To be more quantitative, I have highlighted contours at approximately y=-0.15 and y=0.05 in the gas and liquid layers at x=1 corresponding to concentrations of 0.68 and 0.28, respectively. The first part of the results list returns an interpolation function of the liquid and gas species. We can see that we are within a percent of the other code, which is reasonable given that the interface layer is about 1% of the domain. This check gives me good confidence that my model is not too wrong and that I can start to make it useful (i.e., exercising the model by changing parameters). res[[1]][[2]][1, -0.15] (*0.6769985984321076`*) res[[1]][[1]][1, 0.05] (* 0.27374616012596314`*) # Generating Animations I like to animate. For me, animations are the best way to demonstrate how a system evolves as a function of time or parameter changes. We can export an animated gif file to study the effects of dimensionless parameter changes for both flow configurations as shown in the following code. It will take about 30 minutes per animation and about 5 GB of RAM. Undoubtedly, this code could be optimized for speed and memory usage, but you still can create a dozen animations while you sleep. SetDirectory[NotebookDirectory[]]; f = ((#1 - #2)/(#3 - #2)) &; (* Scale for progress bar *) mDic = meshfn[config -> "Counter"]; (* Create Mesh Instance *) Export["CounterFlow.gif", Monitor[ Table[ modelfn[md -> mDic, k -> kc, dratio -> 1, pel -> 0, peg -> 0, title -> "Counter-Flow"][[3]], {kc, 1, 0.01, -0.01} ], Grid[ {{"Total progress:", ProgressIndicator[ Dynamic[f[kc, 1, 0.01, -0.01]]]}, {"\!\(\*SubscriptBox[\(K\), \(C\)]\)=", \ {Dynamic@kc}}}] ], "AnimationRepetitions" -> \[Infinity]] # Examples I combined the co- (left) and counter-current (right) gif animations for several cases below. Péclet numbers approaching 100 start to look uninteresting visually (all the action is very close to the interface). This should inform the user that perhaps another model is in order with new assumptions to study the small-scale behavior near the interface. ## Changing the Equilibrium Constant @ No Flow ![enter image description here][19] As the equilibrium constant, $K$, reduces, the jump condition increases. ## Changing the Diffusion Ratio $\delta$ @ No Flow ![enter image description here][20] As the liquid-gas diffusion ratio, $\delta$, decreases, the concentration in the gas layer increases. We also see that the solution does not change much for $\delta<0.01$. ## Changing $Pe_L$ @ No Gas Flow ![enter image description here][21] As $Pe_L$ increases, the concentration gradient increases at the interface. ## Changing $Pe_G$ @ No Liquid Flow ![enter image description here][22] As $Pe_G$ increases, we see the concentration in the liquid layer decrease for co-flow and increase for counter-current flow. This should make sense since the inlet concentration for co-flow is 0 and 1 for counter-current flow. ## Changing the Diffusion Ratio $\delta$ @ Middle Conditions ![enter image description here][23] Again, we do not see much change for $\delta<0.01$. One may have noticed that the concentration in the liquid layer goes up as the diffusion coefficient ratio goes down, which may, at first, seem counterintuitive. The reason for this behavior is that the dimensionless velocity in the liquid layer depends on both $Pe_L$ and $\delta$ so it decreases with decreasing $\delta$. # Summary - Constructed an FEM model in the Wolfram Language to study concentration jump conditions in interphase mass transfer. - Results compare favorably to another code designed to handle jump conditions. - Showed several examples of the effect of dimensionless parameter changes on two model flow configurations. - Notebook provided. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=varyKlv0gv0.gif&userId=1402928 [2]: http://appliedchem.unideb.hu/Muvtan/Transport%20Processes%20and%20Unit%20Operations,%20Third%20Edition.pdf [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ConcJumps.png&userId=1402928 [4]: https://reference.wolfram.com/language/ref/DSolve.html [5]: https://ac.els-cdn.com/S0307904X07000601/1-s2.0-S0307904X07000601-main.pdf?_tid=adb2e542-50f1-44ce-ad9f-54ffaaa83bcb&acdnat=1539987146_3e6ce710d8016d91587f466be8e4ada7 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=AbsorptionModel.png&userId=1402928 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PMSystemDescription.png&userId=1402928 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=AbsorptionSystem.png&userId=1402928 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Dimensions.png&userId=1402928 [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=AbsorptionSystem2.png&userId=1402928 [11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=CoCurrentBoundaryMesh.png&userId=1402928 [12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=CounterCurrentBoundaryMesh.png&userId=1402928 [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=CornerRefinement.png&userId=1402928 [14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Interface.png&userId=1402928 [15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=CoordIDs.png&userId=1402928 [16]: https://community.wolfram.com//c/portal/getImageAttachment?filename=testresult3.png&userId=1402928 [17]: https://community.wolfram.com//c/portal/getImageAttachment?filename=TestGrid.png&userId=1402928 [18]: https://community.wolfram.com//c/portal/getImageAttachment?filename=comsolresults.png&userId=1402928 [19]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Cmb_varyKld1v0gv0.gif&userId=1402928 [20]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Cmb_varydelta.gif&userId=1402928 [21]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Cmb_varyliqvelocity.gif&userId=1402928 [22]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Cmb_varygasvelocity.gif&userId=1402928 [23]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Cmb_varydeltalv5gv5.gif&userId=1402928 Tim Laska 2018-11-15T19:31:17Z 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/176000 hi all, i have a ContourPlot of an equation and would like to export it as a 3D file type. [mcode]ContourPlot3D[ x^2 + y^2 - x^2*z + y^2*z + z^2 - 1 == 0, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}][/mcode] can anyone tell me what to add to something like this in order to get it out as a 3D file but also /where/ i should expect this file to go? i am searching the help database and must admit that i sometimes have to be shown how to do these things since the pickorder and/or the syntax sometimes is hard for me to figure out. thanks in advance for any help. Jon Jonathan Chertok 2013-12-28T19:25:48Z https://community.wolfram.com/groups/-/m/t/126143 Hello everyone! I am trying to model the kinetics of an experimental system. I am trying to find the values of 3 variables in a system of differential equations by fitting them to an experimental data set. I have values for "g" as a function of time and I would like to find the values of "k1", "k2", and "k3" that provide the best fit to my data with minimun and maximum value constraints. The values of the k's in my example below are the correct values, as I have set this up to learn how so I can apply it to a more complex system. I've tried to learn through the online resources of Mathematica but I am having trouble getting it to work for me. [b]So in short, I would like to find the values of k1, k2, and k3 that solve my set of equations to best fit my experimental values of g. [/b] Notebook below: [mcode]k1 = 20; k2 = 10; k3 = 2; totaltime = 3;[/mcode][mcode]dataset1 = {{0, 0}, {0.15, 0.271161}, {0.3, 0.525314}, {0.45, 0.68284}, {0.6, 0.782049}, {0.75, 0.846992}, {0.9, 0.890934}, {1.05, 0.921414}, {1.5, 0.969472}};[/mcode][mcode]solution = NDSolve[ {a'[t] == -k1*a[t]*b[t], b'[t] == -k1*a[t]*b[t], c'[t] == k1*a[t]*b[t] - k3*c[t]*f[t], d'[t] == -k2*d[t]*e[t], e'[t] == -k2*d[t]*e[t], f'[t] == k2*d[t]*e[t] - k3*c[t]*f[t], g'[t] == k3*c[t]*f[t], a[0] == 5, b[0] == 2, c[0] == 0, d[0] == 2, e[0] == 1, f[0] == 0, g[0] == 0}, {a, b, c, d, e, f, g}, {t, 0, totaltime}, MaxSteps -> Infinity]; Show[{ListPlot[dataset1, PlotRange -> {{0, 1.6}, {0, 1}}, PlotRangeClipping -> True]}, Plot[Evaluate[{f[t], g[t]} /. solution], {t, 0, totaltime}, PlotLegends -> {"f", "g"}]][/mcode] A Magyar 2013-09-18T16:34:21Z 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/534384 I am trying to find a,b,c from this equation using an array of x and y, ![enter image description here][1] This is my input in mathematica, FindFit[{{171.29, 6}, {171.63, 12.1}, {171.86, 24.2}, {172.06, 48.3}}, {x == (((sqrt (a^2 + 8 a y) - a) (b - c))/(4 y)) + c}, {a, b, c}, {x, y}] But I get this message, FindFit::fitc: Number of coordinates (1) is not equal to the number of variables (2). >> Please advice how to solve for a,b,c [1]: /c/portal/getImageAttachment?filename=5562equation.png&userId=534369 Damodaran Achary 2015-07-22T22:09:16Z 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/140887 Hello there, I have data (in a .dat file) which consists of four columns. x, y, z are coordinates in 3D and i which is the measured intensity at the point defined by xyz. The data is continuous and should give some form of a 3D peak type shape. Thanks! Anna Regoutz 2013-10-18T13:31:09Z 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/135497 So I am generating large matrices (the smallest is 48x48) but only one half of the matrix is viable. Unltimately, what I need is a matrix that is symmetric about the diagonal. At the moment, I am just copying and pasting the values that I need, which is highly impractical as the size of the matrix scales up. The function I am using to generate the values is based off of the difference between the row and column, and so it generates different results when this value is negative verses positive. It also doesnt help to just wrap the difference in an Abs[], for whatever reason (I will post the code at the bottom just in case their is a way to get symmetry without messing with the matrices). I havent really been able to think of a way to do this, but what I would like to be able to do is just redefine all of the values on one half of the diagonal using the "correct" values on the other side of the diagonal. In this particular instance, the "correct" values are those in which m>n in the m x n matrix.  [mcode]pA[ j_, v_] := -I*(-1)^j*(2*DeA*MA)^(1/2)*K[ j, v ] K[ j_, v_ ] := ((Gamma[ k - v - j ]*Factorial[ v + j ]*(k - 2*v - 2*j - 1)*(k - 2*v - 1))/(Gamma[ k - v ]*Factorial[ v ]))^(1/2)*(1/ k) k := (4*DeA)/(\[HBar]*\[Omega]eA)[/mcode] All of those values are then used to generate the matrix, which I have called matpA: [mcode]matpA := Table[pA[((m - 1) - (n - 1)), (n - 1)], {m, vmaxA}, {n, vmaxA}][/mcode] Thanks so much for taking the time to read this and for any help you can provide! Cole Rodman 2013-10-07T20:48:05Z 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/172875 Hi, do you have any idea how to measure the distance between the two planes? I am a new user with Mathematica and your help will be greatly appreciated. [mcode]data1 = {{5.086735, -2.640504,     4.650624}, {6.227440, -2.477485, 3.843544}, {6.160519, -1.731605,     2.649288}, {4.941969, -1.164990, 2.267181}, {3.799611, -1.315889,     3.093711}, {3.864651, -2.054553, 4.284675}, {4.609149, -0.320793,     1.036262}, {3.147213, 0.034489, 1.303689}, {2.295200, 0.817536,     0.531891}, {0.950277, 1.010999, 0.934789}, {0.504240, 0.379798,     2.123730}, {1.354565, -0.416580, 2.898054}, {2.686409, -0.582108,     2.489055}, {0.024258, 1.821306, 0.114273}, {-1.353392, 1.513264,     0.069868}, {0.471982, 2.897945, -0.687157}, {-2.233955,     2.208380, -0.751826}, {-0.408676,     3.621409, -1.497147}, {-1.775026,     3.272191, -1.550693}, {-2.675546, 3.957425, -2.411557}}; In[9]:= Plane1 = Fit[data1, {1, x, y}, {x, y}] Out[9]= 2.18037 - 0.200355 x - 1.20793 y data2 = {{0.989404, -2.326574, -0.675663}, {0.466929, \ -2.898174, 0.507492}, {-0.913869, -2.780568,     0.804534}, {-1.736679, -2.093564, -0.078413}, {-1.209589, \ -1.521258, -1.260581}, {0.155306, -1.637212, -1.561214},    {-3.234276, -1.809443,     0.054719}, {-3.478451, -0.951209, -1.195212}, {-4.647861, \ -0.326679, -1.645893}, {-4.618728, 0.428750, -2.833379}, {-3.433297,     0.549231, -3.579976}, {-2.261558, -0.087363, -3.148840}, \ {-2.289342, -0.827551, -1.957816}, {1.326341, -3.595313,     1.453222}, {3.114413, -4.428375, 2.270776}, {2.668207, -3.758639 ,      1.167271}, {1.006758, -4.128596,     2.609730}, {2.180810, -4.675522, 3.140752}}; In[16]= Plane2 = Fit[data2, {1, x, y}, {x, y}] Out[16]= -4.19445 - 0.401548 x - 1.7137 y Show[ListPlot3D[data1, PlotStyle -> Red], ListPlot3D[data2, PlotStyle -> Green], Plot3D[{Plane1, Plane2}, {x, -7, 7}, {y, -7, 7}]] [/mcode] A Y 2013-12-19T19:47:40Z