Hot answers tagged

27

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


10

Here's a way that seems to work: CenterDot @@ Flatten[ConstantArray @@@ FactorInteger[20!]] CenterDot @@ Flatten[ConstantArray @@@ FactorInteger[625]] To get the number back, merely do Times @@ expr where expr is the name for the expression that results from the code above.


10

You can also make use of Inactive to allow you to calculate the value later. Starting with march's solution and altering the Apply. n = 20!; t = Inactive[Times] @@ Flatten[ConstantArray @@@ FactorInteger[n]] (* 2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*2*3*3*3*3*3*3*3*3*5*5*5*5*7*7*11*13*17*19 *) t can be Activated to calculate the value. Activate@t == n (* ...


9

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


9

Consider your expression, expr = (a + m a + b + n b + c + k c + d + e)/(a b); This gets us almost where we want to go, Expand@expr (* 1/a + 1/b + c/(a b) + d/(a b) + e/(a b) + (c k)/( a b) + m/b + n/a *) But we have too many terms with the same denominator, so we can use GatherBy to group them, then simplify the sums of terms with the same ...


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


8

Mathematica uses FactorTerms to remove content from factors. Since Sqrt[-3] evaluates to I Sqrt[3], I gets factored out as "content". FactorTerms[1 + I Sqrt[3] + 2 x] I (-I + Sqrt[3] - (2 I) x) You can use AlgebraicNumber to make extension generators atomic. Factor[x^2 + x + 1, Extension -> AlgebraicNumber[I Sqrt[3], {0, 1}]] ((2 x + ...


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


7

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_] := ...


6

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


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

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


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

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

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

Defining a function like Clear[FactorByVariable] FactorByVariable[p_,c_]:=c Expand[p/c] will be one of the simpler options. The argument p is the polynomial you wish to factor from and c is the variable you wish to factor out. I think the reason you can't get your desired result with something like FactorTerms[a x + b x^2 + c x^3,{a,c,x}] is because ...


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

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

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

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

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

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



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