Automatically extract a factor from a sum of terms and rewrite the sum

Question

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]

Answer 1

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

Answer 2

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

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.

Answer 3

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
    }
   ];