Tag Info

New answers tagged

1

Your Solve call looks like this Solve[{ some equations }, w2''[2 L] == 0, w2'''[2 L] == 0, vars] Why did you exclude the last equation from your list? When you write it like that, then Mathematica thinks your last equation is the list of variables and vars is the domain specification. This is what the error message tells you Solve::bddom: Value ... of ...


3

In such cases I prefer to get an idea from numerical solution. f[x_] = 202. (2.51521 + 1/(-1 + E^(202. x))) + 802. (2.52457 + 1/(-1 + E^(802. x))) + 1802. (2.52632 + 1/(-1 + E^(1802. x))) + 3202. (2.52694 + 1/(-1 + E^(3202. x))) + 5002. (2.52722 + 1/(-1 + E^(5002. x))); data = Table[{a, x /. FindRoot[f[x] == a, {x, -0.001}]}, {a, -100, 100, 10}]; ...


2

First I'll store the equations to a variable: eqns = {(x - x1)^2 + (y - y1)^2 == r1^2, (x - x2)^2 + (y - y2)^2 == r2^2} Note that I've switched to lowercase variable names; this is generally good practice to avoid conflicts with Mathematica's builtin identifiers, which are always uppercase. Without loss of generality we can assume that the first circle ...


0

I'm going to guess that you're trying to solve for the even states of the finite square well in quantum mechanics. Note that the number of roots is just determined by $R$, and is Floor[R/π]; plot the graphs of $\zeta \tan \zeta$ and $\sqrt{R^2 - \zeta^2}$ to see why this is so. Moreover, it's not too hard from this graph to see that the first root will ...


1

If the goal is only to obtain the sum of positive roots, then f[r_] := Total[ζ /. NSolve[{Sqrt[r^2 - ζ^2] - ζ Tan[ζ] == 0, r^2 - ζ^2 >= 0, ζ > 0}, ζ]] produces this quantity. For instance, Plot[f[r], {r, .1, 10}, AxesLabel -> {R, Total}] Quiet is used only to suppress the occasional information message, Solve::ratnz: Solve was ...


0

Well, this is consistent, sort of. 1/0 is ComplexInfinity in Mathematica, and 1/ComplexInfinity is 0, so it works. For an excellent analysis of both the pragmatic reasons for this, and the associated difficulties, see: http://forums.wolfram.com/mathgroup/archive/2006/May/msg00125.html


5

With[{maxR = 10}, Manipulate[ expr = Sqrt[R^2 - zeta^2] - zeta Tan[zeta]; zero = zeta /. NSolve[{expr == 0, R^2 - zeta^2 >= 0}, zeta] // Quiet; Column[{ Plot[expr, {zeta, -maxR, maxR}, Exclusions -> {Cos[zeta] == 0}, PlotRange -> {{-maxR, maxR}, {-25, 40}}, Epilog -> {Red, AbsolutePointSize[4], Point[{#, 0} ...


1

If you just want the $x$ values: x/. {{x -> 0., y -> 4.}, {x -> 1., y -> 1.}, {x -> 1.5, y -> 0.}, {x -> 0., y -> 0.}} (0., 1., 1.5, 0} and likewise for the $y$ values, which of course can be named, or: mySols = {x, y} /. {{x -> 0., y -> 4.}, {x -> 1., y -> 1.}, {x -> 1.5, y -> 0.}, {x -> 0., y -> 0.}} ...


5

You can get very close to the solution in three iterations of Newton's method: f[x_, a_] := x/Sin[Pi/2 x]^a fInvNewton[y_?NumericQ, a_?NumericQ, iter_: 3] := Nest[# - (f[#, a] - y)/Derivative[1, 0][f][#, a] &, If[y > 2/Pi, y, ((Pi/2)^a y)^(1/(1 - a))], iter] Example: Plot[Evaluate@{fInvNewton[y, 0.5, 3], InverseFunction[f, 1, 2][y, 0.5]}, ...


4

If all you're interested in is the inverse power series, then don't calculate the InverseFunction; instead, use the InverseSeries function: fseries[α_] := Series[x (1/Sin[Pi x/2])^α, {x, 0, 5}] Table[InverseSeries[fseries[α], y], {α, -1, 1, 1/2}] Note that $\alpha$ has to be a rational number for this to work. In particular, if you replace the 1/2 ...


0

This behavior is similar to Solve returning "generic" solutions as in Solve[a x == b, x] {{x -> b/a}} which, of course, does not make sense for a=0. However, as the expression provided to Solve does not involve any other constraints, MMA gives the "generic" solution, i.e., one that holds for almost all values of a, b, except for (possibly) some ...


3

First our definitions: f[x_, y_] := Max[2 - (y - 1)^2, x + 1 - (y - 2)^2] Γ = Interval[{0, 4}] The definition of $G(x)$ is (adjusting the notation slightly): $$ \{y\in\Gamma:\forall_{z\in\Gamma}f(x,y)\geq f(x,z)\} $$ In English, this is The set of $y$ (in $\Gamma$) for which $f(x,y)$ is no less than $f(x,z)$ for any $z$ in $\Gamma$. We can make ...


0

No idea if this is the right thing to do, but here's my approach: red = Reduce[f[x, y] >= f[x, Interval[0, 4]], {x, y}] (* (x <= 0 && 0 <= y <= 2) || (0 < x < 4 && 0 <= y <= 2 + Sqrt[x]) || (x >= 4 && 0 <= y <= 4) *) For a first idea what's going on: ContourPlot[f[x, y], {x, -4, 4}, {y, -4, 4}] ...


1

It appears that Mathematica does automatic simplification in some cases which can change the domain of a function. In your case Simplify[eqs] Gives {1/(2-x)+2/y==0, x y (1/(1-3 x)+1/(2 y+1))==0}, putting x=0 in the domain. A similar thing happens with expressions like Simplify[(x^2-36)/(x+6)]


2

Perhaps eq1 = 1/s^3 + 3 s^2 + 4 s + 1 == 0; eq2 = Simplify[s^3 # & /@ eq1] 1 + s^3 + 4 s^4 + 3 s^5 == 0 which demonstrates that the equation is indeed of the 5th order. Solve[eq2, s] // N {{s -> -1.21261}, {s -> -0.506962 - 0.665378 I}, {s -> -0.506962 + 0.665378 I}, {s -> 0.446601 - 0.439765 I}, {s -> 0.446601 + 0.439765 I}} ...


5

It turns out that Reduce finds candidate solutions relatively quickly and spends the vast majority of time proving correctness and completeness of the result. NSolve didn't have its own code for handling such problems, and was ending up using the same code as Reduce, finding symbolic solutions, and then numericizing them. I have implemented an NSolve version ...


2

As commented, Nest or Fold might be applicable here, but there's a neat and underused function called ComposeList that does this elegantly. Here's an example of a function that takes the list of functions, the starting argument, and number of times to apply them in sequence, resulting in a list of results: f[x_] := x^2 g[x_] := 2*x fns = {f, g} ...


2

For example, this is reasonably fast on the following example: eqn = Sin[x] + 0.5 Cos[10 Pi x]; sols = FindRoot[eqn, {x, #}] & /@ Module[{n = 0}, Reap[ NDSolve[{y'[x] == D[eqn, x], y[0] == (eqn /. x -> 0), WhenEvent[y[x] == 0, Sow[x]; If[++n >= 50, "StopIntegration"]]}, {}, {x, 0, Infinity}] ][[2, 1]] ] (* {{x -> ...


5

This function prints out the solutions to all polynomials of degree d with coefficients of unit magnitude. printAllSolutions[d_] := Do[ With[{p = FromDigits[c~Prepend~1, x]}, Print[Expand[p] -> (x /. NSolve[p == 0, x])] ], {c, Tuples[{-1, +1}, d]} ] I made one optimization, which is that the leading coefficient is always 1. If it is ...


4

Actually, they are equal. Redefine s = First@Solve[pt[t] == qt[t], {a, b}] (* {a -> 1/2 (-3 Csc[t] + 3 Sec[t] - 2 Tan[t]), b -> 1/2 (3 Csc[t] + 3 Sec[t] - 2 Tan[t])} *) to eliminate the extra set of brackets. Then, for any value of t FullSimplify[(pt[t] /. s) - (qt[t] /. s)] (* {0, 0} *)


1

Try this exponential derivative operator: expD[f_, x_] := Module[{x0}, Sum[SeriesCoefficient[f, {x, x0, i}], {i, 0, \[Infinity]}] /. {x0 -> x} ] Examples: expD[x^2, x] (* (1 + x)^2 *) expD[Sin[x], x] (* Sin[1 + x] *) expD[Exp[x], x] (* Exp[1 + x] *)


2

For a graphical study I would solve the two equations independently. First one gives you one up to three x-solutions with y as additional parameter. Second one give one up to three y-solutions with x as additional parameter. Next I would plot the solutions as ParametricPlot[] with different colors on top of each other. So something like solx=Solve[(rA-rB) ...


1

I'm guessing you are looking for the list of replacements that need to be made going down to level 0 instead of just showing the level 0 results. Are you looking for something like this? assignments[d] = a + b; assignments[e] = b c; assignments[f] = d e; assignments[x_] := x; FixedPointList[Map[assignments, #, {-1}] &, {f}][[;; -2, 1]] {f, d e, b ...


1

Maybe I missed the point, but if you just copy and paste your expressions (and insert spaces to give multiplication) you get: d = a + b; e = b c; f = d e which gives you b (a + b) c, which is equivalent to your given f. Is this all you were asking?


0

To set up the points for interpolation, I used two Tables. pts1 = Table[{p, U[p] /. soln[[p, 1]]}, {p, 0, 99}]; pts2 = Table[{p, U[p] /. soln[[p, 2]]}, {p, 0, 99}]; U1 = Interpolation[pts1]; U2 = Interpolation[pts2]; I still think there should be a better way than a For loop. It is terribly slow.


1

One approach is to Solve using cond1 and cond2 only, then keep only those answers that satisfy cond3 and cond4. For instance, DiracPoint[{theta_, phi_}] := Module[{c1, c2, c3, x, y, cond1, cond2}, {c1, c2, c3} = 1 - 3 Sin[theta]^2 Cos[phi - 2 Pi (# - 1)/3]^2 & /@ {1, 2, 3}; Cases[If[0 <= ((c2 + c3)^2 - c1^2)/(4 c2 c3) <= 1, cond1 = ...


3

New way The OP mentioned ContourPlot but its behavior is V10 makes my original solution practically unusable except for a very rough plot. Another approach is to solve the equation for all the roots in a given region. From the ContourPlot, one can see there are two types, ones that cross y == -5 and ones that cross y == 5. We can use NDSolve to solve the ...


2

Append has no side effect You may try AppendTo a = {x^2 + y^2 == 1}; AppendTo[a, x + y == 0] Solve[a, {x, y}] resulting in (* {{x -> -(1/Sqrt[2]), y -> 1/Sqrt[2]}, {x -> 1/Sqrt[2], y -> -(1/Sqrt[2])}} *) or consider simply Append[a, x + y == 0] // Solve


2

I may have misunderstood the intent but post this in case it is helpful. Note: I have tried to mimic the spiral, clockwise rotation with displaced centre of spiral I have displayed tangent to curve, the slope and angle. Parametrization seems the most useful approach: sp[t_, m_, a_, v_] := v + a {Exp[Tan[m] t] Cos[t], -Exp[Tan[m] t] Sin[t]} der[t_, ...


2

Just use NMaximize yRx1[a_, b_] := y /. #2 & @@ NMaximize[{Rx1[y, a, b], y > 0}, y] Example: yRx1[1, 1.5] (*0.903322*)


2

For simplicity, take as an example h2 = c^2 + a^2; Now, plot h == 0 instead of the region h > 0. plt = ContourPlot[h2 == 1, {a, -1, 1}, {c, -1, 1}, FrameLabel -> {"a", "c"}] and extract from it the Graphics elements that make up the curve. pts = Cases[plt, GraphicsComplex[z_, __] :> z, Infinity] (* {{{0.0350877, -0.999373}, {-2.22045*10^-16, ...


4

For the given problem it will be far more efficient to use IntegerPartitions: IntegerPartitions[91, {3}, Range[1, 51, 2]] {{51, 39, 1}, {51, 37, 3}, {51, 35, 5}, {51, 33, 7}, . . .} If you only need one solution: IntegerPartitions[91, {3}, Range[1, 51, 2], 1] {{51, 39, 1}}


0

So the range is not to large you can make a "brute-force" attack ;-) data = Tuples[Range[0,51], 3]; and Select[data, Plus @@ # == 92 &] you´ll get 1788 solutions. This is regarding to the complete Range (0..51). The sum of three odd numbers is odd, so never equal to 92. For the edited questions solution is possible in the same way and delivers ...


1

Just a variant of 2012rcampion, producing the largest integer that fulfils condition: NestWhile[# + 1 &, 1, Length@Union[f @@@ Tuples[Range[#], 2]] == #^2 &] - 1


2

Expanding on belisarius's example code: NestWhile[# + 1 &, 1, ! (Unequal @@ Flatten@Table[f[m, n], {n, 0, #}, {m, 0, #}]) &] (* 1 *) This increments $M$ until your condition is satisfied, which it is trivially for $M=1$. Removing the ! gives us the first $M$ such that there is a repeated value of $f$ ($M=20$).


3

One can certainly compute a[n] for arbitrary positive integer $n$. a[n_] := 1 - Sum[Binomial[n, k] 2^(n - k - 1) a[k], {k, 0, n - 2}] - 2 n a[n - 1]; a[0] := 1; a[1] := -1; a[2] := 3; a[15] (* $-694475294514315$ *) ListLogPlot[Table[a[i], {i, 1, 20}]] Just note that many values of a[i] are negative and won't show up on the ListLogPlot. However, ...


0

This will give the <= factorial result result pretty quickly: invfactorialbound[n_] := Module[{bound = Ceiling[1 + Log[0.3989 (0.03653 + n)]/ ProductLog[0.3678 Log[0.3989 (0.03653 + n)]]]}, While[bound! > n, bound--]; bound]; k=10000!+1*^10 invfactorialbound[k] // Timing (* {0.031200,10000} *) That's on an old netbook. No idea ...


6

Use Maximize with a constraint: Maximize[{x!, x! <= 1000}, x, Integers] {720, {x -> 6}} Or ArgMax for the value of x alone: ArgMax[{x!, x! <= 1000}, x, Integers] 6


1

n = 1; While[n! < 1000, Null; n++]; n - 1 (* 6 *) Speedups for large n If you seek the solutions to very large $n$ problems, it is faster if you use Stirling's approximation, that is: $n! \approx \sqrt{2 \pi n} \left({ n \over e} \right)^n$. Start at a safe lower limit (e.g., Log[Target]), then iteratively search through increasing $n$ (which is ...


0

One approach is to set the first equation equal to the second and use Reduce to solve the system: Block[{f1, f2, n, sol}, f1 := 8*n^2; f2 := 64*n*Log2[n]; sol = N@Reduce[f1 == f2, n]] (* n == 1.1 || n == 43.5593 *) Also, you might want to check out the Mathematica tutorials on equation solving.


1

One way to get the real-number version of Abs, which is piecewise differentiable is to use ComplexExpand: ArcLength[ComplexExpand@{x, x^2 - 4 Abs[x] - x}, {x, 0, 5}] (* 1/2 (5 Sqrt[26] + ArcSinh[5]) *) Alternatively, PiecewiseExpand, along with the assumption that x is real works, too: Assuming[x ∈ Reals, ArcLength[{x, PiecewiseExpand[x^2 - 4 Abs[x] ...


1

Rather uninspiringly but consistent with problematic Abs[x]: f[x_] := Piecewise[{{x^2 + 3 x, x < 0}, {x^2 - 5 x, x > 0}}] e.g. ArcLength[f[x], {x, -2, 2}] ArcLength[f[x], {x, 0, 2}] ArcLength[f[x], {x, -2, 0}] yield respectively, 1/4 (3 Sqrt[10] + 5 Sqrt[26] + ArcSinh[3] + ArcSinh[5]) 1/4 (-Sqrt[2] + 5 Sqrt[26] - ArcSinh[1] + ArcSinh[5]) 1/4 ...


2

You have eqs = {x^2 + y^3 + 1 == 0, x + y^2 - 1 == 0}; pts = Solve[eqs, {x, y}]; To get the data points and the plot: data = {x, y} /. pts // Flatten; ListPlot[{Re[#], Im[#]} & /@ data]


1

Since Abs behaves badly in some situations, let's first assume you want the arc length for some x>0. When x>0, your function can be rewritten as (I'll keep that un-simplified form so that you see, I only removed the Abs) f[x_] := x^2 - 4 x - x Now we can calculate the arc length for the interval [0,5] with the usual formula manually ...


3

Mathematica does not know how to take the derivative of Abs[x] D[Abs[x], x] Derivative[1][Abs][x] Consequently, use the equivalent (for real x) Sqrt[x^2] Abs[x] == Sqrt[x^2] // Simplify[#, Element[x, Reals]] & True f[x_] = x^2 - 4 Sqrt[x^2] - x; ArcLength[{x, f[x]}, {x, 0, 5}] 1/2 (5 Sqrt[26] + ArcSinh[5]) % // N 13.9038


1

This Answer has been revised in two respects: First, boundary condition values are Rationalized to postpone roundoff issues until the very end of the calculation. Second, equations ans3 are solved for k1 τ1 instead of Exp[-k1 τ1], etc. Define var = {CA[t], CB[t], CC[t], CD[t], CE[t], CF[t]}; bc0 = {CA[0] == 0.052952, CB[0] == 0, CC[0] == 0, CD[0] == ...


2

We can start by eliminating $C$ from your equations, as it's trivial to solve for once you have the value of $v$. I'm also going to simplify some of your variable names: $$ \begin{align} bt_ixt'_i &= a_i \\ bt'_i &= b_i \end{align} $$ Now we simply have: $$ c \sum_i \left|a_i - vb_i\right| + v = \sum_i a_i $$ Defining $s_i$ as: $$ s_i = ...


1

If you wanted to use StateSpaceModel to implement the solution, you could do the following ssm = StateSpaceModel[ {x1'[t] == Pi x2[t], x2'[t] == Pi (-a - b Cos[2 t]) x1[t] - d Pi x2[t]}, {{x1[t], 0}, {x2[t], 0}, {x1'[t], 0}, {x2'[t], 0}}, {{u[t], 0}}, {x1[t], x2[t]}, t ] Then find the StateResponse response = StateResponse[{ssm, {1, ...


4

I ve modified slightly your problem to one which works: I used exact numbers w = 2; T = 2 Pi/w; a = 4/10; b = 4; d = 3/10; A = T {{0, 1}, {-a - b Cos[2 t], -d}} I then drop the Initial condition on derivatives which are redundant given the order of your equation: sol = NDSolve[{x'[t] == A.x[t], x[0] == {1, 2}},x[t] , {t, 0, 1}] then I plot the ...


1

When you have multiple equations to be solved at the same time you should use &&(logical AND) to separate them, like in the second example of the Solve reference. xe = 10; a = 1; b = 2; c = 0; Solve[tec == a*b*c && ret == Sqrt[Abs[tec - xe]] && val == tec*ret, {tec, ret, val}] I would also suggest using variables with the first ...



Top 50 recent answers are included