New answers tagged

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 both S and its complement are ...


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 ...


2

eqn = 1 + Q^2/r^2 - 2 M/r - r^2 Λ/3 == 0; soln = Assuming[{Q > 0, M > 0, Λ > 0}, Solve[eqn, r] // Simplify]; Verifying that soln satisfies the equation eqn /. soln // Simplify (* {True, True, True, True} *) approx = Assuming[{M > 0, Q > 0, Λ > 0}, Series[r /. soln, {Λ, 0, 1}, {Q, 0, 2}] // Normal // Simplify] (* {Q^2/...


2

As Mathematica can find an analytic solution in this case, I believe we can have greater confidence in approximation to the exact solution rather than an exact solution to an approximate equation. In general, the roots of a polynomial are notoriously ill-conditioned: a small change in the coefficients can cause a large change in the roots. I provide a ...


2

The problem is that the first argument in Plot must have a constant form. In your example sometimes 2 solutions are found and sometimes 1 solution only. Hence the form varies between {_,_} and {_}. With the following modification, the form {_,_} occurs Lebesgue almost surely, which suffices: f[x_, a_] := Sin[x] - a g[a_] := NSolve[f[x, a] == 0 && x &...


3

This provides the second solution it seems. Series[r /. Solve[1 + Q^2/r^2 - (2 M)/r - (r^2 Λ)/3 == 0, {r}][[4]], {Q, 0, 2}] // Normal // Series[#, {Λ, 0, 1}] & // FullSimplify[#, Assumptions -> {M > 0}] &


0

The documentation of FindRoot says FindRoot first localizes the values of all variables, then evaluates f with the variables being symbolic, and then repeatedly evaluates the result numerically. So the system first evaluates Integrate[(x^{0, 2, 4})*f[x, a, b, c], {x, -Infinity, Infinity}] - {1, 2, 10} // N which gives the errors you see (...


0

It looks like you need to define a function that requires a numerical argument before it will evaluate: bsf = BSplineFunction[{{1, 1}, {2, 3}, {3, 2}, {3, 1}}]; fun1[t_] := bsf[t][[1]] fun2[t_?NumericQ] := bsf[t][[1]] FindRoot[#[t] == 2, {t, .3}] & /@ {fun1, fun2} Output: {{t -> 2.}, {t -> 0.347296}}


2

Here is the equivalent of your 1-d approach, using @ ce's henon henon[alpha_, beta_][{x_, y_}] := {y + 1 - alpha x^2, beta x} Manipulate[ list = NestWhileList[henon[a, b], {1, 1}, Max[Abs[#]] < 200 &, 1, 2000]; ListPlot[list[[-Min[20, Length@list] ;;]], PlotRange -> All], {{a, -.3}, -1, 1}, {{b, -.4}, -1, 1}] the trick here is to use ...


2

First define the map: henon[alpha_, beta_][{x_, y_}] := {y + 1 - alpha x^2, beta x} And then you can do something like list = NestList[henon[1.4, 0.3], {1, 1}, 10000]; ListPlot[list] It is straightforward to wrap this in Manipulate.



Top 50 recent answers are included