Combining lists of a factors with multiplicity

Question

I want to combine factorizations of integers (in the form output by FactorInteger, that is a list of factors with multiplicities) into the factorization of the product (without additional factorization effort, by adding the multiplicities). I have something working (I believe):

(*" Merge two non-empy ordered lists of factors with multiplicity, forming the list for product "*)
MergeF[a_, b_] := Block[{
  p = First[First[a]], n = Last[First[a]], u = Drop[a, 1], 
  q = First[First[b]], m = Last[First[b]], v = Drop[b, 1]}, 
  If[p < q, Prepend[If[u != {}, MergeF[u, b], b], {p, n}], 
    If[p != q, Prepend[If[v != {}, MergeF[a, v], a], {q, m}], 
     If[u != {}, Prepend[If[v != {}, MergeF[u, v], u], {p, n + m}], 
      If[v != {}, Prepend[v, {p, n + m}], {{p, n + m}}]]]]];
(*" test "*)
x = RandomInteger[r = {2, 2^50}]; y = RandomInteger[r]; 
MergeF[FactorInteger[x], FactorInteger[y]] == FactorInteger[x*y]
(*True*)

but it has a number of functional issues:

• It only merges two factorizations, not more separated by commas (or a list of factorizations, I'm ready to change the input format)
• When one input contains a pair matching {-1,_} or {1,_} (as occurs when factoring negative numbers or 1), there can be unwanted terms of the form {-1,_} or {1,_} in the output
• It does not handle empty inputs, which should behave as neutral.

And above all it's inelegant! One of the worst thing is the manual parsing of the arguments. I vaguely see that I could break my definition into multiple ones like MergeF[{{p_,n_}},{{q_,m_}}]:=…, MergeF[{{p_,n_},u_},{{q_,m_}}]:=…, MergeF[{{p_,n_}},{{q_,m_},v_}]:=…, MergeF[{{p_,n_},_u},{{q_,m_},v_}]:=… but I'm not sure that's the way to go.

How can I make a more general and elegant version?

Answer 1

MergeF[a___] :=
  Sort@KeyValueMap[List, GroupBy[Join[a], First -> Last, Total]] /.
    {{-1, _?EvenQ} -> Nothing, {-1, _?OddQ} -> {-1, 1}, {1, _} -> Nothing}

x = RandomInteger[r = {2, 2^50}]; y = RandomInteger[r];
MergeF[FactorInteger[x], FactorInteger[y]] == FactorInteger[x*y]
(*    True    *)

MergeF[]
(*    {}    *)

MergeF[FactorInteger[-123], FactorInteger[-456]]
(*    {{2, 3}, {3, 2}, {19, 1}, {41, 1}}    *)

MergeF[FactorInteger[1]]
(*    {}    *)

MergeF[FactorInteger[-1], FactorInteger[-1], FactorInteger[-1]]
(*    {{-1, 1}}    *)

Answer 2

This should do what you want

MergeFactorizations[factorizations___] := 
    {#[[1, 1]], (Plus @@ #)[[2]]} & /@ 
    Gather[Join[factorizations], First@#1 == First@#2 &] //. 
    {{a___, {1, 1}, b___} /; Length[{a, b}] > 0 :> {a, b}, {} :> {{1, 1}}, 
    {_, 0} :> Nothing, {x : 1 | -1, n_} :> {x, Mod[n, 2]}} // Sort

For example

facts = FactorInteger /@ {-101342, -10042346, 103751}
 
MergeFactorizations @@ facts
Times @@ Power @@@ %
Apply[Times, Apply[Power, facts, {2}], {0, 2}]

{{2, 2}, {11, 1}, {29, 1}, {1987, 1}, {7907, 1}, 
 {7, 1}, {83, 1}, {6449, 1}, {1337617, 1}, {17, 2}, {359, 1}}
 
105588578400873332
105588578400873332 

It works with an arbitrary number of factorizations, and for empty input it returns {}

MergeFactorizations[]

{}

It also handles edge cases with factorizations of 1 and -1

MergeFactorizations @@ FactorInteger /@ {1, 1, -1}
MergeFactorizations @@ FactorInteger /@ {1, -1, -1}

{{-1, 1}}
{{1, 1}}