4
Problem Statement
For notational simplicity, use the non-dimensional formulation described near the end of the question. (Doing so also facilitates comparison with results of a 2D approximation solved earlier.) The PDE is given by
λh D[θw[x, y, z], x, x] + λc D[θw[x, y, z], y, y] + λz D[θw[x, y, z], z, z] == 0
over the domain {x, 0, 1}, {y, 0, 1}, {z, 0, ...
4
Attributes[TagSet] includes HoldAll, so NCM is not expanded during the definition of the pattern and NonCommutativeMultiply (which you have with **) does not match NCM.
To avoid this, you can either expand NCM explicitly in the pattern by using Evaluate:
id /: Evaluate@NCM[id, x_] := x
id /: Evaluate@NCM[y_, id] := y
Or by avoiding the abbreviation entirely:...
3
Note, a double sum can be written with a single Sum. With this we make a replacement:
Sum[a[k], {k, 1, n}]*Sum[b[k], {k, 1, n}] /.
Sum[a1_, {a2_, 1, n}] Sum[b1_, {b2_, 1, n}] :>
Sum[(a1 /. a2 -> k1) (b1 /. b2 -> k2), {k1, 1, n}, {k2, 1, n}]
3
DSolve can solve the problem symbolically if you help it a bit. Just introduce the transform $u=e^{-t^2}v$:
newsys = {pde, ic, bc} /. u -> ({x, t} |-> Exp[-t^2] v[x, t]) // Simplify[#, t >= 0] &
(tsol = v[x, t] /. DSolve[newsys, v[x, t], {x, t}][[1]]) // AbsoluteTiming
(* {31.8537, ……} *)
sol = Exp[-t^2] tsol // Simplify[#, K[1] ∈ Integers] &...
3
So, there's the "from the ground up" approach, where we build the list of neighbors "by hand", maybe in some way making use of the following function:
(* This gets the list element A[[i,j]], unless it's out of bounds, in which case it returns Nothing:*)
maybeGetPart[A_, {i_, j_}] := Quiet[Check[A[[i,j]], Nothing, Part::partw], Part::partw]...
3
As I promised, I am giving a solution based on the relaxational method. This method was developed to solve nonlinear equations. Details one finds in the paper A. Boulbitch, Mathematica Journal, 20, 1, (2018) dx.doi.org/tmj.20-8. Deriving the eigenvalue and eigenfunction of the ground state of the linear part of the equation is a side effect of the method. ...
3
If only a verification of the solutions is desired, then
eq = -u''[x]/2 - 6 ϵ Sech[Sqrt[2 ϵ] (x - z)]^2 u[x] + ϵ u[x] == λ u[x]
FullSimplify[eq /. λ -> -3 ϵ /. u -> Function[{x}, Sqrt[3/4] (2 ϵ)^(1/4)
Sech[Sqrt[2 ϵ] (x - z)]^2]]
(* True *)
FullSimplify[eq /. λ -> 0 /. u -> Function[{x}, Sqrt[3/2] (2 ϵ)^(1/4)
Sinh[Sqrt[2 ϵ] (x - z)] ...
2
You should probably also CHECK HERE "my answer", which explains the enumeration schema for CAs. It is pretty simple for outer totalistic rules. In 2D you can define GoL and test it on a glider:
GoL2D=<|"OuterTotalisticCode"->224,"Dimension"->2,"Neighborhood"->9|>;
ArrayPlot[#,ImageSize->40,Mesh->...
2
For the revised integral, if you assume that the parameters are positive rather than just non-zero,
$Version
(* "12.2.0 for Mac OS X x86 (64-bit) (December 12, 2020)" *)
Clear["Global`*"]
Assuming[{a > 0, b > 0, m > 0, q > 0},
int = Integrate[Cos[a*x]*Log[Sqrt[(b (m + q (1 - x) x))]/2], {x, 0, 1}] //
ComplexExpand[#, ...
2
Using Mathematica 12.2.0 now can solve.
First example:
pde = d*cp*D[T[t, z], t] == k*D[T[t, z], {z, 2}] + Q;
sol = DSolve[{pde, T[0, z] == Tamb, (D[T[t, z], z] /. z -> 0) ==
0, (-k*D[T[t, z], z] /. z -> a) == h*(T[t, a] - Tamb)},
T[t, z], {t, z}]
(*{
{T[t, z] -> Piecewise[{{Tamb + Inactive[Sum][(2*(1 - E^(-((k*t*K[2, K
[1]])/(cp*d))))*h^2*Q*...
2
Maybe FactorList with Trig -> True can help as it does in the given example:
evs = Eigenvectors[{{Cos[t], Sin[t]}, {Sin[t], -Cos[t]}}];
With[{lcd =
Apply@PolynomialLCM /@
Map[1/Times @@ Power @@@
Select[Negative@*Last]@ (* selects denominator *)
FactorList[#, Trig -> True] &,
evs,
{2}]
},
evs*lcd // Simplify
]
...
1
Instead of evaluating a single sum, you could break up the sum into two or more sums.
L = 24;
sind = Range[-Pi, Pi, 2*Pi/L];
a[x_, y_] := x y
g[x_, y_] := x + y
f = Cos[x]*Sin[y]*Sin[x + x1]*Cos[y + y1]*a[x, y] + g[x, y]*Cos[x2 - y2]*Sin[x + x1 + x2];
AbsoluteTiming[sx = Sum[f, {x, sind}, {x1, sind}, {x2, sind}] // Simplify;
sxy = Sum[sx, {y, sind}, {y1, ...
1
As mentioned in the comments, it is probably easier to stay away from using subscripts, which are primarily a formatting command. Your task is readily accomplished using Array, and defining a function to extract the elements you want:
mat = Array[a, {4, 5}]
fun[m_, i_, j_] := {a[i, j + 1], a[i, j - 1], a[i - 1, j], a[i + 1, j]};
mat defines the matrix and ...
1
myMatrix[n_Integer, m_Integer] :=
Table[Subscript[a, i, j], {i, n}, {j, m}] // MatrixForm
myMatrix[3, 4]
1
An alternative method to solve this problem numerically without the NDSolveValue::ibcinc warning (which appears to discard one of the boundary conditions) is to modify the boundary condition at x = 0 slightly, so that it is consistent with the initial condition there while not changing the computed solution in any noticeable way.
NDSolveValue[{D[u[x, t], {x, ...
1
To check your solution perhaps a numerical solution of the PDE helps.
Without warning Mathematica is able to solve it if you transform your equation to a first order system:
pde = {D[u[x, t], {x, 1}] == v[x, t],D[v[x, t], {x, 1}] - 2 t*u[x, t] == D[u[x, t], {t, 1}]};
ic = {u[x, 0] == 1 - 2 x };
bc = {u[1/2, t] == 0, v[0, t] == 0};
U = NDSolveValue[Join[{pde, ...
1
NO[Times[x__, y_NonCommutativeMultiply, z___]] := x z NO[y]
NO[Times[x___, y_NonCommutativeMultiply, z__]] := x z NO[y]
should do the trick in all situations:
Depending of the canonical ordering of Times it might not be necessary to include both versions but better save then sorry.
1
The question is misleading. It is somewhat a Sturm-Liouville type second order differential equation, but instead of being a usual one this is of the type NDSolve Delay Differential Equations. This methodologies are added lately to the Mathematica built-ins. They can not handle parameters as $z$ that is seemingly continuous varying like $x$. So the $z$ ...
1
You have to pass numeric-parameters a,b to function fun!
Try
fun[a_?NumericQ, b_?NumericQ] := 42 Int[Exp[-(x/a)^2] + b, {x, 0, 5}]
NewFun[a_, b_] := fun[a, b] /. {Int -> NIntegrate}
NewFun[1,1]
(*247.222*)
1
You can get a direct anylytical solution for t[r] if you make use of the identiy
tsol = t /. First@DSolve[{1/t'[r] == r^2/3 (1 - r), t[2] == 0}, t, r]
(* Function[{r}, (1/(2 r))
3 (-2 + r + 2 I \[Pi] r - 2 r Log[2] - 2 r Log[1 - r] + 2 r Log[r])] *)
tsol[r] // FullSimplify[#, 1 < r < 2] &
(* 3/2 - 3/r - 3 Log[-1 + r] + Log[r^3/8] *)
...
Only top voted, non community-wiki answers of a minimum length are eligible
