# Tag Info

24

The engine behind this inside Compile is a well-hidden function called OptimizeExpression. it has two levels, 1 and 2. Setting to 2 makes it work harder to find CSEs. e1 = (G u^2 (6 p (2 h + p) - 8 (h + p) u + 3 u^2))/(12 h^2); e2 = (G (3 h + 3 p - 2 u) u^2)/(3 h^2); Experimental`OptimizeExpression[{e1, e2}, OptimizationLevel -> 2] (* Out[40]= ...

12

As noted, one sticking point is that polynomial roots in general cannot be represented in Mathematica by anything other than Root[] objects. Nevertheless, it is possible to do a few manipulations to factorize a real polynomial into its linear and quadratic factors. decompose[poly_, x_] /; PolynomialQ[poly, x] := Module[{gr, rts}, rts = x /. ...

11

Since we can consider $f$ as a $4-$th order polynomial (with respect to $y$) we can always factorize it as you claim in terms of radicals, but for the sake of simplicity let's start writing it symbolically in terms of the Root objects defining $f$ to be p[x,y]: p[x_, y_] := x^9 - x^6 + 4 x^5 y + 2 x^3 y^2 - y^4 pf[x_, y_] = -Times @@ (y - (y /. {ToRules @ ...

8

My lucky day (night). I get to take my own answer which was of dubious value here and basically repurpose it to give a good response to this question. We set this up as a mixed linear program by trying to get sums of logs of factors as close to m as possible, subject to coefficients being nonnegative integers that do not exceed the powers of the ...

8

Your direct method isn't working because neither Complex nor Collect works the way you are expecting. So depending on what you mean by "elegant", the answer to your question may be no. You can jury-rig Collect to work using expr = 2 u + I + 2 + I; Expand[expr/I] /. Complex[x_, y_] -> x + i y I Collect[%, i, Simplify] /. i -> I (* 2 - 2 i - 2 i u *) ...

8

You can find the roots using Solve: sol = Solve[x^5 - 3 x^4 + x^2 - 11 x + 6 == 0, x] // N {{x -> -1.53612}, {x -> 0.552473}, {x -> 3.1838}, {x -> 0.399923 - 1.4355 I}, {x -> 0.399923 + 1.4355 I}} The linear factors are those corresponding to the real roots and the quadratic factors correspond to the imaginary roots. You can get the ...

7

Level may provide a means of getting started. Level breaks down your polynomials into their constituent parts, with various "levels" of complexity. As @Rex Kerr noted in a comment, Level 1 happens to be interesting in the present example. a=(G u^2 (6 p (2 h+p)-8 (h+p) u+3 u^2))/(12 h^2); b=(G (3 h+3 p-2 u) u^2)/(3 h^2); ...

7

By default Mathematica can factorize polynomials to lower order ones in terms of integers if it's possible. Extension serves factorization over the rationals extended by a finite set of algebraic numbers, i.e. any element of the extension is a finite combination of rationals and algebraics $(a_1, a_2,...,a_n)$. The fundamental theorem of algebra states that ...

6

More concise, but same idea as in Artes' approach (which I upvoted, but I'm adding this anyway because it won't squeeze into a comment). factorCompletely[poly_, x_] := Module[ {solns, lcoeff}, solns = Solve[poly == 0, x, Cubics -> False, Quartics -> False]; lcoeff = Coefficient[poly, x^Exponent[poly, x]]; lcoeff*(Times @@ (x - (x /. solns))) ...

6

Since you are going to work with numeric functions, Compile will optimize your functions along those lines. If you define : f = Compile[{{g, _Real}, {u, _Real}, {h, _Real}, {p, _Real}}, {(g u^2 (6 p (2 h + p) - 8 (h + p) u + 3 u^2))/(12 h^2), (g (3 h + 3 p - 2 u) u^2)/(3 h^2)} ] you can already see some of it in the output. To get an even more in ...

6

Here is a very simple little function that takes two expressions k and p, and any function that accepts a single expression (like Expand, Together, Simplify,Apart,...). It then factors k from p and outputs a new expression $p=kq$. The parameter func_ operates on the form of $q$. Here is the function: sfactor[k_, p_, func_] := ...

5

A function from the article that cormullion linked is shorter and faster than what I proposed below. Transcribed in terse style: uf[m_, 1] := {{}} uf[1, n_] := {{}} uf[m_, n_?PrimeQ] := If[m < n, {}, {{n}}] uf[m_, n_] := uf[m, n] = Join @@ Table[Prepend[#, d] & /@ uf[d, n/d], {d, Select[Rest@Divisors@n, # <= m &]}] uf[n_] := uf[n, n] ...

5

Per Daniel Lichtblau's comment, the method used by Decompose is based on the following reference: Fast polynomial decomposition algorithms by V. S. Alagar and Mai Thanh (Google Books link) The BitAnd calls come from some polynomial factorization code used by Decompose.

5

First, set the option of Roots so that it doesn't expand quartics. Optionally, define a Format for Root. SetOptions[Roots, Quartics -> False]; Unprotect[Root]; Format[Root[func_, v_], StandardForm] := Row[{"eq", "(", v, ")"}]; Protect[Root]; a1 = Roots[x^4 + r1 x^3 + r2 x^2 + r3 x + r4 == 0, x][[1]][[2]]; a2 = Roots[x^4 + r1 x^3 + r2 x^2 + r3 x + r4 ...

5

I'm not entirely sure what you are looking for. Do the factors need to have integer coefficients? If not, then you get a factorization into quadratics just by noting you have a polynomial in x^2 and hence can use the quadratic formula. The nonnegativity of both roots will follow, in this specific example, provided the discriminant is nonnegative. [Note: ...

5

This offers no proper explanation, but seems to work in your case. The replacement rule is Abs[Sh]^2 Cos[ϕ]^2 Sin[ϕ]^2 + Abs[Sv]^2 Cos[ϕ]^2 Sin[ϕ]^2 + (-Sv Conjugate[Sh] - Sh Conjugate[Sv]) Cos[ϕ]^2 Sin[ϕ]^2 /. {z_ (-x_ Conjugate[y_] - y_ Conjugate[x_]) :> -z (x Conjugate[y] + y Conjugate[x])} (* Abs[Sh]^2 Cos[ϕ]^2 Sin[ϕ]^2 + Abs[Sv]^2 Cos[ϕ]^2 ...

5

This gathers roots into complex conjugate pairs after solving the system numerically (since factoring a fifth order polynomial analytically is tough): In[1]:= poly = x^5 - 3 x^4 + x^2 - 11 x + 6; In[2]:= Chop[Times @@ Flatten[Expand@*Times @@@ (GatherBy[ NSolve[poly], {Re[x] /. #, Abs[Im[x]] /. #} &] /. Rule -> Subtract)]] ...

4

a) We can pass through the first half of the list of divisors to avoid duplicating factors. There are many possible ways to proceed, let's mention a few of them : f1[n_] := {#, n/#} & /@ First @ Partition[ #, Ceiling[ Length[#]/2] ] & @ Divisors[n] or f2[n_] := Module[{k, l}, k = Divisors @ n; l = Length @ k; ...

4

Here's a way to brute-force search for numbers that have the property that the sum of the digits raised to an integer power is equal to the number itself. list = {}; Do[If[Total[IntegerDigits[b^e]] == b, AppendTo[list, {b, e}]], {b, 2, 800}, {e, 2, 100}]; This returns a list of the numbers and powers (here's just the first 50), ordered so that they ...

4

Assuming only integers will be input to squareFreeQ. Your squareFreeQ as defined in the question does not return True or False as does the built-in SquareFreeQ. Rather your function returns a list of exponents, if any, which are greater than one. Hence, after selecting exponents exceeding 1, compare the list to {}, which occurs for squarefree numbers. The ...

4

This is a variant on the suggestion by @Artes. We start by defining a set of substitutions, using some new variables. Create a Groebner basis. Not to worry if that's not a familiar concept, suffice it to say that we use it for purposes of algebraically rewriting polynomials. The thing to know is that the old variables are to be given greater priority than ...

4

From Daniel Lichtblau's answer, Working with symmetric polynomials, it's easy to do as much as is specified. I interpret "factor" to mean "write in terms of," but I'm not sure exactly what quadratic terms are implied. subs = {q1 -> (k12^2 - k21^2), q2 -> (k22 - k11)^2, q3 -> (k12 + k21)^2}; polys = Subtract @@@ subs; gb = GroebnerBasis[polys, {x, ...

4

Edit: Since now even I have understood the reasoning of the elf requiring more information because after measuring the tree the solution is not unique, I can give a full implementation too. When n is the magical number 2450, then we can create all possibilities with Union[Sort /@ Select[Tuples[Divisors[n], {3}], Times @@ # === n &]] Now, what's ...

4

This is an interesting question that is not solvable in one simple step. Let's take a look at the assumptions. Since we have a fourth-order polynomial with integer coefficients we expect that there might be only complex conjugate roots. Now we have: Times @@ (x - (x /. Solve[ x^4 - (2 m + 4) x^2 + (m - 2)^2 == 0, x])) (-Sqrt[2 - 2 Sqrt[2] Sqrt[m] + m] + ...

4

Here is an approach based on finding an approximate root, bumping to an approximate factor using GroebnerBasis, and resolving as an exact factor using RootApproximant. poly = 3 - 6*x^2 + 3*x^4 - 10*y^2 + 6*x^2*y^2 + 3*y^4; x0 = 11/7; roots = y /. NSolve[poly /. x -> x0, WorkingPrecision -> 400]; root1 = First[roots]; fac = First[ ...

4

I have re-labelled your image for convenience. In future, please refer to documentation re: posting code rather than images. I may have made some transcription errors but perhaps this will point you in direction you are aiming for. e1 = a x^2 + c y^2 + b x y e2 = 2 c y z + 2 a w x + 2 b (x z + y w) e3 = a w^2 + c z^2 + b w z Factor[PolynomialMod[Expand[e2^2 ...

4

Assuming[w > 0 && 1 > a > 0, Collect[(a w)^a (w - a w)^(1 - a), w, Simplify]] $\$ (1 - a)^(1 - a) a^a w Simplify[Cancel[(a w)^a (w - a w)^(1 - a)], Assumptions -> w > 0 && 1 > a > 0] $\$ -(-1 + a) (a/(1 - a))^a w Simplify[Together[(a w)^a (w - a w)^(1 - a)], Assumptions -> w > 0 && 1 > a ...

4

MonomialList may provide functionality you're looking for here. P[x,y,z]=x y^2 z + 2x y z^2 + x^2 y^2; Q[x,y,z]=x^2 y z - x y z^2 + x^2 z^2; P[x,y,z]+a Q[x,y,z]//Expand will yield x^2 y^2 + a x^2 y z + x y^2 z + a x^2 z^2 + 2 x y z^2 - a x y z^2 Now, to get the factorization you're looking for, MonomialList[x^2 y^2 + a x^2 y z + x y^2 z + a x^2 z^2 + ...

4

Amazingly, it turns out that there is a built in Mathematica routine to check whether a polynomial is irreducible or not: IrreduciblePolynomialQ[] Applied to the above two polynomials it confirms that both are in fact irreducible.

3

@asad the comments are all appropriate and (if I understand your aim), I present a way to implement to perhaps kickstart your own approach. However, I suggest in future you post an attempt, however imperfect. Further, it is helpful to post a small example so people can be clear about what you mean. Finally, if I misunderstand your aim then comment, otherwise ...

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