# Write a number as the product of its two largest divisors

For even n >= 10 && n <= 98 I want to write n as the product of its two largest divisors (excluding n itself, i.e. 1 * 60 == 60 is not permitted).

EDIT (to account for rasher's criticism)

I have tried:

First@Reverse@Take[Transpose[{#, Reverse@#}], Length[#/2]/2] &[
Rest@Most@Divisors@#] & /@ {10, 12, 52, 60, 66, 70, 72, 98}


giving

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

but this fails, f.e., on 16, which should give {4, 4}

• Divisors[n] gives them in ascending order to get started... reference.wolfram.com/mathematica/ref/Divisors.html Jul 2, 2014 at 19:09
• Jul 2, 2014 at 19:10
• The two largest divisors of 60, excluding 60 itself, are, if I'm not mistaken, 30 and 20. But their product is not 60 (or at least I'm pretty sure it's not 60). Do you mean instead the two divisors that straddle the square root? Jul 2, 2014 at 19:55
• @Daniel - I think my question plus example is clear (except for square numbers - see answer below). If not, please edit it.
– eldo
Jul 2, 2014 at 20:07
• Agree with Daniel - ambiguous question. In addition, this is not a mechanical turk site to produce code by request. What have you tried? Based on your answering of other questions, you're clearly capable of coding...
– ciao
Jul 2, 2014 at 20:23

h = Function[{n},
Module[{d = Divisors[n], m},
m = Ceiling[Length[d]/2];
d[[{m, -m}]]],
{Listable}]
h @ Range[10, 98, 2]
(* {{2, 5}, {3, 4}, {2, 7}, {4, 4}, {3, 6}, {4, 5}, {2, 11}, {4, 6},
{2, 13}, {4, 7}, {5, 6}, {4, 8}, {2, 17}, {6, 6}, {2, 19}, {5, 8},
{6, 7}, {4, 11}, {2, 23}, {6, 8}, {5, 10}, {4, 13}, {6, 9}, {7, 8},
{2, 29}, {6, 10}, {2, 31}, {8, 8}, {6, 11}, {4, 17}, {7, 10},
{8, 9}, {2, 37}, {4, 19}, {6, 13}, {8, 10}, {2, 41}, {7, 12},
{2, 43}, {8, 11}, {9, 10}, {4, 23}, {2, 47}, {8, 12}, {7, 14}} *)

• nice alliance of style and speed
– eldo
Jul 3, 2014 at 18:39
• @eldo, thank you!!
– kglr
Jul 3, 2014 at 19:57
• @kguler agree with eldo, dealing with squares and listability in a compact way Jul 4, 2014 at 0:23

Indeed, the method linked to by Artes can be modified (Generating pairs of additive and multiplicative factors for integers)

f1[n_] := Last[{#, n/#} & /@ First@Partition[#, Ceiling[Length[#]/2]] &@ Divisors[n]]


Which also works nicely for squares, such as 36 giving {6,6} which is an improvement over the original answer I gave below.

This method is pretty efficient so long as the list isn't too large - a speed-up can be found in the answer of @rasher.

My original idea is based on How do I extract the middle element(s) of a given list?, since the example given in the question is basically asking for the middle pair of divisors. So,

mid[a_List] := a[[# ;; -#]] &@\[LeftCeiling]Length@a/2\[RightCeiling]
mid[Divisors[#]] & /@ {10, 12, 52, 60, 66, 70, 72, 98}


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

I've no idea how foolproof this is...

Certainly the point about excluding 1*itself means you'd have to skip the primes, since mid[Divisors[#]] & /@ Range[10, 98] returns things like {1,29} and so on.

EDIT I've now noticed you said "for even n", oops! So it would be Range[10,98,2].

Also, for the square numbers this method returns one number, e.g. for 36 it returns {6} and not {6,6}.

• +1 f1 seems to work for odd, negative, small and large Integers. More than I expected, and I especially like the {6,6} :)
– eldo
Jul 2, 2014 at 19:46

I'll assume the definition of "two largest" is defined by your example results since you don't define this explicitly. This is a bit faster if you're after a large range of results.

f = (ArrayPad[#, -Ceiling[(Length@#)/2 - 1]] /. {x_} :> {x, x}) &@Divisors[#] &

f /@ {10, 12, 16, 52, 60, 66, 70, 72, 98}

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

• A bit faster by a factor of ~2x in fact! Jul 2, 2014 at 22:22
• @rasher Excellent! Could your solution (like blochwave's) also respect negative integers, so that -1111 -> {11, -101} ?
– eldo
Jul 2, 2014 at 22:28
• @eldo: Sure, do something like f = (ArrayPad[#, -Ceiling[(Length@#)/2 - 1]] /. {x_} :> {x, x }) &@ Divisors[#] {1, Sign[#]} & instead. Note that allowing a non-positive domain makes "largest" even more ambiguous ;-)
– ciao
Jul 2, 2014 at 22:43

I am late to the party here and just for terseness:

f[x_] := {#, x/#} & @@ Nearest[Divisors[x], Sqrt[x]]


So:

f /@ Range[10, 98, 2]


yields:

{{2, 5}, {3, 4}, {2, 7}, {4, 4}, {3, 6}, {4, 5}, {2, 11}, {4, 6}, {2,
13}, {4, 7}, {5, 6}, {4, 8}, {2, 17}, {6, 6}, {2, 19}, {5, 8}, {6,
7}, {4, 11}, {2, 23}, {6, 8}, {5, 10}, {4, 13}, {6, 9}, {7, 8}, {2,
29}, {6, 10}, {2, 31}, {8, 8}, {6, 11}, {4, 17}, {7, 10}, {8,
9}, {2, 37}, {4, 19}, {6, 13}, {8, 10}, {2, 41}, {7, 12}, {2,
43}, {8, 11}, {9, 10}, {4, 23}, {2, 47}, {8, 12}, {7, 14}}

• Matthew, 19,30: "But many who are first will be last, and the last will be first." Pretty & educational piece of code :)
– eldo
Jul 4, 2014 at 1:07
• @eldo thank you...as you know the joy in this site is seeing how many creative ways people have of approaching questions...I learn more from this than plodding in the dark Jul 4, 2014 at 1:16
• and you don't have to buy all these expensive books and can have a couple of drinks instead ...
– eldo
Jul 4, 2014 at 1:21
• my favorite... +1
– kglr
Jul 4, 2014 at 3:55
f[n_] := Thread[List[Divisors[n], n/Divisors[n]]][[Ceiling[Length@Divisors[n]/2]]]

f[#] & /@ {10, 12, 52, 60, 66, 70, 72, 98}

(*{{2, 5}, {3, 4}, {4, 13}, {6, 10}, {6, 11}, {7, 10}, {8, 9}, {7, 14}}*)