1
$\begingroup$

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}

Improve this question
$\endgroup$
5
  • 1
    $\begingroup$ Divisors[n] gives them in ascending order to get started... reference.wolfram.com/mathematica/ref/Divisors.html $\endgroup$
    – dr.blochwave
    Jul 2, 2014 at 19:09
  • 1
    $\begingroup$ Closely related Generating pairs of additive and multiplicative factors for integers. $\endgroup$
    – Artes
    Jul 2, 2014 at 19:10
  • 3
    $\begingroup$ 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? $\endgroup$
    – Daniel Lichtblau
    Jul 2, 2014 at 19:55
  • $\begingroup$ @Daniel - I think my question plus example is clear (except for square numbers - see answer below). If not, please edit it. $\endgroup$
    – eldo
    Jul 2, 2014 at 20:07
  • 3
    $\begingroup$ 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... $\endgroup$
    – ciao
    Jul 2, 2014 at 20:23

5 Answers 5

Reset to default
4
$\begingroup$

@blochwave's answer slightly modified:

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}} *)
Improve this answer
$\endgroup$
3
  • $\begingroup$ nice alliance of style and speed $\endgroup$
    – eldo
    Jul 3, 2014 at 18:39
  • $\begingroup$ @eldo, thank you!! $\endgroup$
    – kglr
    Jul 3, 2014 at 19:57
  • $\begingroup$ @kguler agree with eldo, dealing with squares and listability in a compact way $\endgroup$
    – ubpdqn
    Jul 4, 2014 at 0:23
8
$\begingroup$

Updated answer

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.

Original answer

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}.

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

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}}
Improve this answer
$\endgroup$
3
  • $\begingroup$ A bit faster by a factor of ~2x in fact! $\endgroup$
    – dr.blochwave
    Jul 2, 2014 at 22:22
  • $\begingroup$ @rasher Excellent! Could your solution (like blochwave's) also respect negative integers, so that -1111 -> {11, -101} ? $\endgroup$
    – eldo
    Jul 2, 2014 at 22:28
  • $\begingroup$ @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 ;-) $\endgroup$
    – ciao
    Jul 2, 2014 at 22:43
4
$\begingroup$

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}}
Improve this answer
$\endgroup$
4
  • $\begingroup$ Matthew, 19,30: "But many who are first will be last, and the last will be first." Pretty & educational piece of code :) $\endgroup$
    – eldo
    Jul 4, 2014 at 1:07
  • $\begingroup$ @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 $\endgroup$
    – ubpdqn
    Jul 4, 2014 at 1:16
  • 1
    $\begingroup$ and you don't have to buy all these expensive books and can have a couple of drinks instead ... $\endgroup$
    – eldo
    Jul 4, 2014 at 1:21
  • $\begingroup$ my favorite... +1 $\endgroup$
    – kglr
    Jul 4, 2014 at 3:55
3
$\begingroup$ 
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}}*)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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