Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Language sorted by activeSolve the Nonlinear Schroedinger Equation with NDSolve?
https://community.wolfram.com/groups/-/m/t/1547257
I’m trying to solve the a special form of the Nonlinear Schroedinger Equation using NDSolve (see file attached) and run into the problem of “Warning: scaled local spatial error estimate of …”. This is presumably due to the low resolution along the tau-axis, while increasing this number leads to a massive increase in simulation time.
For instance if I set MinPoints=600, simulation time is 0.47s, while if MinPoints=2000, simulation time increases to 80s, while the warning is still present.
Does any one of you have experience in setting up NDSolve such that good solutions are obtained while maintaining a reasonable simulation speed, particular in the case of the Nonlinear Schrödinger Equation?
What is actually the meaning of “MaxStepSize”?
Thanks in advance. MarkusMarkus Schmidt2018-11-11T14:45:28ZGet historical PE-ratios with FinancialData?
https://community.wolfram.com/groups/-/m/t/1550095
I have tried to get historical PE-ratios with FinancialData like this:
FinancialData["MSFT","PERatio",{2000,1,1}
But with this I only get one value, i.e. the latest PE-ratio. I had expected a whole list of them.
What do I do wrong?Laurens Wachters2018-11-14T13:08:49ZHow do I find the list of values for an EntityProperty qualifier?
https://community.wolfram.com/groups/-/m/t/1555220
Cross-Post on [StackExchange](https://mathematica.stackexchange.com/q/186262/38205)
---
I have an [`EntityProperty`](https://reference.wolfram.com/language/ref/EntityProperty.html) and [I know how to get its list of qualifiers](https://mathematica.stackexchange.com/q/186262/38205). Now how do I figure out the possible values these can take programmatically? Here's an example to get us started:
EntityValue[
EntityProperty["Country", "ExternalBalance"],
"Qualifiers"
]
{"CurrencyUnit", "Date", "PercentOfGDP", "TradeSection"
Now, say, how do I programmatically determine what `"CurrencyUnit"`, `"TradeSection"`, and `"PercentOfGDP"` can be?b3m2a1 2018-11-18T20:46:01ZModeling 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:40ZSpeed up the process of exporting audio to mp3 format?
https://community.wolfram.com/groups/-/m/t/1545310
I was exporting a 60 second audio clip last night, and after waiting half an hour I went to bed. (The export had completed by the time I woke up this morning.)
Why does Mathematica require over 30 minutes for a job like this when any half decent free audio app can do it in seconds?Andrew Dabrowski2018-11-08T15:04:25ZPerformance of recursion code with radial polynomials
https://community.wolfram.com/groups/-/m/t/1549861
Consider the following code:
Clear[r, re, p, pmax, delta, imagesize, delta]
ClearSystemCache[]
re[0, r_] := Sqrt[8/Pi]*((1 - r)/r)^(1/4)*1;
re[1, r_] := Sqrt[8/Pi]*((1 - r)/r)^(1/4)*-1*2*(1 - 2*r);
re[p_, r_] := re[p, r] = Sqrt[8/Pi]*((1 - r)/r)^(1/4)*(-1)^p*(re[1, r]*re[p - 1, r] - re[p - 2, r]);
imagesize = 32;
pmax = 10;
delta = 2/imagesize;
Table[r = Sqrt[x^2 + y^2]; re[pmax, r], {x, -1 + delta/2, 1 - delta/2, delta}, {y, 1 - delta/2, -1 + delta/2, -delta}];
this code is to calculate the distance r from each pixel to point(0,0), then evaluate the radial polynomial as below:
![enter image description here][1]
for accuracy, I will use the recursion version:
![enter image description here][2]
when the imagesize and pmax increase, the time will become unacceptable. So, I would ask if we can use compile of other methods to speed up,like: for imagesize is 256 and pmax is 120, the time will be about 10 seconds. In my code, I also use the memoization to store the value during the evaluation which I will use in the future.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1.png&userId=1399878
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2.png&userId=1399878look xu2018-11-14T00:34:36ZHow can I integrate this calculus?
https://community.wolfram.com/groups/-/m/t/1552453
Hi everyone! I am trying to carry out modeling of a system. However, in my modeling, I need to simulate/ integrate this integral which has been difficult for me. Please, I need your helps and inputs.
The integral is:
> integrate {(ArcCos (((r^2) + (v^2) - (D^2))/(2 * v * r)}* {(2*L *
> r)/(1+((r^e)/(Z)))))} dr
I have tried to solve it this way, but I am not getting it.
A = (ArcCos (((r^2) + (v^2) - (D^2))/(2 * v * r)))
B = ((2*L * r)/(1+((r^e)/(Z))))
integrate(A * B) dr
However, writing it together as;
integrate ((ArcCos (((r^2) + (v^2) - (D^2))/(2 * v * r))* ((2*L * r)/(1+((r^e)/(Z))))))dr
gives this error:
> (no result found in terms of standard mathematical functions)Sam Oke2018-11-16T13:43:43ZSolve a large system of equations with 19 variables?
https://community.wolfram.com/groups/-/m/t/1552056
I need a little help in formulating the correct logic for a set of equations. There are 19 variables with relationships as follows. {p1, p2, ....p19} where {p1, {p2, p4, p5}}. In relation to this the logic is as follows:- p1 has 3 dependents and p1 can be any integer from 1 to 4, the 3 dependents have to take values from 1 to p1-1, any unset variables can be any integer from 1 to 7. . p2 has 4 dependents and as such p2 can be any value from 1 to 5 and it's 4 dependent variables have to include the integers 1 to p2-1 and any unset variable can be any value from 1 to 7. and finally p5 has 6 dependent variables so p5 can be any value from 1 to 7 and it's 6 dependents must contain values from 1 to p5-1 and any unset variable can be any value from 1 to 7. there is a total sum of all 19 variables.
I am not sure if my logic is correct, here is a small part of my system of equations the full set is many lines long.
Solve[{p1 >= p2 || p1 >= p4 || p1 >= p5,
p2 >= p3 || p2 >= p1 || p2 >= p5 || p2 >= p6,
p3 >= p2 || p3 >= p6 || p3 >= p7,....p1 > 0, p2 > 0, p3 > 0,.....p1 + p2 + p3 + p4 + p5 +....==58,p1 <= 4, p3 <= 4,....,p10 <= 7, p11 <= 7},{p1, p2, p3, p4, p5, p6,...},Integers]
# UPDATE:
Solve[{p1 >= p2, p1 >= p4, p1 >= p5, p2 >= p3, p2 >= p1, p2 >= p5,
p2 >= p6, p3 >= p2, p3 >= p6, p3 >= p7, p4 >= p5, p4 >= p1,
p4 >= p8, p4 >= p9, p5 >= p6, p5 >= p4, p5 >= p1, p5 >= p2,
p5 >= p9, p5 >= p10, p6 >= p7, p6 >= p5, p6 >= p2, p6 >= p3,
p6 >= p10, p6 >= p11, p7 >= p6, p7 >= p3, p7 >= p11, p7 >= p12,
p8 >= p9, p8 >= p4, p8 >= p13, p9 >= p10, p9 >= p8, p9 >= p5,
p9 >= p4, p9 >= p14, p9 >= p13, p10 >= p11, p10 >= p9, p10 >= p6,
p10 >= p5, p10 >= p15, p10 >= p14, p11 >= p12, p11 >= p10,
p11 >= p7, p11 >= p6, p11 >= p16, p11 >= p15, p12 >= p11,
p12 >= p7, p12 >= p16, p13 >= p14, p13 >= p8, p13 >= p9,
p13 >= p17, p14 >= p15, p14 >= p13, p14 >= p9, p14 >= p10,
p14 >= p18, p14 >= p17, p15 >= p16, p15 >= p14, p15 >= p10,
p15 >= p11, p15 >= p19, p15 >= p18, p16 >= p15, p16 >= p11,
p16 >= p12, p16 >= p19, p17 >= p18, p17 >= p13, p17 >= p14,
p18 >= p19, p18 >= p17, p18 >= p14, p18 >= p15, p19 >= p18,
p19 >= p15, p19 >= p16, p1 > 0, p2 > 0, p3 > 0, p4 > 0, p5 > 0,
p6 > 0, p7 > 0, p8 > 0, p9 > 0, p10 > 0, p11 > 0, p12 > 0, p13 > 0,
p14 > 0, p15 > 0, p16 > 0, p17 > 0, p18 > 0, p19 > 0,
p1 + p2 + p3 + p4 + p5 + p6 + p7 + p8 + p9 + p10 + p11 + p12 + p13 +
p14 + p15 + p16 + p17 + p18 + p19 == 58, p1 <= 4, p3 <= 4,
p8 <= 4, p12 <= 4, p17 <= 4, p19 <= 4, p2 <= 5, p4 <= 5, p7 <= 5,
p13 <= 5, p16 <= 5, p18 <= 5, p10 <= 7, p11 <= 7, p14 <= 7,
p15 <= 7, p5 <= 7, p6 <= 7, p9 <= 7}, {p1, p2, p3, p4, p5, p6, p7,
p8, p9, p10, p11, p12, p13, p14, p15, p16, p17, p18, p19}, Integers]
Within a minute or so all 32 gb of memory has been used and a few minutes later the kernel shuts down.Paul Cleary2018-11-15T23:23:14ZConstrain inputs for the gain function of LQR Controller?
https://community.wolfram.com/groups/-/m/t/1552047
Hi there, I'm working on a small project, whereby I'm controlling an inverted pendulum via Flywheel and a bldc motor.
I have a NonlinearStateSpacemodel with a single input u[t] and single output theta[t] (the angle of the pendulum body) .
I have completely simulated the system, and created a control scheme that seems to work well, even made a nice little animation to visualize.
![pendulum][1] (please excuse the framerate)
Now comes to the point of programming my micrcontroller, and running/verifying the experiment. However, I've come to notice the control equation ends up producing a solution that can could calculate thousands of ampres...However the motor itself can only take 2...Is there a way within Mathematica and the control system to constrain inputs for the gain function directly using builtin functions? Or must this be done via a semi-smooth newtonian solver or something "hand made"
I can gladly post code should a person want to play with my system, or more info is required.
Thanks for the help!
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=test.gif&userId=1222283Mor Bo2018-11-15T22:46:50ZTry to beat these MRB constant records!
https://community.wolfram.com/groups/-/m/t/366628
Map:
- First we have these record number of digits of the MRB constant
computations.
- Next, we have speed records.
- Then, for a few replies, we compute the MRB constant from Crandall's
eta derivative formulas and see records there.
- The latest reply is "NEW RECORD ATTEMPTS OF 4,000,000 DIGITS!" (at
the end).
POSTED BY: Marvin Ray Burns .
**MKB constant calculations,**
![enter image description here][1] ,
**have been moved to their own discussion at**
[Calculating the digits of the MKB constant][2] .
I think the following important point got buried near the end.
When it comes to mine and a few other people's passion to calculate many digits of constants and the dislike possessed by a few more people, it is all a matter telling us that minds work differently!
The MRB constant is defined below. See http://mathworld.wolfram.com/MRBConstant.html
$$\text{MRB}=\sum _{n=1}^{\infty } (-1)^n \left(n^{1/n}-1\right)$$
Here are some record computations. If you know of any others let me know..
1. On or about Dec 31, 1998 I computed 1 digit of the (additive inverse of the) MRB constant with my TI-92's, by adding 1-sqrt(2)+3^(1/3)-4^(1/4) as far as I could and then by using the sum feature to compute $\sum _{n=1}^{1000 } (-1)^n \left(n^{1/n}\right).$ That first digit, by the way, is just 0.
2. On Jan 11, 1999 I computed 3 digits of the MRB constant with the Inverse Symbolic Calculator.
3. In Jan of 1999 I computed 4 correct digits of the MRB constant using Mathcad 3.1 on a 50 MHz 80486 IBM 486 personal computer operating on Windows 95.
4. Shortly afterwards I computed 9 correct digits of the MRB constant using Mathcad 7 professional on the Pentium II mentioned below.
5. On Jan 23, 1999 I computed 500 digits of the MRB constant with the online tool called Sigma.
6. In September of 1999, I computed the first 5,000 digits of the MRB Constant on a 350 MHz Pentium II with 64 Mb of ram using the simple PARI commands \p 5000;sumalt(n=1,((-1)^n*(n^(1/n)-1))), after allocating enough memory.
7. On June 10-11, 2003 over a period, of 10 hours, on a 450mh P3 with an available 512mb RAM: I computed 6,995 accurate digits of the MRB constant.
8. Using a Sony Vaio P4 2.66 GHz laptop computer with 960 MB of available RAM, on 2:04 PM 3/25/2004, I finished computing 8000 digits of the MRB constant.
9. On March 01, 2006 with a 3GH PD with 2GBRAM available, I computed the first 11,000 digits of the MRB Constant.
10. On Nov 24, 2006 I computed 40, 000 digits of the MRB Constant in 33hours and 26min via my own program in written in Mathematica 5.2. The computation was run on a 32-bit Windows 3GH PD desktop computer using 3.25 GB of Ram.
11. Finishing on July 29, 2007 at 11:57 PM EST, I computed 60,000 digits of MRB Constant. Computed in 50.51 hours on a 2.6 GH AMD Athlon with 64 bit Windows XP. Max memory used was 4.0 GB of RAM.
12. Finishing on Aug 3 , 2007 at 12:40 AM EST, I computed 65,000 digits of MRB Constant. Computed in only 50.50 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 5.0 GB of RAM.
13. Finishing on Aug 12, 2007 at 8:00 PM EST, I computed 100,000 digits of MRB Constant. They were computed in 170 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 11.3 GB of RAM. Median (typical) daily record of memory used was 8.5 GB of RAM.
14. Finishing on Sep 23, 2007 at 11:00 AM EST, I computed 150,000 digits of MRB Constant. They were computed in 330 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 22 GB of RAM. Median (typical) daily record of memory used was 17 GB of RAM.
15. Finishing on March 16, 2008 at 3:00 PM EST, I computed 200,000 digits of MRB Constant using Mathematica 5.2. They were computed in 845 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 47 GB of RAM. Median (typical) daily record of memory used was 28 GB of RAM.
16. Washed away by Hurricane Ike -- on September 13, 2008 sometime between 2:00PM - 8:00PM EST an almost complete computation of 300,000 digits of the MRB Constant was destroyed. Computed for a long 4015. Hours (23.899 weeks or 1.4454*10^7 seconds) on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 91 GB of RAM. The Mathematica 6.0 code used follows:
Block[{$MaxExtraPrecision = 300000 + 8, a, b = -1, c = -1 - d,
d = (3 + Sqrt[8])^n, n = 131 Ceiling[300000/100], s = 0}, a[0] = 1;
d = (d + 1/d)/2; For[m = 1, m < n, a[m] = (1 + m)^(1/(1 + m)); m++];
For[k = 0, k < n, c = b - c;
b = b (k + n) (k - n)/((k + 1/2) (k + 1)); s = s + c*a[k]; k++];
N[1/2 - s/d, 300000]]
17. On September 18, 2008 a computation of 225,000 digits of MRB Constant was started with a 2.66GH Core2Duo using 64 bit Windows XP. It was completed in 1072 hours. Memory usage is recorded in the attachment pt 225000.xls, near the bottom of this post. .
18. 250,000 digits was attempted but failed to be completed to a serious internal error which restarted the machine. The error occurred sometime on December 24, 2008 between 9:00 AM and 9:00 PM. The computation began on November 16, 2008 at 10:03 PM EST. Like the 300,000 digit computation this one was almost complete when it failed. The Max memory used was 60.5 GB.
19. On Jan 29, 2009, 1:26:19 pm (UTC-0500) EST, I finished computing 250,000 digits of the MRB constant. with a multiple step Mathematica command running on a dedicated 64bit XP using 4Gb DDR2 Ram on board and 36 GB virtual. The computation took only 333.102 hours. The digits are at http://marvinrayburns.com/250KMRB.txt . The computation is completely documented in the attached 250000.pd at bottom of this post.
20. On Sun 28 Mar 2010 21:44:50 (UTC-0500) EST, I started a computation of 300000 digits of the MRB constant using an i7 with 8.0 GB of DDR3 Ram on board.; But it failed due to hardware problems.
21. I computed 299,998 Digits of the MRB constant. The computation began Fri 13 Aug 2010 10:16:20 pm EDT and ended 2.23199*10^6 seconds later |
Wednesday, September 8, 2010. I used Mathematica 6.0 for Microsoft
Windows (64-bit) (June 19, 2007) That is an average of 7.44 seconds per digit.. I used my Dell Studio XPS 8100 i7 860 @ 2.80 GH 2.80 GH
with 8GB physical DDR3 RAM. Windows 7 reserved an additional 48.929
GB virtual Ram.
22. I computed exactly 300,000 digits to the right of the decimal point
of the MRB constant from Sat 8 Oct 2011 23:50:40 to Sat 5 Nov 2011
19:53:42 (2.405*10^6 seconds later). This run was 0.5766 seconds per digit slower than the
299,998 digit computation even though it used 16GB physical DDR3 RAM on the same machine. The working precision and accuracy goal
combination were maximized for exactly 300,000 digits, and the result was automatically saved as a file instead of just being displayed on the front end. Windows reserved a total of 63 GB of working memory of which at 52 GB were recorded being used. The 300,000 digits came from the Mathematica 7.0 command
Quit; DateString[]
digits = 300000; str = OpenWrite[]; SetOptions[str,
PageWidth -> 1000]; time = SessionTime[]; Write[str,
NSum[(-1)^n*(n^(1/n) - 1), {n, \[Infinity]},
WorkingPrecision -> digits + 3, AccuracyGoal -> digits,
Method -> "AlternatingSigns"]]; timeused =
SessionTime[] - time; here = Close[str]
DateString[]
23. 314159 digits of the constant took 3 tries do to hardware failure. Finishing on September 18, 2012 I computed 314159 digits, taking 59 GB of RAM. The digits are came from the Mathematica 8.0.4 code
DateString[]
NSum[(-1)^n*(n^(1/n) - 1), {n, \[Infinity]},
WorkingPrecision -> 314169, Method -> "AlternatingSigns"] // Timing
DateString[]
There I had 10 digits to round off. (The command NSum[(-1)^n*(n^(1/n) - 1), {n, \[Infinity]},
WorkingPrecision -> big number, Method -> "AlternatingSigns"] tends to give about 3-5 digits of error to the right.)
**The following records are due to the work of Richard Crandall found [here][3]. **
24. Sam Noble of Apple computed 1,000,000 digits of the MRB constant in 18 days 9 hours 11 minutes 34.253417 seconds
25. Finishing on Dec 11, 2012 Ricard Crandall, an Apple scientist, computed 1,048,576 digits
in a lighting fast 76.4 hours (probably processor time). That's on a 2.93 Ghz 8-core Nehalem. **It took until the use of DDR4 to compute nearly that many digits in an absolute time that quick!!: In Aug of 2018 I computed 1,004,993 digits of the MRB constant in 53.5 hours with 10 processor cores! Search this post for "53.5" for documentation. Sept 21, 2018, I just now computed 1,004,993 digits of the MRB constant in 50.37 hours of absolute time (35.4 hours processor time) with 18 processor cores!** Search this post for "50.37 hours" for documentation.**
26. Previously, I computed a little over 1,200,000 digits of the MRB constant in 11
days, 21 hours, 17 minutes, and 41 seconds,( finishing on on March 31 2013). I used a six core Intel(R) Core(TM) i7-3930K CPU @ 3.20 GHz 3.20 GHz.
27. On May 17, 2013 I finished a 2,000,000 or more digit computation of the MRB constant, using only around 10GB of RAM. It took 37 days 5 hours 6 minutes 47.1870579 seconds. I used my six core Intel(R) Core(TM) i7-3930K CPU @ 3.20 GHz 3.20 GHz.
28. The present world record computation of the MRB constant was finished on Sun 21 Sep 2014 18:35:06. It took 1 month 27 days 2 hours 45 minutes 15 seconds.The processor time from the 3,014,991 digit computation was 22 days. I computed the 3,014,991 digits of the MRB constant with Mathematica 10.0. I Used my new version of Richard Crandall's code in the attached 3M.nb, optimized for my platform and large computations. I also used a six core Intel(R) Core(TM) i7-3930K CPU @ 3.20 GHz 3.20 GHz with 64 GB of RAM of which only 16 GB was used. Can you beat it (in more number of digits, less memory used, or less time taken)? This confirms that my previous "2,000,000 or more digit computation" was actually accurate to 2,009,993 digits. they were used to check the first several digits of this computation. See attached 3M.nb for the full code and digits.
29. 4,000,000 digits are presently being computed!! This is my sixth try; see the reply, "NEW RECORD ATTEMPTS OF 4,000,000 DIGITS!" (at the end of the post).
Here is my mini cluster of the fastest 3 computers mentioned below:
The one to the left is my custom built extreme edition 6 core and later with a 8 core Zeon processor.
The one in the center is my fast little 4 core Asus with 2400 MHz RAM.
Then the one on the right is my fastest -- a six core Digital Storm 6 core overclocked to 4.7 GHz on all cores and with 3000 MHz RAM.
![enter image description here][12]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5860Capturemkb.JPG&userId=366611
[2]: http://community.wolfram.com/groups/-/m/t/1323951?p_p_auth=W3TxvEwH
[3]: http://www.marvinrayburns.com/UniversalTOC25.pdf
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=104871b.JPG&userId=366611
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=91231.JPG&userId=366611
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1a.PNG&userId=366611
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1a.PNG&userId=366611
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=53411.PNG&userId=366611
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1.PNG&userId=366611
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=592522.JPG&userId=366611
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=71291b.JPG&userId=366611
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ezgif.com-video-to-gif.gif&userId=366611Marvin Ray Burns2014-10-09T18:08:49ZRecreate a composition in Wolfram Tones from the mp3 filename?
https://community.wolfram.com/groups/-/m/t/1552142
Can I recreate a composition in Wolfram Tones based on the name of the exported MP3-file?
NKM-G-15-55-163873-1-16089-240-120-4-2384-40-0-1-130-1-130-1-130-1-122-1-207-0.mp3
This name contains a description of all parameter settings, 55 refers to the rule type, 163873 refers to rule, 16089 refers to seed aso. Sadly I can't find a scale that corresponds to 2384 and what does NKM, G and 15 stand for? Luckily I saved the mp3-file but I was stupid enough not to save it as a bookmark/favorite in my browser.
Hans JakobHans Jakob Müller2018-11-16T09:37:26ZRetrieve the rainfall in a city between 2 dates?
https://community.wolfram.com/groups/-/m/t/1551946
I am trying to learn a bit about the API Wolfram Alpha offers (to see if it can deliver the data I require to use it as an oracle in a solidity contract) but cant find an answer to the following.
I am able of retrieving the temperature in a city asking for "temperature in CITY".
What I would like to know is, if it is possible to use the API to retrieve something like "the amount of rainfall in CITY between 12 june 1999 5:00 am and 13 june 4:00 am"?Ruud Private2018-11-15T22:03:13ZPositive integer solution to the elliptic curve y^2 = x^3 + 109 x^2 + 224 x
https://community.wolfram.com/groups/-/m/t/1552008
Sometime ago; I ran into the following problem discussed in:
[(1.) How to find positive integer solutions to a/(b + c) + b/(a + c) + c/(a + b) = 4 ][1]. A more general problem namely; solving a/(b + c) + b/(a + c) + c/(a + b) = N is tackled in: [(2.) An unusual cubic representation problem][2]. The equality: a/(b + c) + b/(a + c) + c/(a + b) =
4 is called the: [(3.) Fruit Cocktail problem][3] . Using the following reference found in: [(4.) Explicit Addition Formulae][4] and considering: Y^2 + a1 X Y + a3 Y = X^3 + a2 X^2 + a4 X + a6 with:
a1 = 0, a2 = A, a3 = 0, a4 = B, and a6 = 0; you can use the analysis in (4.) to build a Mathematica module to handle point addition for elliptic curves of the form : y^2 = x^3 + A x^2 + B x. The attached Mathematica notebook gives an example of how to use this module to find a solution to (1.). A plot for the elliptic curve y^2 = x^3 + 109 x^2 + 224 x is also provided in the notebook.
[1]: https://www.quora.com/How-do-you-find-the-positive-integer-solutions-to-frac-x-y+z-+-frac-y-z+x-+-frac-z-x+y-4/answer/Alon-Amit
[2]: http://ami.ektf.hu/uploads/papers/finalpdf/AMI_43_from29to41.pdf
[3]: https://www.futilitycloset.com/2018/10/30/fruit-cocktail/
[4]: https://crypto.stanford.edu/pbc/notes/elliptic/explicit.htmlGilmar Rodriguez-Pierluissi2018-11-15T19:58:00ZCustomize Dataset Styling?
https://community.wolfram.com/groups/-/m/t/1551451
I've been playing around with a stylesheet in which I've adjusted, amongst other things, the default font sizes and Magnifications for a whole bunch of styles. On the whole, this is working well and, in general, is giving me the desired results. However, it's screwed-up the appearance of Dataset objects as displayed in output cells - it looks like the font size and/or magnification set for Output cells in my private stylesheet aren't being passed through to the Dataset display object. My first thought was to look in the Core and Default stylesheets to see if there's a style definition that looks like it might be associated with the display of Datasets. But this has drawn a blank. Does anyone out there know if it's possible to modify font properties (e.g. FontSize, etc...) for the display of Datasets? And if it is, how to go about doing so.
Thanks in anticipation,
IanIan Williams2018-11-15T12:38:38ZGet grids on image and two slider2D in one control?
https://community.wolfram.com/groups/-/m/t/1551195
Hello,
I require gridlines (x and y axis) on an imported image. However, the help shows gridlines/frametick only for Graphics and Plot functions
{image , FrameTicks-> {0,0}
In addition, on that image i need the two Slider 2D control in one panel and crop the selected region.. An idea of the final interface is show below;
![enter image description here][1]
{Slider2D[{.7, .3}, {.9, .6}]} ;
It appears but both are sliding together
{Slider2D[{.7, .3}], Slider2D[{1, .6}] ;
Appears in two different panes
Thank you for your kind usual help
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=IMAGEGRIDSLIDERFORFORUM.JPG&userId=971622Man Oj2018-11-15T01:58:19ZPolarPlot the function $r=-2t$ with $t$ in $[0,2\pi]$:
https://community.wolfram.com/groups/-/m/t/1550055
Hello everyone, I tried to plot the function $r=-2t$ with $t$ in $[0,2\pi]$:
PolarPlot[-2 t, {t, 0, 2 Pi}, AxesLabel -> {x, y}]
![enter image description here][1]
When $t=\pi/4$, I have:
$$r=-\pi/2=-1.57$$
Through Get Coordinates, I saw the only point so that $r=-1.57$ is $("-"1.57, \,\, 3.9...)$. Why is the angle $3.9..=\pi+(\pi/4)$ different from $t=\pi/4$?
How can I get the above angle by using math formulas? I can't use the classic relationship $tan(t)=y/x$ because I don't know x and y (without looking the plot).
Thank you so much in advance.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=48500.png&userId=818155Gennaro Arguzzi2018-11-14T10:52:41ZWhy is my implementation of a random network slower than the built-in?
https://community.wolfram.com/groups/-/m/t/1528378
Hello everybody,
I wanted for accademic purposes to implement the algorithm that generate a Random Graph of the Barabasi-Albert kind.
I know that there exsist already a built-in function that do exactly that, but for better understanding it I challenged myself to reproduce it.
I came up with this (relatively simple, but effective) code:
m0 = 2;(*How many edges to connect at each time step*)
n = 1000; \
(*How many nodes*)
g = CompleteGraph[m0, VertexLabels -> Automatic];
addBarabAlbert[g_Graph, m_Integer] :=
EdgeAdd[g,
Rule[m, #] & /@ RandomSample[VertexDegree@g -> VertexList@g, m0]]
Do[g = addBarabAlbert[g, i], {i, m0, n}]
Which I think it gives me a correct solution, in fact you can see from the code below that the degree of the vertexes follow a power-law of the same nature as the one generated with the built-in wolfram function.
The only problem is that my implementation is kind of slow (compared to the built-in) and I was wondering why.
Maybe knowing how I could set it up to make it faster will help me in the future with different problems.
Any ideas?
(In the attachment you find the brief code)Ektor Mariotti2018-10-22T23:32:50ZRe-evaluate a random generator to simulate a raquetball play?
https://community.wolfram.com/groups/-/m/t/1544882
Sorry - trying to learn the language...your playing racquetball , you only score when you serve. 60% chance of winning when you serve, 50% chance of winning when you don't serve
p5 := If[Random[] >= .5, 1, 0]
p6 := If[Random[] >= .6, 1, 0]
p := If[x < x + Evaluate[p6], x += 1, np];
np := If[Evaluate[p5] == 1, p, np];
score = Table[p, 10]
Do[Print[x]; p, 5]
the best I can do so far and it's not working, I want to see how far it will take to get to 21, I am not sure how Mathematica works as a programming language. Thanks for any help.Raymond Low2018-11-08T05:54:47ZSelect elements in my texts and count the frequency of each code "@..." ?
https://community.wolfram.com/groups/-/m/t/1550112
Good morning.
After processing a few texts, I ended up with an XML file with a lot of semantic anotation codes initiated by @ and a certain amount of numbers (7 or 8) to identify some words of my texts.
Example: It follows an incident<incident,Noun**@7307477**[incident]> at UC Berkeley when police<police,Noun**@8209687**[police,police force,constabulary,law]>
Does anyone know an efficient and (semi)automatic way to extract all these @xxxxxxx and compile them in a list so that I can count the frequency of each code?
I appreciate any help. Thank you.Eurov Stars2018-11-14T05:01:15ZPlot multi histogram in one image, where the bins are real numbers?
https://community.wolfram.com/groups/-/m/t/1550038
Hi,
I tried to plot the attached data with no success - can some one please advise?
I try with
Histogram[Flatten[Table[i, {i, Length[bincounts ]}, {j, bincounts [[i]]}]]]
, but it plot the X axis from 1-20, instead of -099-0.64
Thanks!
data = {0,0,0,0,0,0,0,0,0,0,2,0,1,2,2,5,1,3,2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
data2 = {0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,3 ,1 ,4 ,5 ,1 ,3 ,1 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 }
bins = {-0.99 ,-0.98 ,-0.97 ,-0.96 ,-0.95 ,-0.94 ,-0.93 ,-0.92 ,-0.91, -0.9 ,-0.89 ,-0.88 ,-0.87 ,-0.86 ,-0.85 ,-0.84 ,-0.83 ,-0.82 ,-0.81 ,-0.8 ,-0.79 ,-0.78 ,-0.77 ,-0.76 ,-0.75 ,-0.74 ,-0.73, -0.72 ,-0.71 ,-0.7 ,-0.69 ,-0.68, -0.67 ,-0.66 ,-0.65 ,-0.64 }Yossi Rab2018-11-14T09:46:23Z3D 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:28ZGet right list of tensors data to port "Input" in NetTrain?
https://community.wolfram.com/groups/-/m/t/1549196
Dear all, my input and target data is prepared in tensor, which is filled from a file. Dimensions[input] yields {398,6,24,24}. First index is the training set number, second is channels (6) and 24 x 24 is my "image" size. In the same way I have prepared the target data, which is in a {398,6} tensor.
When I try to invoke NetTrain, it complains:
NetTrain[Net,{"Inputs"->input,"Targets"->target},{MaxTrainingRounds->1}]
> NetTrain: Data provided to port "Input" should be a list of 6×24×243-tensors.
**Obviously my understanding of tensors and lists seems to be flawed, why is {398,6,24,24} not a list of {6,24,24} tensors?**
The network is defined as follows, just two fully connected layers.
linear1 = LinearLayer[{6,24,24}, "Input"->{6,24,24}];
linear1 = NetInitialize[linear1];
linear2 = LinearLayer[{6}, "Input"->{6,24,24}];
linear2 = NetInitialize[linear2];
Net = NetChain[{linear1, linear2}];Markus Lenzing2018-11-13T12:57:04Z[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:26ZGet right data output format using a For loop?
https://community.wolfram.com/groups/-/m/t/1548944
I have made a for loop, the output is the desired data but i dont know how to make lists of the columns. also the output is not reallt given in the output format "out[]" how do i solve this?
![image][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=notoutput.JPG&userId=1541199sjoerd doggenaar2018-11-13T08:13:36ZPrime 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:45ZWhat is the implicit and/or parametric equations for hyperbolic shapes?
https://community.wolfram.com/groups/-/m/t/1543003
I'm working on programming an implicit surface plotter, and one of my test surfaces is the Astroidal Ellipsoid (or the [Hyperbolic Octahedron][1]). I was able to successfully get this to work, however I wanted to extend this to further hyperbolic shapes, such as the [Hyperbolic Icosahedron][2] and [Hyperbolic Dodecahedron][3].
The issue is that I cannot seem to find equations for the hyperbolic icosahedron or dodecahdron, despite there being a simple implicit and parametric equations for the hyperbolic octahedron. I would like something in the form of "*0 = f(x,y,z)*" or "*x=F(u,v), y=G(u,v), z=H(u,v)*". It doesn't have to be in Cartesian coordinates (so polar or cylindrical coordinates will be fine), as long as I have a simple equation I can copy and paste into my program.
Where can I find the equations I'm looking for? Thank you for your help!
[1]: http://mathworld.wolfram.com/HyperbolicOctahedron.html
[2]: http://mathworld.wolfram.com/HyperbolicIcosahedron.html
[3]: http://mathworld.wolfram.com/HyperbolicDodecahedron.htmlIbrahim Mahmoud2018-11-05T09:47:09ZImplement Wolfram|Alpha in Unity3D GUI using W|A API and Mathematica?
https://community.wolfram.com/groups/-/m/t/1549222
Hi, I am in a process where I will try to implement wolfram alpha into my game GUI in Uity3d. I have a simple game where you are asked math questions and then I want to implement the Wolframalpha search bar into game GUI as well as the “step-by-step solver”, instead of going out of game and do this by yourself. Of course, the step by step is a paid option, and the API you have to pay for as well. If I ever were to let anyone else play the game, free or for payment, would the players also have to buy wolframalpha membership and API solution?
Unity supports C#, but I have also seen a few examples where it is possible to use “Wolfram programming language” and Mathematica with “connect kernal unity attach” button.
Is it possible to implement such things into game and what would I need?T bl2018-11-13T03:51:40ZGenerate a interpolation function from a mesh with assigned value?
https://community.wolfram.com/groups/-/m/t/1546474
Hi all,
I was trying to use Mathematica for preprocessing to generate a Voronoi mesh with assigned values. Here is my code to generate the mesh:
noPoly = 20; boxSize = 400; pts =
RandomReal[{-boxSize, boxSize}, {noPoly, 2}]; mesh =
VoronoiMesh[pts, {{-boxSize, boxSize}, {-boxSize, boxSize}}]
You will get something like:
![Veronoi mesh][1]
Now this is what I want to do:
1) For each "grain" in the diagram, I want to assign a constant value for the whole grain. i.e., define a function f(x,y) on the mesh such that it is constant in the same grain but maybe different for different grains.
2) Then I want to generate a list of x,y,f(x,y) for x,y are uniform grid points, like (1,0), (2,0), (1,1), (1,2).... If I can do this, I know how to generate text file for another software to read and generate this function.
2) is easy if I could do 1), i.e. get the function f(x,y). I have check the Mathematica documentation but have no idea how to do this. It seems PropertyValue might help but how? How do I even get those value defined on a mesh?
Thanks in advance!
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=7998Capture.PNG&userId=948669Ox Clouding2018-11-09T15:26:25ZAccess a function created in Mathematica in visual studio (vb.net)?
https://community.wolfram.com/groups/-/m/t/997709
So, I've tried asking this question before but I always get generally waved to the .NET/Link connection, which is really not helpful at the moment. I may indeed need to use this connection, but I am very surprised no one has been able to answer such a basic question with a kind-of step-by-step answer. I have a function of one variable that I have computed in mathematica. It doesn't matter what the function is, so for simplicity it could just be called f[x_]:=Sin[x]. Now, what I want to do is to be able to call this function in a visual basic .NET program, such as:
i = 0
Do until i = 3 {
Print f[i];
i++;
loop}
Obviously, the f[i] is the function I defined in mathematica, and in this case represents Sin[x], so the vb.net program should print the results of Sin[0], Sin[1], Sin[2], and Sin[3]. The actual function is much more complex and can't really be handled by visual studio (vb.net), so I need to access the mathematica function from my vb.net program. Can anyone help answer this question? For some reason no one has been able to so far and I am puzzled by this. Thanks in advance.Patrick Cesarano2017-01-18T17:58:41ZAdd errorbars to a ListLogLogPlot?
https://community.wolfram.com/groups/-/m/t/1548444
Hey,
I have created a Plot and a Fit and combined them into one loged (both axis) Plot.
Now I have to add the Errorbars but I don't know how and I can't find any solution online.
thanks!Pouria Samieadel2018-11-12T12:51:50ZInsert element into a sublist?
https://community.wolfram.com/groups/-/m/t/1547277
I can't figure out how to do the following.
list = {{1,2,3}, {4,5,6},{ 7,8,9}}
I want to add a number to each sublist
For example add 10 so it looks like:
newlist = {{1,2,3,10}, {4,5,6,10}, {7,8,9,10}}
I have looked Insert, Map etc but can't seem to grasp how to do it.
In actuality I will want to add a unique ID (ie each unique ID is different like a primary key) to each sublist
so it would be
list = {{1,2,3,unique ID},{4,5,6, unique ID},{7,8,9, unique ID}}
The unique ID would be most likely by a function I suppose.
Thanks!David Kerr2018-11-11T16:28:17ZVisualize 3D vector field?
https://community.wolfram.com/groups/-/m/t/1548520
I am getting Visualization`Core`ListVectorPlot3D error when I try visualize this:
vectors =
Table[{{f1[x,y,z], f2[x,y,z], f3[x,y,z]}, {f4[x,y,z], f5[x,y,z], 0}}, {x, -1, 1, .1}, {y, -1,
1, .1}, {z, -1, 1, .1}]
ListVectorPlot3D[vectors]
Do you know how can I solve this? Thank youMartin Vit2018-11-12T13:45:45ZSymbol for Laplace Transform?
https://community.wolfram.com/groups/-/m/t/1548186
Does Mathematica posess any analogue of AMSMath symbol \risingdotseq? I can make something from dots and "=" but it looks very strange.
![enter image description here][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=45902490_2469872856362552_431445966147551232_n.jpg&userId=591660Vadim Zelenkov2018-11-12T09:14:22ZHow to print only the last result!
https://community.wolfram.com/groups/-/m/t/1547204
Hello!
I use
Do[Print[Subscript[a, i] = a[i - 1]; Subscript[c, i] = g[i - 1]], {i,11}]
and need to get only last output. I've haven't found this information at reference, so my question is how to get only i=11 output? Thanks in advance!Alex Graham2018-11-10T15:43:03ZSelect ordered pairs below x^2 and count them?
https://community.wolfram.com/groups/-/m/t/1546940
I have the following code
![enter image description here][1]
I want to "Select" those ordered pairs below x^2 and count them.
something like
Count[Select[t,(x=#1, #2<x^2}]]
but that doesn't work, or anything else I have tried.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=graphicx%5E2.PNG&userId=159426Raymond Low2018-11-10T06:57:58ZInvert colors in graphics created using the drawing palette?
https://community.wolfram.com/groups/-/m/t/1543531
I have developed severe cataracts and can no longer read or use black on any light color. I need to invert it so that it is light on black. When I convert graphics by hand I have to convert it back by hand before it can be converted to pdf for publication. I have hundreds of such graphics and converting them by hand is very cumbersome and error-prone (particularly when I cannot see the end result). Is there any good way to automate this process?George Hrabovsky2018-11-05T19:01:42ZFind all roots to an equation?
https://community.wolfram.com/groups/-/m/t/1541533
Hello. I'm spending my friday night trying to learn Mathematica, and so far it's been going decent. This is only my second day using the program, so bare with me.
I'm currently on an exercise where I'm supposed to plot these two functions in the same graph:
![enter image description here][1]
For that I used
Plot[{Abs[3 - t^2] + Abs[t - 1] - t^2, 3*Sin[t]}, {t, -3.8, 4.6}]
Which gave me this
: ![enter image description here][2]
Now, what I'm wondering is, how do I find all of the roots to my equation ( h(t) = g(t) )? My e-book suggests using FindRoot, but I don't know how/where. Thanks for your help.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=cef38e864a03b6a34c3162d6ee7b7c92.png&userId=1540567
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=b7978e84bb1c8b06a90a15e7044d2e9d.png&userId=1540567Jhn Snd2018-11-02T18:38:25Z