New answers tagged equation-solving
2
This way seems to be pretty quick:
Solve[1/a + 1/b == 1/2008, b]
(*{{b -> (2008 a)/(a - 2008)}}*)
Reduce[b == (2008 a)/(a - 2008) && 0 < a < b && a ∈ Integers && b ∈ Integers]
(*(a == 2009 && b == 4034072) || (a == 2010 &&
b == 2018040) || (a == 2012 && b == 1010024) || (a == 2016 &&
...
3
This works but is a terrible way of solving the problem:
list1 = Range[10000];
f[{a_, b_}] = 1/a + 1/b;
Select[Tuples[list1, 2], f[#] == 1/2008 &]
(* {{3012, 6024}, {4016, 4016}, {6024, 3012}} *)
1
Plot your function for given value c=.5(for example) with the option RegionFunction
pic = Plot3D[ g[p, q, .5] , {p, 0, 1}, {q, 0, 1}, RegionFunction -> Function[{p, q, z}, z <= 1]]
With
points=pic[[1, 1]][[1]]
(*{{7.14286*10^-8, 7.14286*10^-8, 0.500001}, {0.0714286, 7.14286*10^-8,0.64673},
{0.142857, 7.14286*10^-8, 0.753498}, {0.214286,7.14286*...
2
You apparently want to eliminate k and solve for Dc, so
Solve[Eliminate[Dc == k*t0^2 && Dp == k*t1^2, k], Dc]
(* {{Dc -> (Dp t0^2)/t1^2}} *)
2
Strictly speaking you are eliminating $k$ and you don't need Solve. This is what Eliminate is for and it will also generate conditions on $t_0,t_1$:
Eliminate[{Dc == k*t0^2 , Dp == k*t1^2, Dc/(k t0 ^2) == Dp/(k t1^2)}, k]
(* Dc == (Dp t0^2)/t1^2 && t0 != 0 && t1 != 0 *)
6
Put spaces or * between your variables xyz and wwz to give:
Reduce[ForAll[{x, y, z, w},
Implies[x >= 0 && y >= 0 && z >= 0 && w >= 0 && x + y <= z + w,
x*y*w >= w*w*z]]]
(* result False *)
2
Here's how you can find approximate circle positions and radii given a list of intersection areas. I initially tried an exact approach with FindInstance but that would not complete execution for more than two circles.
If we use NMinimize instead we get some inaccuracy for more than three disks, but at least it gives a close answer. In the example below - it'...
3
It is true that the following (incorrectly?) evaluates to $0$ on its own, instead of either returning an explicit expression, or returning unevaluated:
Area[RegionIntersection[Disk[], Disk[{h, 0}, 1]]] (* Out: 0 *)
I was surprised by that; @JM confirmed that version 11.2 returns a symbolic expression, as one would expect, so this appears to be ...
2
You can also use a composition of RegionIntersection, DiscretizeRegion and MeshCoordinates:
MeshCoordinates[DiscretizeRegion @ RegionIntersection[cyl, line]]
{{-1., 0., 0.}, {1., 0., 0.}}
Or combine the three steps in a function:
intersection = MeshCoordinates @* DiscretizeRegion @* RegionIntersection;
intersection[cyl, line]
{{-1., 0., 0.}, {1., 0., 0.}...
6
For the display
cyl = Cylinder[{{0, 0, -1}, {0, 0, 1}}, 1];
line = InfiniteLine[{{0, 0, 0}, {1, 0, 0}}];
pts = {x, y, z} /. Solve[{x, y, z} ∈
RegionIntersection[line, RegionBoundary[cyl]], {x, y, z}]
(* {{-1, 0, 0}, {1, 0, 0}} *)
Graphics3D[
{{Opacity[0.25], cyl},
{Thick, Red, line},
{Black, AbsolutePointSize[6], Point[pts]}},
PlotRange -> {{...
1
For $p,q,r$ integers using Solve it actually did not work. I got result from Solve which is not valid, I do not know if this is a bug or it is by design
ClearAll[x, y, z, p, q, r];
eq1 = x + y + z == 100;
eq2 = x == 7*p;
eq3 = y == 17*q;
eq4 = z == 27*r;
const = Element[{p, q, r}, Integers];
sol = {x, y, z} /.
First@Solve[{eq1, eq2, eq3, eq4, const}, {x,...
5
If you are looking for integer p,q,r, you should just use FrobeniusSolve[] instead:
FrobeniusSolve[{7, 17, 27}, 100]
{{7, 3, 0}, {8, 1, 1}}
Check:
%.{7, 17, 27}
{100, 100}
3
how can I solve it for complex z
One way is to use Solve.
ClearAll[f,z];
f[z_] := 1/2^z + 1/3^z;
Solve[f[z] == 0, z]
(*Solve::ifun*)
Inverse functions are being used by Solve, so some solutions may not \
be found; use Reduce for complete solution information
N[%]
Using Reduce gives
Reduce[f[z] == 0, z]
4
As suggested by J.M., use a higher value of PlotPoints
Clear["Global`*"]
f[x_, y_] =
Tan[Sqrt[(y Exp[x/2])^2 - (x/2)^2]] - (2 Sqrt[(y Exp[x/2])^2 - (x/2)^2])/x;
ContourPlot[f[x, y], {x, -1, 0}, {y, 0, 4},
ContourStyle -> Red,
PlotPoints -> 100,
Exclusions -> {f[x, y] == 0},
ExclusionsStyle -> Blue,
PlotLegends -> Automatic,
Epilog -...
1
At least for the OP's specific example:
Solve[x^2 + x + 1 == 0, x] // ExpToTrig
{{x -> -(1/2) - (I Sqrt[3])/2}, {x -> -(1/2) + (I Sqrt[3])/2}}
As noted in the comments, RootReduce[] works here, because attempting to convert roots of quadratics to a Root[] object automatically yields the explicit radical representation. On the other hand, ...
2
It's ContourPlot, not CounterPlot.
If you fix that, your code will then complain about BarLegend.
If you remove BarLegend, it will return nothing, because r1 does not have a value. You have not substituted the solutions of your equation in it...
You also receive three solutions to your equation. I do not know the physical significance, but you may have to ...
2
As indicated in one of my comments, $y = z^4 + z^5$ has four branches in the neighborhood of $z=0$. AsymptoticSolve returns asymptotic series for all four. The last one is the one corresponding to $y = x+x^{5/4}$:
ClearAll[asol];
asol[n_] := (* n = order of series sought *)
AsymptoticSolve[y == z^(4) + z^(5), {z, 0}, {y, 0, n}][[4]];
z^4 /. asol[2];
...
1
This can be accomplished by replacing
NSolve[k[dlist[[i]], p] == 0, p, Reals]
by
If[t = NSolve[k[dlist[[i]], p] == 0, p, Reals]; (p /. First[t]) < 0, First[t], Flatten[t]]
in the Print statements. This can be tested by
NSolve[k[dlist[[61]], p] == 0, p, Reals]
If[t = NSolve[k[dlist[[61]], p] == 0, p, Reals]; (p /. First[t]) < 0, First[t], Flatten[...
3
You question is somewhat unclearly formulated. If I correctly understand it, the following does the job.
Series[InverseFunction[# (1 + #^(1/4)) &][x], {x, 0, 2}]
$x-x^{5/4}+\frac{5 x^{3/2}}{4}-\frac{55 x^{7/4}}{32}+\frac{5 x^2}{2}+O\left(x^{9/4}\right)$
0
We determine--making strong use of the Mathematica code given by user250938 in the answer to this question--the eight atoms of our 256-dimensional Boolean algebra on three sets. Then, we are able to present a table of imposed constraints and their (now partially revised) associated probabilities fully consistent with this framework. This takes the form
$\...
2
Tim Laska's solution is excellent. It is fast and accurate. However, for completeness, I have a solution for the NDSolve solution, where we can find the intersections instead of the (excellent) particle advancer (i.e. just jump between the intersections instead of advance).
By using the solution from here
line = HalfLine[{0.5, 0.5, 2}, {0, 0, -1}]
...
2
I had thought that the skeleton of the code I showed above in my comment would be enough for you to be able to fill in the details. Apparently that wasn't true. So here is all the code.
dela=-1.5;g1=0.0003;del0=-0.006;ome=3.014;omem=0.125;kexc=0.002;kk=.2;gma=0.00001;nth=0;
kal=(kk+kexc)/2-del0*(kk-kexc)/(2*ome);g0=g1*(1-del0/ome)/2;kb=0.1;
expr1=-I*(P1/...
1
Rationalize all of your constants so that you can specify WorkingPrecision later to use arbitrary-precision.
dela = -3/2;(*Subscript[Δ,L];Laser-Lower polariton detuning*)
g1 = 3*^-4;(*Subscript[g,0];vacuum optomechanical strength*)
del0 = -6*^-3;(*δ;exciton-photon detuning*)
ome = 3014*^-3;(*Ω;Rabi splitting*)
omem = 1/8;(*Subscript[Ω,m];mechanical ...
5
This is not a direct answer to your question, but an alternate approach. You could create a list of primitives and a build function that contains the Computational Solid Geometry (CSG).
square = Cuboid[];
ball = Ball[{0, 0, 1}, 1];
buildList = {square, ball};
(* Constraints *)
buildFn = ¬ #2 ∧ #1 &;
reg = Region[
Style[BooleanRegion[buildFn, ...
0
As a postscript to the succinct, skillful answer of user250938 to the question, was added:
"it seems that your mathoverflow table is inconsistent. The first six entries are solvable, but after adding the seventh it is inconsistent." (The tabular reference [reproduced below] is to https://mathoverflow.net/questions/359986/what-is-the-relevant-literature-if-...
3
Just drop the domain restriction. The domain restriction requires that all variables and functions to include intermediate values be real. Presumably, at some point Mathematica can't determine that and gives up.
Clear["Global`*"]
$Version
(* "12.1.0 for Mac OS X x86 (64-bit) (March 14, 2020)" *)
sol = NDSolve[{D[p[x]/(1 + x)^3, x] == 0, p[0] == 1}, p, {x,...
3
The usual way to go about this is to use the event detection capabilities of NDSolve[], through WhenEvent[]:
{sol, {{xv}}} =
Reap[NDSolveValue[{D[p[x]/(1 + x)^3, x] == 0, p[0] == 1,
WhenEvent[p[x] == 100, Sow[x], "LocationMethod" -> "Brent"]},
p, {x, 0, 1000}]];
Plot[sol[x], {x, 0, 10}, GridLines -> {None, {100}...
3
Clear["Global`*"]
eq1 = Xi[a] y^2 Sin[Θ]^2 == (r^2 + a^2) Sin[θ]^2;
eq2 = Φ == φ + a t/l^2;
eq3 = T == t;
eq4 = Xi[b] y^2 Cos[Θ]^2 == (r^2 + b^2) Cos[θ]^2;
eq5 = Ψ == ψ + b t/l^2;
Without some form of constraints there are many alternatives for {t, r, θ, φ, ψ}in terms of {T, y, Θ, Φ, Ψ}
sol = (Solve[
eq1 && eq2 && eq3 && eq4 &...
2
Here is some exmaple code:
F[0] = And[a, b, c];
F[1] = And[Not[a], b, c];
F[2] = And[Not[b], a, c];
F[3] = And[Not[c], a, b];
F[4] = And[Not[a], Not[b], c];
F[5] = And[Not[a], Not[c], b];
F[6] = And[Not[c], Not[b], a];
F[7] = And[Not[c], Not[b], Not[a]];
S = And[c, Or[a, b]];
sum = 0;
For[i = 0, i <= 7, i = i + 1,
If[TautologyQ[Implies[F[i], S]], sum = ...
0
Well, here's the answer to the concluding question: "Also, how can one generate the $2^8=256$ members of the algebra (for possible such expansions)"?
We simply let $i$ run from 1 to 256 using the command
BooleanFunction[i, {A, B, C}]
For $i=255, 256$, we get True and False, respectively, while the other 254 results are nondegenerate.
As to the primary ...
4
I suspect that the right-hand side should be
$$
\frac{t_0^2-t_1^2}{2t_0^2},
$$
in which case
D[(t0^2 - t1^2)/(2 t0^2), t0] // Simplify
(* t1^2/t0^3 *)
works. To check:
Integrate[t1^2/t0^3, {t0, t1, t}, Assumptions -> {t > t1 > 0}] /. t -> t0 // Together
(* (t0^2 - t1^2)/(2 t0^2) *)
3
This code is original, but it can't be used for nonlinear case. Also it is not looks like RK3. Nevertheless after correcting few typos we have
n = 150;
h = 5/n;
y = Table[0, n + 1]; z = Table[0, n + 1];
xxx = Table[0, n + 1];
xxx[[1]] = 0; y[[1]] = 1; z[[1]] = -1;
fy[xe_, ye_, ze_] := ze;
fz[x_, yt_, zt_] := -3 yt - 4 zt;
Do[
yy = Solve[
k1y == fy[...
0
The others already have pointed out the problem of your code. But I think it's not bad to say that using 1-D Math input typing usually avoids encountering such mistakes. To type your code in 1-D Math input mode, you should use * whenever you have a multiplication. For substitution in your code, I prefer to use ReplaceAll command. And in case your Solve gives ...
5
Solve[eqs, Cases[eqs, _x, All]]
{{x[1, 1, 1] -> -3 - y[1, 1, 1], x[1, 1, 2] -> -4 - y[1, 1, 2],
x[1, 1, 3] -> -5 - y[1, 1, 3], x[1, 2, 1] -> -4 - y[1, 2, 1],
x[1, 2, 2] -> -5 - y[1, 2, 2], x[1, 2, 3] -> -6 - y[1, 2, 3],
x[1, 3, 1] -> -5 - y[1, 3, 1], x[1, 3, 2] -> -6 - y[1, 3, 2],
x[1, 3, 3] -> -7 - y[1, 3, 3], x[2, 1, 1] -...
5
This is not an answer, but a suggestion to investigate whether your system can be reformulated so that it can be solved by the Finite Element Method, FEM. Your boundary conditions appear to be a DirichletCondition on the top and bottom boundaries and a PeriodicBoundaryCondition on the left and right boundaries.
To use the FEM method it is good to cast your ...
4
Clear["Global`*"]
sh = 774*^19;
angle = 10411*^-6;
distance = 532*^21;
arg = NArgMin[
{(Roc*Sinh[distance/Roc] - sh/angle)^2, Roc > 10^20},
Roc, WorkingPrecision -> 30] // N
(* 3.63412*10^23 *)
FindRoot[
Roc*Sinh[distance/Roc] == sh/angle,
{Roc, 10^23}]
(* {Roc -> 3.63412*10^23} *)
NSolve[
{Roc*Sinh[distance/Roc] == sh/angle,
10^...
6
vsol = V1 /.
NSolve[(Sqrt[u1^4 + A1] - u1)/(A1*D1) + L1/(Sqrt[u1^3 + A1]),
V1][[1]]
Plot[vsol, {u1, 0, .01}]
This is a case where I would recommend rescaling your units so you are not multiplying large numbers with small numbers and then adding and subracting them.
Or you could do something like this:
V5 = 0;
Q1 = Rationalize[1.6021*10^(-19), 10^(...
2
s = {(x - y)^2, x*y + z};
e = (x + y)^2 + 4*z;
You can also use PolynomialReduce:
{q, r} = PolynomialReduce[e, s, {x, y, z}]
{{1, 4}, 0}
e == q.s + r // Expand
True
ClearAll[linDecomp]
linDecomp = If[VectorQ[#, NumericQ] && #2 === 0, #, {}] & @@
PolynomialReduce[##, Variables@#] &;
linDecomp[e, s]
{1, 4}
linDecomp[e, s + (x + ...
2
ORIGINAL:
This isn't an answer, but I needed to add pictures and maybe it will help a bit anyways.
The function that you're working with is ghastly, and I don't know remotely enough to figure out how to solve for zeroes that are in the messy part, though solve for the most negative zero shouldn't be too difficult.
I usually like to start by plotting ...
3
This solution is not perfect, but I will throw it out there anyway in case anyone has an interest to improve it.
Use separation of variables
Clear["Global`*"]
Work on the T equation first
pde = D[T[r, z], r, r] + (1/r)*D[T[r, z], r] + D[T[r, z], z, z] == 0
Separation by multiples
T[r_, z_] = R[r] Z[z]
pde/T[r, z] // Expand
(*R''[r]/R[r] + R''[r]/(r R[r]...
3
ode = 0 == -(c + A*t)^2 + D[r[t], t]^2;
sol = DSolve[{ode}, r, t]
(r[t1] - r[t0] /. sol[[1]])
(* c t0 + (A t0^2)/2 - c t1 - (A t1^2)/2 *)
This is the same as
sol2 = Solve[ode, r'[t]]
Integrate[r'[t] /. sol2[[1]], {t, t0, t1}]
(* c t0 + (A t0^2)/2 - c t1 - (A t1^2)/2 *)
Integrate[r'[t], {t, t0, t1}]
(* -r[t0] + r[t1] *)
Do the same for ...
2
If you want the "best" X7 that fits all of your equations, you can try:
NMinimize[Total[Abs[list]], X7]
{42760.6, {X7 -> 2660.97}}
which shows you that there is no X7 that does a great job solving all the equations at once.
0
This works in V 12.1
ClearAll[X];
list = {7.56433 (589.293 - 0.0041175 X7),
7.56987 (589.036 - 0.0082753 X7), 7.58102 (588.519 - 0.01652 X7),
7.59251 (587.989 - 0.0248558 X7), 7.60164 (587.568 - 0.0313713 X7),
7.62271 (586.601 - 0.0460045 X7), 7.64229 (585.707 - 0.059133 X7),
7.68135 (583.938 - 0.0839613 X7), 7.70909 (582.692 - 0.100513 X7),
...
1
Thanks to the answers I received, now the code works and does what it has to do, that is, the NSolve finds roots even for fractional exponents: I leave here a simplified example of the use of NSolve to find the roots of functions dependent on other functions of the same independent variable, and the related plots.
Suppose we have a parabolic function with a ...
3
Along with the equations, include the inequalities as constraints
g = 9.81; m = 2; ρ = 2; v0 = 6;
sol = Solve[{Fw == m g, Fw Sin[Θ] == m an, an == v^2/ρ,
-ρ g Sin[Θ] == 1/2 (v^2 - v0^2),
v > 0, 0 <= Θ < 2 Pi}, {Θ, v, Fw, an}] //
Quiet
(* {{Θ -> 0.658108, v -> 3.4641, Fw -> 19.62,
an -> 6.}, {Θ -> 2.48349, v -> 3....
2
The warning occurs because you used inexact numbers like 0.01 rather than 1/100. The symbolic methods Solve uses are intolerant of approximate arithmetic. So, it replaced them all with exact numbers. It yielded an empty solution set because it couldn't find a solution to the exact equations.
7
The matrix logarithm in Alex's answer will give one out of many possible (complex!) solutions, in complete analogy with the scalar case.
One way to go about this is to simultaneously reduce cmat and the matrix within the exponential to the Jordan form:
{sm, jm} = JordanDecomposition[2 π {{a, b}, {c, d}}]
{sr, jr} = JordanDecomposition[{{Sin[1], Cos[1]}, {-...
answered May 4 at 12:25
5
There is a solution with using MatrixLog
ClearAll[a, b, c, d];
T = 2 Pi; m = T {{a, b}, {c, d}}; q = 1;
cmat = {{Sin[q], Cos[q]}, {-Cos[q], Sin[q]}};
NSolve[m == MatrixLog[cmat], {a, b, c, d}]
Out[]= {{a -> -1.76697*10^-17 + 0. I, b -> 0.0908451 + 0. I,
c -> -0.0908451 + 0. I, d -> 1.76697*10^-17 + 0. I}}
3
I have no idea why, but this seems to work. Starting with your code
T = 2 Pi;
bt = MatrixExp[{{a, b}, {c, d}}*T];
cmat = {{Sin[1], Cos[1]}, {-Cos[1], Sin[1]}};
eqs = {cmat[[1, 1]] == bt[[1, 1]], cmat[[1, 2]] == bt[[1, 2]],
cmat[[2, 1]] == bt[[2, 1]], cmat[[2, 2]] == bt[[2, 2]]};
and "eliminating" one of the variables
elim = FullSimplify @ Eliminate[...
4
We will demonstrate that the exact formula for $z$ reads:
$$z=\wp\bigg(\frac{\sqrt{\Omega_M}}{2}D_c+\wp^{-1}\big(1;0,-\frac{4\Omega_\Lambda}{\Omega_M}\big);0,-\frac{4\Omega_\Lambda}{\Omega_M}\bigg)-1$$
where $\wp(x;g_2,g_3)$ is the Weierstrass elliptic function, which yields a value $w$ in the elliptic integral $$x=\int^{w}_{\infty}\frac{d t}{\sqrt{4t^3-g_2\;...
Top 50 recent answers are included
