New answers tagged

3

If you only care about counting and enumerating, why not use Legendre's three-square theorem? SetAttributes[SumOf3SquaresQ, Listable]; SumOf3SquaresQ[n_] := Mod[n/4^IntegerExponent[n, 4], 8] != 7 FactorialSumOf3SquaresPi[x_] := Total[Boole[SumOf3SquaresQ[Range[x]!]]] FactorialSumOf3SquaresPi[10000] 8746 Or test your conjecture by subtracting $7x/8$ ...


10

Brute-force, but compact: DeleteCases[Table[{k, PowersRepresentations[k!, 3, 2]}, {k, 10}], {___, 0, ___}, {3}] {{1, {}}, {2, {}}, {3, {{1, 1, 2}}}, {4, {{2, 2, 4}}}, {5, {{2, 4, 10}}}, {6, {{8, 16, 20}}}, {7, {{4, 20, 68}, {12, 36, 60}, {20, 44, 52}}}, {8, {{8, 16, 200}, {8, 80, 184}, {40, 88, 176}, {72, 120, 144}, {80, 104, 152}}}, {9, {{8, 304, ...


5

You can Try Table[set = {x, y, z} /. NSolve[{n! == x^2 + y^2 + z^2, x > 0, y > 0, z > 0},{x, y, z},Integers]; set = Union[Sort /@ set]; Join[{n}, set], {n, 3,8}] This will give you how you can express a factorial as a sum of three squares. Now you can use further conditions (like $x\neq y \neq z$) with Select or Cases to filter them.


4

Do not despair! eq1 = SetPrecision[298973528525.436 < 10^10*(n - k*3.32192809488736), 50]; eq2 = SetPrecision[10^10*(n - k*3.32192809488736) < 298973528539.862, 50]; sol = FindInstance[eq1 && eq2, {n, k}, Integers] (* {{n -> 1702347304068985, k -> 512457601562468}} *) {eq1, eq2} /. sol (* {{True, True}} *)


4

To fix the memory problems you could rewrite it in a procedural style. It's probably more than a tweak, a bit ugly, and a bit slower. But you can go forever without having to worry about memory. ClearAll@fail; fail = Compile[{{m, _Integer}, {p, _Integer, 1}}, MemberQ[Mod[6 m - 3, #] & /@ p, 2] || MemberQ[Mod[6 m - 3, #] & /@ p, 4]]; ...


0

This is not an answer. It is an example of using Graph to sieve (without the display). I have 32GB memory and 4 steps is as high as I can go. primes = {1}; Do[ limv = Prime[Length[primes]]^2 - 1; g = Graph[ Flatten[Table[p -> p (m + 1), {p, primes}, {m, 1, limv/p - 1}]]]; primes = Join[primes, Flatten[Position[VertexDegree[g], 1]]]; ...


1

sources = Select[VertexList[g], VertexOutDegree[g, #] >= 1 &]; SetProperty[g, {VertexLabels -> (Thread[ sources -> Placed["Name", Center]]), VertexSize -> (Thread[sources -> 3/2])}]



Top 50 recent answers are included