0
$\begingroup$

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?

$\endgroup$
3
$\begingroup$
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}}    *)
$\endgroup$
1
  • $\begingroup$ I could not come by it, but it's so concise and clear that I understand how it works and can build on that. E.g. by changing Total to Max and trivial adjustment of the replacements, it computes the LCM instead of product. Thanks! $\endgroup$
    – fgrieu
    Jan 23 at 18:30
3
$\begingroup$

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}}
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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