New answers tagged

0

Just a minor change from @JasonB (not taking credit for this one). RecurrenceTable[{a[n] == -2 a[n - 1] - 4 b[n - 1], b[n] == 4 a[n - 1] + 6 b[n - 1], a[0] == 1, b[0] == 0}, {a, b}, {n, 0, 20}] {1, -1, -3, -5, -7, -9, -11, -13, -15, -17, -19, -21, -23, -25, -27, -29, -31, -33, -35, -37, -39}


0

expr = (-E^-x α + E^-x x α)^2/(2 (1 - E^-x x α)^2); ContourPlot[expr == 1, {x, 0, 3}, {α, 0, 4}, FrameLabel -> Automatic] The global minimum is at the boundary min1 = NMinimize[{α, expr == 1, x > 0, α > 0}, {α, x}] (* {1.41421, {α -> 1.41421, x -> 2.40504*10^-8}} *) expr /. {α -> Sqrt[2], x -> 0} (* 1 *) The local minimum ...


2

As others have said, the issue with NSolve is loss of precision. By the way, well done for at least back-substituting your answer to test it -- good idea! You can get a correct answer with pencil and paper, and this is a good skill to practise. Let x = (t/5e6). Divide everything by 3.33333e-15 and rearrange: exp(-x) = 1 - 1e-107/3.33333. Now it should ...


11

The problems at hand comes from using inadequate numerical approximation. The equation behind is quite simple and it can be solved exactly, we put 10/3 instead of 3.33333 (if usual mathematical meaning is assumed use 333333/100000 instead of 10/3) : t0 = t /. Solve[10/3 (1 - Exp[-(t/5000000)]) 10^-15 == 10^-122, t, Reals]//First 5000000 (108 Log[2] + ...


15

To get exact output, use exact input (and please input your question using plain text Mathematica code that one can easily copy). Clear[t]; x = Rationalize[3.33333]; eq = x*10^(-15) - x*Exp[-t/5000000]*10^(-15) == 10^(-122); sol = t /. First@Solve[eq, t]; sol = sol /. C[1] -> 0 eq /. t -> sol t should be positive. Since $MaxExtraPrecision = ...


6

Read any basic article or chapter about rounding error. When substituting back, the computation that occurs is subtraction $10^{-15}$ (with 16 significant figures, hence 31 correct digits in the fractional part) from something very similarly. At the end you still have about 31 correct digits in the fractional part, which is why you are not able to obtain $...


0

This is two sums, which are similar, but the first is good practice for the second (and the $\beta_{0k}$s are a little different from the ones with $n>0$). Throughout, we make the following changes in notation, consistent with your intention to treat $qa$ as the ordinate for plotting and the other two combinations as parameters: $qa \rightarrow x \text{...


2

Clear[x] solv = NDSolve[{ D[u[t, x], {t, 2}] - D[u[t, x], {x, 2}] == 0, u[t, 30] == 0, u[0, x] == E^(-x^2), Derivative[1, 0][u][0, x] == 0}, u[t, x], {t, 0, 2000}, {x, -30, 30}, Method -> {"MethodOfLines", "SpatialDiscretization" -> {"TensorProductGrid", "MinPoints" -> 50, "MaxPoints" -> 50, "DifferenceOrder" ->...


0

I believe this can be solved pretty easily with Wolfram Alpha, to call it on Mathematica hit the equals sign (=) twice at the beginning of a cell. Else, try adding the Reals query to the end of your NSolve, as so: NSolve[{eq1 == 0.05945062873244056, eq2 == 0, eq3 == 0}, {d, f, g, t2, t3}, Reals]


1

Inspired by @obsolesced, it is simple to find solutions based on any set that is mapped to itself by f1 and f2. For example, let S = {q1 + q2 Sqrt[2]} for {q1, q2} rational then f[x] = f1[x] x in S f[x] = f2[x] x not in S satisfies the required functional relation. It is continuous nowhere (except x = -7/2) and S is countably infinite and its ...


3

Here's my attempt to construct a non-analytic solution. The idea is to use one of the analytic solutions in the accepted answer when x belongs to a set of points reachable through successive application of either analytic solution or their inverses, and the other solution otherwise. This set must not be equal the set of reals, otherwise the solution just ...


0

Well, I managed to get the job done in the following way: roots = x /. NSolve[# == 0, x, Reals] & /@ (Tuples[{-1, 1}, {4}].{1, x, x^2, x^3}) absroots = Abs[roots] toplot = Map[Max, absroots, 1] Histogram[toplot] toplot2 = Tally[toplot] ListPlot[toplot2] It may not be the cleanest/easiest way, but with simply altering the first line I can do many ...


6

You can add a new variable in Reduce do get your multiplication, just like this In[13]:= Reduce[ ans == x y && x*y > 50 && x*y < 100 && x < 100 && x > 1 && y > 1 && y < 50, ans, {x, y}, Integers] Out[13]= ans == 51 || ans == 52 || ans == 54 || ans == 55 || ans == 56 || ans == 57 || ans ...


2

EDIT Using to rules will be better: x y/.{ToRules@Reduce[x*y > 50 && x*y < 100 && x < 100 && x > 1 && y > 1 && y < 50, {x, y}, Integers]} @Michael thanks! in your situation, the result will be in the form x==2&&y==26||x==2&&y==27...... so we can use replacement rules to make it ...


0

I encountered a problem copying and pasting your code, as HypergeometricU and LaguerreL begin on new lines, but I believe you meant for them to be part of the definitions for DI1 and DI2. Fixing that, the problem of non-numerical integrand comes from undefined global U, which can be set inside Block, and FindRoot attempting to evaluate its argument ...


6

Introduce a new variable $z=x^py^q$. eqs1 = {(y + 1) (a - z) == 0, (y + 1) z - c == 0} res1 = Solve[eqs1, {y, z}] eq2 = (z == x^p y^q /. First[res1]) Solve[eq2, x] The answer is $y=\frac{c-a}{a}$ and $x=\left(a \left(\frac{c-a}{a}\right)^{-q}\right)^{1/p}$.


10

If I understand the question correctly, you wish to obtain a parameterized solution {U2[U1], W2[W1]} from the equation in the question, so that you can vary that parameter to obtain a "nice" solution. One approach is as follows. Define exp = 32 + 8 a^2 (2 + b) + 4 a (2 + b) (6 + b) - b (-4 (8 + U1 - W1 + U2[U1]) + b (-8 + (-2 + U1) U1 + W1^2 - 2 U2[...


1

Or use my favorite command: FindInstance[ {(x - 1)^2 + (y - 1)^2 + (z - 1)^2 == 49, x != 1, y != 1,z != 1}, {x, y, z},Integers, 100]


1

You can use Floor and Solve for part a. Solve[Floor[5 x] == 2 x + 1, x, Reals] x -> 1/2 FindInstance for part b (or a). FindInstance[Floor[1/5 x] > 1 + 2 x, {x}, Reals] x -> -(109/5)


2

This is a solution to the problem with exactly the boundary conditions as stated: Dc = 1460 Kc = 9.41/(10^2) LaplacEquation = Dc*D[u[x, y], {x, 2}] + Dc*D[u[x, y], {y, 2}] - Kc*u[x, y] == 0 v[x] /. First[DSolve[{LaplacEquation /. u -> (v[#] &), v[0] == 1}, v[x], x]] (* ==> E^(-0.0080282 x) (1. - 1. C[1] + E^(0.0160564 x) C[1]) *) All I did ...


2

DSolve has limited abilities with PDEs. I can get part way there, maybe, but something is fishy about the result Mathematica returns. First, since your equation is linear and homogeneous and has a simple relationship among the coefficients, we can rewrite it as a BVP over a unit square: $$\nabla^2u + a\, u=0, u(x,0)=u(x,1),\ u(0,y)=1$$ It is apparently ...


1

Why not just generate the parametric equations for the intersection of the spheres? You know that the intersection points form a circle in a plane perpendicular to the vector between the centers of the spheres. sphereIntersection[{x1_, r1_}, {x2_, r2_}, th_] := Module[{dvec, d, d1, r, rr, ss, nx, ny, nz}, dvec = x2 - x1; d = Norm@dvec; dvec = {...


2

Using the results from this MathWorld page: BlockRandom[SeedRandom["spherical"]; c1 = RandomReal[1, 3]; c2 = RandomReal[1, 3]; r2 = RandomReal[3/2]; r1 = RandomReal[3/2]; d = EuclideanDistance[c1, c2]; u = (d^2 + r1^2 - r2^2)/(2 d^2); cc = {1 - u, u}.{c1, c2}; rc = Sqrt[r1^2 - d^2 u^2]; ...


3

This answer uses the circle3D function written by Taiki, found here. But it specifically does not use any of the Region functionality to find the intersection. Instead, I just grabbed some formulas from this MathWorld page circle3D[centre_: {0, 0, 0}, radius_: 1, normal_: {0, 0, 1}, angle_: {0, 2 Pi}] := Composition[ Line, Map[RotationTransform[{...


2

If you want to simply sample the intersection, you can do this: RandomPoint[ ImplicitRegion[ RegionMember[ RegionIntersection[Sphere[{0, 0, 0}, 1], Sphere[{1, 1, 1}, 1.5]], {x, y, z}], {x, y, z}], 100] // Point // Graphics3D This should work, but maybe it doesn't because of the single-dimensional nature of the sampling region: ...


5

sp1 = Sphere[{0, 0, 0}, 1]; sp2 = Sphere[{1, 1, 1}, 1.5]; ri1 = RegionIntersection[sp1, sp2]; l = MeshCoordinates[DiscretizeRegion[ri1]]; Show[Graphics3D[{Opacity[0.5], sp1, sp2, Thick, Red, Line@l[[Last[FindShortestTour[l]]]]}]] Note that you can find the center and radius of the circle with: o = Mean[l]; r = Mean[Table[Norm[l[[i]] - Mean[l]], {i, ...


3

As Mr. Wizard supposed in a comment, one can indeed use ContinuedFractionK[] here: With[{A = 3., B = 2., x = 0.1}, 1/(1 + I A x + ContinuedFractionK[-n^2/(4 n^2 - 1) x^2 A (1 - I 2 B x), 1 + I A x, {n, 2, 2000}])] 0.9197103744410972 - 0.28251974414934944 I However, if what you want is to approximate the ...


0

I don't know if this is really an answer as the question itself seems misguided. (Why would one want to "display" a massive expression even if this could be done?) Nevertheless I would like to comment on the code used by the Betatron. Hold was used for manual control of recursion, however it would be easier to avoid unwanted recursion in the first place by ...


3

A common way, for a long time, of denoting a (generalized) continued fraction is to list the partial numerators and denominators, sometimes with $+$ and fraction bars like this: $$ F = b_0+ \frac{a_1}{b_1+}\, \frac{a_2}{b_2+}\, \frac{a_3}{b_3+}\cdots $$ It is also an efficient way to store a continued fraction (cf. ContinuedFraction). What is needed is a way ...


0

If the data has the dimensions {n, 2} where n = Length[Range[ti, tf, dt]] things should work fine. Below is a minimal data set that has a length of 501. ti = 100; tf = 1600; dt = 3.; ndsol1 = ParametricNDSolve[{y'[x] == -k1*y[x] - k2*y[x]*y[x] - k3*y[x]*y[x]*y[x], y[ti] == 0.016470755}, y, {x, ti, tf}, {k1, k2, k3}] junk = y[0, 1.05, 1.05] /. ...


2

When the expression is inside a List use Apply at level 1 list1 = {(expr1) || (expr2) || (expr3)}; List @@@ list1 (* {{expr1, expr2, expr3}} *) list2 = {(expr1) && (expr2) && (expr3)}; List @@@ list2 (* {{expr1, expr2, expr3}} *) If there is no external List then just use Apply list3 = (expr1) || (expr2) || (expr3); List @@ ...


4

As said by @Mr.Wizard, you don't have a solution because it is a overdetermined system of equations, i.e., there are more equations than unknowns. If you look at @Mr.Wizard 's plot, it is possible to note that the three equations has no common intersection. But if you elliminate one of the equations you can find two points of solution. NSolve[{Sin[α] ...


3

Solve is one of the functions that returns a list of rules and you need to use the /. Replace All command. Read: http://support.wolfram.com/kb/12505 m = {{1, 1, 1}, {1, 2, 3}, {1, 4, 9}}; b = {1, 2, 3}; abc = LinearSolve[m, b] f = Dot[abc, {x, y, z}] sol = Solve[f == 0, z] Plot3D[z /. sol, {x, 0, 15}, {y, 0, 15}] And as J.M. mentioned f= Dot [abc, {x, y,...


3

I'd take a more brute force approach than the ones you have suggested. Not because it's better, but it's just how I roll. For a bit of speed, we can first calculate the Eigenvalues with all the parameters substituted. Then copy and paste the ones we want. They are big ugly things which I won't reproduce here. efun[ϕ_, ϕfl1_, ϕfl2_] := Root[...]; gfun[ϕ_, ...


4

When DSolve runs a long time, it's probably because either Integrate or Solve is chewing over a tough problem. Here's a way to make Integrate give up quicker, so that you can see if that is the problem. Note/warning: The code returns Inactive[Integrate][...] instead of an unevaluated Integrate[...]. The latter seems preferable, but I was unable to figure ...


1

Try this $Assumptions = {w, x, y, z} \[Element] Reals; f = {1/2 (-x - y + Sqrt[4 w^2 + x^2 - 2 x y + y^2]), 1/2 (-x - y - Sqrt[4 w^2 + x^2 - 2 x y + y^2]), -z, x + y - Sqrt[4 w^2 + x^2 - 2 x y + y^2], x + y + Sqrt[4 w^2 + x^2 - 2 x y + y^2], 2 z}; Table[c = f[[i]]; d = Drop[f, {i}]; Simplify[Reduce[And@@Map[c<=#&, d], {w, x, y, z}]], {i, 1, ...


8

With $Version (* 10.4.1 for Microsoft Windows (64-bit) (April 11, 2016) *) the code in the question produces the desired answer, although slowly, (* {{y -> Function[{x}, E^x*C[1] + E^x*C[2]*Integrate[E^(-ArcTan[K[1]] - 2*K[1]), {K[1], 1, x}]]}} *) Computation time, as measured by AbsoluteTiming, is about 40 minutes on my PC. Addendum As is ...


3

Do you really need to return x from your function (even as part of a larger expression)? There is simply no good way to do this if x has a global value, as x = 1; x -> 2 immediately evaluates to 1 -> 2. You could return the solution value only (val instead of x -> val): SolveIt[a_, b_] := Module[{x, soln}, soln = Solve[a x + b == 0, {x}]; ...


3

As explained in Mathematica help, "Module creates a symbol with name xxx\$nnn to represent a local variable with name xxx. The number nnn is the current value of $ModuleNumber." This variable is not renamed after the module has completed. If instead the variable x refers to a global variable which already has a value (e.g. x=3), the x in Solve[eqn,x] will ...


0

Got everything working the way I want it to. Here is the code below if anyone ever wants to model a cantilever bending on a box. Manipulate[h = x /. Quiet@Solve[k == x*Cos[\[Theta]] - (p*x^2)/(6*c*d) (3 f + x) Sin[\[Theta]], x, Reals][[1]]; a = x /.Quiet@Solve[l == x*Cos[\[Theta]] - (p*x^2)/(6*c*d) (3 f + x) Sin[\[Theta]], x, Reals][[1]]; b = a*Sin[\[...


1

There's no need for all this dynamic stuff, you can use Solve[] in conjunction with Manipulate[], and let Manipulate[] handle the dynamic stuff. Manipulate[ h = x /. Quiet@ Solve[2 == x*Cos[θ] - (p*x^2)/(6*c*d) (3 f + x) Sin[θ], x, Reals][[1]]; Show[{Graphics[{Opacity[0.5], Red, Rectangle[{1, 0}, {2, 1}]}, PlotRange -> {{-1, 2},...


2

You want to run a = x /. Solve[x + 1 == 0, x, Reals][[1]] The [[1]] selects the first solution, and the x /. applies the solution to the expression x.


2

Answer courtesy of Rahul: s = DiscretizeRegion[ ImplicitRegion[ Min[EuclideanDistance[{x, y, z}, #] & /@ carbonXYZ] == rc + ra, {x, y, z}], {{-1, 28}, {-2, 23}, {-5, 5}}, MaxCellMeasure -> 0.1] RandomPoint[s]


8

It comes with which roots correspond to which branches of a cubic root in the exact expression. For instance, consider the simpler $$y^3 = z$$ Then my three solutions are $y=\sqrt[3]{z}$, $y=(-1)^{2/3}\sqrt[3]{z}$, and $y=(-1)^{-2/3}\sqrt[3]{z}$. Mathematica defines that $\sqrt[3]{-1} = \frac{1}{2} + \frac{\sqrt{3}}{2}i$. So if I track the first solution, ...


2

Having a helper function rhs, which evaluates only with a numeric vector as argument, for the right-hand side of the force equation lets you use vectors as you want. This way the undesired symbolic precalculation (threading of drag (v.v) Normalize[v] with {0, 0, gravity}) is bypassed and the solving continues numerically. See this answer for a bit more ...


1

f[x_, μ_, σ_] := (Sqrt[2*Pi]*σ*x*(1 - x))^(-1)*Exp[-0.5*σ^(-2)*(Log[x/(1 - x)] - μ)^2] g[μ_?NumericQ, σ_?NumericQ] := NIntegrate[x*f[x, μ, σ], {x, 0, 1}] h[μ_?NumericQ, σ_?NumericQ] := NIntegrate[x^2*f[x, μ, σ], {x, 0, 1}] FindRoot[{g[μ, σ] == 0.3, h[μ, σ] == 0.1}, {{μ, 1}, {σ, 1}}] (*{μ -> -0.894192, σ -> 0.495778}*)


2

myList = {a + 2 g, -2 c d - 3 b f + 2 a g, d^2 f - c d g, -2 c^2 - a f, c d f - c^2 g}; var = Variables[Level[myList, -1]]; soln = Solve[ {myList == 0, {-3 <= # <= 3, # != 0} & /@ var} // Flatten, var, Integers] {{a -> -2, b -> -2, c -> -1, d -> -1, f -> 1, g -> 1}, {a -> -2, b -> -2, c -> 1, d -> 1, f -&...


2

FindInstance[ And @@ Thread[myList == 0] && And @@ Thread[-3 <= {a, b, c, d, f, g} <= 3] && And @@ Thread[ {a, b, c, d, f, g} != 0], {a, b, c, d, f, g}, Integers] (*{{a -> -2, b -> -2, c -> -1, d -> -1, f -> 1, g -> 1}}*) If you want to find more solutions, just add , 5 after Integers, for this problem it seems ...


5

I think that that the key feature is to use the MaxExtraConditions option for the Solve command. In elaborate answer of Artes in here, a very very nice presentation is referred. It is entitled as Getting the Most from Algebraic Solvers in Mathematica by Adam Strzeboński. You can download the .cdf file of the presentation which is really helpful. Slide $10$ ...


3

Try the following: eq = Eliminate[{A*ra^B == fa, A*rb^B == fb}, A] Solve[eq, B] (* {{B->-(Log[fb/fa]/(Log[ra]-Log[rb]))}} *) and as you repeat this or do it by hand, please note that there are certain restrictions on the values. If you want to know what Maple did not tell you, try this Reduce[eq, B] and look at the conditions that need to be ...



Top 50 recent answers are included