New answers tagged

2

Given eqn = {vo == r1 + v2/(r1 + 1/(I w + c1)), v1 == ((rs + 1/(I w + cs)) v2 + rf + vin)/(rs + rf + 1/(I w + cs)), (vin - v2)/(rs + rf + 1/(I w + cs)) == 2 gm v1 + v2/(r1 + 1/(I w + c1))}; then Solve[eqn, {vo, v1, v2}]// FullSimplify gives the following solution


1

NMinimize requires a function rather than a list of equations. Let's take your equations and try three things. Use eqn11 to solve for c3. Replace c3 with 21/5000 in the other equations. Replace the equality in the remaining equations with a subtraction. eqn1 = c2 + a2 Cosh[(20048005 d)/80227844] - 9; eqn2 = 1/400 (127 - 10 d) 2 a3 + (127/20 - d/2) b3 + ...


0

Yes Solve should achieve that in Mathematica. Wolfram Alpha is my favourite way though. Solve[x == E^(-(r + (1/2)*σ^2) t - g*σ*Sqrt[t]), g]


3

The reference provided in the question recommends m = 3, so that is what I consider. (Edit: m = 2 has no real solution, as can be seen from NSolve[sys, var].) The equations with minor simplification then become n = 2; m = 3; p1 = Tuples[{1, Subscript[x, i], Subscript[y, i]}, {n}]; p3 = DeleteDuplicates[Times @@@ p1]; p4 = Integrate[#, {Subscript[x, i], ...


2

NDSolve as used in the question has too many boundary conditions in x and none in t. (One periodic boundary condition in x for each dependent variable fully meets the need for boundary conditions in that dimension.) Not knowing what boundary conditions are desired in t, I made some up. e = 0.1; k = -4.47675; eqns = {D[y1[t, x], {t, 1}] + k/Pi * D[y1[t, ...


0

As the comments say you just need to use ReplaceAll apply on that Rule. In your code, soldp is {dp -> 5161.06 psi}, what you want is only 5161.06 psi, in this case dp /. soldp would help: Grid[{{"Pressure depletion is", (Pini - dp /. soldp)/psi, "psi"}}, Frame -> All] // nf // ScientificForm There is also a less common way to do the same thing: ...


7

Avoid subscripts and user-defined names starting with capitals. Format[a[n_]] := Subscript[a, n] Format[b[n_]] := Subscript[b, n] Format[c[n_]] := Subscript[c, n] equ1 = 0.0004666666666666666 (Cosh[0.24988836793370642 d] a[2] + c[2]) == c[3]; equ2 = 0.30000000000000004 == 1/4 (12.7` - d)^2 a[3] + 1/2 (12.7 - d) b[3] + c[3]; equ3 = ...


2

TD = 200; Debye[x_] := 3 (x/TD)^3 Integrate[y^3/(Exp[y] - 1), {y, 0, TD/x}, Assumptions -> x > 0] Fa[x_] := 8.6173324*10^(-5) x (9*TD/(8 x) + 3 Log[1 - Exp[-TD/x]] - Debye[x]) ser = Series[Fa[x], {x, 0, 1}] // Normal (* 0.00025852 x Log[1 - E^(-200/x)]*) Plot[ser, {x, 1, 100}]


1

Try fulleq=Append[eqnsMain, eqnsAdd]; And then Eliminate[fulleq, c] Using the {} parenthesis to fuse them would require Flatten on the result, as Mathematica will combine the vectors, not their components.


2

n = 0; a = 1; L = 0; b = 1/100; m = 1/2; g = (2 m a r)/(n + L + 1); f[r_] = AiryAi[(2 m b)^(1/3) r]; r0 = r /. FindMaximum[r^(L + 1) f[r], r, WorkingPrecision -> 20][[2]] // Rationalize[#, 0] &; r0 // N // InputForm (* 4.103398736759 *) r1inv = Series[1/r, {r, r0, 4}] // Normal // Simplify; r0 == r /. Solve[r1inv - 1/r == 0, r, ...


1

eqns = {AA == 2 a + 4 b + 45 c + 5, BB == 4 a + 45 b + 31 c + 78, CC == 0.23 a + 0.4 b + 4.35 c + 0.12, DD == 0.73 a + 0.2 b + 43.455 c + 3.12}; Substituting for c eqns2 = eqns /. c -> 43.5 AA + 34 b + 32 (* {AA == 5 + 2 a + 4 b + 45 (32 + 43.5 AA + 34 b), BB == 78 + 4 a + 45 b + 31 (32 + 43.5 AA + 34 b), CC == 0.12 + 0.23 a + 0.4 b + ...


0

And the third variant, note the transformation fun1[x_] := a1*x + b1*y - 4 fun2[x_] := a2*x + b2*y - 6 a1 = 2; a2 = 5; b1 = -4; b2 = 2; solP = {x, y} /. FindInstance[fun1[x] == 0 && fun2[x] == 0, {x, y}] {{4/3, -(1/3)}} ContourPlot[{fun1[x], fun2[x]}, {x, -5, 5}, {y, -5, 5}, Epilog -> {Red, PointSize[Large], Point[solP]}]


1

In response to your comment, assign an intermediate variable With[{a1 = 2, a2 = 5, b1 = -4, b2 = 2}, solxy = Solve[ {a1*x + b1*y == 4, a2*x + b2*y == 6}, {x, y}][[1]]; p = a1*x + b2*y /. solxy] (* 2 *) The values of x and y are solxy (* {x -> 4/3, y -> -(1/3)} *)


0

One way is Bob Hanlon's solution; here is another way: params = {a1 -> 2, a2 -> 5, b1 -> -4, b2 -> 2}; sol = First@FindInstance[{a1*x + b1*y == 4, a2*x + b2*y == 6} /. params, {x, y}] {x -> 4/3, y -> -(1/3)} p = a1 x + b2 y /. params /. sol // Simplify 2 In your code replace Solve[{a1*x + b1*y == 0; a2*x + b2*y == 0}, {x, y}] with ...


2

Now that we have your initial conditions, the problem turns out to be simple and not CPU intensive. eqn = Derivative[0, 0, 2, 0][u][x, y, z, t] + Derivative[0, 2, 0, 0][u][x, y, z, t] + Derivative[2, 0, 0, 0][u][x, y, z, t] == D[u[x, y, z, t], t]; inti = u[x, y, z, 0] == 314; bon1 = DirichletCondition[u[x, y, z, t] == 304, x == 0]; bon2 = ...


4

You have the irreducible polynomial of the 7th degree: -x + a^3 x - a^3 x^2 - a^4 x^2 - a^5 x^2 + 2 a^4 x^3 + 2 a^5 x^3 + 2 a^6 x^3 - a^4 x^4 - a^5 x^4 - 6 a^6 x^4 - a^7 x^4 + 6 a^6 x^5 + 4 a^7 x^5 - 2 a^6 x^6 - 6 a^7 x^6 + 4 a^7 x^7 - a^7 x^8 The general algebraic solution doesn't exist for polynomials of the 5th degree and higher with arbitrary ...


0

If you don't need to many quadrature points (say, less than 1000), then the easiest way to get them is simply by finding the eigenvalues of the tridiagonal Jacobi matrix, the Golub Welsch algorithm. Here's a post describing the rules for the matrix elements. pointsAndWeightsGaussLegendre[n_] := Module[{jacobi}, jacobi = ConstantArray[0, {n, n}]; ...


2

In general, the transformation must be invertible in order not to introduce new roots. For instance, trafo is not invertible for x = -1 and introduces additional roots involving x -> -1. Likewise, trafo2 = {{1 + x, 1}, {-1, 1 - x}} Det[trafo2] (* 2 - x^2 *) is not invertible for x -> Sqrt[2] and x -> -Sqrt[2], and introduces corresponding ...


0

You can simply include the domain restriction in your system of equations instead: Eq4 = -1 == (Cos[δ] Sin[t])/(Cos[φ ] Sin[δ] - Cos[t] Cos[δ] Sin[φ]) Reduce[{Eq4, 0 < t < Pi/2} /. {δ -> -0.401426, φ -> 0.841248699}, t] (* Out: t == 0.869424 *) Reduce complains that it "was unable to solve the system with inexact coefficients. The answer ...


3

You're experiencing the typical and, in the simple example, expected limitations of searching for roots. The two FindRoot results are easily understood in terms of Newton's method. The best way to proceed, assuming given the example is typical, is to use WhenEvent. sol = NDSolve[{y''[t] == -y[t], y[0] == 1, y'[0] == 0, WhenEvent[y[t] == 0, firstzero = ...


3

You should realize that your expression is complex-valued in the interval that you specified. Plot does not handle the plotting of complex numbers, so it returns unevaluated. Alpha, on the other hand, autonomously decides to plot the real and imaginary parts of your expression separately. In order to get Mathematica to do the same, the easiest way is to ...


2

I suspect that W|A is a bit more forgiving in its interpretation of commands, and thus allows complex functions, whereas Mathematica expects a real function and thus has difficulty with a complex one. If you try Plot[Sqrt[x], {x, -2, 2}] in Mathematica you will not get the imaginary values for $x<0$. Accordingly, this works for the posed problem: ...


0

In short sol = First@Solve[{x + 5 y == 4, 2 x + b y == c}, {x, y}, Reals] {x -> 4 - (5 (-8 + c))/(-10 + b), y -> (-8 + c)/(-10 + b)} sol /. b -> 10 // Quiet {x -> ComplexInfinity, y -> ComplexInfinity} sol /. {b -> 10, c -> 8} // Quiet {x -> Indeterminate, y -> Indeterminate} For b != 10 && c != 8 x -> 4 - 5 y ...


6

The quickest way to get there is to first Solve the first equation for x or y, then use Reduce on the second equation for the other variable: Reduce[ 2*x + b*y == c /. Solve[x + 5*y == 4, y], x] So either b=10, which makes c=8, or else c and b depend on the value of x. It's interesting the different outputs you get depending on which variables you ...


5

I think this is somehow a problem from the perspective that Mathematica will NOT teach you math, it will help you computing stuff in several cases. You have to be able to interpret the output with your math understanding. Your equations can be solved by eqs = { x + 5*y == 4 , 2*x + b*y == c }; vars = {x, y}; sol = Solve[eqs, vars] Here ...


4

You can give explicit ranges as inputs to Solve Solve[{Sin[t] == 1/2, 0 <= t < 2 π}, t] (* {{t -> π/6}, {t -> (5 π)/6}} *)


9

Since @hesam asked about a command, and to get a better understanding of @DanielLichtblau's approach, I tried to generalize it and package it in a function. Feedback would be appreciated! TrackRoot[eqns_List,unks_List,{par_Symbol,parmin_?NumericQ,parmax_?NumericQ},ipar_?NumericQ, iguess_List,opts___?OptionQ]:= ...


2

Look what you get: Table[(x^3 - 2 x)^Log[x], {x, 0.1, 1, 0.1}] {23.9206 - 33.4926 I, 1.52163 + 4.25002 I, -1.56727 + 1.16885 I, -1.27875 - 0.344258 I, -0.625532 - 0.901147 I, -0.0342845 - 1.00769 I, 0.426687 - 0.882703 I, 0.749933 - 0.632977 I, 0.938908 - 0.322649 I, 1. + 0. I} You can plot the real and imaginary part: Plot[Evaluate@ReIm[(x^3 - 2 ...


8

As noted by @ChrisK, this works better starting at the top. Reason being there are no real solutions below the parameter value of 48. Using FoldList one can readily use the prior result to seed the next, that is, providing a starting point. This is a fairly common homotopy approach. points = Rest[FoldList[({x, y} /. FindRoot[{x^2 + y^2 - #2, x*y - ...


5

I'd love to see a good answer to this, because it's a common problem I face. My crude improvement on your technique is to use the previous parameter value's answer as an initial guess, which helps FindRoot. Even better, use linear or quadratic extrapolation and add some adaptive step size. But you won't be going around any bends like the vertical limit ...


1

Try Code: ClearAll["Global`*"] RSolve[{f[n + 1] == f[n] + 2 n + 1, f[1] == -3}, f[n], n] Output: {{f[n] -> -4 + n^2}}


2

Starting in version 10 you can used Indexed to make use of subscript formatting of list indices. sol = Solve[1/y == 1/Indexed[r, 1] + 1/Indexed[r, 2], y] (* {{y -> (Indexed[r, {1}] Indexed[r, {2}])/(Indexed[r, {1}] + Indexed[r, {2}])}} *) You can then replace r by its list directly. sol /. r -> {q, w} (* {{y -> (q w)/(q + w)}} *) Hope this ...


0

Code: Solve[s == a - p*b, b] Output: {{b -> (a - s)/p}} Reference: Solve


3

Because something is wrong with the boundary at $x=0$. Let's solve the equation with DSolve. Since DSolve has trouble in dealing with f[0] == 1, we first use a more general b.c. f[a] == b: eq = f''[r] + r^-1 f'[r] - r^-2 f[r] + (1 - r^2) f[r] == 0 {generalasol} = f[r] /. DSolve[{eq, f[a] == b, f[1] == 1}, f[r], {r}]; and take the limit: asol = ...


2

The problem here is that your equation has terms singular at r=0, while you fix one of the boundary conditions exactly in this point. The workaround may be in shifting the first boundary condition a bit out of this point: ClearAll[r]; eq = f''[r] + f'[r]/r - f[r]/r^2 + (1 - r^2) f[r] == 0; nds = NDSolve[{eq, f[0.1] == 1, f[1] == 1}, f[r], {r, 0, 1}] // ...


5

You can use any of the alternative methods found here: Methods for NSolve For example: NSolve[{D[P[T, V], {V, 1}] == 0, D[P[T, V], {V, 2}] == 0}, {T, V}, Reals, Method -> "Legacy"] (* {{T -> 0.0943287, V -> 7.66613}, {T -> -9.67712, V -> -2.35529}, {T -> -5.12191, V -> -0.778707}} *) The other alternatives seem to work, ...


6

Not a solution, more of an extended comment. Clearly there are real solutions, the curves below do cross ContourPlot[ Evaluate[{D[P[T, V], {V, 1}] == 0, D[P[T, V], {V, 2}] == 0}], {V, -10, 10}, {T, -10, 10}, PlotPoints -> 40] You can get the real-valued solutions version 9 gave via Solve[{N@D[P[T, V], {V, 1}] == 0, N@D[P[T, V], {V, 2}] ...


1

So there are too many things missing from your code to try it, but we can answer the question anyway. When you do your FindRoot, you'll get an answer like {rzin -> -1.44} This is a replacement rule. You can use it like rzin - 4 /. {rzin -> -1.44} (* -5.44 *) So what you do in your loop is soln = FindRoot[{.....}, {rzin, 2}]; Integrate[...., ...


3

One can get a truly ridiculous solution by ComplexExpand[]ing the real and imaginary parts: Reduce[ComplexExpand[{Re /@ #, Im /@ #}] &[ (1 + I)^n == (1 + Sqrt[3] I)^m], {m, n}, Integers] (* ... an astonishing mess involving 14 integer parameters ... *) However, pulling out the magnitude and argument is much nicer. Reduce[ComplexExpand[{Abs ...


6

As stated in the question and also the comment above by Szabolcs, Mathematica does not seem to be able to solve the equation directly. For instance, neither Solve nor Reduce produces the desired result. However, as I suggested in a comment above, the equation can be decomposed into expressions for its amplitude and phase, and each solved to obtain the ...


0

eq1 = (1 + I)^n; eq2 = (1 + Sqrt[3] I)^m; Reduce[ComplexExpand@Thread[AbsArg@eq1 == AbsArg@eq2], {n, m}, Integers] (* C[1] \[Element] Integers && n == 24 C[1] && m == 12 C[1] *) ContourPlot[{Re@eq1 == Re@eq2, Im@eq1 == Im@eq2}, {n, 20, 50}, {m, 10, 30}, Epilog -> {Red, PointSize@Large, Point@{{24, 12}, {48, 24}}}] The solutions ...


3

Last@Reap@Do[ If[ ReIm[(1 + I)^n] == ReIm[(1 + Sqrt[3] I)^m] , Sow[{n, m}] ] , {n, 100} , {m, 100} ] {{{24, 12}, {48, 24}, {72, 36}, {96, 48}}}


3

Read the documentation about Rationalize Now starting from the complex form you can build you own function nicef = Exp[Rationalize[Im[Chop[Log[#]]], 1/16] I] & nicef[-0.735145 + 0.67791 I] E^((12 I)/5) or if the input is $a$ then just Rationalize[a,1/16]


15

I think the negative result of Solve and Reduce is correct, because the fractional power in question requires choosing a branch of the inverse function to $z\mapsto z^3$. The default in Mathematica is to put this cut along the negative real axis. This comes from the fact that the Arg function has that same cut, and that fractional powers 1/n of x are ...


5

Since you seem to want non-negative solutions, try FrobeniusSolve, which is built for linear Diophantine problems such as yours. Count such solutions with Sum[Length[FrobeniusSolve[{3, 7, 1}, b]], {b, 0, 198}] and find the solutions with Flatten[Table[FrobeniusSolve[{3, 7, 1}, b], {b, 0, 198}], 1] On multi-core machines, use ParallelSum and ...


3

Another way: FindInstance[ 3 x + 7 y + z <= 198 && x > 0 && y > 0 && z > 0, {x, y, z}, Integers, 5] {{x -> 43, y -> 9, z -> 5}, {x -> 50, y -> 4, z -> 15}, {x -> 35, y -> 9, z -> 22}, {x -> 34, y -> 10, z -> 26}, {x -> 24, y -> 17, z -> 3}} verify it 3 x + 7 y + z <= ...


8

There are an infinite number of solutions unless you constrain x, y, z more than just to being integers. For example, let {x, y, z} all be negative. Using the asumption that they are all non-negative Solve[{3 x + 7 y + z <= 198, x >= 0, y >= 0, z >= 0}, {x, y, z}, Integers] // Length (* 67354 *) Using the asumption that they are all ...


3

I doubt if this question is on the correct forum, but... this can be accomplished using Minimize with constraints, if search range is bound (sum below 2000 in this case): Minimize[{a^3 + b^3, a^3 + b^3 == c^3 + d^3 && a > 0 && b > 0 && c > 0 && d > 0 && ! (a == c && b == d) && ! (a ...


0

Let Reduce try to find the conditions that make your square root Real. Reduce[-b^2+2 b (-c v1+v2 ymax+ymin-v2 ymin)-(c v1+v2 ymax+ymin-v2 ymin)^2>0 && 0<b<ymax && 0<v2<1 && 0<v1<1 && c>0 && ymax>0 && ymin>0, {b,c,ymax,ymin,v1,v2}] That should return a perhaps complicated ...


7

The following is ten times faster. The remaining time is mostly consumed while evaluating your function, so there may be some optimization window there. point1[j_] := Join[x[[;; j]], w[[j + 1 ;;]]]; point2[j_] := Join[x[[;; j - 1]], w[[j ;;]]]; max = 11; fx = f[x]; β = SparseArray[{{i_, i_} -> -1/100}, {size, size}]; Do[{ w = x + β.fx; T = ...



Top 50 recent answers are included