Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Staff Picks sorted by activeModeling jump conditions in interphase mass transfer
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=1402928Tim Laska2018-11-15T19:31:17ZVisualizing Text Sentiments in RGBColor and ChromaticityPlot
https://community.wolfram.com/groups/-/m/t/1552094
Today, I got an idea, Why not show text sentiments value from different author in just one-shot all together?
So I write a few lines of code in Mathematica 11.3, see attached Notebook.
The idea is very nature. As people said, every color represents an emotion, and vice versa.
So I use "warm" red to represent positive, "cool" blue for negative, and green for neutral.
Let's start an example from Alice.
sentence = TextSentences[ExampleData[{"Text", "AliceInWonderland"}]];
sentiment = Classify["Sentiment", #, "Probabilities"] & /@ sentence;
width = Floor[N[Sqrt[Length@sentiment]], 1];
plot = ArrayPlot[
Partition[Take[RGBColor @@@ sentiment, width^2], width],
ImageSize -> 300, PlotLabel -> "Alice in Wonderland"]
![enter image description here][1]
Then I got all texts plot in various color.
![enter image description here][2]
Result Discussion:**
----------------------
1. Typical "Neutral" sentiments: "Origin of Species","Declaration of Independence"
![enter image description here][3]
![enter image description here][4]
2. Typical "Positive + Negative" (maybe more dramatic) sentiments: Shakespeares "Hamlet"
,"Sonnets"
![enter image description here][5]
![enter image description here][6]
3. Non-English Text: Sentiments classify may not be very accurate.
![enter image description here][7]
![enter image description here][8]
Take a glance, if the text-color match the color in your mind?
====================================================
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=example1.png&userId=569571
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=All.png&userId=569571
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=TextOriginOfSpecies.png&userId=569571
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=TextDeclarationOfIndependence.png&userId=569571
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=TextHamlet.png&userId=569571
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=TextShakespearesSonnets.png&userId=569571
[7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=TextFaustI.png&userId=569571
[8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=TextDonQuixoteISpanish.png&userId=569571Frederick Wu2018-11-16T09:51:40Z3D Design in Mathematica: Costa Rica Keychain
https://community.wolfram.com/groups/-/m/t/1549848
**[Open in Cloud][1]** | **[See Original][2]** | **Download to Desktop via Attachments Below**
Hi everyone! Welcome back to another 3D Design in Mathematica Tutorial. Last time I showed how to create a [polyhedral terrarium][3]. Today I will use Mathematica's MeshRegion command to design a keychain shaped like a country. I had the opportunity to visit Costa Rica in February 2017 and especially enjoyed my visit to the cloud forests of [Monteverde][4], so let's choose Costa Rica for our example.
![enter image description here][5]
##Step One: Import the shape of Costa Rica
We'll be relying on one of the strengths of Mathematica and the whole Wolfram suite—its vast amount of [curated data][6]. The command [CountryData][7] can access diverse information about countries such as their GDP, their population, their borders, their languages, and even their flags. For instance, we can access the shape of Costa Rica by using the following command.
CountryData["CostaRica", "Shape"]
![enter image description here][8]
What we would really like are the coordinates of the vertices of this shape, which we can acquire using the command:
vertices =
CountryData[Entity["Country", "CostaRica"], "Polygon"][[1, 1, 1]];
The first few elements of this list are:
![enter image description here][9]
which are the longitude and latitude of each of the coordinates.
##Step Two: Simplify the boundary
Keeping an eye toward printability, I realized that Costa Rica's actual land and sea borders are too complicated to be able to be printed in metal. (Shapeways has certain tolerances that must be adhered to for them to accept your file.) So I needed to find a way to smooth the border to reduce the complexity. After searching around for quite a while, I learned about a couple well-known simplification algorithms including [Mike Bostock][10]'s awesome [visualization][11] implementing the [Visvalingam-Whyatt algorithm][12].
I found this [list of implementations][13] of Mike's simplify code and was able to run the python implementation [on repl.it][14]. I needed to take the data from Mathematica and put it into the right python format to input into simplify, which would take a pair of coordinates {11.0785, -85.6911} and output them as the string {'x':11.0785, 'y':-85.6911}. So I used Mathematica's String operations.
newpoints =
StringJoin @@ Map["{'x':" <> ToString[#[[1]]] <> ", 'y':" <> ToString[#[[2]]] <> "}," &, vertices];
I input the resulting code:
> [{'x':11.0785, 'y':-85.6911}, {'x':11.2142, 'y':-85.6144}, ... ,
{'x':11.0782, 'y':-85.6907}]
into simplify with the parameter 0.05. The output was again in python format, which I needed to reconvert into Mathematica format by deleting extraneous characters:
StringDelete[StringDelete[newpoints, "'y':"], "'x':"]
We can compare the before and after of this process:
![enter image description here][15]
Notice that there are still some jagged parts of the polygon, so I decided to make a few manual adjustments too. The best way I have found to do this is to use the [ToolTip][16] command:
Graphics[{Polygon@simplified, Red, Map[Tooltip[Point@#, #] &, simplified]}]
which displays a vertex's coordinates when you hover over it so that I know I am removing the correct vertices.
![enter image description here][17]
By the end of this process, I had reduced the original polygon with over 1400 vertices to a polygon with 55 vertices that still contains the essence of the shape of Costa Rica.
simplified = {{-85.6911, 11.0785}, {-85.6144, 11.2142}, {-84.9387,
10.9541}, {-84.7104, 11.091}, {-84.4801, 10.973}, {-84.3577,
10.9965}, {-84.2041, 10.7839}, {-84.0131, 10.7908}, {-83.9293,
10.7087}, {-83.6779, 10.7938}, {-83.6978, 10.8801}, {-83.6401,
10.9096}, {-83.3902, 10.3557}, {-82.7786, 9.66272}, {-82.62,
9.57017}, {-82.6712, 9.49412}, {-82.8549, 9.57112}, {-82.9361,
9.47312}, {-82.9359, 9.07847}, {-82.7118, 8.92455}, {-82.9192,
8.76513}, {-82.83, 8.63599}, {-82.8396, 8.48029}, {-83.0517,
8.33343}, {-83.1454, 8.36625}, {-83.1207, 8.60242}, {-83.3745,
8.74827}, {-83.4645, 8.72645}, {-83.2844, 8.54143}, {-83.2774,
8.3865}, {-83.5892, 8.45915}, {-83.7345, 8.59876}, {-83.5704,
8.84997}, {-83.6403, 9.05175}, {-84.2461, 9.49397}, {-84.6181,
9.58172}, {-84.703, 9.92881}, {-84.774, 9.99558}, {-85.2166,
10.1833}, {-85.1987, 10.0272}, {-84.9217, 9.9254}, {-84.8642,
9.82857}, {-85.1111, 9.559}, {-85.2539, 9.78983}, {-85.6684,
9.90357}, {-85.8752, 10.3566}, {-85.7732, 10.4469}, {-85.811,
10.5156}, {-85.6993, 10.6107}, {-85.6584, 10.766}, {-85.9497,
10.8896}, {-85.8843, 10.9498}, {-85.7141, 10.9201}, {-85.755,
11.0254}, {-85.6907, 11.0782}};
##Step Three: Define an interior
I would like to make a raised lip around the outside of the keychain, so I will use some code I wrote last year that creates a boundary of a fixed thickness on the inside or outside of a given polygon.
Before I apply it, I'll remove some of the peninsulas from our polygon and some of the redundant vertices and visualize the difference:
minimal = {{-85.6144, 11.2142}, {-84.9387, 10.9541}, {-84.7104,
11.091}, {-84.4801, 10.973}, {-84.3577, 10.9965}, {-84.2041,
10.7839}, {-84.0131, 10.7908}, {-83.9293, 10.7087}, {-83.5979,
10.8238}, {-83.3902, 10.3557}, {-82.7786, 9.66272}, {-82.9361,
9.47312}, {-82.9359, 9.07847}, {-82.9192, 8.76513}, {-83.1207,
8.60242}, {-83.3745, 8.74827}, {-83.5704, 8.84997}, {-83.6403,
9.05175}, {-84.2461, 9.49397}, {-84.6181, 9.58172}, {-84.703,
9.92881}, {-84.774, 9.99558}, {-85.2166, 10.1833}, {-85.1987,
10.0272}, {-85.2539, 9.78983}, {-85.6684, 9.90357}, {-85.8752,
10.3566}, {-85.7732, 10.4469}, {-85.811, 10.5156}, {-85.6584,
10.766}, {-85.7141, 10.9201}}
Graphics[{Polygon@simplified, Gray, Polygon@minimal}]
![enter image description here][18]
Now let's describe the algorithm to create a polygon nested inside our bounding shape—we'll be using geometry and trigonometry! We define the vertices of the interior polygon in relation to the vertices of the exterior polygon. The interior vertex is found along the angle bisector of the edges incident with the exterior vertex. We determine its final position by ensuring that the distance to each exterior edge is the prescribed distance *ep*.
Let me give you the code and then dissect it.
ep = .15;
boundarypoints = Reverse@minimal;
interiorhalfangles =
Table[FullSimplify[
Mod[Apply[
ArcTan, (boundarypoints[[i]] -
boundarypoints[[Mod[i + 1, Length[boundarypoints], 1]]])] -
Apply[ArcTan, (boundarypoints[[Mod[i + 2,
Length[boundarypoints], 1]]] -
boundarypoints[[Mod[i + 1, Length[boundarypoints], 1]]])],
2 Pi]], {i, Length[boundarypoints]}]/2;
edgedirections =
Table[FullSimplify[
Apply[ArcTan,
boundarypoints[[Mod[i + 2, Length[boundarypoints], 1]]] -
boundarypoints[[Mod[i + 1, Length[boundarypoints], 1]]]]], {i,
Length[boundarypoints]}];
interiorvectors =
Map[AngleVector, interiorhalfangles + edgedirections];
interiorvertices =
MapThread[#1 + ep/Sin[#3] #2 &, {RotateLeft[boundarypoints],
interiorvectors, interiorhalfangles}]
We choose our thickness (*ep* for epsilon) to be .15. Notice that the following command is to invert the order of the points on the bounding polygon. If we had left the list as is, the new polygon would have been constructed on the outside of the original polygon instead of on the inside.
Then I find the interior half angles by using a special overloading of the ArcTan command. The expected functionality of ArcTan is that ArcTan applied to a single number finds the angle whose tangent is that number. More useful in this context is the two argument version of ArcTan:
**Useful Command**: ArcTan[x,y] gives the angle that the line through (x,y) makes with the positive x-axis.
I have used ArcTan to find the angles that each of the directed edges make with the positive x-axis and taking their difference modulo 2π so that the number is between 0 and 2π. Another command that seemed useful when I started programming was VectorAngle, which finds the angle between two vectors, but that gives the unsigned angle instead of the signed angle between the two vectors.
If we add the interior half angle to the angle that the corresponding edge makes with the x-axis, we get the direction of the vector leaving the exterior vertex toward the interior vertex. Applying the command AngleVector gives the unit vector in that direction. (It gives me warm fuzzy feelings to know that Mathematica has both a command VectorAngle and a command AngleVector!)
The interior vertices are finally calculated using trigonometry to calculate the distance along this unit vector from the exterior vertex.
The final result is a polygon that nests perfectly inside the original Costa Rica shape.
Graphics[{Polygon@simplified, Red, Polygon@interiorvertices}]
![enter image description here][19]
##Step Four: Create a Mesh Object
Now that we have our exterior polygon and our interior polygon, we will convert these Graphics objects into MeshRegion objects, since this seems to be the underlying structure necessary to export three dimensional objects to STL files. The first step is to use [DiscretizeGraphics][20] to convert the polygons into [MeshRegion][21] objects.
interior = DiscretizeGraphics@Graphics@Polygon@interiorvertices;
exterior = DiscretizeGraphics@Graphics@Polygon@simplified;
Then we use RegionDifference to excise the interior from the exterior.
lip = RegionDifference[exterior, interior]
![enter image description here][22]
The last pieces we need are the boundaries of these regions.
exteriorbdry = RegionBoundary@exterior;
interiorbdry = RegionBoundary@interior;
With these building blocks, we can create our three-dimensional model. We define four variables that are the heights of each of the layers, making sure that they are numerical / decimal instead of exact / infinitely precise numbers. There are errors if you use exact numbers like '0' instead of '0.'. I am not sure why.
**Pro tip**: Notice that I have defined these variables outside the subsequent code. By separating the definition of the variables, it makes it easier to modify the rest of the code later if you need to change a parameter for aesthetic or printing reasons.
extbottom = 0.;
intbottom = 0.1;
inttop = 0.2;
exttop = 0.3;
And then build the pieces that comprise the hull of the model by using a RegionProduct command.
Show[RegionProduct[interior, Point[{{intbottom}}]],
RegionProduct[interior, Point[{{inttop}}]],
RegionProduct[interiorbdry, Line[{{extbottom}, {intbottom}}]],
RegionProduct[interiorbdry, Line[{{inttop}, {exttop}}]],
RegionProduct[lip, Point[{{extbottom}}]],
RegionProduct[lip, Point[{{exttop}}]],
RegionProduct[RegionBoundary@exteriorbdry,
Line[{{extbottom}, {exttop}}]]]
You can see each of these objects individually and all assembled together.
![enter image description here][23]
##Step Five: Add a loop
Since we want to use this object as a keychain, we need to add in a ring onto which we can clip a key ring. To do this we will be adding a torus into the object, which has this general form.
thickness = .15;
innerradius = .8;
outerradius = 2;
xcoord = -84;
ycoord = 10.75;
zcoord = Mean[{extbottom, exttop}];
loop = ParametricPlot3D[{(outerradius thickness +
innerradius thickness Cos[v]) Cos[u] +
xcoord, (outerradius thickness +
innerradius thickness Cos[v]) Sin[u] + ycoord + 2 thickness,
thickness Sin[v] + zcoord}, {u, 0, 2 Pi}, {v, 0, 2 Pi},
Mesh -> None, PlotPoints -> 200]
![enter image description here][24]
I chose the ring to have the same thickness as the body and played with the other parameters, especially the x-, y-, and z-translations to figure out where best on the model to place it. One reason why I think my choices work well is because the circle is basically just North of the center of gravity—the map of Costa Rica will have North oriented upward when dangling from the keychain!
##Step Six: Send to the printer!
Now let's print out the model! (Remember that there is more detail on the prototyping and printing processes at the bottom of the [name ring design post][25].) One thing we have to take into consideration is that stainless steel requires a 1 mm thickness everywhere, which may mean that you will have to change the thickness parameters above if you want to shrink the keychain much smaller. Here is what Shapeways gives as a 3D rendering of the keychain:
![enter image description here][26]
And [here][27] is a 3D rendering of the keychain by Sketchfab.
[![enter image description here][28]][29]
Now you have the tools to make your own keychain for any country or administrative region. What countries are on your bucket keychain list? Until next time!
[1]: https://www.wolframcloud.com/objects/wolfram-community/3D-Design-Costa-Rica-Keychain-by-Christopher-Hanusa
[2]: http://blog.mathzorro.com/2017/05/costa-rica-keychain.html
[3]: http://blog.mathzorro.com/2017/04/polyhedral-terrarium.html
[4]: https://en.wikipedia.org/wiki/Monteverde%22
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-11-13at4.46.12PM.jpg&userId=20103
[6]: https://reference.wolfram.com/language/howto/UseCuratedData.html
[7]: http://reference.wolfram.com/language/ref/CountryData.html
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=60931.png&userId=20103
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=50202.png&userId=20103
[10]: https://bost.ocks.org/mike/
[11]: https://bost.ocks.org/mike/simplify/
[12]: https://hydra.hull.ac.uk/resources/hull:8338
[13]: https://github.com/mourner/simplify-js
[14]: https://repl.it/HX04/1
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-11-13at16.09.50.png&userId=20103
[16]: https://reference.wolfram.com/language/ref/Tooltip.html
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=18243.png&userId=20103
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=62184.png&userId=20103
[19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=32995.png&userId=20103
[20]: https://reference.wolfram.com/language/ref/DiscretizeGraphics.html
[21]: https://reference.wolfram.com/language/ref/MeshRegion.html
[22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=42766.png&userId=20103
[23]: http://community.wolfram.com//c/portal/getImageAttachment?filename=56697.png&userId=20103
[24]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-11-13at12.49.33.png&userId=20103
[25]: http://blog.mathzorro.com/2017/03/Creating-a-Name-Ring.html
[26]: http://community.wolfram.com//c/portal/getImageAttachment?filename=11178.png&userId=20103
[27]: https://skfb.ly/67TPJ
[28]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-11-13at4.48.51PM.png&userId=20103
[29]: https://skfb.ly/67TPJChristopher Hanusa2018-11-13T22:33:28Z[WSS18] Introducing Hadamard Binary Neural Networks
https://community.wolfram.com/groups/-/m/t/1374288
##Introducing Hadamard Binary Neural Networks
Deep neural networks are an important tool in modern applications. It has become a major challenge to accelerate their training. As the complexity of our training tasks increase, the computation does too. For sustainable machine learning at scale, we need distributed systems that can leverage the available hardware effectively. This research hopes to exceed the current state of the art performance of neural networks by introducing a new architecture optimized for distributability. The scope of this work is not just limited to optimizing neural network training for large servers, but also to bring training to heterogeneous environments; paving way for a distributed peer to peer mesh computing platform that can harness the wasted resources of idle computers in a workplace for AI.
#### Network Architecture and Layer Evaluator
Here, I will describe the network and the Layer Evaluator, to get an in depth understanding of the network architecture.
Note:
- **hbActForward** : Forward binarization of Activations.
- **hbWForward** : Forward binarization of Weights.
- **binAggression** : Aggressiveness of binarization (Vector length to binarize)
Set up the Layer Evaluator.
layerEval[x_, layer_Association] := layerEval[x, Lookup[layer, "LayerType"], Lookup[layer, "Parameters"]];
layerEval[x_, "Sigmoid", param_] := 1/(1 + Exp[-x]);
layerEval[x_, "Ramp", param_] := Abs[x]*UnitStep[x];
layerEval[ x_, "LinearLayer", param_] := Dot[x, param["Weights"]];
layerEval[ x_, "BinLayer", param_] := Dot[hbActForward[x, binAggression], hbWForward[param["Weights"], binAggression]];
layerEval[x_, "BinarizeLayer", param_] := hbActForward[x, binAggression];
netEvaluate[net_, x_, "Training"] := FoldList[layerEval, x, net];
netEvaluate[net_, x_, "Test"] := Fold[layerEval, x, net];
Define the network
net = {<|"LayerType" -> "LinearLayer", "Parameters" -> <|"Weights" -> w0|>|>,
<|"LayerType" -> "Ramp"|>,
<|"LayerType" -> "BinarizeLayer"|>,
<|"LayerType" -> "BinLayer", "Parameters" -> <|"Weights" -> w1|>|>,
<|"LayerType" -> "Ramp"|>,
<|"LayerType" -> "BinLayer", "Parameters" -> <|"Weights" -> w2|>|>,
<|"LayerType" -> "Sigmoid"|> };
MatrixForm@netEvaluate[net, input[[1 ;; 3]], "Test" ] (* Giving network inputs *)
![enter image description here][1]
#### Advantages of Hadamard Binarization
- Faster convergence with respect to vanilla binarization techniques.
- Consistently about 10 times faster than CMMA algorithm.
- Angle of randomly initialized vectors preserved in high dimensional spaces. (Approximately 37 degrees as vector length approach infinity.)
- Reduced communication times for distributed deep learning.
- Optimization of im2col algorithm for faster inference.
- Reduction of model sizes.
### Accuracy analysis
![enter image description here][2]
As seen above, the HBNN model gives 87% accuracy, whereas the BNN model (Binary Neural Networks) give only 82%. These networks have only been trained for 5 epochs.
### Performance Analysis
X Axis: Matrix Size
| Y Axis: Time (seconds)
**CMMA vs xHBNN**
![enter image description here][3]
**MKL vs xHBNN**
$\hspace{1mm}$![enter image description here][4]
### Visualize weight histograms
![enter image description here][5]
It is evident that the Hadamard BNN preserves the distribution of the weights much better. Note that the BNN graph has a logarithmic vertical axis, for representation purposes.
### Demonstration of the angle preservation ability of the HBNN architecture
![enter image description here][6]
Binarization approximately preserves the direction of high dimensional vectors. The figure above demonstrates that the angle between a random vector (from a standard normal distribution) and its binarized version converges to ~ 37 degrees as the dimension of the vector goes to infinity. This angle is exceedingly small in high dimensions.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=tempz.png&userId=1302993
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=accuracy.png&userId=1302993
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=6613xCma.png&userId=1302993
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=xMKL.png&userId=1302993
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=histogram.png&userId=1302993
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=anglepreserve.png&userId=1302993Yash Akhauri2018-07-10T22:12:26ZPrime Digit Sums
https://community.wolfram.com/groups/-/m/t/1547925
**[Open in Cloud][1] | Download to Desktop via Attachments Below**
The digit sum of a number is defined as the sum of the number's digits -- for example, the digit sum of 1753 is 1 + 7 + 5 + 3 = 16. Suppose we want to find a prime number with a specific digit sum, say 100. The first question we might ask is how large such a prime has to be.
Assume the prime has n digits, and that the digits are uniformly distributed across their possible values. The latter is not strictly true, but is a reasonable (and useful) approximation. The first digit ranges from 1 to 9, so its mean contribution to the digit sum is (1 + 2 + ... + 8 + 9) / 9 = 5. The last digit can only be 1, 3, 7 or 9, so its mean contribution is 5 as well. The n - 2 middle digits range from 0 to 9, so their mean contribution to the digit sum is 4.5. The expected number of digits in a prime with digit sum of 100 is then:
Solve[5 + 4.5 (n - 2) + 5 == 100.]
which Mathematica evaluates as
<pre>{{n -> 22.}}</pre>
&nbsp;
The following statement generates a list of 22-digit primes with digital sum equal to 100:
Select[Total[IntegerDigits[#]] == 100 &] @
Table[RandomPrime[{10^21, 10^22 - 1}], 500]
This produced a list of 29 primes, each of them with digit sum 100:
<pre>{4521257098793752154293, 9017327967050768510809, 3543471831774385676233,
4951733709836020590667, 5026500359626929375097, 4830276814937101295983,
4011907639876429249513, 6171811939300897296109, 5866137711153653636863,
8677001882936009545831, 4982358962465604851221, 3423014619370074987967,
8922054209057943887341, 1531029595478281847173, 4171093644776292816481,
7954066375059510903583, 8139443827613312593459, 3619554293242633643893,
5380882911097144908157, 5584139552066825826217, 4205239726768073229169,
3152572162924535569891, 4121557920549990576217, 8927457552171433903933,
5108738173157780358607, 8037860073637146096259, 1259940420399148246387,
6208576318302772942981}</pre>
&nbsp;
After many runs, it seems that about 4.3% of 22-digit primes have digital sums equal to 100. Since the number of 22-digit primes is approximately LogIntegral[10.<sup>22</sup>] - LogIntegral[10.<sup>21</sup>] = 1.8x10<sup>20</sup>, there are around 7.7x10<sup>18</sup> 22-digit primes with digital sum equal to 100. This is something like the age of the universe in seconds -- an enormous number.
##Smallest Prime##
Next we might ask, what is the smallest prime with digit sum 100? Obviously it will have more than 11 digits, since the maximum digit sum of an 11-digit number is 99. Suppose we prepend the digit 1 to a string of eleven 9s. If this is a prime we can go home early:
PrimeQ[199999999999]
Unfortunately, Mathematica evaluates this as `False`. But to minimize the number of digits, we do want the number to have as many 9s as possible. Consider numbers containing ten 9s and an additional two digits that add up to 10. Are there any primes among them? The following code generates all such numbers, select the primes, and sorts them from smallest to largest:
num = Table[9, 10];
pList2 = Sort@
Select[PrimeQ]@
DeleteDuplicates@
Flatten@Table[
FromDigits[Insert[Insert[num, i, j], 10 - i, k]], {i, 1, 5}, {j,
1, 11}, {k, 1, 12}]
The result is a list of 57 primes:
<pre>{298999999999, 299899999999, 299999989999, 299999999989, 399979999999,
399999979999, 499999999699, 694999999999, 699999999499, 799399999999,
799999399999, 899929999999, 899999999929, 929899999999, 929999899999,
929999989999, 937999999999, 939979999999, 939999979999, 939999997999,
949969999999, 979999399999, 989929999999, 989999299999, 991999999999,
992989999999, 992999989999, 993799999999, 993999999997, 995999999959,
996999994999, 997993999999, 998992999999, 998999999929, 999299989999,
999499699999, 999499969999, 999799993999, 999929998999, 999969499999,
999969999949, 999989299999, 999992989999, 999992998999, 999993999997,
999995999599, 999997993999, 999999599959, 999999699499, 999999799399,
999999939997, 999999949969, 999999969499, 999999982999, 999999991999,
999999997939, 999999999937}</pre>
&nbsp;
The smallest is 298999999999. Call this number p1. Can there be any prime smaller than p1 with digital sum of 100? Suppose there is one. If it exists, it too must have 12 digits.
Since the hypothetical prime is less than p1 and has the same number of digits, then at least one of its digits must be smaller than the corresponding digit in p1. If at least one digit is smaller, then to maintain the digital sum of 100, at least one digit must be larger than the corresponding digit in p1. But the only digit that can be larger is the 8, and it can only be 9.
If the 8 is increased to 9, then to maintain the digital sum of 100 one of the other digits must be decreased by 1. We could decrease the 2 to get 199999999999, but we've already seen that that is not a prime. The only other possibility is to change the second digit to an 8, giving 289999999999. But if this were a prime, it would occur in pList2. Since it does not, 298999999999 is the least prime with a digital sum of 100.
##Largest Prime##
What is the largest prime with digital sum 100? For this problem to have an answer, we must restrict ourselves to nonzero digits only. The obvious first choice is a string of 100 1s:
PrimeQ[FromDigits[Table[1, 100]]]
But Mathematica evaluates this as `False`. However, to maximize the number of digits we do want as many 1s as possible. We next look at numbers containing all ones and one other non-unit digit. For example, 98 1s and a 2, or 97 1s and a 3, etc. The code below generates all such numbers, selects those that are prime, and sorts them from smallest to largest:
plist3 = Sort@
Select[PrimeQ][
FromDigits /@
Flatten[Table[
Insert[Table[1, 100 - i], i, j], {i, 2, 9}, {j, 101 - i}], 1]]
The result is a list of 11 primes:
<pre>{111119111111111111111111111111111111111111111111111111111111111111111\
11111111111111111111111,
1111111111111111111111111111111111111111111111111111111111111111111111\
11111111111111118111111,
1111111111111117111111111111111111111111111111111111111111111111111111\
111111111111111111111111,
1111111111171111111111111111111111111111111111111111111111111111111111\
111111111111111111111111,
1111111117111111111111111111111111111111111111111111111111111111111111\
111111111111111111111111,
1711111111111111111111111111111111111111111111111111111111111111111111\
111111111111111111111111,
1111111111111111111111111111111111111111111111111111111111111111111111\
1111161111111111111111111,
1111111111111111111111111111111111111111111111111111111111111111111111\
11111111111111111151111111,
1111111111111111111111111111111111111111111115111111111111111111111111\
11111111111111111111111111,
1111111111111111113111111111111111111111111111111111111111111111111111\
1111111111111111111111111111,
1111111111111111111111111111111111111111111111112111111111111111111111\
11111111111111111111111111111}</pre>
&nbsp;
The largest is 111111111111111111111111111111111111111111111111211111111111111111111111111111111111111111111111111. Let's call this number p2. An argument similar to the one given for the smallest prime shows that p2 is the largest prime with nonzero digits and a digit sum of 100. For if there is a larger prime, it too will have 99 digits, meaning at least one of the digits will be larger than the corresponding digit in p2, and at least one other digit will be smaller. But the only digit that can be smaller is the 2, which would become a one. That means one of the other ones has to become a 2. Therefore the hypothetical prime must also have 98 1s and a 2. But the algorithm above found all such primes, and p2 is the only one. Thus there is no larger prime.
[1]: https://www.wolframcloud.com/objects/wolfram-community/Prime-Digit-Sums-by-John-ShonderJohn Shonder2018-11-12T00:32:45Z