# Tag Info

12

Using an undocumented function: GroebnerBasis`DistributedTermsList[x^10 y^10 z^5 w^5 + 3 a x^10 w^20, {x, y, z, w}][[1, All, -1]] {1, 3 a} Here's a documented solution: CoefficientRules[x^10 y^10 z^5 w^5 + 3 a x^10 w^20, {x, y, z, w}] {{10, 10, 5, 5} -> 1, {10, 0, 0, 20} -> 3 a}

8

polynomial[vars_List, n_Integer, coeff_] := #.Array[coeff, Length@#] &@ DeleteDuplicates[Times @@@ Tuples[Prepend[vars, 1], n]] Clear[a] polynomial[{x, y, z}, 3, a] (* a[1] + x a[2] + y a[3] + z a[4] + x^2 a[5] + x y a[6] + x z a[7] + y^2 a[8] + y z a[9] + z^2 a[10] + x^3 a[11] + x^2 y a[12] + x^2 z a[13] + x y^2 a[14] + x y z a[15] + x z^2 ...

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

6

for a one liner poly[{x_,y_,z_},n_,a_]:= Sum[a[i, j, k] x^i y^j z^k, {i, 0, n}, {j, 0, n - i}, {k, 0, n - i - j}]

4

another way poly[vars_List, a_, order_] := Module[{n = Length@vars, idx, z}, idx = Cases[Tuples[Range[0, order], n], x_ /; Plus @@ x <= order]; z = Times @@@ (vars^# & /@ idx); z.((Subscript[a, Row[#]]) & /@ idx) ] poly[{x, y, z}, a, 3] (*a is used for coefficient*) poly[{x, y, z}, a, 2] poly[{x, y}, a, 2] poly[{x}, a, 4] ...

4

Try something like x /. Solve[Sum[RandomChoice[{-1, 1}] x^k, {k, 0, 3}] == 0, x, Reals] instead of your Roots expression. Use NSolve if you want the numerical value of the roots, rather than a symbolic representation. For instance: t = Table[x /. NSolve[Sum[RandomChoice[{-1, 1}] x^k, {k, 0, 3}] == 0, x, Reals], 4500]; realroots = DeleteDuplicates@...

3

None of the answers thus far used one of my favorite Mathematica functions. Thus, With[{vars = {x, y, z}, deg = 3}, Sum[With[{fs = FrobeniusSolve[ConstantArray[1, Length[vars]], k]}, Inner[#2^#1 &, fs, vars, Times].(C @@@ fs)], {k, 0, deg}]] C[0, 0, 0] + z C[0, 0, 1] + z^2 C[0, 0, 2] + z^3 C[0, 0, 3] + y C[0, 1, 0] + y z C[0, 1,...

2

In general one should not expect to obtain a general symbolic solution (a function x[a,b]) to the given equation since there are two independent variables, see e.g. Solve symbolically a transcendental trigonometric equation and plot its solutions for certain aspects regarding transcendental equations. To get an idea how the solution depends on parameters a ...

2

Perhaps this! It works if you only need the plot and not the values, or the function. That would require more work. ContourPlot3D[ Evaluate[-x + (Log[f2[x]] - Log[f1[x]] + Log[b] - Log[a])/((1 - a) + (1 - 1/f1[x]) - (1 - b) + (1 - 1/f2[x]))] , {a, 0, 1}, {b, 0, 1}, {x, 0, 1} , AxesLabel -> {"a", "b", "x"} , Contours -> {0} , Mesh -> None ...

2

Instead of using ((Subscript[a, Row[#]])&/@idx) or ((ToExpression["a"<>ToString[Row[#]]])&/@idx) or Array[coeff, Length@#] or a[i, j, k] it is possible to simply use Unique["a"] to get nice simple unique coefficient names.

1

You may also use FromCoefficientRules and Indexed. ClearAll[poly]; poly[coeff_Symbol, vars_?VectorQ, order_Integer?Positive] := FromCoefficientRules[ Flatten@MapIndexed[#2 - 1 -> Indexed[coeff, #2] &, ConstantArray[0, ConstantArray[order + 1, Length@vars]], {Length@vars}], vars] poly builds a list of CoefficientRules using Indexed of the ...

1

To find the exact values for min and max roots roots = DeleteDuplicates@ Flatten[x /. Solve[# == 0, x, Reals] & /@ (Tuples[{-1, 1}, {4}].{1, x, x^2, x^3})] // SortBy[#, N] &; {min, max} = roots[[{1, -1}]] // ToRadicals The approximate numeric values are as shown by @MarcoB {min, max} // N (* {-1.83929, 1.83929} *)

1

I encountered this problem too. You can restart kernel periodically by code. Search for this post "Self-restarting MathKernel - is it possible in Mathematica?" http://stackoverflow.com/questions/7864643/self-restarting-mathkernel-is-it-possible-in-mathematica?newreg=5d4d976837bb474db3c8aad81ebc6982

Only top voted, non community-wiki answers of a minimum length are eligible