# Tag Info

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

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

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

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}

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

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}

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

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

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

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

1

You can also call WolframAlpha["1/243"].

5

Since belisarius specifically refused to expound on his answer, which arguably would make my editing it for such purpose tantamount to vandalism, I shall post my own. Regarding RealDigits: For integers and rational numbers with terminating digit expansions, RealDigits[x] returns an ordinary list of digits. For rational numbers with non-terminating digit ...

8

NumberForm[N[1/243,135],DigitBlock->27] 0.004115226337448559670781893 004115226337448559670781893 004115226337448559670781893 004115226337448559670781893 004115226337448559670781893 00 let x = 0.004115226337448559670781893... then for it to repeat forever would require that eqn = (10^27 -1) x == 4115226337448559670781893; Solve[eqn, x] ...

13

RealDigits[1/243] (* {{{4, 1, 1, 5, 2, 2, 6, 3, 3, 7, 4, 4, 8, 5, 5, 9, 6, 7, 0, 7, 8, 1, 8, 9, 3, 0, 0}}, -2} *)

2

For this particular case (could be easily extended): Count[#, Max@#] &[ StringLength /@ Rest@StringSplit[ToString@N[1/243, 10^6], "00"]] 37037 With 10^6 digits after the decimal point there are 37037 repetitions.

3

f = Module[{n = 1, res}, While[(res = Reduce`SumOfSquaresReps[n, #]) == {}, n++]; res]&; f[17] (* {{1, 4}} *) f[999][[1]] (* {1, 1, 6, 31} *) f[999] (* {{1, 1, 6, 31}, {1, 6, 11, 29}, {1, 7, 7, 30}, {1, 7, 18, 25}, {1, 10,13, 27}, {1, 14, 19, 21}, {1, 15, 17, 22}, {2, 3, 5, 31}, {2, 3, 19, 25}, {2, 5, 21, 23}, {2, 9, 17, 25}, {3, 3, 9, 30}, ...

0

k = 1; m[1] = 999; While[m[k] =!= 0, n[k] = Floor@Sqrt[m[k]]; k = k + 1; m[k] = m[k - 1] - (Floor@Sqrt[m[k - 1]])^2]; sol = n[#] & /@ Range[1, k - 1] (* {31, 6, 1, 1} *)

1

Here is another one: squarePartition[n_] := squarePartition[n, 1, Table[k^2, {k, 1, Floor[Sqrt[n]]}]]; squarePartition[n_, l_, squares_] := Module[{result = IntegerPartitions[n, {l}, squares]}, Sqrt[First[result]] /; result =!= {} ]; squarePartition[n_, l_, squares_] := squarePartition[n, l + 1, squares]; squarePartition /@ {17, 999} (* {{4, 1}, ...

5

Shamelessly stealing, but using a built-in function Block[{n = 1, results}, While[(results = PowersRepresentations[#, n, 2]) == {}, n++]; results] &[999]

5

Module[{n = 1, results}, While[(results = Sqrt[IntegerPartitions[#, {n}, Range@Floor@Sqrt[#]^2]]) == {}, n++]; results] &[999] (* {{31, 6, 1, 1}, {31, 5, 3, 2}, {30, 9, 3, 3}, {30, 7, 7, 1}, {30, 7, 5, 5}, {29, 11, 6, 1}, {29, 10, 7, 3}, {27, 15, 6, 3}, {27, 14, 7, 5}, {27, 13, 10, 1}, {27, 11, 10, 7}, {26, 17, 5, 3}, {26, 15, 7, 7}, ...

Top 50 recent answers are included