Tag Info

Hot answers tagged

47

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


33

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


29

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


28

This is the Collatz function I know: Collatz[1] := {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[500] // Flatten // Union, ...


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


23

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


22

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] := ...


21

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


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

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


19

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[50]}, Pick[r, PrimeOmega[r], 2]]


19

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


18

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


17

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


17

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_] := ...


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


16

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


16

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[1] \[Element] Integers && C[1] >= 0 && r == 3 C[1] *) We see that the value of r can in fact be any nonnegative multiple of 3. The result sought is ...


16

As far as obtaining a True/False answer: Element[Sqrt[2], Rationals] (* False *)


15

Is this what you are searching for? a = {-4, 11}; b = {16, -1}; dy = (b[[2]] - a[[2]])/(b[[1]] - a[[1]]); offset = u /. Solve[a[[2]] == dy*a[[1]] + u, u][[1]]; coords = {x, y} /. {Reduce[y == dy*x + offset && x > 0 && y > 0, {x, y}, Integers] // ToRules} (* {{1, 8}, {6, 5}, {11, 2}} *) Graphics[{PointSize[Large], ...


15

You could use FactorInteger to find out whether or not there are exactly two primes building up a number: SemiPrimeQ[n_Integer] := With[{factors = FactorInteger[n]}, Total[factors[[All, 2]]] == 2 ] The rest is easy: Select[Range[50], SemiPrimeQ] (* {4, 6, 9, 10, 14, 15, 21, 22, 25, 26, 33, 34, 35, 38, 39, 46, 49} *) And for those who like inline ...


15

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


14

As Heike mentions in the comments, FromContinuedFraction[] does what you want: FromContinuedFraction[{2, 2, 1, 7, 1, 2, 2, 16}] 6784/2891 If FromContinuedFraction[] had not been built-in, however, something like this could be done: (* backward recursion *) Fold[#2 + 1/#1 &, Infinity, Reverse[{2, 2, 1, 7, 1, 2, 2, 16}]] 6784/2891 or even (* forward ...


14

--- edit --- More recent versions of the work containing the code mentioned below are found at these links: SymbolicFAQ and PCwGB --- end edit --- This will not scale to dimension 100 but will be an improvement on what you now have. It is cribbed from the section "Linear Algebra over Galois Fields here as well as the section "Groebner bases over modules ...


13

If you are strictly interested in the number of trailing zeros in factorials $n!$, as the example in your question suggests, then consider the number of pairs of 2 and 5 in all the factors of numbers 1 through $n$. There is always a 2 to match a 5, so the number of fives gives the number of zeros. Integers divisible by 5 contribute one 5 to the total. ...


13

This is bit faster: toPrime = 500; sums = Accumulate@FoldList[Times, 1, Range[2, Prime@toPrime - 1]]; primes = Prime[Range[toPrime]]; Mod[sums[[primes - 1]], primes] Precompute factorial sums and primes. Mod is fast on lists.


13

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


13

Update: the lhs of $i^2+(i+1)^2=j^2+(j+1)^2+(j+2)^2$ is always odd so $j$ should be even. The fastest solution I found: max = 10^12; {(Sqrt[3 + 6 (# + 1)^2] - 1)/2, #, #^2 + (# + 1)^2 + (# + 2)^2} & @@@ (2 Position[#, 0]) &@UnitStep[Abs[# - Round[#]] - 1.*^-10] &[ Sqrt[0.75 + 1.5 #^2] - 0.5] &@ Range[3., Sqrt[max/3.], 2] // ...


12

While we wait for an MMA implementation of BBP formula to generate the digits of Pi, we can use published results to identify repeated digits and their locations. Searching through the one billion digits of Pi in the file pi-billion.txt, in chunks of 10 million digits, with built-in function StringPosition: (patterns = Table[Table[i - 1, {9}], {i, 10}]; ...



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