4
$\begingroup$

I would like to automatically extract the same factor of each term, and thus write a sum such as:

$$\frac{4 \sin (2 \pi x)}{\pi }+\frac{4 \sin (6 \pi x)}{3 \pi }+\frac{4 \sin (10 \pi x)}{5 \pi }+\frac{4 \sin (14 \pi x)}{7 \pi }$$

as

$$\frac{4}{\pi} \left( \sin(2 \pi x) + \frac{1}{3} \sin(6 \pi x) + \frac{1}{5} \sin (10 \pi x) + \frac{1}{7} \sin (14 \pi x)\right)$$

My goal is to have Mathematica find the factor (here $\frac{4}{\pi}$) automatically (not "by hand") and then perform the manipulations.

I've tried Factor, DivideBy, and several algebraic manipulation functions, but nothing works smoothly or fully automatically in such cases. Together is almost appropriate, but not quite.

Here's code for the above:

(4 Sin[2 π x])/π + (4 Sin[
           6 π x])/(3 π) + (4 Sin[10 π x])/(5 π) + (4 Sin[
           14 π x])/(7 π) + (4 Sin[18 π x])/(9 π)

At @Nasser's request, here are a few similar made-up cases (in minimal form):

(5 E)/Sqrt[2] Cos[x] + (10 E)/(2 Sqrt[2]) Sin[2 x] + (15 E)/(3 Sqrt[2]) Cos[3 x] + (20 E)/(4 Sqrt[2]) Sin[4 x]

2/x Cos[x] + 4/x Exp[x] + 6/x Tan[x] + 8/x Cot[x]

5/Sqrt[3 x] Tan[x] + 10/Sqrt[3 x] Cot[x] + 15/Sqrt[3 x] Csc[x]

3/x Cos[x] + 6/x^2 Tan[x] + 9/x^2 Exp[x] + 12/x^3 Cot[x]
$\endgroup$
2
  • 5
    $\begingroup$ Please also enter the code for your expressions rather than just their images. $\endgroup$
    – Bob Hanlon
    Nov 25, 2023 at 18:51
  • $\begingroup$ FullSimplify? If that's not good enough, you can try to tweak the ComplexityFunction to favour smaller integers more strongly $\endgroup$
    – Lukas Lang
    Nov 25, 2023 at 20:41

3 Answers 3

3
$\begingroup$

Unfortunately LCM does not work with Pi in there (it only works on rational numbers). So had to remove it temporarily to apply LCM then put it back in.

So this is not very general as it assumes Pi is there. I am sure there will be better and more general method. But this is what came to mind at this moment.

expr = 4/Pi*Sin[2*Pi*x] + 4/(3*Pi)*Sin[6*Pi*x] + 4/(5*Pi)*Sin[10*Pi*x] + 4/(7*Pi)*Sin[14*Pi*x]
res = Cases[List @@ expr, any_*Sin[_] -> any*Pi];
leastCommonMultipler = LCM[Sequence @@ res];
leastCommonMultipler/Pi*(Simplify[expr /. any_ -> Pi/leastCommonMultipler*any])

Mathematica graphics

$\endgroup$
2
  • $\begingroup$ Definitely a help, thanks ($+1$). But my expressions (many from Fourier analysis) will have $\pi$, $\sqrt{2}$, $e$, and such. And most certainly all terms will not include, say, $\sin$. The code must work with arbitrary functions, but with a single factor throughout. $\endgroup$ Nov 25, 2023 at 19:02
  • 1
    $\begingroup$ @DavidG.Stork in this case, it might help and be useful if you could include in your question more examples that represent more of the input you want to transform. May be 4 or 5 such examples that typically show up. This will make it easier to give general solution that works for all. Because one solution that might work for one, might not work for another. $\endgroup$
    – Nasser
    Nov 25, 2023 at 19:38
3
$\begingroup$

Not the most elegant way, but perhaps good enough(?) or at least something on which others can build something smarter.

Given an expression

exp = (4 Sin[2 π x])/π + (4 Sin[
       6 π x])/(3 π) + (4 Sin[10 π x])/(5 π) + (4 Sin[
       14 π x])/(7 π) + (4 Sin[18 π x])/(9 π);

we can proceed to Sort it

(exp // Sort)[[1]]

and subsequently extract the numerical value we wish to factorize using Thread and Variables in the following way

% /. Thread[Variables[%] -> 1]

Then, it is pretty much straightforward to complete our exercise. We Solve the following

Solve[exp == % xx, xx] // Expand // Flatten

and the final result we wish to obtain is

%%*(xx /. %)

Now, we can pack everything in a compound expression using a Module and giving it a cool name, because why not?

davidgstork[exp_] := Module[{sorted, num, sltn},
   sorted = (exp // Sort)[[1]];
   num = sorted /. Thread[Variables[sorted] -> 1];
   sltn = Solve[exp == num*xx, xx] // Expand // Flatten;
   Return[num*(xx /. sltn)];
   ];

And we examine the examples provided by the OP

davidgstork[(4 Sin[2 π x])/\[Pi] + (4 Sin[
      6 π x])/(3 π) + (4 Sin[10 π x])/(5 π) + (4 Sin[
      14 π x])/(7 π) + (4 Sin[18 π x])/(9 π)]
davidgstork[(5 E)/Sqrt[2] Cos[x] + (10 E)/(2 Sqrt[2]) Sin[
    2 x] + (15 E)/(3 Sqrt[2]) Cos[3 x] + (20 E)/(4 Sqrt[2]) Sin[4 x]]
davidgstork[2/x Cos[x] + 4/x Exp[x] + 6/x Tan[x] + 8/x Cot[x]]
davidgstork[
 5/Sqrt[3 x] Tan[x] + 10/Sqrt[3 x] Cot[x] + 15/Sqrt[3 x] Csc[x]]
davidgstork[3/x Cos[x] + 6/x^2 Tan[x] + 9/x^2 Exp[x] + 12/x^3 Cot[x]]

results

Final comment: it is the output of the 3$^{rd}$ and 4$^{th}$ examples that I don't particularly like, since I expect that @David would have preferred to have factored an overall $\tfrac{1}{x}$ and $\tfrac{1}{\sqrt{x}}$ respectively.

$\endgroup$
2
  • 1
    $\begingroup$ Good insight, and a big step in the right direction, but a few problems remain: First, I don't think Sort[] will work in the arbitrary case. And uyes, there should be a $1/x$ in the factor for your example 3. (But oh... what a cool name!) $\endgroup$ Nov 26, 2023 at 2:25
  • $\begingroup$ @DavidG.Stork glad you found this helpful. Some comments: yes, I kind of had the idea that Sort would not work in the most general case, though perhaps a good hint on how to approach. About the factors that I mentioned and you, also, explained I still have no clue on how to get those....Finally, pertaining to the name of the Module function, I was expecting that you would perhaps like it :-) $\endgroup$
    – bmf
    Nov 26, 2023 at 12:23
3
$\begingroup$
Clear["Global`*"];
expr1 = (4 Sin[2 π x])/π + (4 Sin[
       6 π x])/(3 π) + (4 Sin[10 π x])/(5 π) + (4 Sin[
       14 π x])/(7 π) + (4 Sin[18 π x])/(9 π);
expr2 = (5 E)/Sqrt[2] Cos[x] + (10 E)/(2 Sqrt[2]) Sin[
     2 x] + (15 E)/(3 Sqrt[2]) Cos[3 x] + (20 E)/(4 Sqrt[2]) Sin[4 x];
expr3 = 2/x Cos[x] + 4/x Exp[x] + 6/x Tan[x] + 8/x Cot[x];
expr4 = 5/Sqrt[3 x] Tan[x] + 10/Sqrt[3 x] Cot[x] + 15/Sqrt[3 x] Csc[x];
expr5 = 3/x Cos[x] + 6/x^2 Tan[x] + 9/x^2 Exp[x] + 12/x^3 Cot[x];
trigs = Sin | Cos | Tan | Csc | Sec | Cot;
expr = {expr1, expr2, expr3, expr4, expr5};
lcm[expr_] := List @@ expr // Cases[#, _?NumberQ, 2] & // Apply[LCM]
gcd[expr_] := List @@ expr // Cases[#, _?NumberQ, 2] & // Apply[GCD]
lcms = lcm /@ expr;
gcds = gcd /@ expr;
ifactors = List @@ expr // Map[Apply[Intersection]];
fc = Transpose[{lcms, gcds}] // 
    DeleteCases[#, Except[_Integer], {2}] & // Map[Min];

res = MapThread[Row[
     {Times[If[Head@#2 === Times, 1, #1], #2 ]
      , "("
      , (#3/(If[Head@#2 === Times, 1, #1] #2)) // Distribute
      , ")"
      }] &
   
   , {
    fc, ifactors, expr
    }
   ];

enter image description here

$\endgroup$
2
  • $\begingroup$ Thanks for all the work ($+1$), but look at your last example: it found the factor $3$ but should have found $\frac{3}{x}$. I wonder why it didn't get the full factor. $\endgroup$ Nov 26, 2023 at 17:00
  • 1
    $\begingroup$ Thanks. I haven't been able to get the common factor x out from Plus[Times[9,Power[E,x],Power[x,-2]],Times[3,Power[x,-1],Cos[x]],Times[12,Power[x,-3],Cot[x]],Times[6,Power[x,-2],Tan[x]]]. Will have to think more about it. $\endgroup$
    – Syed
    Nov 26, 2023 at 17:13

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.