Hot answers tagged

11

Here is a very short solution: qf = a x^2 + b y^2 + c z^2 + 2 d x y + 2 e x z + 2 f y z; 1/2 D[qf, {{x, y, z}, 2}] (* ==> {{a, d, e}, {d, b, f}, {e, f, c}} *) This is just an application of the answer to Quick Hessian matrix and gradient calculation.


10

I think you need CoefficientArrays: mat = Last@CoefficientArrays[qf, {x, y, z}, "Symmetric"->True]; {x, y, z}.mat.{x, y, z} == qf // Simplify (* True *)


6

A bit complicated, this one: With[{m = 5, r = 3}, CoefficientList[Sum[(-x)^n/n!, {n, 0, m}]^r, x] == Table[Sum[FactorialPower[r, k] BellY[n, k, Table[(-1)^i, {i, m}]], {k, 0, r}]/n!, {n, 0, m r}]] True Recall that the partial Bell polynomials are a way to express Faà di Bruno's formula, which applies here since ...


6

Here is a way that yields symmetric matrix (for this example you could just write it down): m=Module[{r = {x -> 1, y -> 2, z -> 3}, tu = Tuples[{x, y, z}, 2]}, Normal@SparseArray[(## /. r) -> Coefficient[qf, Times @@ ##]/(2 - Boole[#[[1]] === #[[2]]]) & /@ tu, {3, 3}]] yields: {{a, d, e}, {d, b, f}, {e, f, c}} Check: ...


5

I upvoted the other responses. That said, there is a better way. CoefficientList[ Resultant[x^3 + a2*x^2 + a1*x + a0, y - (x^3 + x + 1), x], y] (* Out[1179]= {-1 + 4 a0 - 3 a0^2 + a0^3 - a1 - 2 a0 a1 + 2 a1^2 + a0 a1^2 - a1^3 + a2 + a0 a2 - 2 a0^2 a2 - 3 a1 a2 + 3 a0 a1 a2 + a0 a2^2 - a1 a2^2 + a2^3, 3 - 6 a0 + 3 a0^2 + a1 - 2 a1^2 + a1^3 - 2 a2 - ...


5

Another way: poly = 387 a1^4 a2^3 x^3 y^7 z^100 w^364; vars = Variables[poly]; exps = Exponent[poly, vars]; Coefficient[poly, Times @@ (vars^exps)] 387 or Cancel[poly/(Times @@ (vars^exps))] 387 p.s. In general, you'd want to hit your polynomial with MonomialList if it's not a proper monomial. And just for fun, here's an overly complicated ...


5

lookMaNoXYZ = 1 & @@@ # &; lookMaNoXYZ[ x^2 y^6 ] 1 lookMaNoXYZ[10 x^2 Pi y^6 / 4] (5 π)/2 lookMaNoXYZ[x^2 55. y^6] 55.


5

I guess the answer is "no," Solve does not always find solutions in terms of radicals when they exist. Example: The polynomial $x^5 + 20 x^3 + 20 x^2 + 30 x + 10$ has root expressible in terms of radicals (see Wikipedia): poly = x^5 + 20 x^3 + 20 x^2 + 30 x + 10; x1 = 2^(1/5) - 2^(2/5) + 2^(3/5) - 2^(4/5); poly /. x -> x1 // Simplify (* 0 *) But ...


4

The direct way works: Times @@ Table[ x - With[{r = Root[#1^3 + a2 #1^2 + a1 #1 + a0 &, i]}, r^3 + r + 1], {i, 3}] // Expand // Simplify // CoefficientList[#, x] & {-1 + 4 a0 - 3 a0^2 + a0^3 - a1 - 2 a0 a1 + 2 a1^2 + a0 a1^2 - a1^3 + a2 + a0 a2 - 2 a0^2 a2 - 3 a1 a2 + 3 a0 a1 a2 + a0 a2^2 - a1 a2^2 + a2^3, ...


4

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


4

The expressions for the coefficients of the Pochhammer symbol are in fact well-known (see e.g. Concrete Mathematics): $$\prod_{k=0}^{n-1}(x+k)=\sum_{k=0}^n \left[{n}\atop{k}\right]x^k$$ where $\left[{n}\atop{k}\right]$ is a Stirling cycle number. In Mathematica, this corresponds to (-1)^(n - k) StirlingS1[n, k]. Table[Product[x + k, {k, 0, n - 1}] == ...


3

From the LegendreP help page:


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

ClearAll[cF] cF = # /. Thread[Variables[#] -> 1] &; cF[x^2 y^6 ] 1 cF [367 a1^4 a2^3 x^3 y^7 z^100 w^364 ] 367


3

Example: (*Example 1*) Select[387 a1^4 3 a2^3 x^3 y^7 z^100 w^364, IntegerQ] (*Example 2*) Select[x^2 y^6, IntegerQ] Output: (*Output 1*) 387 (*Output 2*) 1 Reference: Select IntegerQ


2

A slick way is to use the Newton-Girard formulae in conjunction with the handy RootSum[] function: Solve[Table[s[m] == RootSum[Function[x, x^3 + b x^2 + c x + d], Function[r, (r^3 + r + 1)^m]], {m, 3}] ~Join~ Table[-Sum[s[k] e[m - k], {k, m - 1}] - m e[m] == s[m], {m, 3}], Array[e, 3], Array[s, 3]] // Expand ...


2

Another direct approach p1 = #1^3 + a2 #1^2 + a1 #1 + a0 &; p2 = 1 + # + #^3 &; Simplify@CoefficientList[Product[x - p2@Root[p1, i], {i, Exponent[p1@x, x]}], x] Or make it a function that takes two polynomials, p1 and p2, and produces the coefficients of the polynomial p2 evaluated at the roots of p1 ClearAll[f] f = ...


2

FullSimplify[Eliminate[{gf == 1 + (a3 - a1 x)^2 w1 + (b3 - b2 x)^2 w2, k1 == -(a3/a1 - x)}, {a3}], Assumptions -> a1 != 0]


2

I'm going to restrict to the case of rational coefficients. There are ways to extend to complex rational coefficients but that's more than I have time or desire to consider right now. I'll illustrate an efficient methodology with this example. Along the way I will say a bit about modest improvements that can be made. We'll start with the polynomial and the ...


2

A little bit more general way: coeff[p_, x_] := Coefficient[p, x] /. (# -> 0 & /@ Variables[p]) p = x y^2 + 15 x^2 y + x + 3 y + 10; p2 = 3 t^2 + z; p3 = 3 t^2 x + z; coeff[p, x] coeff[p2, t^2] coeff[p3, t^2] coeff[p3, x t^2] (* 1 3 0 3 *)


2

poly = 387 a1^4 a2^3 x^3 y^7 z^100 w^364; CoefficientRules[poly][[1, 2]] 387


2

Using some undocumented functionality: poly = 387 a1^4 a2^3 x^3 y^7 z^100 w^364; GroebnerBasis`DistributedTermsList[poly, Variables[poly]][[1, 1, 2]] 387 poly2 = Sqrt[2/3] x^5 y^7; GroebnerBasis`DistributedTermsList[poly2, Variables[poly2]][[1, 1, 2]] Sqrt[2/3] GroebnerBasis`DistributedTermsList[x^3 y^2, {x, y}][[1, 1, 2]] 1


1

data=List/@RandomReal[10,{1001}]; data2=Transpose[{Range[-5,5,.01], Flatten@data}]; (* Subdivide[-5,5,1000] instead of Range[-5,5,.01] if you have v 10.4 *) fit=Fit[data2,{0, x, x^2, x^4, x^5, x^6}, x] +0.0310271 x+1.86717 x^2-0.166636 x^4-0.0000977394 x^5+0.00414635 x^6 Show[Plot[fit, {x,-5,5}, Frame->True, PlotRange->All], ...


1

a bit of an extended comment, but i case anyone doesnt see the issue clearly, LegendreP[46, x] is a 46 order polynomial, with all even powers of x and alternating signs on the coefficients. We can separate out the positive and negative terms: {neg, pos} = { Total@MapIndexed[# x^(4 First@#2 - 4) &, #[[1 ;; ;; 2]]], Total@MapIndexed[# x^(4 First@#2 - ...


1

I found the answer in dmesg It actually was killed by the out-of-memory killer Although the computer had more than 4 GB, perhaps the other programs (e.g. Firefox) filled it up


1

Apparently, nobody brought up this possibility: SeriesCoefficient[-72 + 9 (-2 + x)^2 + 4 (3 + y)^2, {x, 2, 0}, {y, -3, 0}] -72 where it is assumed that you know the terms subtracted from the corresponding variables.



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