Tag Info

Hot answers tagged

8

Let me start by saying that this problem is probably best solved with a procedural backtracking algorithm, like the one given here. This makes Mathematica a poor choice for tackling it. In fact, judging from this sci.math topic from 1994 the people who originally derived the complete list of PPDIs did it in C. But since we're here to talk about Mathematica, ...


7

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


4

The $n^{th}$ triangle number satisfies Binomial[n+1,2], therefore, solving for m=Binomial[n+1,2] and checking if the solution is an integer gives the answer directly. triangularQ[m_] := IntegerQ@(n /. First@Solve[Binomial[n + 1, 2] == m, n]) {#, triangularQ[#]} & /@ Range[2, 28] // TableForm reference: http://en.wikipedia.org/wiki/Triangular_number ...


4

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


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


3

@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, ...


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}}*)


3

Here is another approach (based on $t_n=\frac{n(n+1)}{2}$): fn[x_] := Mod[Sqrt[1 + 8 x], 2] == 1 For the test example fn[3003] is true: Just for fun (but factoring extremely large numbers an issue): an[x_?(# > 0 &)] := Abs[# - 2 x/#] & @@ Nearest[Divisors[ 2 x], Sqrt[2 x]] == 1 an[0] := True Just for illustration (and not proof but are ...


3

There is an especially useful function HarmonicNumber appearing most likely the best approach in similar tasks since its implementation is optimized and it has close relations to number theoretic functions like the Riemann zeta function ΞΆ represented in Mathematica by Zeta, basically HarmonicNumber tends to Zeta for Re[z] > 1 : Limit[ HarmonicNumber[n, ...


3

What if you made a number spiral similar to the prime spiral of Stanislaw Ulam? This transforms the 1D distribution of Hamming numbers into a 2D distribution. Note that kSmoothSpiral generalizes to any k-smooth number. NumberSpiral[n_Integer] := Block[{m = Floor[N[Sqrt[n]]]}, If[ EvenQ[Floor[2.0*Sqrt[n]]], {(-1)^m*((n - m*(m + 1)) ...


2

MemberQ[f2 /@ Range@1000, 3003] True With[{r = Range@10, tri = f2 /@ Range@1000}, Transpose[{r, MemberQ[tri, #] & /@ r}]] // TableForm Take[CoefficientList[Series[x/(1 - x)^3, {x, 0, 100}], x], -10] {4186, 4278, 4371, 4465, 4560, 4656, 4753, 4851, 4950, 5050}


1

This is an example of how to handle the operation, arguments are your list and the Q: With[{l = #1, q = #2}, QFactorial[Total@l, q]/Times @@ (QFactorial[#, q] & /@ l)] &[{1, 2,3}, 5] (* 79315236 *)


1

This is not a computationally efficient solution, but it works also in a spreadsheet: nn = 12; a = Table[Sum[If[n == k*(k + 1)/2, 1, 0], {k, 1, nn}], {n, 1, nn}]; b = Table[If[a[[i]] == 1, True, False], {i, 1, nn}] Output: {True, False, True, False, False, True, False, False, False, True, False, False}



Only top voted, non community-wiki answers of a minimum length are eligible