Tag Info

Hot answers tagged

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


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


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

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


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


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

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

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


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


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


3

Here's a semi-manual method of simplifying solutions by creating our own substitutions. As a more manageable example, let's start with the solution to the cubic: cube = Solve[a x^3 + b x^2 + c x + d == 0, x] Here's just the first root (TeXForm[x /. cube[[1]]]): $\frac{\sqrt[3]{\sqrt{\left(-27 a^2 d+9 a b c-2 b^3\right)^2+4 \left(3 a ...


3

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


3

For part (b) of your question, there is a built-in function: IntegerPartitions[12, {2}] (* {{11, 1}, {10, 2}, {9, 3}, {8, 4}, {7, 5}, {6, 6}} *) For the last part, deDup1 = DeleteDuplicates[#, #1 == Reverse@#2 &] &; (* or *) deDup2 = DeleteDuplicates[#, Union@#1 == Union@#2 &] &; deDup1@Function[int, {#, int/#} & /@ ...


3

Quote from MSieve (one of the more popular factorization programs): On a fast modern CPU, a 110-digit QS factorization takes nearly 120 hours for Msieve. A 100-digit one should be significantly less than that. So, no, it does not take 100 years. The trouble you are having fitting your data is not that there are too few points, but the distribution of ...


3

Not sure if this is what you are after but maybe if its not it will help you clarify the question: long = RandomInteger[10^30]; base = 2^32; repr = IntegerDigits[long, base]; Total@MapIndexed[ #1 base^(First@#2 - 1) &, Reverse@ repr] == long StringJoin[ MapIndexed[ If[First@#2 > 1, "+", ""] <> ToString[#1 ] <> Table[ ...


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


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


3

Perhaps shorter: << Combinatorica` factors = Join @@ ConstantArray @@@ FactorInteger@2450; toWork = {#, Tr@#} & /@ (Sort /@ Apply[Times, KSetPartitions[factors, 3], {2}] // Union) Sort[First[Transpose @@ Select[GatherBy[toWork, Last], Length@# == 2 &]], Max] // First (* {5, 10, 49} *)



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