We’re rewarding the question askers & reputations are being recalculated! Read more.

# Tag Info

73

If you want to make several sequences of the Collatz function for turning it into a graph, you probably want to memorize, which parts you already calculated. What we try to do is to create a graph like this (image from xkcd): When we would calculate the whole chain for each number until it (hopefully) reaches the end sequence 8,4,1 we do a lot of work over ...

45

The other methods described work well, but I am partial to exact answers. So, here it is. First, note that the Fibbonacci sequence has a closed form $$F_n = \frac{\Phi^n - (-\Phi)^{-n}}{\sqrt{5}}$$ where $\Phi$ is the GoldenRatio. Also, as observed elsewhere, we are looking only at every third term, which gives the sum $$\sum^k_{n = 1} \frac{\Phi^{3n} - (... 40 This is the Collatz function I know: Collatz := {1} Collatz[n_Integer] := Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0 Collatz[n_Integer] := Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0 Generating a graph from this is easy: Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range // Flatten // Union, ... 32 For general large integers n, I don't know if there's a better method than Min[IntegerExponent[n, 5], IntegerExponent[n, 2]]. Or more compactly, IntegerExponent[n, 10] or IntegerExponent[n]. 29 Here is a recursive method using Outer: FactorPoints[{1}] := {{0, 0}} FactorPoints[{n_}] := 3/2 Csc[Pi/n] Through[{Cos, Sin}[# (2 Pi)/n]] & /@ Range[n] FactorPoints[{n_, rest__}] := Flatten[Outer[Plus, 9/4 Csc[Pi/n] FactorPoints[{rest}], FactorPoints[{n}], 1], 1] FactorPlot[n_] := Graphics[Disk /@ FactorPoints[Sort[Flatten[ConstantArray ... 29 I can't take much credit for this answer--I hadn't even got version 10.2 installed until J. M. commented to me that these functions could be written efficiently in terms of the Hamming weight function. But, it is understandable that he doesn't want to write an answer using a smartphone. The definition of the built-in ThueMorse is: ThueMorse[n_Integer] := ... 27 There are many ways to proceed, the best one uses FrobeniusSolve : I Since we know, that a x + b == y /. Solve[{-4 a + b == 11, 16 a + b == -1}, {a, b}] // Simplify {3 x + 5 y == 43} we find FrobeniusSolve[ {3, 5}, 43] {{1, 8}, {6, 5}, {11, 2}} a bit more straightforward way : II {x, y} /. Solve[ (a x + b == y /. Solve[ {-4 a + b == 11, 16 a + b == ... 25 Actually, I believe the issue reduced to that of implementing PrimePi[]. It is easy to implement Prime[] using PrimePi[] and FindRoot[] — in fact this is done on page 134 of Bressoud and Wagon, "A Course in Computational Number Theory". So all you need is to have a fast implementation of PrimePi[]. The first efficient way was found by Legendre in 1808. The ... 24 Let me introduce the following animated approach: As you can see, I've slightly changed the way of diagram generation. The main differences are the following. 1. Now the diagrams are more symmetric. This is due to proper rotation after each sudivision. 2. As the main principle is to use factors in decreasing order, I consider 4 as a separate factor and ... 24 You can just step through i and j while trying to simultaneously satisfy$$i^2+(i+1)^2=j^2+(j+1)^2+(j+2)^2$$Just loop and if the inequality is too small on the left, increment i. If it's too small on the right, increment j. That looks like this: Clear[f, g, i, j]; f[i_] = i^2 + (i + 1)^2; g[j_] = j^2 + (j + 1)^2 + (j + 2)^2; max = 10^6; i = 1; j =... 24 Fast algorithm n = 5566 IntegerPart[10 Mod[7 PowerMod[10, n - 1, 101], 101]/101] A brute force approach (see also these posts on stackoverflow :) ) may be fine for the current problem, but what if n is a huge number? The only possibility apart from guessing the periodic sequence of numbers as mgamer suggested would be to use modular arithmetics. Let me ... 23 Note: I am not particularly knowledgable in the field of this question, so what I write below may well be wrong. I don't know whether or not this should be considered a bug, but to my mind this is an instance of a clash of programming and mathematical functionality. To put it differently, predicates (functions ending with Q) seem to be a wrong match for ... 23 It's due to an implementation-dependent issue. We should try to improve on it. Has not been much clamor to do so, therefore it has not been a high priority. --- edit --- I've had a look at the code. It is quite intentional that the largest is around what you state (I see the constant being set to 7.783516108362\times 10^{12}). It has to do with this ... 23 PrimeQ and FactorInteger use different algorithms. In general asking whether a number is prime is an easier problem than finding its factors. To quote the documentation, "PrimeQ first tests for divisibility using small primes, then uses the Miller–Rabin strong pseudoprime test base 2 and base 3, and then uses a Lucas test", while "FactorInteger switches ... 23 Perhaps: ReduceEulerPhiInverse (* {7, 9, 14, 18} *) Not sure why such things are hidden & undocumented, perhaps because it's available through Reduce and Solve: Solve[EulerPhi[x] == 6, x, Integers] (* {{x -> -18}, {x -> -14}, {x -> -9}, {x -> -7}, {x -> 7}, {x -> 9}, {x -> 14}, {x -> 18}} *) 22 Your code works fine, but it's missing half the roots, and a Flattening of the list of numbers prior to applying Re and Im helps. Adding those in: data = Flatten[ Table[{(-b + Sqrt[b^2 - 4 a c])/(2 a), (-b - Sqrt[b^2 - 4 a c])/(2 a)}, {a, 1, 20}, {b, -20, 20}, {c, -20, 20}]]; ListPlot[{Re[#], Im[#]} & /@ data, PlotRange -> {{-3, 3},... 21 Here's my modest attempt: shiftMe[g_, 1] := g shiftMe[g_, {2, tag_Integer?Positive}] := If[OddQ[tag], Translate[Scale[g, 1/2], #] & /@ {{0, 1}, {0, -1}}, Translate[Scale[g, 1/2], #] & /@ {{1/2, 0}, {-1/2, 0}}] shiftMe[g_, k_?PrimeQ] := Translate[Scale[g, 1/k], Through[{Cos, Sin}[2 π #/k - π/(2 k)]]] & /@ Range[0, k - 1] /; k > 2 ... 21 As far as obtaining a True/False answer: Element[Sqrt, Rationals] (* False *) 21 We can exploit the built in LogGamma: x = 12345678987654321; Ceiling[LogGamma[N[x + 1]]/Log] 193299018111544064 Edit, Addressing precision: We have naively for n > 1, that n! < n^n. Taking logs of both sides gives the (not very tight) bound \log\Gamma(x + 1) < x \log(x) for x > 1. This means if we want the number of digits of n!... 21 A story of incremental improvement Let's look at the OP's original expression again, for reference:$$\sum_{m=1}^{c}\frac{1}{m}\sum_{d \mid m}\mu(d)n^{m/d}$$Most people here are familiar with Sum[], and would not have much trouble translating the outer summation into Mathematica syntax. The inner part,$$\sum_{d \mid m}\mu(d)n^{m/d} is not terribly ...

20

Straight iteration over the even valued Fibonacci numbers is fast. fibSum[max_] := Module[ {tot, n, j}, tot = 0; n = 0; j = 3; While[n = Fibonacci[j]; n <= max, j += 3; tot += n]; tot] Or one can use matrix products. This seems to be about the same speed. It has the advantage of not requiring a built in Fibonacci function. fibSum2[max_] := ...

20

Sum[Fibonacci[n], {n, 3, InverseFunction[Fibonacci], 3}] (* 4613732 *)

20

The built-in functionPrimeOmega gives you the number of prime factors and counts multiplicities. Therefore, this can easily be used to give you semi-primes as you have defined them: With[{r = Range}, Pick[r, PrimeOmega[r], 2]]

18

In general Mathematica cannot compute symbolically infinite sums over primes because of the lack of appropriate mathematical tools. However there are infinite products over primes which are basically well understood on the mathematical level. One famous example is the Euler formula for the Riemann zeta function, one of the most beautiful (and mysterious ...

18

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

18

Cause Under the hood SystemSquaresR is still calling functions in the context NumberTheory. Partial output of: Needs["GeneralUtilities"] PrintDefinitions @ SquaresR SquaresR[2, NumberTheorySquaresRDumpn _ Integer?Positive] := Block[{NumberTheorySquaresRDumpres}, NumberTheorySquaresRDumpres = NumberTheorySquaresRDumpsquaresR2[...

18

A Trace reveals the problem: Product[If[PrimeQ[p], (p^2 + 1)/(p^2 - 1), 1], {p, 2, Infinity}] // Trace (* {Product[If[PrimeQ[p], (p^2 + 1)/(p^2 - 1), 1], {p, 2, Infinity}], {{PrimeQ[p], False}, If[False, (p^2 + 1)/(p^2 - 1), 1], 1}, Product[1, {p, 2, Infinity}], 1} *) The If[] statement is evaluated before the Product. In turn PrimeQ[p] ...

17

Let us try to produce the solution without applying brute force, similar to mgamer's answer (that did not actually use Mathematica). Reduce[Mod[10^r - 1, 37] == 0, r, Integers] (* -> C \[Element] Integers && C >= 0 && r == 3 C *) We see that the value of r can in fact be any nonnegative multiple of 3. The result sought is ...

17

I want to answer the part of the question, "How could my son be expected to find a prime factor?" Well, this depends on what your son has been taught, of course. A first thing to notice is that, since 99! is divisible by every prime less than 99, 99! - 1 is not divisible by any of those primes; so 101 is the smallest prime which could be a factor of it. So ...

17

I do a lot of cybersecurity competitions where we crack crypto, so I'm used to grappling with Mathematica for ring algebra. The sole thing Mathematica honestly isn't great for is cryptography. For this stuff, I generally just use SageMath Cloud, because it has all of the above algorithms built into DiscreteLog. You just throw your values at the function and ...

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