1

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}

eldo
  • 67,911
  • 5
  • 60
  • 168

5 Answers5

8

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

Community
  • 1
dr.blochwave
  • 8,768
  • 3
  • 42
  • 76
  • 1
    +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 02 '14 at 19:46
5

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}}
ciao
  • 25,774
  • 2
  • 58
  • 139
  • A bit faster by a factor of ~2x in fact! – dr.blochwave Jul 02 '14 at 22:22
  • @rasher Excellent! Could your solution (like blochwave's) also respect negative integers, so that -1111 -> {11, -101} ? – eldo Jul 02 '14 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 02 '14 at 22:43
4

@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}} *)
kglr
  • 394,356
  • 18
  • 477
  • 896
4

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}}
ubpdqn
  • 60,617
  • 3
  • 59
  • 148
  • Matthew, 19,30: "But many who are first will be last, and the last will be first." Pretty & educational piece of code :) – eldo Jul 04 '14 at 01: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 – ubpdqn Jul 04 '14 at 01:16
  • 1
    and you don't have to buy all these expensive books and can have a couple of drinks instead ... – eldo Jul 04 '14 at 01:21
  • my favorite... +1 – kglr Jul 04 '14 at 03:55
3
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}}*)
Basheer Algohi
  • 19,917
  • 1
  • 31
  • 78