New answers tagged equation-solving
1
Try
sol = Solve[Eq , r][[6]] ;
The two points on the curve follow
p0 = {v, r} /. sol /. v -> 0 // N
p1 = {v, r /. sol } /. NMinimize[{D[r /. sol, v], v > 50}, v][[2]]
Show[{Plot[r /. sol, {v, 0, 64}], Graphics[{Red,Point[{p0, p1}]}]}, PlotRange -> {0, Automatic}, AxesOrigin -> {0, 0}]
4
A single call to DSolve can, in fact, return the solution to this pair of ODEs, but it is not pretty. For convenience, define
eq = {y0[x] + y0''[x] == 0, y1[x] + y1''[x] == x y0[x]};
Then, as noted in the question, two calls to DSolve yield
ry0 = DSolve[First@eq, {y0[x]}, x] // Flatten
ry1 = DSolve[Last@eq /. %, y1[x], x] // Flatten // Simplify
(* {y0[x] -&...
11
I think you did everything right. The problem is that {Vx[1,1],Vy[1,1]} equals {253, 292} which is very far from {0,0}. See, the entries of J are finite difference approximations of derivates. For example, the upper left entry of J is
(Vx[x + Vx[x, y], y] - Vx[x, y]) / Vx[x, y]
Replacing the Vx[x, y] that originated from the diagonal matrix by h, this ...
3
The most straightforward method involves Simplify with assumptions being its second argument:
Simplify[ a/(b^2 + 1) + b/(c^2 + 1) + c/(a^2 + 1) >= 3/2,
a + b + c == 3 && a >= 0 && b >= 0 && c >= 0]
True
The assumption that a, b, c are nonnegative is important (this should be mentioned in the original question)...
4
Update
Upon further examination, I noticed that the definition of Subscript[x, k - 1]'[0] in the question contains an extra factor of b, with the consequence that this initial condition is inconsistent with the ODEs,
Sqrt[Subscript[y, k - 1]'[t]^2 + Subscript[x, k - 1]'[t]^2] == b
Also, the definitions of Subscript[x, n]'[0] and Subscript[y, n]'[0] are ...
9
Minimize[{a/(b^2 + 1) + b/(c^2 + 1) + c/(a^2 + 1), {a, b, c} > 0,
a + b + c == 3}, {a, b, c}]
{3/2, {a -> 1, b -> 1, c -> 1}}
7
This can be done as follows.
Resolve[ForAll[{a, b, c}, {a, b, c} >= 0,
Implies[a + b + c == 3, a/(b^2 + 1) + b/(c^2 + 1) + c/(a^2 + 1) >= 3/2]], Reals]
True
or/and
FindInstance[ a + b + c == 3 && {a, b, c} >= 0 &&
a/(b^2 + 1) + b/(c^2 + 1) + c/(a^2 + 1) < 3/2, {a, b, c}, Reals]
{}
2
Clear["Global`*"]
nco = 1.4681 // Rationalize;
ncl = 1.4628 // Rationalize;
rco = 4.2*10^3 // Rationalize;
u = 2*Pi*rco*(nco^2 - ncoeff^2)^(1/2)/wl;
w = 2*Pi*rco*(ncoeff^2 - ncl^2)^(1/2)/wl;
f[ncoeff_, wl_] =
u*BesselJ[0, u]/BesselJ[1, u] - w*BesselK[1, w]/BesselK[0, w] // Simplify;
The function has even symmetry in ncoeff
f[-ncoeff, wl] == ...
0
Often the solver of NMinimizeis more robust and calculates one solution
NMinimize[{1, BesselI[1, x]/(x*BesselI[0, x]) == 0.2}, x]
(*{1., {x -> -4.38412}}*)
without restriction.
Second solution follows to
NMinimize[{1, BesselI[1, x]/(x*BesselI[0, x]) == 0.2,x>0}, x]
(*{1., {x -> 4.38412}}*)
1
Bound the value for x
Solve[{BesselI[1, x]/(x*BesselI[0, x]) == 1/5, -5 < x < 5}, x]
(* {{x -> Root[{(-5) BesselI[1, #] +
BesselI[
0, #] #& , -4.38411711031472304526702680222165674734`18.}]}, {x ->
Root[{(-5) BesselI[1, #] + BesselI[0, #] #& ,
4.38411711031472304526702680222165674734`18.}]}} *)
NSolve[{BesselI[1, ...
3
The following (NSolve instead of Solve) works.
NSolve[E^(-b (1.365)) + E^(-b (-0.350)) + E^(-b (-0.409)) == 0, b];
ListPlot[ReIm[b /. % /. C[1] -> 0], ImageSize -> Large,
PlotRange -> {{-0.8, 1.9}, {-500, 500}}]
0
Examples in the manual are a good start for all questions.
AddIn: SMSExport[a,b] traslates to a=b
SMSExport[a,b,"AddIn"->True] traslates to a=a+b
AceGen generates C, Fortran, ... codes. Please run one of the examples in the manual and look at the generated source codes files.
The input for AceGen can not be a PDE as such. You have to ...
1
Plot3D[f[x, z],
{x, 0, 1}, {z, 0, 1},
RegionFunction ->
Function[{x, z},
0 <= z <= 1 && 0 < x < 1 && 2 z > x && 2 z + x < 2]]
(You have a typo using $y$ instead of $z$.). And your function $f(x,z)$ is a function, not a region, so I think your question is ambiguous.
5
Here a version which doesn't uses Subscript' s:
v = 800;
b[0] = 0.5;
b[1] = 1;
g[n_, b_] := b Sinc[n Pi b] ;
h[n_, b0_, b1_] := g[n, b1] - g[n, b0]
H = Table[
KroneckerDelta[n, m] (n^2 + v*(b[1] - b[0] - h[2 m, b[0], b[1]])) +
v*(1 - KroneckerDelta[n, m])*(h[n - m, b[0], b[1]] -h[n + m, b[0], b[1]])
, {n, 1, 10}, {m, 1, 10}];
Eigensystem[H]
1
You need to impose restrictions on the probabilities:
$$0<\pi_1<1$$
$$0<\pi_2<1$$
$$\pi_1+\pi_2=1$$
$$0<p_{11}<1$$
$$0<p_{22}<1$$
$$p_{11}+p_{12}=1$$
$$p_{21}+p_{22}=1$$
There are at least two ways to obtain the stationary distribution:
Solve[{π1, 1 - π1} == {π1, 1 - π1} . {{p11, 1 - p11}, {1 - p22, p22}}, π1]
(* {{π1 -> -((1 - p22)...
1
In this particular case, you can view the solution set in the $z,m_0$ plane (i.e. allowing $m_0$ to vary) with ContourPlot:
z0 = 4.8;
ContourPlot[
Tan[z] == Sqrt[(1/(2 m0)) (z0/z)^2 - 1], {z, -5, 5}, {m0, 0, 2},
PlotPoints -> 50]
(PlotPoints -> 50 just makes the resolution a bit better.)
Note: as @Artes mentions in a comment on the original ...
5
With a tip of the hat to @MichaelE2 (from whom I learned this trick), we can differentiate the implicit relation between $\lambda$ and $k_z$ and then solve it as an ODE:
neweq = eq /. λ -> λ[kz];
startkz = π/6;
startval = λ[startkz] /. Solve[neweq /. kz -> startkz, λ[startkz]]
soln = NDSolve[{D[neweq, kz], λ[startkz] == startval}, λ, {kz, 0, π/1.31}, ...
1
ClearAll[R, a, b, c]
Solve the equation in terms of c
Solve[R == -(a b^2)/(c (a - b)), c]
{{c -> -((a b^2)/((a - b) R))}}
These are called replacement rules. Apply more rules using /.
{{c -> -((a b^2)/((a - b) R))}} /. {R -> -3, a -> 2, b -> -6}
{{c -> 3}}
To get started with Mma:
https://www.wolfram.com/language/elementary-...
3
Clear["Global`*"]
The equation can be solved exactly
eqn = -1.05976 + λ (-4.3872 + (-3.9 -
1. λ) λ) + (1.10144 + 0.624 λ) Cos[
1.31 kz] + 0.035152 Cos[2.62 kz] == 0;
sol[kz_] =
Solve[eqn // Rationalize // Simplify, λ, Reals] // Simplify;
EDIT: For the revised plot range,
Plot[Evaluate[λ /. sol[kz]], {kz, 0, Pi/1.31},
Frame -&...
1
Try
f[x_]:=(a x^2+b x+c)/(d x^2+e x+m);
FindInstance[{D[f[x1],x1]==0,D[f[x2],x2]==0,
0<a<=1,0<b<=1,0<c<=1,0<d<=1,0<e<=1,0<m<=1,
x1!=x2,Element[x1|x2,Integers]},{a,b,c,d,e,m,x1,x2}]
which finds an instance which seems to satisfy your conditions.
If you change all those <= to < then it finds a different solution.
1
The errors you are receiving are because you are aborting the code. If you run the penultimate line of the code,
seriesH = Union[seriesH, ruleH]
on a "clean" kernel (with nothing in memory), you get exactly the same errors. This suggests that the errors arise because you aborting the code before the previous line defines seriesH.
As to why it is ...
1
Integrate[(r*R[1, 0, r])^2, {r, 0, s}] /. s -> σ*a // FullSimplify
(* 1 + E^(-2σ) (-1 - 2σ (1 + σ)) *)
FindRoot[% == 0.95, {σ, 3}]
(* {σ -> 3.1479} *)
In one line:
FindRoot[Integrate[(r*R[1, 0, r])^2, {r, 0, σ*a}] == 0.95, {σ, 3}]
(* {σ -> 3.1479} *)
2
Clear["Global`*"]
d = 3;
ag = 10;
pg = 10;
wp = 20;
SetOptions[NIntegrate,
AccuracyGoal -> ag,
PrecisionGoal -> pg,
WorkingPrecision -> wp,
MaxRecursion -> 20];
SetOptions[FindRoot,
AccuracyGoal -> ag,
PrecisionGoal -> pg,
WorkingPrecision -> wp];
f[z_, zh_] := 1 - (z/zh)^(d + 1);
It is only necessary to ...
2
Because this system of equations is linear with constant coefficients, it can be solves symbolically.
sol = DSolveValue[eqs, {c[y], qyy[y], my[y]}, {y, -1, 1}];
With
LeafCount@sol
(* 73666 *)
sol is too lengthy to reproduce here. It can, however, be plotted without difficulty. For instance,
Plot[Evaluate[sol /. {d -> .1, l -> .1}], {y, -1, 1}, ...
1
I hope I understand your question correctly. You calculate the temp. as a function of time on a grid with 11 points. At each point the temp. is a scalar function u[i], i=1..11. The solution sol1 is a list of the u[i].
With these preliminaries we can get the function values for a specific time (e.g. T) by first creating a list of function names:
us = Table[u[...
16
Using @Michael's formulation of the problem, we can use Reduce to show that the given nice polynomial is smallest. Consider:
p[x_] := x(x-b)(x-c);
We want to find positive integers b and c such that p'[x] = 3(x-d)(x-e) with d and e integers. So:
eqns = Resolve[ForAll[x, p'[x] == 3(x-d)(x-e)]]
2 b + 2 c - 3 d - 3 e == 0 && b c - 3 d e == 0
Now, ...
15
We can perform a brute-force search on all such polynomials with roots up to a certain magnitude. First note that if $p(x)$ is a "nice" polynomial with roots $x_1 < x_2 < x_3$, then so is $q(x)$, the polynomial with roots $0$, $x_2 - x_1$, and $x_3-x_1$. This means that we only need to look for polynomials with one root at 0 and the other ...
1
Mathematica DSolve is smart enough to use this method automatically.
ClearAll[T, t, f, a];
ode = T'[t] + a T[t] == f[t]
DSolve[ode, T[t], t]
$$
\left\{\left\{T(t)\to e^{-a t} \int _1^te^{a K[1]} f(K[1])dK[1]+c_1 e^{-a
t}\right\}\right\}
$$
By hand to verify:
The ODE is
\begin{align*}
T' +a T &= f \left(t \right)
\end{align*}
The integrating ...
3
Use Surd to get the branch you want.
Surd[(8 + 3 Sqrt[21]), 3] + Surd[(8 - 3 Sqrt[21]), 3] // RootReduce
(* 1 *)
3
Clear["Global`*"]
sol1 = Solve[Sqrt[2 x/a2] == Sqrt[2 x/a1] + x*b, x] /. {a2 -> 1, a1 -> 4,
b -> 10}
(* Solve::nongen: Solutions may not be valid for all values of parameters.
{{x -> 0}, {x -> 1/200}, {x -> 9/200}} *)
Check the solutions
Sqrt[2 x/a2] == Sqrt[2 x/a1] + x*b /. {a2 -> 1, a1 -> 4, b -> 10} /. sol1
(* ...
1
I don't know why Mathematica doesn't solve, but I can provide a workaround to get an approximated solution:
\[Alpha] = 1; n = 2;
g[\[Omega]_] = PDF[NormalDistribution[\[Alpha], n*\[Alpha]], \[Omega]]
First f[t] can be evaluated symbolically
f = Function[{t},Integrate[g[\[Omega]]*Exp[I*(\[Alpha] - \[Omega])*(t)], {\[Omega], 0, 10}] //Evaluate]
(*Function[{t},...
0
Giving values to Subscript is not a preferred way in Mathematica. Instead, define $a_1$ and $b_1$ as they were "functions":
Clear[x1, w1, a1, b1, R1];
x1 = 1;
w1 = 2;
a1[j_] := Sqrt[Pi*x1/2]*BesselJ[j + 1/2, x1];
b1[j_] := Sqrt[Pi*w1/2]*BesselJ[j + 1/2, w1];
R1 = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(10\)]\(\((2*j + 1)\)*
Re[a1[j] + ...
1
NN = 3;
Rationalize, Simplify, and Flatten System
System = {{1.27413 +
1.22474 (0.0226805 c[1., 1.] - 0.0676201 c[2., 1.] +
0.142026 c[3., 1.]) -
3.65148 (0.0226805 c[1., 2.] - 0.0676201 c[2., 2.] +
0.142026 c[3., 2.]) -
0.334719 (1.22474 c[1., 2.] - 3.65148 c[2., 2.] +
7.66938 c[3., 2.]) -
...
1
Mathematica is "helpfully" adjusting the ranges of the plot (particularly the range of P) to allow for more detail in the region $N > 0$. You can force Mathematica to show the entire plot by using the PlotRange -> All option.
Note the difference in "vertical" range between the two plots. It appears that most of your phase space ...
1
If result is the result of your Reduce[..], then try this:
Map[FullSimplify, result, {2}]
I'm not sure why you want to get rid of some of the conditions. It could be done by deleting the inequalities that do not contain {a1, a2} or just a2:
DeleteCases[%, i_ /; FreeQ[i, a1 | a2]] (* or just FreeQ[i, a2] *)
Notes:
The argument {a1, a2} to Reduce in the OP ...
2
Try the following.
This is your system:
u1 = -((b + \[Beta] + a1)/((b + \[Beta]) r\[Mu]));
u2 = -((\[Mu] a2)/((1 + b \[Mu] + \[Beta] \[Mu]) r\[Mu]));
sys1 =
Reduce[Abs[1 + r\[Mu] u1] > Abs[r\[Mu] u2] &&
b > 0 && \[Beta] > 0 && \[Mu] > 0 && 0 < r\[Mu] <= 1 &&
Abs[u1] >= 1 && a1 &...
5
Clear["Global`*"]
u1 = -((b + β + a1)/((b + β) rμ));
u2 = -((μ a2)/((1 + b μ + β μ) rμ));
sol = Reduce[
Abs[1 + rμ u1] > Abs[rμ u2] &&
b > 0 && β > 0 && μ > 0 && 0 < rμ <= 1 &&
Abs[u1] >= 1 && a1 > 0, {a1, a2}, Reals]
(* β > 0 && b > 0 && 0 &...
1
sol = Solve[
4*Sin[a/2]*Cos[a/2]^3*tr + Sin[a/2] == 1 && 0 <= a <= Pi, {a, tr},
Reals]
(* {{a -> \[Pi]}, {tr ->
ConditionalExpression[1/4 Csc[a/2] Sec[a/2]^3 (1 - Sin[a/2]),
0 < a < \[Pi]]}} *)
Plot[Evaluate[tr /. sol], {a, 0, Pi}, PlotRange -> {0, 20},
GridLines -> Automatic]
{min = ...
0
My opinion lies somewhere in between those of David Stork and Somos -- I often find Mathematica quite useful even for problems like these. That being said, I don't find it useful to the extent that it generates insight. Insight always seems comes from me or the documentation.
I'll outline the 'least inspired' approach I can come up with:
compute 100 terms ...
1
You can find solutions with FindInstance and a little detour.
Regard the two onesided equations as polynoms in a and determine the parameters {b,c,d,e,f} where they both have the same roots.
eqs = {a + b + c == d e f, d + e + f == a b c};
vars = {a, b, c, d, e, f};
resa = Resultant[a + b + c - d e f, -a b c + d + e + f, a]
(* d + e + f + b c (b + c - d ...
1
I present this as a way to simulate the approach to solving the problem rather than a computer proof. I accept this may not be the intention. Further, I do not believe it is as nice as the video approach.
r[{x_, y_}, n_] :=
Expand@*Simplify /@
NestList[{#[[2]], (#[[2]]^2 - 1)/#[[1]]} &, {x, y}, n][[All, 1]];
CoefficientList[#, x, 11] & /@ r[{...
2
This code using Do returns
DeleteDuplicates[ With[{M = 9},
Reap@Do[If[a + b + c == d e f && d + e + f == a b c,
Sow[{{a, b, c}, {d, e, f}}]],
{a, 1, M}, {b, a, M}, {c, b, M},
{d, 1, M}, {e, d, M}, {f, e, M}]][[2, 1]],
#1 == Reverse@#2 &]
almost immediately.
The similar version using FindInstance
DeleteDuplicates[With[{M =...
1
Here is one suggestion that might work. It seems (on a cursory glance of the conditions making up the sequence) that previous solutions are nested in current ones. For that reason, it probably makes sense to define this recursively. Below, I have worked out a klugey solution based on your current code. It could be made much nicer, but I believe that it ...
2
There is no "silver bullet" that allows FindRoot to work well independent of the initial guess and allowed range. However, some modest changes to a portion of the code solves the problem at hand:
sig[b_?NumericQ, zQ_?NumericQ, zh_?NumericQ] :=
sig /. FindRoot[torootsig[b, sig, zQ, zh], {sig, -0.008, -1.5, 0},
AccuracyGoal -> ag, ...
4
You asked
Any suggestions on an elegant, computational approach?
It is not clear what you mean by that. Since this was a
Putnam problem, the elegant approach would be to
observe that
$\,Q_n(x)=U_n(x/2)\,$ where $\,U_n\,$ is the Chebyshev polynomial
of the second kind since it satisfies the same initial values
and given recursion and a linear recursion.
You ...
3
It seems the problem is not precisely formulated. Nonetheless we can reconstruct reasoning behind the result obtained in the article metioned.
Let's define
f[x_, y_] := 1/16 (-1 + x (2 - x + x^3 (-1 + y)^2 y^2))
then it is straightforward to exploit Reduce this way:
Reduce[ f[x, y] > 0, y]
nevertheless the result is much more involved than the formula (...
1
The use of Reduce instead of Solve does the job.
Reduce[-50 *Sin[0.214068 *(t - 35.1493)] + 50 == 100 && 0 <= t <= 365, t, Reals] // Simplify
C[1] \[Element] Integers && ((0 <= C[1] <= 11. && t == 27.8115 + 29.3514 C[1]) || (-1. <= C[1] <= 10. && t == 57.1628 + 29.3514 C[1]))
The output shows that each ...
6
Make the numbers exact:
m[t_]:=-50 Sin[0.214068 (t-35.1493)]+50;
Solve[Rationalize[m[t]]==100&&0<=t<=365,t,Reals]
Solve should really be used with exact numbers. Otherwise, use NSolve
NSolve[m[t] == 100 && 0 <= t <= 365, t, Reals]
8
Under the assumption that the answers to the questions in my comment are all affirmative:
MapAt[ReleaseHold,
Equal @@ Solve[Replace[eq, a -> Hold[a], {2}], Hold[a]][[1, 1]], 1]
(* a == -a^2 + b^2 *)
Top 50 recent answers are included