New answers tagged

0

Using Smith Normal Form you can get two integer matrices with determinant 1 that would satisfy the equation $$X1.K.X2 = K_2$$ May be this is a good start you can use... resK = SmithDecomposition[K]; MatrixForm /@ resK resK2 = SmithDecomposition[K2]; MatrixForm /@ resK2 resK[[2]] == resK2[[2]] (* True *) K2 == ...


1

As mentioned in the comments that DSolve will be unable to solve this nonlinear coupled system of two ODE's. Instead you can use NDSolve. Here is my try omega = 1.83465945; a0 = 0; epsilon = 0.5; Eq1 = y1''[x] == (Sqrt[(1 - epsilon^2)/((Sqrt[1 + a0^2] + y2[x])^2 - epsilon^2*(1 + y1[x]^2))]/epsilon^2 - omega^2) y1[x]; Eq2 = y2''[x] == (Sqrt[(1 - ...


0

No idea what your F looks like, so I made a simple one. For your constraints, I'd use Assuming[] as an outer wrapper and apply Simplify[] to the results of Reduce[] (since you seem to be working with positive dimensional solution sets instead of sets of discrete points). F[x_, y_, z_, u_, v_, w_] := x + y + Max[{z, u, v, w, 0}] Assuming[{ -1 <= z ...


0

There are 2 ways to solve this problem. The first one is to just generate all the possible combinations and plug them into the equation like this Tuples[{0, 1}, 4] /. List -> Ese2 (Thanks to BlacKow for this). And the second one uses the || operator to impose the conditions as an equality. Solve[Ese2[x1, x2, x3, x7] == 0 && (x1 == 0 || x1 == 1) ...


0

You can use WolframAlpha for first ideas and Polynomial Equations for MMA Strategies. Have Fun!


0

As mentioned in the comment, first you need to write your equation in Mathematica syntax, poly = (a*x + b)*(c*x + d) == (c*x + f)*(a*x + g) Now use, Solve to find $x$ Solve[poly, {x}]


1

m = 2; x = Array[xi, m]; f = Array[fi, m]; fi[i_] := xi[i] - 1/i xi[i]^2; sol = Solve[Grad[f, x] == 0, x] (* {{xi[1] -> 1/2, xi[2] -> 1}} *) xo = x /. sol[[1]]; FindRoot[Cases[Flatten@Grad[f, x], Except[0]] == 0, Thread@{x, xo}] {xi[1] -> 0.5, xi[2] -> 1.}


1

Clear[m, x, x1, x2, f, fi]; m = 2; x = Array[xi, m]; f = Array[fi, m]; fi[i_] := xi[i] - 1/i xi[i]^2; sol = Solve[Grad[f, x] == 0, x] FindRoot[Flatten[Table[Grad[f, x][[n, n]] == 0, {n, 1, m}]], Table[{xi[n], 1}, {n, 1, m}]] {xi[1] -> 0.5, xi[2] -> 1.} For very large m you can use a RandomInteger[] or RandomReal[] randomize ...


3

The reason why the contour is broken is because ContourPlot seems to be based on the Intermediate Value Theorem and it will fail to find points where the function just touches zero. The details have been discussed in the post Problem with ContourPlot. For your question, you can first factor out x and y, then the contour will be fine: P[x_, y_] := ...


3

Reduce[ForAll[x, a x^2 + b x + c == a (x - x1) ( x - x2)], {x1, x2},Backsubstitution -> True] gives you the solution you want.


3

I guess this is worth explaining a little better. Here is what I get running the exact code: You can see the error message and the domain say the integration stopped around 0.0473. The trouble arises here, if you don't notice that and plot over your specified range Plot[h[r] /. First@sol, {r, 10^-18, 1}] you get a plot, but its just garbage past ...


0

This is what I get with MMA10 (Linux). {solh, sols} = {h, s} /. NDSolve[{DiffEq1 == 0, DiffEq2 == 0, h[10^(-18)] == 225, s[10^(-18)] == 10, Derivative[1][h][10^(-18)] == 0, Derivative[1][s][10^(-18)] == 0, WhenEvent[h[r] == 0, Sow[s[r]]]}, {h, s}, {r, 10^(-18), 1}][[1]]; Plot[{solh[x], sols[x]}, {x, 0, .35}] x /. FindRoot[solh[x] == 0, {x, ...


4

You may start with this, add whatever you need and then remove the unnecessary manipulation parameters: Manipulate[Show[{ Graphics[{Opacity[0.5], Red, Rectangle[{1 + a, c + b}, {2 + a, 4 + b}]}, PlotRange -> {{0, 2}, {-3, 0}}, Axes -> True, AxesOrigin -> {1 + a, c}], Plot[{-(P*x^2/6) (3 - x), -k*x}, {x, 0, 1}, Axes -> ...


1

Using upper case letters for the beginning of a symbol is frowned upon so I am going to replace A and B with u and v. So your equilibrium system becomes: dA = c u + b v - a u dB = d v + a u - b v Now when we replace a with 1 and b with 2 we get dA /. {a -> 1, b -> 2} (* -u + c u + 2 v *) dB /. {a -> 1, b -> 2} (* u - 2 v + d v *) Below is ...


0

I found a solution by myself. If I continue my uploaded example, where I dump function values to the file and load it later, it will be like this. Calculate Numerical derivative from source function Needs["NumericalCalculus`"] IIIDNf[x_] = ND[IIINf[w], w, x] Just to see how it looks like I plot the graph of derivative (green) and source function (red). ...


3

The solutions are actually the same. Note that 8 ArcTan[1 - Sqrt[2]] + π // N // Chop 8 ArcTan[1 + Sqrt[2]] - 3 π // N // Chop (* 0 *) (* 0 *) Therefore, the second set of solutions reduces to sols = Simplify[Solve[Tan[π/4] + Tan[kx L + π/4] == 0, {kx}, Reals]] sols = sols/. {ArcTan[1 - Sqrt[2]] -> -π/8, ArcTan[1 + Sqrt[2]] -> (3 π)/8} // Expand ...


1

See Equations and Manipulating Equations and Inequalities eq1 = x^2 - x -x + x^2 eq2 = x (x - 1) (-1 + x) x eq1 == eq2 -x + x^2 == (-1 + x) x Expand[eq1 == eq2] True Even when you do tests on symbolic expressions, there are some cases where you can get definite results. An important one is when you test the equality of ...


1

Most recent edit This seems to work (tested exactly what is posted here in a fresh kernel), however it does complain a little. α = 4; μ = 10; k = 1; τ = 1; δ = 1/2; s[r_] := (μ r^α)/Pm f[h_] = FullSimplify[ Exp[2 k] (k + 1)/τ Exp[-k - (k + 1) h/τ] BesselJ[0, Sqrt[4 k (k + 1) h/τ]] ]; int[r_, h_] = Integrate[(1 - Exp[-s[r] Pm h ...


1

region = Reduce[{0 < -a - d + 1 < 1, 0 < (2 a + 2 b + 2 d - 3 e + 2 f + 1)/3 < 1, 0 < -f - b + 1 < 1, 0 < e < 1, 0 < a < 1, 0 < -(2 f - 3 e + 2 d + 3 c + 2 b + 2 a - 2)/3 < 1, 0 < f < 1, 0 < (-3 e + 2 d + 3 c + 2 b + 1)/3 < 1, 0 < d < 1, 0 < c < 1, 0 < b < 1, 0 < -(2 d + 3 c ...


1

FindInstance[{ 0 < -a - d + 1 < 1, 0 < (2 a + 2 b + 2 d - 3 e + 2 f + 1)/3 < 1, 0 < -f - b + 1 < 1, 0 < e < 1, 0 < a < 1, 0 < -(2 f - 3 e + 2 d + 3 c + 2 b + 2 a - 2)/3 < 1, 0 < f < 1, 0 < (-3 e + 2 d + 3 c + 2 b + 1)/3 < 1, 0 < d < 1, 0 < c < 1, 0 < b < 1, 0 < -(2 d + ...


1

Since your system is overdetermined we can just randomly specify some of the parameters: With[{h = 0.605, A = 0.625, b0 = 1.21, h1p = RandomReal[], h2p = RandomReal[], h0p = RandomReal[], b4p = RandomReal[]}, FindInstance[ A0 == 0.5 h0p (2 b0 - x0) && A1 == 0.5 h1p (b0 - x0 + b2) && A2 == 0.5 h2p (b2 + b3) && A3 ...


0

Try Solve: Solve[A0 == 0.5 h0 (2 b0 - x0) && A1 == 0.5 h1 (b0 - x0 + b2) && A2 == 0.5 h2 (b2 + b3) && A3 == 0.5 (h - h0 - h1 - h2) (b4 + b3) && A0 + A1 + A2 + A3 == A && A0 > 0 && A1 > 0 && A2 > 0 && A3 > 0, {A0, A1, A2, A3, b4, b2, h0, h1, h2, b3, x0}, Reals] It returns ...


2

Difficulties encountered in solving the dispersion relation in the Question are due not so much to convergence of the integral as to the branch point in complex γ- space, which occurs where the argument of ArcTanh[] is equal to 1. Based on the related article cited in a comment above, the integration contour {γ, 1, Infinity} must pass below all non-analytic ...


2

Replacing For and it's clutter with Table, you can do this easily: timeMax = 1000; Table[sol = NDSolve[{I*x'[t] == Exp[-((t - tao)/bigT)^2]*y[t], I*y'[t] == Exp[-((t - tao)/bigT)^2]*x[t] + Exp[-((t + tao)/bigT)^2]*z[t], I*z'[t] == Exp[-((t + tao)/bigT)^2]*y[t], x[0] == 1, y[0] == 0, z[0] == 0}, {x, y, z}, {t, 0, timeMax}]; S = Re[1 - ...


4

The way I remember it from my Linear Algebra class is like this: Clear[b]; A = {{-1, 1, -1, 0, 0, 0}, {1, 0, 0, -1, -1, 0}, {0, -1, 0, 0, 1, -1}, {0, 0, 1, 1, 0, 1}}; bb = Array[b, Length@A]; Thread[NullSpace@Transpose@A . bb == 0] (* {b[1] + b[2] + b[3] + b[4] == 0} *) That is, the condition for a solution to A.x == b to exist is that b be in the ...


11

You can use Reduce[] to find a set of all conditions as follows: A = {{-1, 1, -1, 0, 0, 0}, {1, 0, 0, -1, -1, 0}, {0, -1, 0, 0, 1, -1}, {0, 0, 1, 1, 0, 1}}; b = {b1, b2, b3, b4}; x = {x1, x2, x3, x4, x5, x6} allConditions=Reduce[A.x == b, x] This returns b1 == -b2 - b3 - b4 && x3 == b2 + b3 + b4 - x1 + x2 && x5 == -b2 + x1 - x4 ...


9

Your recurrence is an instance of the logistic map $$x_{n+1} = r x_n(1 - x_n).$$ The first sentence of the Solution in some cases section in the link above says: The special case of r = 4 can in fact be solved exactly, as can the case with r = 2; however the general case can only be predicted statistically. Mathematica is indeed able to solve the ...


2

I don't know why RSolve is unable to yield a result for RSolve[{a[n + 1] == a[n] (1 - a[n]), a[0] == 2}, a[n], n] If we apply a multiplier of 2 it gives an answer RSolve[{a[n + 1] == 2 a[n] (1 - a[n]), a[0] == 2}, a[n], n] I would be most interested to understand why the former has no solution using RSolve. Note that removing the boundary condition ...


2

Not the most compact, but you can define recursive functions like this : a[0] = 2; a[n_] := a[n - 1] (1 - a[n - 1]); Table[a[k], {k, 0, 6}] (* {2, -2, -6, -42, -1806, -3263442, -10650056950806} *) If you care about speed/efficiency just add memoization to make it run in linear time: a[n_] := a[n] = a[n - 1] (1 - a[n - 1]);


3

Form here you should use: RecurrenceTable sol = RecurrenceTable[{a[n + 1] == a[n] (1 - a[n]), a[0] == 2}, a[n], {n, 0, 6}] with result: {2, -2, -6, -42, -1806, -3263442, -10650056950806} And plot: ListLogPlot[Abs[sol], Filling -> Bottom]


2

The way you defined the conditions is a little bit hazy to me. For example consider {n, N1} >= 0 && n < N1. The first condition does not do anything to N1. In fact, Reduce[{n, N1} >= 0 && n < N1, {n, N1}] n >= 0 && N1 > n So you can simply combine them to N1>0. Make this modification in your first condition, and ...


4

list = {X21 -> 2./q^2, X20 -> (2. - n q X21)/(m q), X19 -> (2. - m n X20 - n (m X20 + n X21))/m^2, X18 -> 2./(l q), X17 -> (2. - l n X18)/(l m), X16 -> 2./l^2, X15 -> (2. - g q X18)/(f q), X14 -> (2. - f n X15 - g (m X17 + n X18))/(f m), X13 -> (2. - g l X16)/(f l), X12 -> (2. - f g X13 - g (f X13 + g X16))/f^2, ...


2

$$ h(z) =\sum _{k=0}^n \frac{k\, p(k)}{z-k\, h (z)}$$ Observe that the rhs of the equality is the expectation of the random variable $u = k/ (z- k\, h(z))$, where $k$ is a Binomial random variable with parameters $n$ and $ρ$. So we can try TransformedDistribution and Expectation or NExpectation to see if we get anything useful: n = 10; ρ = 6/10; tdist = ...


0

I tend to use Equal -> Subtract to move from equalities to having everything on the left hand side, i.e. (eq /. Equal -> Subtract) -2 + 3 x + 2 x^2 If you want them to back to equations then here is a function that will allow it to be applied at any level of a list (rather than needing to use Thread): rearrangeLeft[a_, b_] := a - b == 0 ...


1

Your equation is too complicated for Solve. You can however try NSolve with a range for x. I choose here 0<x<1. NSolve[{C1*BesselK[0, 3.7268*10^-4*x] == 1.3*10^-6, x == 53.66*C1*BesselK[1, 3.7268*10^-4*x], 0 < x < 1}, {C1, x}] {{C1 -> 1.30002*10^-7, x -> 0.136815}}


1

I am a little confused about the aim of the question. In the following I aim to show various ways of showing the zero set of $f(x,y)$ as defined in OP. f[x_, y_] := (x^2 + y^2 - 4) ((x - 1)^2 + y^2 - 4); p3d = Plot3D[f[x, y], {x, -3, 3}, {y, -3, 3}, MeshFunctions -> {#3 &}, Mesh -> {{0}}, MeshStyle -> {Red, Thick}, PlotPoints -> 50]; s = ...


3

Can use NDSolve to parametrize numerically. f[x_, y_] = x^2 + y^2 - 4; g[x_, y_] = x^2 - 3*y^2; pt = {2, 0}; xyvals = NDSolveValue[ Flatten[{D[f[x[t], y[t]], t] == 0, x'[t]^2 + y'[t]^2 == 1, Thread[{x[0], y[0]} == pt]}], {x[t], y[t]}, {t, 0, 11}]; (If you want to see the better part of a circle, do ParametricPlot[xyvals, {t, 0, 11}, AspectRatio ...


4

Plot3D[g[x, y], {x, -5, 5}, {y, -5, 5}, MeshFunctions -> {f[#, #2] &}, Mesh -> {{{0, Directive[Thick, Red]}}}, BoxRatios->1] Plot3D[g[x, y], {x, -5, 5}, {y, -5, 5}, PlotStyle -> None, BoundaryStyle -> None, MeshFunctions -> {f[#, #2] &}, Mesh -> {{{0, Directive[Thick, Red]}}}, BoxRatios->1] cp = ContourPlot[f[x, ...


2

Try this: PadLeft[IntegerPartitions[n]]


5

FrobeniusSolve[ConstantArray[1, #], #2] &[5,4] For large n it would be better to use IntegerPartitions to avoid solutions that are identical up to permutation. Using the second and third arguments, IntegerPartitions[#, {5}, Range[0, #]] gives all the solutions {x[1],x[2],x[3],x[4],x[5]} with the structure x[1] >= x[2] >= x[3] >= x[4] ...


0

I am not sure if I still understand your question properly. I will delete it later if it is completely irrelevant. Let there be a function tab[x_] := # x & /@ Range[5] which gives an list for a variable tab[g] {g, 2 g, 3 g, 4 g, 5 g} Now I define a new function lin[f__] := Variables[f][[1]] -> f Which gives you the result as rule ...


1

Just for fun: fun[num_] := Module[{s}, s = Normal@Series[-(x/(-1 + x + x^2)), {x, 0, num}]; s /. {x :> Row[{Style[1, Red, Bold], x}], x^n_ :> Row[{Style[1, Red, Bold], x^n}], a_ x^n_?NumericQ :> Row[{Style[a, Red, Bold], x^n}]}] vis[n_] := Module[{ser = fun[n], tab}, tab = Table[{Text[ser[[j]], {j, Fibonacci[j] + 0.2 n}], ...


0

Manipulate[ListPlot[Fibonacci[Range[u]], Filling -> Axis], {u, 1, 20, 1}] or Manipulate[DiscretePlot[Fibonacci[t], {t, 1, u, 1}, Filling -> Axis], {u, 1, 20, 1}] or Manipulate[DiscretePlot[SeriesCoefficient[Series[x/(1 - x - x^2), {x, 0, u}], t], {t, 1, u, 1}, Filling -> Axis], {u, 1, 20, 1}] to get


5

It doesn't seem there is a one line solution but we can adapt W|A to give a result similar to DSolve and friends. fSolve[eq_Equal] := fSolve @ ToString@eq; fSolve[eq_String] := Values[ WolframAlpha[ "solve " <> eq, {"SolutionAsAFunctionalEquation", "FormulaData"} ] ] /. Hold[Equal[f_, d_]] :> f -> d /. { Subscript[\[ScriptC], n_] :> ...


4

The problem with the way you're trying to solve it right now is that your variables aren't all independent of each other. Specifically, for a given trapezoid, you cannot vary $h$, $a$, $b$, $c$, and $d$ independently of each other. Once you have specified the first four, then $d$ cannot be freely varied (it's constrained to be one of two possible values.) ...


2

Here's a polynomial interpolation method, which can be be found in Chapter 5 of Boyd (2014). nn = 64; z0 = w1 + w2; rr = 1.1 w1; ff = N[WeierstrassP[z0 + rr #, inv] - L, Precision[#]] &; wprec = MachinePrecision; tj = 2 Pi*Range[0, nn - 1]/nn; wj = N[Exp[I tj], wprec]; fj = ff /@ wj; (* f[zj] *) aa = InverseFourier[fj]/Sqrt[nn]; (* Rough check of ...


1

Define the integrand with the measure as integrand = c*Exp[-m*x^2/ω^m]*1/(Sqrt[2*π]*λ*ω)*Exp[-(Log[B] - μ)^2/(2*λ^2)] Dt[B, Constants -> {λ, m, x, μ, ω}]; where we use Dt[t] to represent the measure, which we will transform using the substitution: subs = Assuming[{μ > 0, λ > 0, B > 0, t ∈ Reals}, First@Solve[t == (Log[B] - μ)/(Sqrt[2] λ), B, ...


0

When in doubt check for Complexes, FunctionDomain[(-1)^x + 2^x - 2 x - 1, x, Complexes] True FunctionRange[(-1)^x + 2^x - 2 x - 1, x, Complexes] -2. <= Complexes <= 4.25 ComplexExpand[(-1)^x + 2^x - 2 x - 1, x] $e^{-\pi \Im(x)} \cos (\pi \Re(x))+i \left(e^{-\pi \Im(x)} \sin > (\pi \Re(x))+2^{\Re(x)} \sin (\log (2) \Im(x))-2 ...


3

Here you are plotting a complex function, as you know, so you need to plot the real and imaginary parts separately. Plot[ReIm[(-1)^x + 2^x - 2 x - 1], {x, -4, 4}, Evaluated -> True] You can get some help on this from Wolfram Alpha, if you start your expression with two equal signs: This shows that you need to plot the real and imaginary parts ...


3

I think in general no one know's how to express roots of polynomials in terms of radicals, or even determine when it's possible. Quintics has been solved and there's a Mathematica package to solve them. Radicals.nb SolveQuintic[x^5 + 20 x + 32 == 0, x] For sextics I believe the most that is known is how to determine which equations can be expressed in ...



Top 50 recent answers are included