# Tag Info

## New answers tagged equation-solving

2

Just spelunking a little I got this for the harmonic oscillator problem: eqs = {y[1]'[T] == y[2][T], y[2]'[T] == -y[1][T]}; iniconds = {y[1][0] == 1, y[2][0] == 0}; invariants = {1/2 (y[1][T]^2 + y[2][T]^2)}; vars = {y[1][T], y[2][T]}; system = {eqs, iniconds, vars, {T, 0, 10}, {}, invariants, {}}; erksol = NDSolve[NDSolveProblem@system, Method -> ...

1

You could also to match coefficients: Solve[ Equal @@ PadRight @ {CoefficientList[Numerator[(-s^2 + 40 s + 50)/(s (s + 1) (s + 5)^2)], s], CoefficientList[Numerator @ Together[a/s + b/(s + 1) + (c*s + d)/(s + 5)^2], s]}, {a, b, c, d}] (* {{a -> 2, b -> -(9/16), c -> -(23/16), d -> -(255/16)}} *)

0

I'm not sure what the correct way of showing an answer to a question I myself asked. But here is how I did anyway: I used ContourPlot3D Manipulate[ContourPlot[{ (*29*) Dparallel==1/(2 omega0) Sqrt[(-omegaC + mu[r] Dparallel)^2 + (mu[r] Dorth)^2] (-alpha - 1) + alpha/(2 omega0) Sqrt[(-2 omega0 - omegaC + mu[r] Dparallel)^2 + (mu[r] Dorth)^2] + 1/(2 ...

2

You can use Solve. f[x_] := With[ {sol = y /. Quiet[ Solve[x/Tan[Pi x] == y/Tan[Pi y] && Floor[x] - 1 < y < Floor[x], y], Solve::ratnz]}, If[Length[sol] > 0, First[sol], Null] ]; Plot[f[x], {x, 1.4, 3}, PlotStyle -> Thick, AspectRatio -> Automatic]

0

There was a very similar question on StackOverflow. I recommend you read my answer there. I'm going to reproduce part of that answer here: ContourPlot is designed for plotting. It does do something similar to root finding, but it's designed for visualization so the curves extracted form a ContourPlot won't be of a very high precision. We can do better ...

0

Looks like there are at least two solutions (real or "almost real"): You can get initial approximations from the following plot: Plot[Log[Abs[expr]], {x, 3.8 10^10, 4.0 10^10}, PlotRange -> Full] To get more accurate results use FindRoot FindRoot[expr, {x, 3.85 10^10}] (* x->3.84004 10^10-0.609932 I*) FindRoot[expr, {x, 3.95 10^10}] (* ...

0

Probably there is solution ... Unless I made a silly mistake (always possible), I find Mathematica seems to think otherwise. a1 = Rationalize[Sqrt[2*10^11*3.055*10^-5], 0]; a2 = 1/100; a3 = 7849; a4 = 10; a5 = 50; a6 = 11; a7 = 700; sol = Solve[(k (k^3 a1 - I a2 - k (a4 + a5^2 a3)) + x - 2 k a5 a3 a6 - a3 a6^2) == 0, k]; {k2, k4, k3, k1} = sol[[All, ...

2

I am not sure what exactly you mean by "the problem of the variable names" (in the comments). Anyway you could construct a function like this (ignore the red syntax highlighting in the definition) SyntaxInformation[solveAndAssign] = {"LocalVariables" -> {"Solve", {2, 2}}}; SetAttributes[solveAndAssign, HoldAll]; solveAndAssign[eqn_, var_Symbol] := ( ...

2

Just extract second argument from Rule function by Solve[p == 2 t + 1, t][[1, All, 2]] Use All in case of more then one solution.

0

Not a full answer : You can simplify the equation by substituting (149163411674835586124096205921334157174479655112799 Sqrt[K0])/ 35362087636687395438079446898535340978108366770607 -> x In terms of x your equation is : eqx = -(2397273135785684105116286138088240239609486751943174/ 6428810371332877606946043738694402071216515377775) - ( 7849 ...

6

Using the functions defined in my answer to your previous question here you have the intersections with all three coordinate planes: getOneCluster[pts_List, maxDist_?NumericQ] :=(*Returns a cluster*) Module[{f}, f = Nearest[pts]; FixedPoint[Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@pts}]] clusters[data_] := Module[{f, ...

0

The answer from a comment: To respond to the question, it is a matter of precision. The input has approximate numbers and does not have sufficient precision to get reliable solutions. Hence different methods can give different results. Setting upperbound = 1/2 will make this an exact input and the different methods will deliver the same result (around ...

1

getOneCluster[pts_List, maxDist_?NumericQ] :=(*Returns a cluster*) Module[{f}, f = Nearest[pts]; FixedPoint[Union@Flatten[f[#, {Infinity, maxDist}] & /@ #, 1] &, {First@pts}]] clusters[data_] := Module[{f, dist},(*Some Characteristic Distance, assuming no isolated points*) f = Nearest[data]; dist = 3 Max[EuclideanDistance[Last@f[#, 2], #] ...

3

Use Mesh and MeshFunctions: gr1 = ParametricPlot3D[ Evaluate[{x[t], y[t], p2[t]} /. sol2], {t, 0, tfin}, PlotPoints -> 4000, MeshFunctions -> {#1 &}, Mesh -> {{0}}, MeshStyle -> {Directive[PointSize[Medium], Red]}, BoxRatios -> {1, 1, 1}, ViewPoint -> {1, 0, -2}, DisplayFunction -> Identity]

0

Partial answer: the inconsistent boundary condition is that you are specifying df/dr non zero for all t, which is inconsistent with the zero (hence df/dr=0) initial condition. Ive modified the third condition as: (D[y[r, f, t], r] /. r -> 2*10^-6) == -(1/(Pi 10^-8)) (1 + Sin[2 Pi t]) Piecewise[{{t 10, t < 1/10 }, {1, ...

1

Mathematica can solve it if you use explicit numerical values for the parameters, and it does return a result: {}. From the NSolve doc page: NSolve gives {} if there are no solutions to the equations. From a contour plot of your equations I believe this result is correct and there are no real valued solutions: ContourPlot[{ -1 + 4/(5 x^(3/10)) + ...

1

This is belisarius' comments combined into an answer The usual way is to solve it once and then use the replacement rules: eqn = c0/(c0 + cs) == Iunk/Is; subsCoke = {cO -> c0, cs -> 2, Iunk -> 0.3995, Is -> 0.7339}; subsPepsi = {c0 -> c0, cs -> 2, Iunk -> 0.3915, Is -> 0.7645}; s = Solve[eqn, c0][[1]]; {s /. subsCoke, s /. ...

2

You have a system of 3 equations. How can you simultaneously solve it for 3 variables and eliminate 3 more variables? In other words, if you eliminate ub, uc, pm, there is no equation left to solve... So you should simply use Solve[system, {θ, ν, K}]

1

By the sounds of it, you are saying this: I have a linear homogeneous equation f(a,b,c,...,n)=0, and I have some monomial like b, ab^2, or cd^2m^5 and I want to divide out by that coefficient to make this term have coefficient 1. The quickest way to do this might be: EXP = a + 5 b + 10 c; Expand[EXP/Coefficient[EXP, b]] This will divide out by the ...

4

Solve works correctly, when returning {} it means there are no solutions. To demonstrate it let's rewrite your system: system = Thread[{-((2 (4 θ0 + θ1))/σ^2) - (2 (4 θ0 + θ2))/σ^2, -((4 θ0 + θ1)/(2 σ^2)), -((4 θ0 + θ2)/(2 σ^2)), -(2/σ) + (4 θ0 + θ1)^2/(2 σ^3) + (4 θ0 + θ2)^2/(2 σ^3)} == ...

1

Let's do it with simplified variable names: To[x_] := 2 c1 Cosh[x a1] + a2 Tu[x_] := 10 Exp[-m x] bcs = {To[L/2] == Tu[L/2], To'[L/2] == a4 Tu'[L/2]}; s = First@Solve[bcs[[1]], c1] Quiet@Solve[bcs[[2]] /. s[[1]], m]

3

The issue we encounter here is an apparent incompleteness of the recent updates in the system, we should remember that Solve has been updated in the recent versions of Mathematica and although documentation pages say "last modified in 8", one can distinguish various different issues between ver.8 and ver.9, it's just a state of art. In ver. 8 we get: ...

1

Here is the final result if you are interested. data = Import /@ FileNames["/home/marco/LatexDocs/analytical/uvvis/PHOS_*.CSV"]; data = data[[All, 2 ;;, {1, 2}]]; ListLinePlot[data, PlotLegends -> {"BB", "MR", "PT", "TB", "UI"}, AxesLabel -> {Style["wavelength (nm)" , FontSize -> 16], Style["Absorbance", FontSize -> 16]}, PlotRange ...

4

Import the data and filenames, cull the datasets of information that is not useful: data = Import /@ FileNames["*.csv"]; filenames = FileNames["*.csv"]; data = data[[All, 2 ;;, {1, 2}]]; ListLinePlot[data, PlotLegends -> filenames] Looks like PT data was either incorrectly collected or is effectively transparent in the region of interest. The ...

2

Having f[x_] := x^1.1 - 2.5 x^.5 And also knowing that the formula of the tangent line is f'[x](x-a) + f[a] You could just make a Plot with it. With a=1, as you requested: Here is the code of it: With[ {a = 1}, Plot[ { f[x], f'[a] (x - a) + f[a] }, {x, 0, 10}, PlotRange -> {-4, 4}, PlotStyle -> Thick, Epilog ...

1

Exploring the above matrix M we get Dimensions[M]=={10,9}. Also MatrixRank[M]==9 and MatrixRank[M[[1 ;; 9]]]==9 so we transform the system to a square system: M = M[[1 ;; 9]]; b = b[[1 ;; 9]]; det = Det[M]; then simply calculating determinants we obtain the xi solvefor[i_] := Module[{B}, B = M; B[[All, i]] = b; Det[B]/det] example : solvefor[1] ...

0

Let me try to rephrase the question in a simpler, clearer way: I have a relationship between $x$ and $y$ in implicit form: $f(x,y) = 0$. This equation might have multiple $y$ solutions for a given $x$. I have the function $f$ as a numerical black box. How can I calculate the derivative $y'(x)$ at a given point $x=x_0$? We can solve this using ...

4

I would propose the following unorthodox approach for this specific : Since c>=1 obviously a>b Catch@Do[ c = N[a^(1/3) - b^(1/3) - 3 Sqrt[5*37^(1/3) - 16]]; If[c == IntegerPart[c], Throw[{a, b, IntegerPart[c]}]] , {a, 1, 2000}, {b, 1, a - 1}] // AbsoluteTiming returns {88.341053, {1369, 296, 2}} in my machine Just to be sure a further ...

1

To get the x values for example so you can plot them, you can do the following: listx = {}; Table[ AppendTo[listx, x /. solutionValues[[2]][[i]]], {i, 1, Length[solutionValues[[2]]]}] After that, you use Transpose to get whatever you want to plot against listx. You use If[] to get all your conditional statements on the length of costVals. I hope it ...

1

This was (partially answered on the mathematica-community site). Here is that posting: Without solving the problem of finding the condition where the trajectory lies within a disk. This modification of your code may help you construct a numerical technique. sol = DSolve[{y'[t] == g/(2 zf) y[t] + u z[t], z'[t] == -g + g/zf z[t] - u y[t], ...

0

The following is just my guess. Usually != is not dealt with directly, it is broken into a<b || a>b. Then it's natural that the number of cases grows exponentially.

2

During the years I developed this peculiar idea that that best way to use Mathematica is to use it to the least possible extent. Hence, if you can do a simplification by hand, do it by hand. The problem with Mathematica is that that software is sometimes too smart - or too dumb, depending on the point of view. Some behaviors of MMA that stand in the way of ...

1

Here's one way to fix things. I've set values for x and y in arrays (rather than having them be undefined values of functions): n = 10; x = RandomInteger[{-10, 10}, n]; y = 3 x + RandomInteger[{-1, 1}, n]; f2[a_, b_, y_, x_, n_] = Sum[(y[[i]] - a - b*x[[i]])^2, {i, n}]; Solve[{D[f2[a, b, y, x, n], {a}] == 0, D[f2[a, b, y, x, n], {b}] == 0}, {a, b}] {{a ...

0

Problem is to find the number of integer values of pair (x,y) that satisfy it Here is a way to proceed: We'll use Tuples to generate the pairs (a, b) of Integers in the range we're interested. I'm just going to do this for the range [-2, 2] Tuples[Range[-2, 2], 2] {{-2, -2}, {-2, -1}, {-2, 0}, {-2, 1}, {-2, 2}, {-1, -2}, {-1, -1}, {-1, 0}, {-1, ...

2

Reduce works in general. First, multiply both sides of the equation by x y to simplify, and then: Reduce[a b - b x - a y + x y == 1, {x, y, a, b}, Integers] ((C[1] | C[2]) ∈ Integers && x == C[1] && y == C[2] && a == -1 + C[1] && b == -1 + C[2]) || ((C[1] | C[2]) ∈ Integers && x == C[1] && y == C[2] ...

0

For each pair (a,b) you can use Reduce, a=1;b=10; Reduce[(a/x - 1) (b/y - 1) == 1/(x y) , {x, y}, Integers] Then, use ToRules to convert to proper solutions. However, this is probably quite inefficient and may take some time for all combinations of $a,b$.

3

Yes, Mathematica can prove these inequalities symbolically. To be more precise, it can Reduce them to True. Generating human-readable proofs is also possible but that's one broad topic. First, we'll use a “coordinate change”. Notice that your expressions for R, s, r are all symmetric in x, y, z. This hints that we might benefit from using symmetric ...

0

This goofy way will let you specify how many to generate, the maximum power of x, and the +/- range of coefficients to use (excluding zero): Plus @@@ Table[(RandomInteger[{-#3, #3 - 1}] /. (0 -> #3)) x^s, {#1}, {s, 0, #2}] &[5, 2, 10] (* {-4 + 10 x - x^2, -10 - 5 x + 6 x^2, 5 - 6 x + 10 x^2, -8 - 9 x - 5 x^2, -6 - 9 x - 5 x^2} *) Same result, ...

3

Here's a slightly different method. Except for the fact that you want non-zero integers, RandomInteger would be perfect for this, e.g. len = 5; RandomInteger[{-10, 10}, {len, 3}] (* {{-3, -2, 10}, {2, -3, -8}, {5, 3, -2}, {9, 3, -2}, {-9, 3, -6}} *) which gives your list of triples directly. Now, you could alter the range and make substitutions like Yi ...

2

Here is a rough way to achieve this: RandomPolynomial[max_Integer, var_Symbol] := Module[{pol, lis}, lis = Table[RandomChoice@Join[Range[-10, -1], Range[10]] var^deg, {deg, max,0, -1}]; pol = Tr@lis] Now let's create 25 of these: Table[RandomPolynomial[2, x], {25}]

3

rand := RandomInteger[{-10, 9}] /. (0 -> 10) eq := rand x^2 + rand x + rand Array[eq &, {25}] {5 - 3 x - 6 x^2, -9 - 6 x + 5 x^2, -2 - 6 x + 9 x^2, 7 - 6 x + 9 x^2, 2 + 8 x + 8 x^2, 3 - x + 5 x^2, -10 + 4 x - 5 x^2, -4 + 6 x + 10 x^2, 2 - 5 x - 5 x^2, -7 - 2 x - 8 x^2, -7 - 4 x - 6 x^2, -1 - 2 x + 7 x^2, 8 - 2 x + x^2, 5 + 2 x + ...

8

A reliable approach would use the third argument of Reduce as variables to eliminate (see Behavior of Reduce with variables as domain) Reduce[{p == a b x + b^2 y + a c z, a b == 1, b^2 == 2, a c == 4}, {p}, {a, b, c}] p == x + 2 y + 4 z In the former editions of Mathematica (ver <= 4) Reduce used the third argument for eliminating another ...

1

There are many ways to calculate the solutions, as several people have already suggested: Reduce[x*y*z == 180 && 10 >= x >= 1 && 10 >= y >= 1 && 10 >= z >= 1, {x, y, z}, Integers] (x==2 && y==9 && z==10) || (x==2 && y==10 && z==9) || (x==3 && y==6 && z==10) || ...

0

Solve and Reduce are exact methods for solving exact equations. If there are no known ways to produce an analytical solution, these functions cannot furnish an answer. Equations of the form you describe don't have a known closed-form solution. NSolve is also an exact method, but returns numerical results, so it too will not be useful here. If all you ...

0

Following 21 combinations are possible: {2,9,10}, {2,10,9}, {3,6,10}, {3,10,6}, {4,5,9}, {4,9,5}, {5,4,9}, {5,6,6}, {5,9,4}, {6,3,10}, {6,5,6}, {6,6,5}, {6,10,3}, {9,2,10}, {9,4,5}, {9,5,4}, {9,10,2}, {10,2,9}, {10,3,6}, {10,6,3}, {10,9,2},

3

Given the small size of the problem, brute force works just fine.. Select[Sort/@Tuples[Range[10],{3}]//Union,Times@@#==180&] {{2,9,10},{3,6,10},{4,5,9},{5,6,6}} This is about 5x faster than the Reduce solution..

1

Working directly with the factors like ubpdqn, but somewhat different approach. Not efficient, but straightforward to understand: factors = {2, 2, 3, 3, 5}; perms = Permutations[factors]; Now by mapping ReplaceList over perms with the replacement rule in the code that follows, we can partition each list in perms into every possible partition of three ...

4

I only post this given the relatively small size of the problem. The factors of 180 (including multiplicity): 2,2,3,3,5 By inspection any collection of three (or more) factors will exceed 10. This means 1 x num1 xnum2 cannot be a solution as one of the num will have three or more of the factors above. Further, partitioning the set of five factors into ...

1

You indicated in the comments below your question that your goal is to plot v1 and v2 against t. The following code does that using NDSolve. I corrected the capital-V error in your definition of j and added some initial conditions. Clear[j, v, s] j[v_] = v[t] + v[t]^2; τ = 1; s = 0.1; ip = 0; sol = NDSolve[{v1'[t] == -v1[t]/τ + (j[v2]*s) + ip, ...

Top 50 recent answers are included