8
Solutions force exactly one eigenvalue to be zero. So we solve for the condition that an eigenvalue vanish, and check that rank is two.
mat = {{1, x, 3}, {2, 4, 5}, {2, 4, x}};
candidateSols = Flatten[Map[Solve[# == 0, x] &, Eigenvalues[(mat)]]]
(* Out[997]= {x -> 2, x -> 5} *)
Both pass the test:
Map[MatrixRank[mat /. #] &, candidateSols]
...
8
SolveAlways[] makes quick work of your problem:
SolveAlways[(3 t^2 + 5 t + a) (4 t^2 + b t - 2) == 12 t^4 + 26 t^3 - 8 t^2 - 16 t + 6, t]
{{a -> -3, b -> 2}}
7
It does not look possible to solve this for general a, b. But for specific values of these, Mathematica can solve it for c
Manipulate[
expr = Exp[(-Pi*a)/c] + Exp[(-Pi*b)/c] - 1;
Grid[{{Row[{"equation is ", expr, "==0"}]},
{Plot[expr, {c, -2, 2}]},
{N@Solve[expr == 0, c]}
}]
,
{{a, 1, "a"}, -2, 2, 1/10, Appearance -> "Labeled"},
{{b, 1, "b"...
6
Use FindRoot
Clear["Global`*"]
f[t_?NumericQ] := Module[{tt = SetPrecision[t, 30]},
NIntegrate[Sqrt[1 - Sqrt[x]]/ArcTan[tt + ArcTan[x]], {x, 0, 1},
WorkingPrecision -> 30]]
Plot the sides of the equation
Plot[{f[t], Pi^2/6}, {t, 0, 1},
WorkingPrecision -> 30,
PlotLegends -> Placed["Expressions", {.5, .7}]]
sol1 = FindRoot[f[t] == Pi^2/6,...
6
One way could be
ClearAll[t,a,b}
z1 = CoefficientList[(3*t^2 + 5*t + a)*(4*t^2 + b*t - 2), t];
z2 = CoefficientList[12*t^4 + 26*t^3 - 8*t^2 - 16*t + 6, t];
eqs = Thread[z1 == z2];
Solve[eqs,{a,b}]
5
Easiest way to solve this problem quickly is to very thoroughly re-state the problem. I do not promise that this is a complete solution to the problem, but I hope it provides significant insight into how to approach finding any such complete solution.
From what I understood from the comments, we are looking for matrices consisting of only $-1$ and $+1$ ...
4
(1) What AlgebraicRulesData really is, is obsolete.Yes, it is still supported. Or ignored, to be more accurate. As for the copy/paste business, it has an internal validation flag. Those do not survive copying and in the case of AlgebraicRulesData there is no way (or attempt) to revalidate them. Without the flag being set, rule replacement will not handle ...
4
Perhaps,
ClearAll[r, i, j, u, v, k, h]
Simplify[u[i, j + 1] == (1 - 2 r) u[i, j] + r (u[i + 1, j] + u[i - 1, j]),
{r == v k/h^2, (u[i, j + 1] - u[i, j])/k == v (u[i + 1, j] - 2 u[i, j] + u[i - 1, j])/h^2}
]
True
3
Not a full answer...
I took what proved to be a similar approach as @eyorble, in that I turn it into a graph problem.
I also just demonstrate how to get a lot of solutions, but not the guaranteed total number of solutions. I think the total number blows up combinatorically, so probably not worth counting.
The main idea is that the matrix $A$ is invertible,...
3
try this
Reduce[ForAll[t, (3*t^2 + 5*t + a)*(4*t^2 + b*t - 2) == 12*t^4 + 26*t^3 - 8*t^2 - 16*t + 6], a]
b == 2 && a == -3
3
This is more an extended comment than a formal answer. With the code and parameters given in the question, the first plot in the question should be something like
Plot[Evaluate@Table[(i[k] /. sol)[t], {k, 1.5, 2.5, 0.2}], {t, 0, 10}, PlotRange -> All,
ImageSize -> Large, AxesLabel -> {t, i}, LabelStyle -> {15, Bold, Black}]
The maximum of ...
2
In addition to Marius' comment, you can use Solve with Method -> Reduce:
Solve[
{
Sin[ϕ1] + 0.6 Sin[ϕ1 + ϕ2] == 0 && ϕ1 > -π && ϕ1 <= π,
0.1 Sin[ϕ2] + 0.6 Sin[ϕ1 + ϕ2] == 0 && ϕ2 > -π && ϕ2 <= π
},
{ϕ1, ϕ2},
Method->Reduce
]
Solve::ratnz: Solve was unable to solve the system with ...
2
Exists and ForAll are qualifier statements and you can attempt to Resolve them to remove the qualifiers as follows:
qualifierStatement=Exists[x,a x^2+b x+c==0]
Now to resolve it under the real domain as follows:
resolvedStatement=Resolve[qualifierStatement,Reals]
Now to get your condition you need to ensure that the quadratic actually exist which is only ...
2
The first predicate is false for a->0, b->0, c->1:
(b==0 && ((c>0 && a<0)||(a>0 && c<0)))||(b!=0 && 4 a c<=b^2)||c==0 /. {a->0, b->0, c->1}
False
The second predicate is true for this case:
b^2 - 4 a c >= 0 /. {a->0, b->0, c->1}
True
2
wuyudi had the right idea to use Tuples[], but as the OP notes, trying to generate all of them just to cull entries afterwards can rapidly become combinatorically prohibitive. Instead, use the equivalence of Tuples[] with the problem of generating all the $m$-digit base $b$ numbers:
With[{nums = {-1, 1, 2, 4}, count = 5},
Table[With[{id = nums[[...
2
Select[Tuples[{-1, 1, 2, 4}, 5], Mod[Total@#, 3] == 0 &]
2
The output of Solve (stored in sol) gives more than one solution (actually, there are 9 possible solutions):
sol = Solve[((I*(del + gamma*Abs[a1]^2) - k/2) a1 - (ke/2) a2 +
Sqrt[ke] s ==
0) && ((I*(del + gamma*Abs[a2]^2) - k/2) a2 - (ke/2) a1 +
Sqrt[ke] s == 0), {a1, a2}];
Length@%
9
You can plot them individually:
n = 1;
...
2
To plot the solution for a range of delc, make these changes to your code:
(1) Remove delc = 1; Leave delc undefined. It will be your parameter.
(2) Keep the ParametricDSolveValue command and its first argument, but change the other arguments to get
s = ParametricNDSolveValue[ ... ,
{1/2*(V11[t] + V22[t] - 2*V12[t])^(-1)}, {t, 0, 100}, delc];
...
1
Here is one possibility:
conds = K > 0 && p > 0 && h > 0 && r > 0;
Complement[Reduce[K*(r - h)/r > 0 && (p*h)/(r - h) < p && conds, h, Reals], conds]
0 < h < r/2
1
If the symbolic Tan[theta*Pi/180] is replaced by the number Tan[theta*Pi/180.], then the variable order is preserved:
theta = 120;
NSolve[
-0.034298780658685656 + y == Tan[theta*Pi/180.] (-0.012483735231386907 + x) &&
-0.028199999999999996 + y == 0 && x > 0 && y > 0,
{x, y}]
(* {{x -> 0.0160049, y -> 0.0282}} *)
I ...
1
another option is to find a function to fit the plot, then use Solve to find the root.
ClearAll[f, x, t];
f[t_?NumericQ] := NIntegrate[Sqrt[1 - Sqrt[x]]/ArcTan[t + ArcTan[x]], {x, 0, 1}]
Plot[f[t] - Pi^2/6, {t, 0, 1}]
So your t is somewhere around 0.1. To find it, you could fit the curve to a function and then use Solve or root finding. For example
data=...
1
You can search it.
Select[Table[{t,
NIntegrate[
Sqrt[1. - Sqrt[x]]/ArcTan[t + ArcTan[x]], {x, 0, 1}]}, {t, 0, 1,
0.001}], RealAbs[#[[2]] - Pi^2/6] < 0.01 &]
{{0.112, 1.64927}, {0.113, 1.643}, {0.114, 1.63679}}
so 0.112 ~ 0.114 is where the answer at.
With more search, you can get more precious answer.
1
This is a precision issue
$Version
(* "12.0.0 for Mac OS X x86 (64-bit) (April 7, 2019)" *)
Clear[dBeta, solnEquation, solnFun];
dBeta[k_Integer, x_, var1_] = Derivative[k, 0][Beta[#1, #2, 2] &][x, var1];
solnEquation[var1_, var2_, x_] =
Sum[Binomial[5, k]*dBeta[k, x, var1]*var2^k, {k, 0, 5}];
equation[var1_, var2_, x_] := solnEquation[var1, var2, ...
1
Get a fast impression e.g. for a^2 + x - y^2 == 0 with
ContourPlot3D[a^2 + x - y^2 == 0, {x, -3, 3}, {y, -3, 3}, {a, -4, 4},
ViewPoint -> {0, 0, Infinity}, AxesLabel -> {x, y},
MeshFunctions -> Function[{x, y, a}, a], Mesh -> {Range[-3, 3]}]
1
Assuming you want positive solutions, you can do the following:
g[a_,b_] := Quiet @ Solve[Exp[(-Pi*a)/c] + Exp[(-Pi*b)/c] == 1 && c>0, c]
Examples:
g[1, 1]
g[1, Pi]
g[1.414, 3.928]
{{c -> π/Log[2]}}
{{c -> Root[{
1 + E^(-π/# + π^2/#) - E^(π^2/#)& ,
8.44332255655234342027637371623542201922`20.601814494499823}]}}
{{...
Only top voted, non community-wiki answers of a minimum length are eligible
