Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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)

share|improve this question
    
Have you seen IntegerPartitions[]? –  J. M. Nov 23 '12 at 10:51
add comment

3 Answers 3

up vote 3 down vote accepted

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}}
share|improve this answer
add comment

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 *)
divPairsF2 = Thread[{#[[;; Ceiling[Length[#]/2]]], 
               Reverse[#[[1 + Floor[Length[#]/2];;]]]}] &[Divisors[#]] &;
 (* or *)
divPairsF3 =DeleteDuplicates@(Sort /@ (Thread[{#, Reverse[#]}] &@Divisors[#])) &;

divPairsF1[12]
 (* {{1,12},{2,6},{3,4}} *)
share|improve this answer
    
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
show 1 more comment

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.

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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