# Generating pairs of additive and multiplicative factors for integers

Given an integer $n$, I want to get two lists:

a) the set of pairs of the divsors $a,b$ into exactly two factors $n=a\cdot b$,

b) the set of pairs $a,b$ of two summands $n=a+b$.

The code I came up with works, but I'd like to know if there is a more efficient/elegant or even build in alternative:

  Function[ int, {#,int/#}& /@ Divisors[int]][12]

Function[ int, {#,int-#}& /@ Range[int -1]][12]


Also, in case I want to do that later, how do I eliminate lists from a list, which only differ in order, e.g. how do I reduce {{a,b},{b,a}} to {{a,b}} ?

(Side note: These problems arise in writing the code for this bigger problem)

-
Have you seen IntegerPartitions[]? –  Guess who it is. Nov 23 '12 at 10:51

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;
Table[{k[[i]], k[[l + 1 - i]]}, {i, Ceiling[l/2] }] ]


or a completely different (less efficient) approach :

f3[n_Integer] /; n > 0 := Solve[x y == n && 0 < x <= y, {x, y}, Integers][[All, All, 2]]


e.g.

f1[37900003]
And @@ (f1[#] == f2[#] == f3[#] & /@ Range[100, 200])

{{1, 37900003}, {19, 1994737}, {131, 289313}, {2489, 15227}}
True


b)

Let's point out three different ways, using various Mathematica functions, respectively IntegerPartitions, FrobeniusSolve and PowersRepresentations :

g1[n_Integer /; n > 0] := IntegerPartitions[n, {2}]
g2[n_Integer /; n > 0] := FrobeniusSolve[{1, 1}, n]
g3[n_Integer /; n > 0] := PowersRepresentations[n, 2, 1]


All these functions yield outputs in different forms; g2, g3 include zeros, in g2 the ordering is valid, e.g.

g1[15]

{{14, 1}, {13, 2}, {12, 3}, {11, 4}, {10, 5}, {9, 6}, {8, 7}}

g2[15]

{{0, 15}, {1, 14}, {2, 13}, {3, 12}, {4, 11}, {5, 10}, {6, 9}, {7, 8},
{8, 7}, {9, 6}, {10, 5}, {11, 4}, {12, 3}, {13, 2}, {14, 1}, {15, 0}}

g3[15]

{{0, 15}, {1, 14}, {2, 13}, {3, 12}, {4, 11}, {5, 10}, {6, 9}, {7, 8}}


We can get rid of 0, e.g. wrapping g2 or g3 in DeleteCases, e.g. :

DeleteCases[ g3[15], {___, 0, ___}]

{{1, 14}, {2, 13}, {3, 12}, {4, 11}, {5, 10}, {6, 9}, {7, 8}}


A more general approach is PowersRepresentations[n,k,p], which gives the distinct representations of the integer n as a sum of k non-negative p -th integer powers, e.g. PowersRepresentations[n, 2, 3] gives all possible natural pairs {a,b} satisfying : $\; a^3+b^3 = n$, e.g. :

PowersRepresentations[855, 2, 3]

{{7, 8}}


indeed 7^3 + 8^3 == 855.

Using g1 or g3 we needn't to eliminate sets which only differ in order, anyway one can use DeleteDuplicates or Union, e.g. :

Union[{{a, b}, {b, c}, {c, a}, {b, a}, {a, c}}, SameTest -> (Sort[#1] === Sort[#2] &)]


and

DeleteDuplicates[{{a, b}, {b, c}, {c, a}, {b, a}, {a, c}}, Sort[#1] == Sort[#2] &]


yield :

{{a, b}, {a, c}, {b, c}}

-

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/#} & /@ Divisors[int]][12]
(* {{1, 12}, {2, 6}, {3, 4}} *)


Update: and for part (a) - big thanks to @Rojo for the idea - you can use:

divPairsF1 = Divisors[#] /.
d_ :> Transpose @ MapAt[ Reverse,
Partition[d, Sequence @@ Through @ {Ceiling, Floor}[Length@d/2]],
1  ] &;
(* or *)
Reverse[#[[1 + Floor[Length[#]/2];;]]]}] &[Divisors[#]] &;
(* or *)
divPairsF3 =DeleteDuplicates@(Sort /@ (Thread[{#, Reverse[#]}] &@Divisors[#])) &;

divPairsF1[12]
(* {{1,12},{2,6},{3,4}} *)

-
cool, can it also produce the flipped sets, e.g. $\{2,10\}$? –  NikolajK Nov 23 '12 at 11:12
You could also rely on the Divisors ordering and do something like Divisors[int]/.d_:>Transpose@MapAt[Reverse, Partition[d, Length@d/2], 2] –  Rojo Nov 23 '12 at 11:20
IntegerPartitions gives the partitions in reverse-lex order. To get a list including the flipped sets, you can use Join @@ ({#, Reverse /@ #} &[ IntegerPartitions[12, {2}]]) // DeleteDuplicates –  kguler Nov 23 '12 at 11:20
@Rojo, thank you, great idea. Updated with your suggestion. –  kguler Nov 23 '12 at 11:49
Sorry for my code, but one should beware of the cases with odd number of divisors. Perhaps changing to Partition[d, Sequence @@ Through@{Ceiling, Floor}[Length@d/2]], or in your version, adding a Ceiling to the first Span and a Floor to the second –  Rojo Nov 23 '12 at 14:05

For product pairs you might use:

pp = Thread[{#, Reverse@#}][[ ;; Ceiling[Length@#/2] ]] & @ Divisors @ # &;


This is several times faster than your construct on my machine.

You may also be interested in this function which is a generalization of this to n products.

For additive pairs IntegerPartitions has already been recommended.

-