Tag Info

New answers tagged

2

How are you calculating the velocity around the cylinder I am using Plot[Norm[f[20 + 5 Cos[\[Theta]], 20 + 5 Sin[ \[Theta]]]], {\[Theta], 0, 2 \[Pi]}] to give Which I think is correct. For the pressure we need the correct form for Bernoulli. Where you take the values of pressure at infinity as 0 but ignore the velocity at infinity. I am also ...


0

vpw = 3.3; Mp = 80; rp = 0.014*Mp; b0 = 26.31016273 - 1.7168*(10^3/t) - 3.5519*Log[t]; b1 = 24.65681838 - 1.547*(10^3/t) - 3.4314*Log[t]; b2 = 9.080370819 - 6.9445*(10^2/t) - 1.2222*Log[t]; g = b0 + b1*phip + b2*phip^2; dg = b1 + 2*b2*phip; ddg = 2*b2; dddg = 0; S1 = 1/(phip*rp*vpw) + 1/(1 - phip) - (2*g - 2*(1 - 2*phip)*dg - phip*(1 - ...


3

I know nothing about the range of the data for your problem. Assuming that the values for Rho, Mu and z are real numbers you can gain insight into your problem by combining bbgodfrey's comment with a plot using Manipulate. For example, if Rho and Mu are known parameters you can see how the solution varies as you change the value of z. Manipulate[ ...


10

One quick way for rational functions is to leverage built-in control system functions: TransferFunctionPoles[TransferFunctionModel[1/(1 + s^2), s]][[1, 1]] {-I, I}


8

Yo can go by solving the inverse of the function and then Count the solution. f[x_] := x/(a - x)^3/(b - x); div = x /. Solve[1/f[x] == 0, x]; poles = Union[div] Count[div, #] & /@ poles {a,b} {3,1} Depending on how complicated your function is, you may have to go for numerical treatment, like NSolve or NRoots. Tally As Guess who it is ...


4

With Mathematica version 10 you could do it as follows: y[x_] := 1/5 E^(2/5 x) sol = Maximize[ArcCurvature[{x, y[x]}, x], x] (* {8/375 Sqrt[2/3] E^(1/2 (-3 Log[2] + 4 Log[5])), {x -> -(5/4) (3 Log[2] - 4 Log[5])}} *) Plot[y[x], {x, -5, 10}, Epilog -> {Red, PointSize[.02], Point[{sol[[2, 1, 2]], y[sol[[2, 1, 2]]]}]}, AspectRatio -> Automatic] ...


1

I would use {x1, x2} = x /. solutions The key is ReplaceAll.


7

The equation has infinite number of nontrivial roots. You can query a subset of them, though: Solve[1 + x^2 Tan[x] == 0 && -10 < x < 10, x, Reals] (* {{x -> Root[{1 + #1^2 Tan[#1] &, -9.4360086156910331017}]}, {x -> Root[{1 + #1^2 Tan[#1] &, -6.3083089552381513776}]}, {x -> Root[{1 + #1^2 Tan[#1] &, ...


3

b m - a m - p n (p (b - a) + p b - p b m - p a + p a m) == 5 b FullSimplify@Solve[% /. a -> b - x, x][[1]] /. Rule -> Equal /. x -> b - a {-a + b == (5 b)/(m + (-2 + m) n p^2)}


3

This appears to give you one approximate solution in a few seconds sol=NMinimize[ Norm[Abs[eta1]^2 + Abs[gamma1]^2 - 1] + Norm[Abs[eta2]^2 + Abs[gamma2]^2 - 1] + Norm[Abs[eta3]^2 + Abs[gamma3]^2 - 1] + Norm[Abs[tau1]^2 + Abs[kappa1]^2 - 1] + Norm[Abs[tau2]^2 + Abs[kappa2]^2 - 1] + Norm[Abs[tau3]^2 + Abs[kappa3]^2 -1 ] + Norm[Dot[q1, Conjugate[q1]] - ...


0

Can I create a function which efficiently returns a list of the small positive roots of $\varepsilon \lambda=\cot\lambda$? Here is a routine I wrote quite a while back, when I was doing some research related to the square well potential. The procedure does the computation in two stages: an initial approximation computed through the Delves-Lyness contour ...


2

The issue is that you're asking for a general solution for y only whereas your particular set of equations has a solution only for one specific value of x. You should have called Solve as: Solve[f[x, y] == g[x, y], {x, y}] During evaluation of Solve::ratnz: Solve was unable to solve the system with inexact coefficients. The answer was obtained by ...


2

FindInstance, as described by Mr.Wizard, gives solutions for a given perimeter, which may then be tested for uniqueness. However, Project Euler challenges you to consider and learn about other methods which solve the problem, usually faster and without a mysterious "black box". For example, this problem concerns right-angled triangles with integer sides, ...


1

Though there may be an analytic approach to your problem I think for the generic case you can still make use of FindInstance; request two solutions and see how many it returns (zero, one, two). FindInstance[ {a^2 + b^2 == c^2, a + b + c == 1200, 0 < b <= a, c > 0}, {a, b, c}, Integers, 2 ] {{a -> 450, b -> 240, c -> 510}, {a -> ...


5

The equation can be solved exactly by rationalizing the coefficients first r = Rationalize; n0 = r@9.54472*10^(-5); n1 = r@3.72396*10^(-4); n2 = r@7.431*10^(-4); n3 = r@1.4862*1^(-3); k0 = Exp[(Log[n1]*Log[P0] - Log[n0]*Log[P1])/(Log[n1/n0])]; gam0 = (Log[P0/P1])/(Log[n0/n1]); s0 = First@Solve[k0*gam0*n1^(gam0 - 1) - 1 == 0, P1, Reals]; s[p_] := P1 /. s0 ...


2

It's works with the assumed n! Lets n = 5. n = 5; y = Sum[c[i]*x^i, {i, 0, n}] + O[x]^(n + 1); ODE = (D[y, {x, 2}])^2 + 1/2*D[y, x] + 1/2*y - p*x - q == 0; Y = FullSimplify@ Normal[y /. Solve[LogicalExpand[ODE], Table[c[i], {i, 1, n}]]] // Quiet Solution: $${\frac{-10 c(2) x^5 (c(0)+2 p-2 q)^2+3 x^5 (c(0)+2 p-2 q)^3-32 c(2)^3 x^4 (3 x-5) (c(0)+2 ...


0

Unfortunately, simplification is in the eye of the beholder and, therefore, erratic. Try solv = DSolve[{a*u''[y] - b*c*u[y] == d, u'[0] == 0, u[1] == 0}, u, {y, -1, 1}] z = u[y] /. solv[[1]] FullSimplify[FullSimplify[Numerator[z] Exp[(- Sqrt[b] Sqrt[c])/Sqrt[a]]]/ FullSimplify[Denominator[z] Exp[(- Sqrt[b] Sqrt[c])/Sqrt[a]]]] (* (d (-1 + Cosh[(Sqrt[b] ...


8

If you attempt to Reduce your equations with respect to all unknown quantities, you obtain a result: Clear[Evaluate[Context[] <> "*"]] Reduce[{ c == (b x2 - o y2)/(b x2), x5 == 1 - x1 - x2 - x3 - x4, y5 == 1 - y1 - y2 - y3 - y4 - y6, x1 == 7 x2, x3 == x2, s == o y6/(b x2 - o y2), s == (o y4 - b x4)/(b x2 - o y2), b x2 c (1 - s) ...


3

Clear[c1, c2, c3, p1, a, u]; eqns = {p == c1^(-1 + a) c2^(1 - a) a c3, 1 == c1^a c2^-a (1 - a) c3, u == c1^a c2^(1 - a)}; assumptions = p > 0 && 1 > a > 0; soln = Assuming[assumptions, Solve[eqns, {c1, c2, c3}][[1]] // ExpToTrig // FullSimplify] eqns /. soln // Simplify[#, assumptions] & {True, True, True}


1

As you're interested only in Real and positive solutions, the following will do: eq = {a y == (1 - a) x && u0 == x^a y^(1 - a)}; assum = {y > 0 && x > 0 && 1 > a > 0}; s0 = Solve[eq[[1, 1]], x]; sy = Solve[FullSimplify[eq[[1, 2]] /. s0[[1]], Assumptions -> assum], y]; js = Join[s0 /. sy, sy] // Flatten (* {x -> ...


2

This is my attempt at Probabilistic Bisection Algorithm, as described in the thesis linked by @Szabolcs in the comments. ClearAll[pbaFindRoot]; Module[{initialDistribution, modifyDistribution, outputDistribution, bernoulliTestPowerOneFilter}, initialDistribution[rangemin_, rangemax_] := N@{(rangemin + rangemax)/ 2, {{{0, rangemin}, ...


2

This is a hack to create a function which interoperates at least on some level with FindRoot. Still, it's very much only a starting point. Primary goal of regularize is to attempt keeping values below and above sought root not jumping on the other side. ClearAll@regularize; regularize[f_Function, rootval_, minsigmas_, minsamples_Integer, ...


3

Reduce[a x + 1 > 0 && a > 2, x] a > 2 && x > -(1/a) Reduce[a x + 1 > 0 && a > 2 && x < -1, x] False Assuming[a > 2 && x < -1, Refine[a x + 1 > 0]] False


7

This problem is solvable analytically, although we use Mathematica for some of the algebra. To begin, write the initial expression as (1 + x)^(2/m) - (1 - x)^(2/m) - (1 - x^2)^(1/m); and divide through by the third term. Expand[-%/%[[3]]] /. (1 - x^2)^(-1/m) -> (1 - x)^(-1/m) (1 + x)^(-1/m) (* -1 - (1 - x)^(1/m) (1 + x)^(-1/m) + (1 - x)^(-1/m) (1 + ...


7

Manipulate[ Show[ ContourPlot[ (1 + x)^(2/m) - (1 - x)^(2/m) - (1 - x^2)^(1/m), {x, -.1, 1.1}, {m, .1, 5}, Contours -> {0}], pt = {x /. FindRoot[ (1 + x)^(2/m) - (1 - x)^(2/m) - (1 - x^2)^(1/m), {x, m/5}], m}; Graphics[{ Text[ToString[Round[pt, .001]], pt, {-1.25, 0}], Red, AbsolutePointSize[6], Point[pt]}]], {{m, 1}, ...


3

You can use bezier from my answer to How to know form of plotted Bezier function to get the formulas: bezier[pts_List] := With[{n = Length[pts] - 1}, Evaluate@ Sum[Binomial[n, i] (1 - #)^(n - i) #^i pts[[i + 1]], {i, 0, n}] &] Following the explanation in the linked answer, we can solve the equation bezier[pp][t] == {x, y} for y in terms of x as ...


2

For multiple results you could do for example: g1[x_, y_, z_] := 2 x + y - z g2[x_, y_, z_] := x^2 - y^3 - z^2 t[x_] := t[x] = {y, z} /. FindRoot[{g1[x, y, z], g2[x, y, z]}, {{y, 1}, {z, 1}}] Plot[{t[x][[1]], t[x][[2]]}, {x, 1, 5}, PlotStyle -> {Red, Green}] ContourPlot3D[{g1[x, y, z] == 0, g2[x, y, z] == 0}, {x, 0, 5}, {y, 0, -5}, {z, 0, 5}]


4

(*First we defime our "rows"*) params = {{2, 3, 3}, {2, 2, 1}, {5, 3, 5}}; (*Now we define a function of the params that solves the equation*) f[{a_, b_, c_}] := Solve[a x^2 + b x + c == 0, x] (*and we apply the function to each parameter set at a time*) f /@ params // Column (* {{{x -> 1/4 (-3 - I Sqrt[15])}, {x -> 1/4 (-3 + I Sqrt[15])}}, {{x ...


7

Thank you Michael!! I will write the answer here for other people. t[y_?NumericQ] := x /. FindRoot[g[x, y], {x, 1}] worked like charm


2

There may infinitely many solutions. This will find some, if you limit the range on k: Block[{θ = π/18, l1 = 0.167, l2 = 0.078596}, NSolve[θ == ArcTan[(1/Sqrt[k] Sin[Sqrt[k] l1] + l2 Cos[Sqrt[k] l1])/(-l2 Sqrt[k] Sin[Sqrt[k] l1] + Cos[Sqrt[k] l1])] && 0 < k < 10000, k] ] Solve::ratnz: Solve was unable to solve ...


0

One way to deal with the singularities (that lead to dimensional components of the solution space) when x, y and/or z are zero is through a change of variables that lets excessive zeros be factored out. changevar = {y -> x s, z -> x s t}; Short /@ Factor[foc /. changevar] We can use FactorList to get at the irreducible factors and delete constants ...


1

For a numerical approximation you may try something like: M = {{s, ab, ac}, {ab, s, bc}, {ac, bc, s}}; disc = Discriminant[CharacteristicPolynomial[M, x], x] // FullSimplify f[e_] := 2 Norm[e]^-3 (1 - 3 Sin[θ]^2 Cos[φ - ArcTan[e[[1]], e[[2]]]]^2) Cos[{x, y}.e]; ab = f[{1, 0}]; ac = f[{0, 1}]; bc = f[{1, 1}] + f[{-1, 1}]; s = f[{2, 0}] + f[{0, 2}]; ...


1

Edit Based on the latest info from the OP, I offer up the following way to derive a Cartesian function from a suitable Bezier curve using BezierFunction. ctrlPts = { {0., 0., 0.}, {0.002, 0.08942, -0.08942}, {0.008, 0.233889, -0.178706}, {0.018, 0.366918, -0.267724}, {0.031, 0.496136, -0.350769}, {0.049, 0.639568, -0.439999}, {0.07, 0.779356, ...


1

Per Szabolcs's comment: x = SetPrecision[{0.57, 0.6, 0.7, 0.8, 0.9, 1, 1.1}, 100]; N@NSolve[SetPrecision[ 1/Sqrt[y] 0.02 (1.`5. I (64.`5. + 2.10 Sqrt[y]) Sqrt[-64.`5. + 4.21 Sqrt[y]] + (64.`5. - 2.10 Sqrt[y]) Sqrt[64.`5. + 4.21 Sqrt[y]]) Sqrt[-64.`5. + 4.21 Sqrt[y]] Sqrt[64.`5. + 4.21 Sqrt[y]] + 0.03 Sqrt[y] - # ...


2

Too much fuss :) rf1 = Reduce[And @@ Thread[foc == 0] && x > 0 && y > 0 && z > 0, {x, y, z}, Quartics -> True, Backsubstitution -> True]; Show[ContourPlot3D[Evaluate@Thread[foc == 0], {x, 1, 7}, {y, 1, 6}, {z, 1, 6}, Mesh -> None], Graphics3D[{Green, Sphere[{x, y, z}, .3] /. ...


3

As noted in comments on question 87963, a formal solution to these coupled equations can be obtained from the substitution, {u[x, t] -> u0 Exp[d1 t + d2 x], v[x, t] -> v0 Exp[d1 t + d2 x]} eq1 = Collect[(Unevaluated[D[u[x, t], t] + a1 D[u[x, t], x] - (c + k1) u[x, t] + k1 v[x, t]] /. {u[x, t] -> u0 Exp[d1 t + d2 x], v[x, t] -> v0 ...


2

The constant c can be eliminated from the equations by a standard transformation. eq1 = (Unevaluated[D[u[x, t], t] + (a + b x) D[u[x, t], x] - (c + k1) u[x, t] + k1 v[x, t]] /. {u[x, t] -> uu[x, t] E^(c t), v[x, t] -> vv[x, t] E^(c t)})/E^(c t) // Simplify (* -(k1*uu[x, t]) + k1*vv[x, t] + Derivative[0, 1][uu][x, t] + a*Derivative[1, 0][uu][x, ...


0

This is more an extended comment, although it does answer the question. Using Belisarius' interpretation of the equations, one might think that Solve[{eq1, eq4}, {A1, m1}] could yield a solution directly, but it returns unevaluated. However, Solve can yield a solution, if provided some hand-holding. solve[{e1_, e2_}, {a_, b_}] := Module[{t1, t2, t3}, ...


3

eq1 = 3.5331476718 10^-6 == A1 Exp[-(-0.53326099689) m1^2]; eq2 = 7.2716492165 10^-4 == A2 Exp[-(0.53326099689) m2^2]; eq3 = 4.0740049497 10^-10 == A3 Exp[-(-8.885761178410 ^-2) m3^2]; eq4 = -3.1704480355 10^-6 == 2 (-0.53470532215) m1 A1 Exp[-(-0.53470532215) m1^2]; eq5 = -4.6012662532 ...


2

You're in luck if you're only interested in a domain where x = h/(2 s0) is approximately 1/2. That domain is contained by the domain of InverseFunction applied to Cos[φ0]/φ0: ϕ = InverseFunction[Cos[#]/# &] InverseFunction can only work on a domain on which the function is one-to-one. In this case, it's from zero to the first minimum around ϕ0 -> ...


2

Alexei Boulbitch's answer is quite nice, but here are another couple of useful techniques for situations like this. First, if all you need is a graph of the function, you can use ParametricPlot to get that. You want $\phi(x)$, where $\cos \phi/\phi = x$; so you can use $\phi$ as a parameter and plot the curve $(\cos \phi/\phi, \phi)$: ...


2

Looking at the plot: Manipulate[Plot[Cos[x]/x - y, {x, 0, 2 \[Pi]}], {y, 0, 1}] that is, here: and varying the parameter y=h0/(2s0), one finds that the first root is close to x==1. Let us look for this root only, than it is easy to find a list of values with the structure {y,x0}, where y is the value of the parameter and x0 is the root: lst = ...


9

RegionNearest will do this automatically for many cases, including $y-x^2=0$: RegionNearest[ImplicitRegion[y - x^2 == 0, {x, y}], {0, y0}]


4

Reduce[-(1 - x) Log[1 - x] - x*Log[x] == 1/2, x, Reals] (* x == Root[{-1 - 2 Log[#1] #1 + Log[1 - #1] (-2 + 2 #1) &, 0.199709902553977194585}] || x == Root[{-1 - 2 Log[#1] #1 + Log[1 - #1] (-2 + 2 #1) &, 0.80029009744602280541}] *) % // N (* x == 0.19971 || x == 0.80029 *) Plot[{1/2, -(1 - x) Log[1 - x] - x*Log[x]}, {x, 0, 1}]


4

For Reals f[α_]:= -((-1 + Sqrt[1 + 4 α] + α (-3 + Sqrt[1 + 4 α]) + Sqrt[2 - 2 Sqrt[1 + 4 α] + 2 α (-2 + 4 Sqrt[1 + 4 α] + α (-11 + 2 α + Sqrt[1 + 4 α]))])/(2 (-1 - 2 α + Sqrt[1 + 4 α]))) Reduce[-1 < f[α] < 1, α] (* Root[-4 + 20 #1 - 12 #1^2 + #1^3 &, 2] <= α < 2 *) For Complexes (still working on it) ...


2

If my interpretation of your question is correct, the following code should produce the desired behaviour. prePrint[input_] := Module[{solveFor}, input /. {D[y_, x_, NonConstants -> {y_}] :> (solveFor = y'[x])} // If[OwnValues[solveFor] === {}, input, Solve[#, solveFor]] & // FullSimplify]; $PrePrint = prePrint; Test D[x == ...


6

In at least the univariate case, the guess of "Newton-Raphson" is not too far off. Daniel mentions the three possible methods supported by NSolve[]/NRoots[] in his comment. "CompanionMatrix" is likely done by forming the Frobenius companion matrix from the polynomial's coefficients, and then performing the usual QR algorithm to extract the eigenvalues, so ...


3

Starting with bbgodfrey's excellent suggestion to solve ab == ac == bc == 0, we can obtain a fairly compact list of all of the solutions. If we Reduce the equations with conditions on the variables we get a complicated result, so it's easier to Reduce first and apply conditions after: Reduce the equations and throw out some obviously inconsistent results: ...


4

Further edited to simplify results It is not difficult to show that the three eigenvalues, w, of M are equal if and only if M is diagonal; i.e., ab = ac = bc = 0. f[e_] := 2 Norm[e]^-3 (1 - 3 Sin[θ]^2 Cos[ϕ - ArcTan[e[[1]], e[[2]]]]^2) Cos[{x, y}.e] abeval = f[{1, 0}] (* 2 Cos[x] (1 - 3 Cos[ϕ]^2 Sin[θ]^2) *) aceval = f[{0, 1}] (* 2 Cos[y] (1 - 3 Sin[θ]^2 ...


2

It has been noted a fair number of times on this site that one can use the MeshFunctions option of Plot[] to help in root-finding. Applied to this case: ie[x_] := Im[Exp[1/2 + I x]] iz[x_] := Im[Zeta[1/2 + I x]] pic = Plot[{ie[x], iz[x]}, {x, 0, 20}, Mesh -> {{0.}}, MeshFunctions -> {(ie[#] - iz[#]) &}, MeshStyle -> ...



Top 50 recent answers are included