Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Science sorted by activeHow can I graph data imported in CSV format?
https://community.wolfram.com/groups/-/m/t/1594211
I currently have data in this format of an x value and 5 sets of y values that I am importing into mathematica as data sets. I have been trying to find a way to graph data imported to mathematica in this format, but I haven't found any success. The data is in CSV format in a .dat file. Thank you!
![Example photo of data format][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-01-17at9.15.47PM.png&userId=1482346Aaron Fultineer2019-01-18T04:24:38Zproduct difference between Mathematica and Wolfram one
https://community.wolfram.com/groups/-/m/t/1593685
Can I say Wolfram one is the subscription model of Mathematica and with cloud storage?
Any other difference?
Besides, will system modeler adopter similar subscription model and add to wolfram one package?Harold Chan2019-01-18T05:10:59ZDetecting Negative Correlation
https://community.wolfram.com/groups/-/m/t/1593941
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Capture.JPG&userId=1592912
Given two time series data, I want to identify the start and end time as indicated in red of a certain period where those selected variables are negatively correlated.
The image is data for one day. But I have 200 of these files and want to use 1 month as training data. What algorithm should I use to do this?T P2019-01-18T04:11:23ZTo determine the proportion of specific colours in an image
https://community.wolfram.com/groups/-/m/t/1594100
Hi all,
Do you have any idea how can I determine the proportion of Yellow (or Yellowish), Brown (Brownish), and Red (Redish) colour in a specific image? I tried to use HSV, but I could not find any threshold for H, S, snd V for the aforementioned colours.
I attached a sample image.
Kind regards,
EbrahimEbrahim Sangsefidi2019-01-18T02:27:38ZWolfram Language programmers are using human language level programming?
https://community.wolfram.com/groups/-/m/t/1581337
I received the following information:
"Programming languages will end up being increasingly high-level until they become identical to natural language. You will eventually be able to write all your programs in English, Portuguese, or any other natural language, although you will also be able to mix that with instructions of the kind used in today's programming languages whenever you think that's more efficient or clearer,"
Why will programming languages end up being increasingly high-level until they become identical to natural language?
When will programming languages begin to be increasingly high-level?
Wolfram Language programmers are using human language level programming?
If yes, is Wolfram Language the only human-language-level programming language that exists?Quantum Robin2019-01-02T04:07:54ZHow to create a discussion with the library?
https://community.wolfram.com/groups/-/m/t/1593874
Hi there
I'm new to Wolfram Alpha, currently trying to figure out Mathematica. I created an URL library and would now like to create a discussion with that library. Does anyone have any tips on how to get me started? It can be anything really, also if it is only a little related to the question.
Thanks a lot!
Nadine MackayNadine Mackay2019-01-17T23:07:39ZDisplay the line number in a mathematica package?
https://community.wolfram.com/groups/-/m/t/1592936
for example ,
BeginPackage[ "Package`"]
MainFunction::usage =
"MainFunction[ x] computes a simple function."
Begin[ "Private`"]
MainFunction[ x_] :=
Module[ {y},
y = x^2;
y + 1
]
End[]
EndPackage[]
i don't know how to display the line number in a mathematica's .m file. Thank you in advance!zhu xiaoming2019-01-16T09:03:58ZGet numerical solution of PDE for diffusion at high diffusion rates?
https://community.wolfram.com/groups/-/m/t/1575334
I am trying to solve numerically the following PDE with IC and BCs as shown for u(t,x).
\[PartialD]u/\[PartialD]t = \[PartialD]^2u/\[PartialD]x^2 + p Subscript[(\[PartialD]u/\[PartialD]x), x=0]\[PartialD]u/\[PartialD]x
t = 0, u= 0
x= 0, u= 1
x = 1, u = 0
This equation arises in binary diffusion of a species where the diffusion rates are large as opposed to low rates where the second term on the RHS is very small and the PDE becomes identical to the heat conduction equation. This second term accounts for the convective flow induced by the diffusing species. The parameter p is related to the surface concentration of the diffusing species (at x = 0). A closed form solution is available for the case of a semi-infinite region where the last BC becomes x = \[Infinity], u = 0.
I tried to use NDSolve and NDSolveValue (code shown below) but I got an error message:
NDSolveValue::delpde: Delay partial differential equations are not currently supported by NDSolve.
I am unsure if there is (1)a mistake in the code, (2) code is correct but NDSolve cannot provide a solution, or (3) there is a different approach that will work. Would appreciate any help. Thanks.
usolh = NDSolveValue[{D[u[t, x], t] ==
D[u[t, x], x, x] + 0.5*(D[u[t, x], x] /. x -> 0)*D[u[t, x], x],
u[0, x] == 0, u[t, 0] == 1, u[t, 1] == 0},
u, {t, 0, 5}, {x, 0, 1}](*we are assuming p=0.5 here*)Rutton D Patel2018-12-20T03:09:22ZRun python code from a mathematica notebook? (Mac OS)
https://community.wolfram.com/groups/-/m/t/1588303
Hi,
I am trying to run python code in Mathematica. Ideally, I would like to use Mathematica's algebraic facilities to rearrange values in my python functions. However I am having problems starting an external session. I already have python installed. I have been following the documentation
https://reference.wolfram.com/language/workflow/ConfigurePythonForExternalEvaluate.html
![enter image description here][1]
If someone could let me know where I am going wrong, see screenshot, that would be great!
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2019-01-12at11.45.42.png&userId=1587970
Thanks in advanceCharlotte Hawkins2019-01-12T11:47:48ZModeling 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:17ZHow do I interpret a "repeating decimal" result in WolframAlpha?
https://community.wolfram.com/groups/-/m/t/1593436
I entered
0.262230013182483822189641685476719346112-0.0042727174678
in the search box of WolframAlpha, and it uses the term "Repeating decimal" in the outcome
0.257957295714683822189641685476719346112629182307118558090..
I don't see what the point of this is.Paul Slater2019-01-16T21:04:21ZAvoid issues using RegionCentroid on Polygon?
https://community.wolfram.com/groups/-/m/t/1593569
So I'm having an issue where the RegionCentroid operation does not compute even though I've used it successfully many times in the past.
Here are the coordinates of the shape I'm trying to determine the centroid for:
C1 = {-0.82998570, 0.39131282, 1.38566726}
C2 = {-0.01947705, -0.00824240, 2.45464906}
C3 = {1.21666293, -0.61144232, 2.04941022}
C4 = {1.35625427, -0.67525738, 0.64442667}
S = {-0.01598580, -0.00235848, -0.00262605}
Here I'm building the Polygon:
Plane= Polygon[{C1, C2, C3, C4, S}]
And here is what what I'm using to determine the centroid of the region:
OO=RegionCentroid[Plane]
This is an issue I'm experiencing in Mathematica 11.3. That exact line of commands worked fine in Mathematica 10. I'm getting the error message shown below.
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=asdasdasdasd.png&userId=1593555
Any ideas as to why this is happening and how to fix it?
Thanks!Victor Murcia2019-01-17T07:54:34ZUnet network using the neural network tools
https://community.wolfram.com/groups/-/m/t/1592458
Hi
I created the following unet network using the neural network tools:
UNET := NetGraph[
<|
"enc_1" -> conv[64],
"enc_2" -> {pool, conv[128]},
"enc_3" -> {pool, conv[256]},
"enc_4" -> {pool, conv[512]},
"enc_5" -> {pool, conv[10]},
"dec_1" -> dec[512],
"dec_2" -> dec[256],
"dec_3" -> dec[128],
"dec_4" -> dec[64],
"map" -> {ConvolutionLayer[1, {1, 1}], LogisticSigmoid}
|>,
{
NetPort["Input"] ->
"enc_1" -> "enc_2" -> "enc_3" -> "enc_4" -> "enc_5",
{"enc_4", "enc_5"} -> "dec_1",
{"enc_3", "dec_1"} -> "dec_2",
{"enc_2", "dec_2"} -> "dec_3",
{"enc_1", "dec_3"} -> "dec_4",
"dec_4" -> "map" -> NetPort["Output"]},
"Input" ->
NetEncoder[{"Image", {512, 1}, ColorSpace -> "Grayscale"}],
"Output\[Rule] NetDecoder[{" Image "," Grayscale "}]
]
How can I get the output of the "enc5" layer ?Guy Malki2019-01-15T11:34:52ZFourier Transforms and 'Hybrid Images' in the Wolfram Language
https://community.wolfram.com/groups/-/m/t/1592896
![A mandrill-pepper hybrid][1]
Recently, I was asked to assist somebody with graphing the Fourier transform of an image. The resulting images were neat, and the work reminded me of a really fun application of Fourier transforms: [Hybrid Images][2]
By taking the Fourier transforms of two images, and combining the high-frequency parts of one with the low-frequency parts of the other, you get an image that looks like one thing when your eyes are focused, and another thing when they are unfocused. The classic example is the Einstein – Marilyn Monroe image.
![Einstein - Marilyn Monroe][3]
Of course, the above example is in black and white, so a natural extension would be to include color. Also, I would like to explore how the image changes as I vary how much of each image is included.
Thankfully, both of these things are easy to do in the Wolfram Language.
As a warmup, let’s simply visualize the Fourier transform of an image by itself. I use one of the test images provided in ExampleData[].
`
mandrill=ExampleData[{"TestImage","Mandrill"}]
`
![Mandrill test image][4]
`
mandrill2 = ColorSeparate[mandrill];
`
With the `ColorSeparate` function, I split the image into its RGB channels. I will be taking the Fourier transform of each of these.
`
shift := Table[(-1)^(i + j) #[[i]][[j]], {i, 1, Length[#]}, {j, 1, Length[#[[1]]]}] &
mandrill3 = Fourier[shift@ImageData@#] & /@ mandrill2;
`
Before taking the transform, I apply a function `shift` to the image, so that the low frequencies of the image will appear at the center of the Fourier transformed image, rather than at the edges.
`
ColorCombine[Image /@ Abs[mandrill3]]
`
![Fourier Transform of Mandrill][5]
And there we have the Fourier transform of our mandrill.
To put it all together, we could write this as
`
ColorCombine[
Image /@ Abs /@
Fourier /@ shift /@ ImageData /@ ColorSeparate[mandrill]]
`
Now that we’ve got the warm-up out of the way, we want to take two different images, and mix them together. We’ll need two images that are the same size, so I’ll set it to manually resize the images to 512*512. All the example images are that size already, but you may need to resize if you want to use something else.
`
size = 512;
test1 = ImageResize[ExampleData[{"TestImage", "Mandrill"}], size];
test2 = ImageResize[ExampleData[{"TestImage", "Peppers"}], size];
ft1 = Fourier /@ shift /@ ImageData /@ ColorSeparate[test1];
ft2 = Fourier /@ shift /@ ImageData /@ ColorSeparate[test2];
`
Now we can make a temporary variable based on one image, and replace a square of size `2x` in the center of the Fourier-transformed image with the corresponding elements of the other image.
`
Manipulate[
Module[{temp = ft1},
temp[[1;;3,size/2-x;;size/2+x,size/2-x;;size/2+x]]=ft2[[1;;3,size/2-x;;size/2+x,size/2-x;;size/2+x]];
ColorCombine[Image/@Abs/@InverseFourier/@temp]],
{x,1,size/2-1,1}]
`
This generates a manipulate box where you can control how much of each image is included. For this example I find that `x=45` or so is the sweet spot for making the Mandrill 'hidden' when seen from afar, as included at the top of the post. We can also swap the two images, and have some hidden peppers in a picture of a Mandrill.
![A pepper-mandrill hybrid][6]
Hopefully, some of you find this as fun as I do. I attach the notebook I used to generate these hybrid images.
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Mathematica_8EZiogEXIi.png&userId=1541430
[2]: https://en.wikipedia.org/wiki/Hybrid_image
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Hybrid_image_decomposition.jpg&userId=1541430
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Mandrill.png&userId=1541430
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=FTMandrill.png&userId=1541430
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Mathematica_4m1iGQm2JR.png&userId=1541430Duncan Pettengill2019-01-16T18:22:25ZImport large CDF files?
https://community.wolfram.com/groups/-/m/t/1593295
I'm trying to consolidate 200 files, 32 MB each unzipped which is about 6.5 GB of highly compressed data into one .CDF file.
Would loading this in Mathematica be an issue?T P2019-01-17T04:40:34ZTry 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.
- Then we have some hints for anyone serious about breaking my record
- Next, we have speed records.
- Then we have a program Richard Crandall wrote to check his code for computing record number of digits.
- That is followed by a time that we started a 5,000,000 digits calculation.
- Then there is a conversation about whether Mathematica uses the same algorithm for computing MRB by a couple of different methods.
- Then, for a few replies, we compute the MRB constant from Crandall's
eta derivative formulas and see records there.
- The last two replies are "NEW RECORD ATTEMPTS OF 4,000,000 DIGITS!" and the computation is almost complete!!!!!.
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[]
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. A previous 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,000,000+ 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. Finished on Wed 16 Jan 2019 19:55:20, I computed over 4 million digits of the MRB constant!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!.....
It took 65.13 days with a processor time of 25.17 days.On a 3.7 GH overclocked up to 4.7 GH,
Intel 6 core computer with 3000MH RAM. According to this computation, the previous record, 3,000,000+ digit computation, was actually accurate to 3,014,871 decimals. Search "Wed 16 Jan 2019 19:55:20" for message with notebook.
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 Xeon 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 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:49ZFactoring out common factors from a list / vector / matrix
https://community.wolfram.com/groups/-/m/t/153277
I'd like a way to pull out common factors from lists, basically a way to reverse the automatic mapping of multiplication across a list. If you type
[mcode]a{x,y,z}[/mcode]
[i]Mathematica[/i] performs the scalar multiplication immediately:
[mcode]{a x, a y, a z}[/mcode]
Similarly,
[mcode]2 IdentityMatrix[3][/mcode]
gives
[mcode]{{2,0,0},{0,2,0},{0,0,2}}[/mcode]
But what if we want to factor back out the 2? Is there a simple way to factor out common factors from lists, or lists of lists? FactorTerms and FactorTermsList do something similar, but only for numerical factors of polynomials.
I'm thinking of turning the list/vector/matrix into a polynomial, then FactorTermsList could be used to identify common factors, and then the list or matrix would have to be reconstructed. Like this:
[mcode]a {x, y, z}
% . Table[Z^(k-1),{k,Length[%]}]
FactorTermsList[%,Z]
Row[{Times @@ Most[%], CoefficientList[Last[%], Z]}][/mcode]
I could wrap that in a function, preferably first generalizing it to handle matrices or arbitrary depth lists of lists. But does anyone have a simpler idea? Thanks!Ken Caviness2013-11-13T22:34:30ZLet Me Mathematica That For You
https://community.wolfram.com/groups/-/m/t/1593007
Ever wanted to do the equivalent of "Let me Google that for you" for a stupid, trivial Mathematica question? Now you can!
Introducing [Let Me Mathematica That For You](https://www.wolframcloud.com/objects/b3m2a1/LetMeMathematicaThatForYou.html) which uses cloud notebooks to run any and all queries passed in via a sandbox Cloud notebook:
Here's a fun example:
Reverse/@Table[IntegerDigits[Prime[i]],{i,2,549}]//Reverse//Flatten//FromDigits//PrimeQ//AbsoluteTiming
Which in query format is:
Reverse%2F%40Table%5BIntegerDigits%5BPrime%5Bi%5D%5D%2C%7Bi%2C2%2C549%7D%5D%2F%2FReverse%2F%2FFlatten%2F%2FFromDigits%2F%2FPrimeQ%2F%2FAbsoluteTiming
And we pass that as the query parameter to the URL giving us this:
[![people are idiots](https://i.stack.imgur.com/xMeeE.png)](https://www.wolframcloud.com/objects/b3m2a1/LetMeMathematicaThatForYou.html?query=Reverse%2F%40Table%5BIntegerDigits%5BPrime%5Bi%5D%5D%2C%7Bi%2C2%2C549%7D%5D%2F%2FReverse%2F%2FFlatten%2F%2FFromDigits%2F%2FPrimeQ%2F%2FAbsoluteTiming)
Feel free to use it yourself. It doesn't cost me anything. All of the HTML fits on a single page, so feel free to fork and use it for your own things too.b3m2a1 2019-01-16T03:53:36ZBest Way to Find and Replace Adjacent Elements in a List?
https://community.wolfram.com/groups/-/m/t/1593367
Hi everyone,
I have a function that returns a list with a series of boolean value False followed by a series of boolean value True like this:
{False, False, False, True, True, True, True, True}
The False's always come before the True's, and the number of False's does not have to equal the number of True's. I need to replace the last False in the series—the third one in my example—with True. This works
Flatten[ReplaceAll[
Split[{False, False, False, True, True, True, True,
True}, #1 =!= #2 &], {False, True} -> {True, True}]]
but it seems like there should be a simpler or more elegant way. Any thoughts?
GregGregory Lypny2019-01-16T20:27:08ZMathematica Package Repository (Paclet Server) Updates
https://community.wolfram.com/groups/-/m/t/1575086
__The server is open for submissions. Please do. [It's easy](https://github.com/paclets/PacletServer/wiki/Contributing#updating-paclet) and [here's a template to work off of](https://github.com/paclets/PacletServer/issues/37).__
---
A while back I posted here about a paclet server, which is to say a repository for Mathematica packages which people can easily install and use
The key, here, is the *easily*. As in single-line installation and integrated with all of Mathematica's standard tools.
[![enter image description here][1]](https://paclets.github.io/PacletServer/)
The server is [hosted on GitHub](https://github.com/paclets) and so everything is open source and anyone can contribute. The deployment is done with GitHub pages as [the cloud is still insufficient](https://community.wolfram.com/groups/-/m/t/1485141) for a number of reasons. There is also a [GitHub Wiki](https://github.com/paclets/PacletServer/wiki) that provides notes on how you can install from the server, upload to the server, etc.
This server has been slowly evolving over the past just-under-a-year as I get a better handle on how to make it easier to add paclets, easier to customize, and nicer in general.
I decided to start this thread to track this progress in a place that Mathematica users would see.
Any suggestions people can provide are greatly appreciated and feel free to communicate with [us on Gitter](https://gitter.im/paclets/community#) for potentially faster discussion.
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3804blah.png&userId=1186441b3m2a1 2018-12-20T08:22:16ZSolve analytically 1D transport equation?
https://community.wolfram.com/groups/-/m/t/1589719
I'm trying to solve for the analytical solution of 1D transport equation to verify the results of the numerical solution.
eqn = D[u[x, t], t] == D[u[x, t], {x, 2}];
ic = u[x, 0] == 50;
bc1 = u[0, t] == 50;
bc2 = D[u[1, t], x] == 0;
DSolve[{eqn, ic, bc1, bc2}, u[x, t], {x, t}]
However, I obtain the following,
DSolve::deqn: Equation or list of equations expected instead of True in the first argument {(u^(0,1))[x,t]==(u^(2,0))[x,t],u[x,0]==50,u[0,t]==50,True}.
Have I missed any step? I'm looking for the symbolic solution of the PDE with Dirichlet boundary condition at the inlet and Neumann boundary condition at the outlet.
Could someone help?Natash A2019-01-14T07:51:09ZAdd a SoftmaxLayer to trainable network with vector input 14x14 pixel pics?
https://community.wolfram.com/groups/-/m/t/1592948
Dear all,
I have a working trainable network. The input is a vector of 14 x 14 pixel images, the output is a vector with three elements. Now I would like the output vector to be normalized. For this reason I added a SoftmaxLayer[], however NetTrain now complains "expected a vector of 1 to 3 indices."
Here's the working network:
...more layers...
layer10 = LinearLayer[{3}];
layer11 = ElementwiseLayer[ Tanh ];
Net = NetChain[{layer1, layer2, layer3, layer4, layer5, layer6, layer7, layer8, layer9, layer10, layer11}];
Here's the code that leads to the error from NetTrain:
...more layers...
layer10 = LinearLayer[{3}];
layer11 = ElementwiseLayer[ Tanh ];
layer12 = FlattenLayer[];
layer13 = SoftmaxLayer[];
Net = NetChain[{layer1, layer2, layer3, layer4, layer5, layer6,
layer7, layer8, layer9, layer10, layer11, layer12, layer13}];
TrainedNet = NetTrain[Net, <| "Input" -> Images, "Output" -> Labels|>, {MaxTrainingRounds -> 256, Method -> "ADAM", BatchSize -> 128, ValidationSet -> Scaled[0.2]}]
(NetTrain::notiintvec: Expected a vector of indices between 1 and 3.):
It seems to be required to add a FlattenLayer[], because the ElementwiseLayer returns a layer of tensors due to Tanh[]. As per examples, it should be working without the flattening. Can anyone point me to where I have gone wrong?Markus Lenzing2019-01-16T13:17:11ZSharing WL code JSFiddle style
https://community.wolfram.com/groups/-/m/t/1593034
I decided to build off of [Let Me Mathematica That For You](https://www.wolframcloud.com/objects/b3m2a1/LetMeMathematicaThatForYou.html) to write something akin to [JSFiddle](https://jsfiddle.net/) which this week we're calling [WLFiddle](https://www.wolframcloud.com/objects/b3m2a1/WLFiddle?cell1=eyJzdHlsZSI6IlRleHQiLCJjb250ZW50IjoiV2VsY29tZSB0byBXTEZpZGRsZSEifQ%3D%3D). It's basically the same a LMMTFY but with some helper code you need to use and it forces you to use Base64:
cellToString[c : (Cell[b_BoxData, ___] | Cell[_, "Input", ___])] :=
First@FrontEndExecute@
ExportPacket[c, "InputText"];
cellToString[c : Cell[_, s_String, ___]] :=
ExportString[
<|"style" -> s,
"content" ->
First@FrontEndExecute@
ExportPacket[c, "PlainText"]
|>,
"JSON",
"Compact" -> True
];
makeWLFiddle[cells : {__Cell}] :=
With[
{
cc = NotebookTools`FlattenCellGroups[cells],
key = StringJoin[ToString /@ RandomInteger[10, 15]]
},
StringReplace[
URLBuild[
"https://www.wolframcloud.com/objects/b3m2a1/WLFiddle",
MapIndexed[
"cell" <> ToString[#2[[1]]] ->
Developer`EncodeBase64[cellToString[#]] &,
cc
]
],
key -> " "
]
];
makeWLFiddle[notebook_NotebookObject] :=
Module[
{
cells = Flatten@{NotebookRead[notebook]},
cc
},
If[Length@cells == 0,
cells = First@NotebookGet[notebook]
];
URLShorten[makeWLFiddle[cells]]
];
I also deployed the notebook where I developed that [as a fiddle](https://wolfr.am/AF7COxRS):
[![fiddle](https://i.stack.imgur.com/yc4M6.png)](https://wolfr.am/AF7COxRS)
Hope this is fun for other people too.b3m2a1 2019-01-16T10:04:49ZStore variables after using Solve?
https://community.wolfram.com/groups/-/m/t/1592537
Hello everyone, I'm new here and new to Mathematica, very excited about it.
I have two questions:
1)is there a way to store variables after a Solve operation? For example a=Solve[x+1==0,x]
2)solving this gives me troubles: Solve[s^2+s+1==0,s] result s -> -(-1)1/3}, {s -> (-1)2/3}. Correct result are two complex conjugate radixes, is that a sort of module+phase writing? If so is there a way to obtain arithmetic format?
Using the domain field Solve[s^2+s+1==0,s,Complexes] doesn't help. The thing I do not understand further is that if I solve a*s^2 +b*s +c==0 it gives be the classical 2nd order formula and if then I substitute a=b=c=1 then I get the correct complex radixes in arithmetic form!
Thanks.Ermanno Citraro2019-01-15T11:18:23ZSimplifying (Making) Mathematica Documentation
https://community.wolfram.com/groups/-/m/t/1592149
The Documentation Center is nice. The docs are reasonably complete. Stuff is somewhat searchable. It looks really nice. But if you've ever made your own system for generating these kinds of docs you know it's a *lot* of work. The notebooks are unnecessarily complicated. There are cutesy little elements here and there that don't really buy us much.
I wanted something cleaner that would be easier to write, more transparent, and, crucially, more distributable. What I came up with was the [SimpleDocs](https://paclets.github.io/PacletServer/simpledocs.html#main-content) package.
[![enter image description here][1]](https://paclets.github.io/PacletServer/simpledocs.html#main-content)
I'll write a more extended example soon and once the interface has gelled completely, but I want to show off what it can do for us, entirely automatically. To do so I decided to make documentation for my (admittedly a little bloated) package development package [BTools](https://paclets.github.io/PacletServer/btools.html#main-content).
The first thing I did was start a new project from the `SimpleDocs` interface (I'll document that later so it's easy to follow along). The build folder started out much simpler (but I didn't have to do much of anything for it!) but here's what it looks like now:
![enter image description here][2]
I'm making two things in tandem, on the one hand I'm making docs that integrate nicely with the documentation center. Here's an example of what I get when searching for `WebSiteBuild` locally:
![enter image description here][3]
It looks a lot like WRI docs (excluding the fact that I only have autogenerated content and the "Details" are hidden), but there are a few key differences, the big two being that it's much, much simpler internally and it's *version independent*. I package my own stylesheet with the docs, so they can be used cross version without issue and without looking terrible.
All the content in that notebook was generated automatically, though. I didn't write any of it (and there are lots of details and options you don't see here). In fact, I actually generated *all* of the function docs automatically, and now I can go back and more fully document the big ones at my leisure. There is also a tutorial on how this works in the `SimpleDocs` docs.
At the same time as I build the docs notebooks I also built out .md files for each docs page. This is nice because these can then be fed into any number of website generators to make nice docs websites. Here's the website I built for BTools that comes automatically from `SimpleDocs` (again, this will be documented more thoroughly in the coming weeks):
[![enter image description here][4]](https://www.wolframcloud.com/objects/b3m2a1.docs/BTools/)
In this there's an [index of functions](https://www.wolframcloud.com/objects/b3m2a1.docs/BTools/index/functions.html) and if I had guides or tutorials yet there'd be an index for both of those as well.
You can also [search for keywords] (https://www.wolframcloud.com/objects/b3m2a1.docs/BTools/search.html?q=App) which is powered by [tipuesearch](http://www.tipue.com/search/):
[![enter image description here][5]](https://www.wolframcloud.com/objects/b3m2a1.docs/BTools/search.html?q=App)
And there is much, much more I could do with this website and things. At the moment I'm really just scraping the very most basic stuff of what I can automatically do without *any* real effort on my part (except for in development).
Hopefully this has shown that Mathematica docs can be simpler and, once I've finished using this package to document itself, can be simpler to make for anyone. As I said, I'm hoping to get this done and finalized in the next few weeks and once that is through I will write here again (and write a blog post) detailing how you can easily use it for yourself.
In the meantime here's a video of the documentation for BTools being autogenerated:
[![enter image description here][6]](https://www.youtube.com/watch?v=4lTrMwHCjyU)
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=5722urg.png&userId=1186441
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=hmm.png&userId=1186441
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=meep.png&userId=1186441
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=5444meh.png&userId=1186441
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=bleep.png&userId=1186441
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=yt.png&userId=1186441b3m2a1 2019-01-15T02:42:56ZImprove code for finding the coordinates of a triangular mesh?
https://community.wolfram.com/groups/-/m/t/1567948
Hello, The problem of finding the coordinates of a triangular (equilateral) mesh discussed earlier is solved. It also counts the number of equilateral triangles formed by the intersecting parallel lines. But the problem is that the code takes more time for larger values of n i.e. the size of the side of the triangle. Can the code be improved? The code is given here. Thanks for any suggestion.
n = 4;
Print["Number of lines/size of triangle = ", n]
h = Sqrt[3] /2;
Array[x, n];
Array[s, n];
x[0] = {{n/2, n h}};
For[i = 1, i <= n, i++,
x[i] = Table[{x[0][[1, 1]] - i/2 + j, n h - i h}, {j, 0, i}]];
set = Apply[Union, Table[x[i], {i, 0, n}]];
Print["Number of vertices = ", Length[set]]
cond := (EuclideanDistance[#[[1]], #[[2]]] ==
EuclideanDistance[#[[2]], #[[3]]] ==
EuclideanDistance[#[[1]], #[[3]]] && #[[1]] != #[[2]] != #[[
3]] && #[[1, 1]] < #[[2, 1]] < #[[3,
1]] && (#[[1, 2]] == #[[2, 2]] || #[[2, 2]] == #[[3, 2]] || #[[
3, 2]] == #[[1, 2]]) &)
tr0 = Tuples[set, 3];
tr1 = Select[tr0, cond];
Print["Number of Triangles = ", Length[tr1]]jagannath debata2018-12-09T07:39:12ZLearn more about the formula for the asymptotic growth of prime numbers?
https://community.wolfram.com/groups/-/m/t/1592343
In the function gallery, there is a formula for the asymptotic growth of prime numbers.
http://functions.wolfram.com/NumberTheoryFunctions/Prime/06/01/0006/
Where can I find more about this? Specifically, how all those terms were found?Collin Merenoff2019-01-15T11:29:43ZRetrieve the Adain-Style (ImageRestyle) network?
https://community.wolfram.com/groups/-/m/t/1592304
I cannot retrieve the Adain-Style (ImageRestyle) network. The download aborts about halfway through.Collin Merenoff2019-01-15T01:27:39ZHeisenberg uncertainty for the harmonic oscillator?
https://community.wolfram.com/groups/-/m/t/1588779
I have to do a program about the Heisenberg uncertainty for the harmonic oscillator. I wrote all the integrals that I need to use for the medium values and the specific function of the oscillator, but it doesn't work...Could someone help me please?
ψ[n_, x_] := Sqrt[α/(2^n n! Sqrt[π])] HermiteH[n, α x ] E^(-((α x)^2/2)) /. α -> 1;
mediex[i_, x_] := \!\(\*SubsuperscriptBox[\(∫\), \(0\), \(∞\)]\(\((Abs[\ψ[i, x]])\)^2*x \[DifferentialD]x\)\)
mediex[5, x]
> 15/(8 Sqrt[π])
mediex2[i_, x_] := \!\(\*SubsuperscriptBox[\(∫\), \(0\), \(∞\)]\(\((Abs[\ψ[i, x]])\)^2*x^2 \[DifferentialD]x\)\)
mediex2[5, x]
> 11/4
mediep[i_, x_] := \!\(\*SubsuperscriptBox[\(∫\), \(0\), \(∞\)]\(ψ[i, x]*\((\(-iℏ\)\ )\) D[ψ[i, x],
x] \[DifferentialD]x\)\)
mediep[5, x]
> 0
mediep2[i_, x_] := \!\(\*SubsuperscriptBox[\(∫\), \(0\), \(∞\)]\(ψ[i, x]*\((ℏ^2\ )\) D[D[ψ[i, x], x],
x] \[DifferentialD]x\)\)
mediep2[5, x]
> -((11 ℏ^2)/4)Ana Monea2019-01-13T13:40:20ZMusic Visualization in Mathematica
https://community.wolfram.com/groups/-/m/t/1582655
*Click image to zoom in. Use browser back button to read further.*
----------
[![enter image description here][2]][2]
Over the Christmas holidays, I finally found some time to test out something I had in mind for a while: Creating an abstract visualization of music. These things are well known and are built into many music-players, but I never tried it myself. If you want to know the whole story behind it you can read my [blog-post about home-recording](http://halirutan.de/music/programming/Music-Visualization/).
What I did is importing an MP3 into Mathematica and using `AudioLocalMeasurements` to extract frequencies and loudness of the song.
audio = Import[file];
meas = AudioLocalMeasurements[audio, {"MFCC", "Loudness"},
Association, PartitionGranularity -> Quantity[1./30., "Seconds"]];
This gives two `TimeSeries` and lets you extract values for every time point of the song. The MFCC is a list of numbers that represent (afaik) the strengths of certain frequencies. The loudness is a single number and gives an estimated loudness measure of the portion.
To visualize it, I used a single `ParametricPlot` that uses the frequency-strengths as factors of a simple trigonometric sum which is plotted in a circular fashion. The size of the circular structure is influenced by the loudness and in addition, it rotates slowly over time. To colorize the plot, I used the distance from the origin and employed one of Mathematica’s color schemes. The majority of the function below is setting-up options to create a plot with fixed plot-range, aspect ratio, etc., and turn it into a slightly blurred image of fixed resolution.
(* Change the line below if you want full HD *)
resolution = {1920, 1080}/10;
ratio = Divide @@ resolution;
With[{mfcc = meas["MFCC"], loudness = Rescale[meas["Loudness"]]},
gr[time_?NumericQ] := With[{f = mfcc[time], l = loudness[time]},
Block[{img, t},
With[{s = Sum[4 f[[i]]*Sin[(i + 3)*t], {i, Length[f]}]},
img =
ParametricPlot[(s + 2 l + .1) {Cos[t + .2 time], Sin[t + .2 time]}, {t, 0, 2 Pi},
PlotRange -> {{-2, 2}*ratio, {-2, 2}},
PlotRangeClipping -> True,
PlotRangePadding -> None,
PlotStyle -> Directive[Thickness[0.008]],
Axes -> False,
ColorFunction -> Function[{x, y, u}, ColorData["Rainbow", Norm[{x, y}]]],
ColorFunctionScaling -> False,
Background -> Black,
AspectRatio -> 1/ratio];
GaussianFilter[Rasterize[img, ImageSize -> resolution], First[resolution]/400.]
]]
]
]
gr[250]
This is how a frame at t=250s looks like
![enter image description here][1]
Unspectacular to say the least, but we are not quite done. A simple trick to make it more interesting is to `Fold` frames so that the old frame leaves a trace in each subsequent image. Specifically, I blurred the old frame, enlarged it and cropped it back to the original size. It is then added to the current frame, where I give the old frame a higher weight before using `ImageAdjust` to rescale all pixel values. This makes everything very colorful and foggy, and the enlargement gives the impression as if we would move forward in space.
tstart = 100;
FoldList[
ImageAdjust[
ImageCrop[
ImageResize[5 GaussianFilter[#1, First[resolution]/100.], Scaled[22/20]],
resolution
] + gr[#2]
] &,
gr[tstart], Range[tstart, tstart + 100]
]
[![enter image description here][2]][2]
The above is now used to create a frame each 1/30th second which is then exported as an image. After all frames are created, I merged the music and the single frames into one video using `ffmpeg`, and I have outlined more details on my webpage.
[Here is video of the final result](https://youtu.be/tufrob3Ohlk) and I hope you like it.
[![enter image description here][3]](https://youtu.be/tufrob3Ohlk)
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=frame250.jpg&userId=11733
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=fold.jpg&userId=11733
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2019-01-16at11.00.52.png&userId=20103Patrick Scheibe2019-01-04T14:16:37ZHow to copy and paste stuff in Mathematica Online
https://community.wolfram.com/groups/-/m/t/597085
I have figured out how to copy and paste whole cells, but not any kind of text (from clipboard). When I right-click in a cell (in the web browser), the 'Paste' option is shown, however nothing happens!Tim Nguyen2015-10-25T07:12:24ZSelect cases from a list based on two conditions?
https://community.wolfram.com/groups/-/m/t/1588219
Let's say we have a list of lists of length 3, as below:
{{{1}, {2}, {1, 2, 3}}, {{1}, {3}, {1, 2, 3}}, {{1}, {1, 2}, {1, 2,
3}}, {{1}, {2, 3}, {1, 2, 3}}, {{2}, {3}, {1, 2, 3}}, {{2}, {1,
2}, {1, 2, 3}}, {{2}, {2, 3}, {1, 2, 3}}, {{3}, {1, 2}, {1, 2,
3}}, {{3}, {2, 3}, {1, 2, 3}}, {{1, 2}, {2, 3}, {1, 2, 3}}}
Now, from that list I want to extract those lists which satisfy the following rules:
1) neighbouring elements in the list have either the same first element or last element, e.g. `{{1},{1,2},{1,2,3}} or {{2},{2,3},{1,2,3}}`.
2) when there are more than one element of length 1 in the list, we take the difference of all such pairs of elements. If that difference is not equal to the absolute value of 1 for all such pairs and the rest of the elements of that list satisfy Rule 1., we pick that list. We keep in mind that the lists in the list below can be of any length. So for example, we would pick `{{1},{3},{1,2,3}} but not {{1},{2},{1,2,3}}`.
Applying those 2 rules to the list above we would get:
{{1},{3},{1,2,3}},{{1},{1,2},{1,2,3}},{{{2},{1,2},{1,2,3}},{{2},{2,3},{1,2,3}},{{3},{2,3},{1,2,3}}
I kind of want to avoid using loops but if that's the only possibility then that's fine. If someone can see some different rules that would allow us the get the same output from that list above then I'd love to see it too. Any help is much appreciated.Damian Wierzbicki2019-01-11T23:26:24ZAnimate these 2D plots?
https://community.wolfram.com/groups/-/m/t/1587486
Consider the following code:
z1 = {-R*W*Sin[W*t] + l'[t]*Sin[\[Phi][t]] +
l[t]*(\[Phi]'[t])*Cos[\[Phi][t]],
R*W*Cos[W*t] - l'[t]*Cos[\[Phi][t]] +
l[t]*(\[Phi]'[t])*Sin[\[Phi][t]]};
V = m*g*(R*Sin[W*t] - l[t]*Cos[\[Phi][t]]) + 1/2*k*(l[t] - l0)^2;
T = 1/2*m*z1.z1;
Lagrange = T - V;
eqs = D[D[Lagrange, \[Phi]'[t]], t] - D[Lagrange, \[Phi][t]];
eqs2 = D[D[Lagrange, l'[t]], t] - D[Lagrange, l[t]];
g = 9.7; m = 1; l0 = 1; k = 1000; R = 2; W = Pi/2;
sol = NDSolveValue[{eqs == 0, eqs2 == 0, l[0] == l0, l'[0] == 0,
Derivative[1][\[Phi]][0] == 0, \[Phi][0] == 0}, {l[t], \[Phi][
t]}, {t, 0, 20}]
{Plot[sol.{1, 0}, {t, 0, 5}, AxesLabel -> {"t", "l"}],
Plot[sol.{0, 1}, {t, 0, 5}, AxesLabel -> {"t", "\[Phi]"}]}Ricardo Waste2019-01-11T14:03:10ZUse package "Calculus`VectorAnalysis`" ?
https://community.wolfram.com/groups/-/m/t/1587220
I am trying to:
Needs["Calculus``VectorAnalysis`"]
But it Failed and the error messages say:
Cannot open Calculus'VectorAnalysis' and Context Calculus'VectorAnalysis' was not created when Needs was evaluated. Does anyone know how I can get that package?Yunlin Zeng2019-01-11T01:13:14ZMongoDB and Mathematica
https://community.wolfram.com/groups/-/m/t/88662
Hi everyone,
I'm looking for a database link between Mathematica and [b][url=http://en.wikipedia.org/wiki/MongoDB]MongoDB[/url][/b]. Is it possible? I see nothing about this in the DatabaseLink reference. Any ideas?
SteeveSteeve Brechmann2013-08-03T04:30:38ZCheck out this great VS Code extension for Wolfram language
https://community.wolfram.com/groups/-/m/t/1589399
Hey guys, I've developed a great extension on VS Code to write Wolfram under Microsoft's Language Server Protocol(LSP). It includes diagnostics, auto-completion, hovering and usage hints, etc. More features are on the way. It is NOT for syntax highlight. It could be easily extended to other editors too.
For details, please check out our [github][1].
[1]: https://github.com/kenkangxgwe/lsp-wlXianglong Hu2019-01-14T06:27:00ZSpecify a function for Expectation: Specifically AR(2) Time Series?
https://community.wolfram.com/groups/-/m/t/1589354
I'm new to Mathematica so having some issues with functional specifications. Basic help will suffice even if it's not specific to my problem below.
I'm trying to take the expectation of a product of functions and definitely doing it incorrectly. For instance how would I recreate variance such as:
$$ \sigma^2= \mathrm { E } [ X ^ { 2 }] - \mathrm { E } [ X ] ^ { 2 }$$
I'm dealing with a WhiteNoiseProcess with constant variance. I got something relevant with:
> In[1]= Expectation[ $ y[t] * y[t] $, y \[Distributed] WhiteNoiseProcess \[ $\sigma$ ]]
> Out[1]= $\sigma^2$
Any help with how to properly input functions would be helpful. But if specifically how to take expectations of their products that'd be great.
---
My specific problem of interest involves Yule-Walker case:
The objective function is $$ y _ { t } = a _ { 1 } y _ { t - 1 } + a _ { 2 } y _ { t - 2 } + \varepsilon _ { t }$$
The assumptions for this AR(2) time series function is the error is white noise with a mean of 0, and constant variance equal to $ \sigma^2 $. The series $ y_t $ is stationary with a constant mean $ \mu $ and variance equal to $ \sigma^2 $. Both of are time invariant.
$$E y _ { t } y _ { t } = a _ { 1 } E y _ { t - 1 } y _ { t } + a _ { 2 } E y _ { t - 2 } y _ { t } + E \varepsilon _ { t } y _ { t }$$
So by Yule-Walker steps I'm trying to multiply this difference equation by $ y_t $ then take its expectation.
The only other relevant output I got more specific to my problem is the following:
In[12]:= Expectation[a[1]* y[t-1] *y[t] + a[2] * y[t-2]*y[t] + \[Epsilon][t]*y[t] , {y \[Distributed] NormalDistribution[\[Mu],\[Sigma]], \[Epsilon] \[Distributed] WhiteNoiseProcess [\[Sigma]]}]
Out[12]= a[2] y[-2+t] y[t]+a[1] y[-1+t] y[t]
Any help is appreciated.A.I. S2019-01-14T00:53:04ZLimit problem from "Mean girls" TV program?
https://community.wolfram.com/groups/-/m/t/1588947
I watched mean girls recently and i got interested in the math problem presented.
evaluate the limit:
(lim)(x→0) ( ln(1-x)-sinx)/(1-cos^2x )
![enter image description here][1]
One girl got the answer -1, which was wrong. The main character reached the right answer in 13 seconds, the limit does not exist. What intrigues me is what different ways could this be solved? How can you reach the answer in 13 seconds, and how did the other girl get -1?
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=meangirls.png&userId=1588914ingrid schau2019-01-13T18:56:14ZMultiply both sides of an equation by an expression?
https://community.wolfram.com/groups/-/m/t/1584776
For example, a ==b ---> a * c == b * c.
Thanks.Zhonghui Ou2019-01-08T12:34:03ZSet properties to Plot (lines and mesh styles)?
https://community.wolfram.com/groups/-/m/t/1585930
I have a simple Inquiry about this attached file of the plot.
I need to make every line in the plot in the different form like (Dotted, Dashed, Dot-Dashed, CirculeDot, Line) for the five lines in the plot.
Also for the mesh style, can I change their style for every line like(point, circle, triangle, square, sixfold or fivefold) because all the lines are meshed by point.Aymen Amer2019-01-09T15:02:19ZWhere do I put the Join[] in this expression?
https://community.wolfram.com/groups/-/m/t/1588573
Hey!
So maybe I'm just not seeing something, but where would it put a Join[] in the following expression to get just one list and not a list of lists?
In[]:= Table[Table[N[frequencyPitch[o, p]], {p, 1, intervalFundamentalPartition}], {o, 0, 1}]
Out[]= {{16.3516, 17.3239, 18.354, 19.4454, 20.6017, 21.8268,
23.1247, 24.4997, 25.9565, 27.5, 29.1352, 30.8677}, {32.7032,
34.6478, 36.7081, 38.8909, 41.2034, 43.6535, 46.2493, 48.9994,
51.9131, 55., 58.2705, 61.7354}}
If I use Catenate[] around the above expression it works; but I read somewhere I should use Join[] if working with pure lists.
Thank you very much!
TimTimo Kuchheuser2019-01-12T19:24:35ZObtain a numerical solution and Plot this equation?
https://community.wolfram.com/groups/-/m/t/1578585
I found equations of motion for my generalized coordinates which are "Phi" and "l" , but I can not get numeric solutions and plots for them.Could you help me please?
z1 = (-R*W*Sin[\[Theta]] + l'[t]*Sin[\[Phi][t]] +
l*\[Phi]'[t]*Cos[\[Phi][t]] - R*W*Cos[\[Theta]] +
l'[t]*Cos[\[Phi][t]] - l*\[Phi]'[t]*Sin[\[Phi][t]]);
z1^2 // Expand // TrigReduce;
V = -m*g*(-R*Sin[\[Theta]] + l[t]*Cos[\[Phi][t]]) +
1/2*k*(l[t] - l0)^2;
T = 1/2*m*z1^2 // Expand // TrigReduce;
Lagrange = T - V;
eqs = D[D[Lagrange, \[Phi]'[t]], t] - D[Lagrange, \[Phi]] // Expand //
TrigReduce;
eqs2 = D[D[Lagrange, l'[t]], t] - D[Lagrange, l] // Expand //
TrigReduceÖmer Faruk AKYILDIZ2018-12-27T19:27:52ZSolve the Extended Generalized Bivariate Meijer G Function (EGBMGF)?
https://community.wolfram.com/groups/-/m/t/1564744
Hi everyone,
I am currently working on RF/FSO transmission systems. As a solution in the analytic expression, I obtained Extended Generalized Bivariate Meijer G Function (EGBMGF). To my best knowledge, the EGBMGF is not available in standard mathematical packages. How can I solve the problem numerically by using wolfram mathematica? How to calculate EGBMGF in mathematics? I deliver the analytical term of EGBMGF.
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=EGBMGF.jpg&userId=1564710Marko Smilic2018-12-03T13:53:30ZSolve the Karush-Kuhn-Tucker equations with Reduce
https://community.wolfram.com/groups/-/m/t/1402471
Some years ago I published a short article in the Mathematica Journal describing solving the Karush-Kuhn-Tucker equations with Reduce, to do symbolic optimization. I was pleased to see that the approach subsequently used by several people. However, the code in that article has the problem that it gives all local minima. I've recently updated the code to only give global minima. The new code has the advantage over Minimize that it gives multiple global minima and also provides the values of the Lagrange multipliers, which give the sensitivity of the objective function to changes in the constraints. The code is shown below with copious comments. I've also given two examples in which the code returns a result but Minimize does not, even though this is an unusual circumstance.
Code
In[1]:= (* Generate the Karush-Kuhn-Tucker Equations *)
KTEqs[obj_ (* objective function *), cons_List (* constraints *), vars_List (*
variables *)] :=
Module[{consconvrule = {GreaterEqual[x_, y_] -> LessEqual[y - x, 0],
Equal[x_, y_] -> Equal[x - y, 0],
LessEqual[x_, y_] -> LessEqual[x - y, 0],
LessEqual[lb_, x_, ub_] -> LessEqual[(x - lb) (x - ub), 0],
GreaterEqual[ub_, x_, lb_] -> LessEqual[(x - lb) (x - ub), 0]} ,
x, y, lb, ub , stdcons, eqcons, ineqcons, lambdas, mus, lagrangian, eqs1,
eqs2, eqs3, alleqns, allvars },
(* Change constraints to Equal and LessEqual form with zero on the right-
hand side *)
stdcons = cons /. consconvrule;
(* Separate the equality constraints and the inequality constraints *)
eqcons = Cases[stdcons, Equal[_, 0]][[All, 1]];
ineqcons = Cases[stdcons, LessEqual[_, 0]][[All, 1]];
(* Define the Lagrange multipliers for the equality and inequality \
constraints *)
lambdas = Array[\[Lambda], Length[eqcons]];
mus = Array[\[Mu], Length[ineqcons]];
(* Define the Lagrangian *)
lagrangian = obj + lambdas.eqcons + mus.ineqcons;
(* The derivatives of the Lagrangian are equal to zero *)
eqs1 = Thread[ D[lagrangian, {vars}] == 0];
(* Lagrange multipliers for inequality constraints are \[GreaterEqual]0 to \
get minima *)
eqs2 = Thread[mus >= 0];
(* Lagrange multipliers for inequality constraints are 0 unless the \
constraint value is 0 *)
eqs3 = Thread[mus*ineqcons == 0];
(* Collect the equations *)
alleqns = Join[eqs1, eqs2, eqs3, cons];
(* Collect the variables *)
allvars = Join[vars, lambdas, mus];
(* Return the equations and the variables *)
{alleqns, allvars}
]
In[2]:= (* Convert logical expressions to rules *)
torules[res_] := If[Head[res] === And, ToRules[res], List @@ (ToRules /@ res)]
In[3]:= (* Find the global minima *)
KKTReduce[obj_(* objective function *), cons_List (* constraints *),
vars_List (* variables *)] :=
Block[{kkteqs, kktvars, red, rls, objs, allres, minobj, sel, ret, minred,
minredrls},
(* Construct the equations and the variables *)
{kkteqs, kktvars} = KTEqs[obj, cons, vars];
(* Reduce the equations *)
red = LogicalExpand @
Reduce[kkteqs, kktvars, Reals, Backsubstitution -> True];
(* Convert the Reduce results to rules (if possible ) *)
rls = torules[red];
(* If the conversion to rules was complete *)
If[Length[Position[rls, _ToRules]] == 0,
(* Calculate the values of the objective function *)
objs = obj /. rls;
(* Combine the objective function values with the rules *)
allres = Thread[{objs, rls}];
(* Find the minimum objective value *)
minobj = Min[objs];
(* Select the results with the minimum objective value *)
sel = Select[allres, #[[1]] == minobj &];
(* Return the minimum objective value with the corresponding rules *)
ret = {minobj, sel[[All, 2]]},
(* Else if the results were not completely converted to rules *)
(* Use MinValue to find the smallest objective function value *)
minobj = MinValue[{obj, red}, kktvars];
(* Use Reduce to find the corresponding results *)
minred =
Reduce[obj == minobj && red, kktvars, Reals, Backsubstitution -> True];
(* Convert results to rules, if possible *)
minredrls = torules[minred];
ret = If[
Length[Position[minredrls, _ToRules]] == 0, {minobj, minredrls}, {minobj,
minred}];
];
(* Remove excess nesting from result *)
If[Length[ret[[2]]] == 1 && Depth[ret[[2]]] > 1, {ret[[1]], ret[[2, 1]]},
ret]
]
In[4]:=
Examples
In[5]:= Minimize[{x^2 - y^2, Cos[x - y] >= 1/2, -5 <= x <= 5, -5 <= y <= 5}, {x, y}]
Out[5]= Minimize[{x^2 - y^2, Cos[x - y] >= 1/2, -5 <= x <= 5, -5 <= y <= 5}, {x, y}]
In[6]:= KKTReduce[x^2 - y^2, {Cos[x - y] >= 1/2, -5 <= x <= 5, -5 <= y <= 5}, {x, y}]
Out[6]= {-25 + 25/9 (-3 + \[Pi])^2, {{x -> -(5/3) (-3 + \[Pi]),
y -> 5, \[Mu][1] -> (20 (-3 + \[Pi]))/(3 Sqrt[3]), \[Mu][2] ->
0, \[Mu][3] ->
1/9 (9 + 6 Sqrt[3] Sin[5 + 5/3 (-3 + \[Pi])] -
2 Sqrt[3] \[Pi] Sin[5 + 5/3 (-3 + \[Pi])])}, {x -> 5/3 (-3 + \[Pi]),
y -> -5, \[Mu][1] -> (20 (-3 + \[Pi]))/(3 Sqrt[3]), \[Mu][2] ->
0, \[Mu][3] ->
1/9 (9 + 6 Sqrt[3] Sin[5 + 5/3 (-3 + \[Pi])] -
2 Sqrt[3] \[Pi] Sin[5 + 5/3 (-3 + \[Pi])])}}}
In[7]:= TimeConstrained[
Minimize[{(Subscript[x, 1] - Subscript[x, 2])^2 + (Subscript[x, 2] -
Subscript[x, 3])^4, (1 + Subscript[x, 2]^2) Subscript[x, 1] + Subscript[
x, 3]^4 - 3 == 0}, {Subscript[x, 1], Subscript[x, 2], Subscript[x,
3]}], 60]
Out[7]= $Aborted
In[8]:= AbsoluteTiming @
KKTReduce[(Subscript[x, 1] - Subscript[x, 2])^2 + (Subscript[x, 2] -
Subscript[x, 3])^4, {(1 + Subscript[x, 2]^2) Subscript[x, 1] + Subscript[
x, 3]^4 - 3 == 0}, {Subscript[x, 1], Subscript[x, 2], Subscript[x, 3]}]
Out[8]= {1.67203, {0, {{Subscript[x, 1] -> 1, Subscript[x, 2] -> 1,
Subscript[x, 3] -> 1, \[Lambda][1] -> 0}, {Subscript[x, 1] ->
AlgebraicNumber[Root[3 + 2 #1 + 2 #1^2 + #1^3 &, 1], {0, 1, 0}],
Subscript[x, 2] ->
AlgebraicNumber[Root[3 + 2 #1 + 2 #1^2 + #1^3 &, 1], {0, 1, 0}],
Subscript[x, 3] ->
AlgebraicNumber[
Root[3 + 2 #1 + 2 #1^2 + #1^3 &, 1], {0, 1, 0}], \[Lambda][1] -> 0}}}}Frank Kampas2018-08-11T17:18:58ZSolve a system of differential equations?
https://community.wolfram.com/groups/-/m/t/1581981
Hello. I need to solve differential equations system dh/dt=f(h) d^2h/dt^2=g(h), h=h(t)
Here is the code:
ksi = 1;
system = {h'[t] == ksi/2*((1/(h[t]*h[t] + 1/4)^3/2) - 1), h''[t] == -((1/(h[t]*h[t] + 1/4)^3/2) - 1)*h[t]};
sol = DSolve[system, {h[t]}, t];
Plot[Evaluate[{h[t]} /. sol], {t, -1, 10}, WorkingPrecision -> 20]
And it shows an error.
Could anybody fix this problem? Thanks a lot.Torebek Zhumabek2019-01-03T13:55:18ZDerive after Nintegration or symbolic integration?
https://community.wolfram.com/groups/-/m/t/1588515
j1 = 0.9
j3 = 0.9
j4 = 0.1
jz = 0.5
d1 = 0.1
d2 = 0.1
z = 4
r1 = 1/2 (Cos[x] + Cos[y])
r2 = Cos[x]*Cos[y]
a = 2*(j1 - j2 + j2*r2 - j1*r1)*z*sa + d1*(2*sa - 1) + jz*sb
b = 2*(j3 - j4 + j4*r2 - j3*r1)*z*sb + d2*(2*sb - 1) + jz*sa
c = jz*Sqrt[sa*sb]
ecl = (j2 - j1)*n*z*sa^2 - d1*n*sa^2 + (j4 - j3)*n*z*sb^2 -
d2*n*sb^2 - jz*n*sa*sb
(*A+B>0*)
w1 = ((a - b)*((a + b)^2 - 4*c^2) + ((a + b)^2 + 4*c^2)*
Sqrt[(a + b)^2 - 4*c^2])/(2*((a + b)^2 - 4*c^2))
w2 = ((-a + b)*((a + b)^2 - 4*c^2) + ((a + b)^2 + 4*c^2)*
Sqrt[(a + b)^2 - 4*c^2])/(2*((a + b)^2 - 4*c^2))
q1 = w1/(Exp[w1/t] - 1)
q2 = w2/(Exp[w2/t] - 1)
sa = 0.5
sb = 0.5
j2 = 0.3
D[(1/(4*Pi^2))*NIntegrate[q1 + q2, {y, -Pi, Pi}, {x, -Pi, Pi}], t]
1.If NIntegrate is used in the last derivation, the following error will occur and the value of 0 will be returned.
NIntegrate::inumr: The integrand ((0. +4. (0.8 +Times[<<3>>]+Times[<<2>>])-4. (0.6 +Times[<<3>>]+Times[<<2>>])) ..... Plus[<<3>>]+4. Plus[<<3>>])^2)) has evaluated to non-numerical values for all sampling points in the region with boundaries {{0,3.14159},{0,3.14159}}.
2.Doubts should be caused by the fact that the variable t is not assigned, but I have to derive t, so I can't assign value. Is it impossible to use NIntegrate?
3.Finally, I use Integrate, but I can't work it out. Is there any convenient way?
PS: I only need a numerical value at last, and I don't need a formula, so I try to use NIntegrate.Thank you very much.qin richard2019-01-12T12:49:08ZCreate a GUI for a classifier based on images?
https://community.wolfram.com/groups/-/m/t/1586343
I developed the following code which is suitable for cloud deployment. However, in order to avoid the problems of the cloud, I would like to create an user interface that runs in a Mathematica notebook. How could I do that?
My code is as follows:
dobermann =
{-> "Dobermann", -> "Dobermann", -> "Dobermann", -> "Dobermann", -> "Dobermann"};
rottweiler =
{-> "Rottweiler", -> "Rottweiler", -> "Rottweiler", -> "Rottweiler", -> "Rottweiler"};
alano =
{-> "Alano", -> "Alano", -> "Alano", -> "Alano", -> "Alano"};
labrador =
{-> "Labrador", -> "Labrador", -> "Labrador", -> "Labrador", -> "Labrador" };
husky =
{-> "Husky", -> "Husky", -> "Husky", -> "Husky", -> "Husky" };
dogTypeSet = {dobermann, rottweiler, alano, labrador, husky};
class = Classify[Flatten[{dobermann, rottweiler, alano, labrador, husky}]];
CloudDeploy[
FormPage[
"image" -> "Image",
Column[{#image, "This is a " <> ToString[class[#image]]}] &,
AppearanceRules ->
<|"Title" -> "What dog is that?",
"Description" -> "Enter an image of a dog and I'll tell you what it is",
"SubmitLabel" -> "Classify"|>, PageTheme -> "Blue"],
Permissions -> "Public"]
The images must be inserted before the arrows. I removed them so as not to have problems in transcribing the code.Pasquale Rossi2019-01-10T08:06:17ZCloudDeploy APIFunction accepting string?
https://community.wolfram.com/groups/-/m/t/1441758
base function:
beta = Function[{x},
y = ResourceData[ResourceObject[x]]
]
then I am deploying this using CloudDeploy:
CloudDeploy[APIFunction[{"x" -> "String" }, beta[#x] &]] ;
this giving back url but when I add ?x="Meteorite Landings" this in front of the link I am getting `$Failed` error
also how do I grab the dataset in json format?Sag Mk2018-09-06T20:16:03Z[GIS] Call Baidu Geoencoder with SN from Wolfram Langugage
https://community.wolfram.com/groups/-/m/t/1588031
*Download the notebook at the end of the thread*
------
##Abstract##
We discuss in detail about how to use *Wolfram Language* and [Baidu Map API service][1] to work on GIS related domestic data science project. This API service is very useful to convert any given street address to geo position in terms of latitude and longitude within mainland China.
----------
##Demo##
For example, I can visualize average cost person for dinner of a restaurant against its location via `GeoBubbleChart`. Without geoencode, I may not put their street address into the plot funtion directly. The same routine is quite useful in commercial property planning in general.
![test][2]
----------
##Instruction##
Starting from a valid App Key (AK) for the API service according to [this document][3]
bdAPIkey = "7ha3**********************72g";
![ing][4]
After you are asked to generate the APP key, you will need to choose how to verify the GET request you send to the server to retrieve data. Two options available:
- White list of IP address or "0.0.0.0/0" to accept all IP
- SN checksum
The first method is only OK for testing or in the case that you have a static IP to send request from for internal use or reverse proxy. We are going to use the second method which is more generic than the first one.
[Basics steps are][5]:
- Encode a specific partial URL from the query
- Append a private key to the above result and enconde againe
- Compute the MD5 checksum of the new string to generate the SN required
- Attach the SN to the original query
- Send this GET http request to the server and retrieve XML/Json result
- Parse the structured return value
The domain is always like this:
domain = "http://api.map.baidu.com";
The scheme URL and the query URL are constructed via `URLBuild` with the App Key sitting at the end of the query
urlpartial=URLBuild[{"/geocoder","v2/"},
{"address"-> "上海市上海中心","callback"-> "showLocation","output"-> "xml","ak"-> bdAPIkey},CharacterEncoding -> "UTF8"]
(* "/geocoder/v2/?address=%E4%B8%8A%E6%B5%B7%E5%B8%82%E4%B8%8A%E6%B5%B7%E4%B8%AD%E5%BF%83&callback=showLocation&output=xml&ak=7ha<SAMPLE_KEY>72g" *)
[Shanghai Tower, a 632 m skyscraper][6] is chosen to be the address as input for instance. *Note: This entity is curated in Wolfram Language and its geo position is available in `Entity[...]` call.*
The next step requires us to attach the private key/SK to the encoded partial URL:
urlpartial~~sk
(* "/geocoder/v2/?address=%E4%B8%8A%E6%B5%B7%E5%B8%82%E4%B8%8A%E6%B5%B7%E4%B8%AD%E5%BF%83&callback=showLocation&output=xml&ak=7ha<SAMPLE_KEY>D72gHo<SAMPLE_KEY>HP" *)
where
sk = Ho<SAMPLE_KEY>HP
Then the signature/SN for verification is generated by (See comment below about *All MD5's created equal*)
sn = Hash[URLEncode[urlpartial ~~ sk], "MD5", "HexString"]
(* "c87<MD5 HEX Digest>d8d" *)
Let's append the signature/SN to the original query. We can do this either by `HTTPRequest[<URL>, "Body"->{...}]` or `URLBuild` again:
fullURL = URLBuild[{"http://api.map.baidu.com", "geocoder", "v2/"},
{"address" -> "上海市上海中心", "callback" -> "showLocation",
"output" -> "xml", "ak" -> bdAPIkey, "sn" -> sn}]
(* "http://api.map.baidu.com/geocoder/v2/?address=%E4%B8%8A%E6%B5%B7%E5%B8%82%E4%B8%8A%E6%B5%B7%E4%B8%AD%E5%BF%83&callback=showLocation&utput=xml&ak=7h<SAMPLE_Key>2g&sn=c87<MD5 HEX Digest>d8d *)
Just pass the URL string into the `HTTPRuest` function:
req = HTTPRequest[fullURL, <|Method -> "GET"|>]
and the resultant response, if everything goes well, is
xmlOBJ = URLExecute[req, "XML"]
![geo][7]
You can inspect the returning XML object to see the `{lat,lon}` information is available for the aforementioned address. Use the following code to extract the geo position pair from the XML with `Case` function:
SetAttributes[FindLatLonPair, HoldAll]
FindLatLonPair[xmlOBJ_] := Module[{xmllocations},
xmllocations =
Cases[xmlOBJ, XMLElement["lat", __] | XMLElement["lng", __],
Infinity];
Association[Sort@xmllocations /. {
XMLElement["lng", {}, {lng_}] :>
Rule["Longitude", ToExpression@lng],
XMLElement["lat", {}, {lat_}] :>
Rule["Latitude", ToExpression@lat]
}
]
] /; Head[xmlOBJ] === XMLObject["Document"]
Quickly apply this function on the XML object we had before:
![result2][8]
----
##Code of the Demo##
Assuming I have curated some data for a list of restaurants in a region. The data include the street addresses and average cost per customer on food and service for dinner there.
Import the data *(not attached with the notebook)*
entitiesRaw = DeleteCases[Import["data.csv"], item_ /; item[[1]] === ""];
If you wrap everything I have shown in the API call into a function, then `Map` the function onto all street address in the datasheet imported, You shall have a list of valid XML objects. Extract all `lat-lon` pairs:
geopos = FindLatLonPair /@ (resultsXMLObj);
(*{<|lat->n1,lon->n2|>,<|lat->n3,lon->n4|> ... }*)
Use the following method to generate `geo postion <-> value pair`
bubbleChartPair = Thread[(GeoPosition[Values[#]] & /@ geopos) -> {dinnerCost1, dinnerCost2 .... } ];
(*{ {Lat, Lon} -> dinnerCost , {Lat, Lon} -> dinnerCost ... }*)
just put them into the `GeoBubblePlot` function to generate a nice spacial trend graphic, for instance
GeoBubbleChart[bubbleChartPair]
*Some of the Geo positions are offset due to difference in datum (BD9 vs [Mathematica's default datum][9]) or civic GIS usage [precision lost][10].*
[1]: http://lbsyun.baidu.com/index.php?title=webapi/guide/webservice-geocoding
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=demo.PNG&userId=23928
[3]: http://lbsyun.baidu.com/apiconsole/key?application=key
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=appkey.png&userId=23928
[5]: http://lbsyun.baidu.com/index.php?title=webapi/appendix
[6]: https://www.wolframalpha.com/input/?i=shanghai%20tower
[7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=2798result.PNG&userId=23928
[8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=result2.PNG&userId=23928
[9]: https://reference.wolfram.com/language/ref/GeoPosition.html
[10]: https://www.gps.gov/systems/gps/performance/accuracy/Shenghui Yang2019-01-11T19:56:27ZUse extra indicators in financial charts?
https://community.wolfram.com/groups/-/m/t/1588019
1) How can I get the list of values of some financial indicator used in *InteractiveTradingChart*, calculate some function of it ((for example, the square) and include it in InteractiveTradingChart as an extra indicator?
2) Is it possible in *FinancialData* to get the data for shorter periods than Daily?Victor Mitin2019-01-11T18:20:49Z