# Tag Info

## Hot answers tagged number-theory

25

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

19

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

18

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

17

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

15

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

15

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

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

13

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

12

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

11

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 and related computations" in this notebook. deg = 12; flen = 3; j = 0; While[flen > 2 && j++ < 100, defpoly = x^deg + 1 + ...

11

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

11

You can also use InterpolatingPolynomial with Solve, Reduce or Eliminate: a = {-4, 11}; b = {16, -1}; coords = Solve[y == InterpolatingPolynomial[{a, b}, x] && 0 <= x <= 16&&0<=y, {x, y}, Integers][[All, All, 2]]; (* or *) coords={ToRules[Reduce[ y == InterpolatingPolynomial[{a, b}, x] && 0 <= x <= ...

10

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

10

Update Sorry for my ignorance not taking into account that the question specifically asked for a Mathematica 7 solution. I updated the complete post. Mathematica 7 In Mathematica 7 we don't have the option the compile code into a C-library which includes the thread parallelization which can be turned on when using RuntimeAttributes->Listable and ...

10

It's meant to be done divide-and-conquer style. Here is one way to go about that. listMod[n_, {val_}] := {Mod[n, val]} listMod[n_, vals : {_, __}] := With[{len = Length[vals], rem = Mod[n, Times @@ vals]}, Join[listMod[rem, Take[vals, Floor[len/2]]], listMod[rem, Drop[vals, Floor[len/2]]]] ] Your example: n = 31415926535; primeslist = ...

10

This is caused by a bug in RootReduce for Root objects representing last coordinates of solutions of triangular systems. The bug affects cases where the last coordinate of the solution is real, but some of the other coordinates are not real. Thanks for pointing it out. The problem can be fixed with the following patch (you can put it in your init.m file). ...

9

Here is a recursive divide-and-conquer. There are probably nicer ways to code it. trailingZeros[n_, b_] := Module[ {scale=Log[b,N[n]], sqrt, ndigits}, If [scale<1, Return[0]]; sqrt = Ceiling[scale/2]; ndigits = IntegerDigits[n, b^sqrt, 2]; If [Last[ndigits]==0, sqrt + trailingZeros[First[ndigits],b], trailingZeros[Last[ndigits], b]] ] ...

9

It has been explained in good detail why your inputs did not work the way you wanted them; however, there is still a way to get what you want: Resolve[Exists[n, Element[n, Primes] && Mod[n, 2] == 0]] True FindInstance[Element[n, Primes] && Mod[n, 2] == 0, n, Integers] {{n -> 2}} In general, use Element[n, Primes] whenever you need to ...

8

(nextPrime[#1] = #2) & @@@ {{-3, 2}, {-2, 2}, {-1, 2}, {0, 2}, {1, 2}, {2, 3}}; nextPrime[n_Integer?EvenQ] := nextPrime[n - 1]; nextPrime[n_Integer] /; PrimeQ[n + 2] := n + 2; nextPrime[n_Integer] := nextPrime[n + 2] nextPrime[n_ /; n \[Element] Reals] := nextPrime[Floor@n]

7

This is Andrew's method with a few tweaks of my own. The addition of the adjustment argument should make other customization a bit easier. f[{1}] = {{0, 0}}; f[{2}] = {{0, -9}, {0, 9}}/8; f[{2, 2, rest___}] := f[{4, rest}, RotationMatrix[π/4]] f[{n_}, adj___] := Array[3/2 Csc[π/n] {Cos@#, Sin@#} &[# 2 π/n + π/2] &, n].adj f[{n_, rest__}, ...

6

Given a large n, to find k largest primes below n (as well as above) the best approach uses NextPrime (it has been added to Mathematica 6) : NextPrime[n] gives the next prime above n. NextPrime[n,k] gives the k-th prime above n. If k is negative it gives k-th largest prime below n. k need not be a single number but it may be a list of ...

6

Addendum If you just want the greatest 10 primes less than M, you can start from Prime[PrimePi[M]-9]. By doing so, you gain a speed increase of 2 orders of magnitude when M = 100000. M = 100000; m = PrimePi[M] AbsoluteTiming[Table[Prime[k], {k, m - 9, m}]] 9592 {0.000171, {99877, 99881, 99901, 99907, 99923, 99929, 99961, 99971, 99989, 99991}} Now ...

6

I had a clever idea for how to do this using LatticeReduce[], but I decided to code up the Smith-Cornacchia algorithm first to bench mark against, and it was effectively instant for inputs in your range. Here is a sloppy implementation. In particular, I am embarrassed by applying Divisors[] to something which is computed as a product. However, the result is ...

6

Neither Resolve or FindInstance hold their arguments, so they evaluate immediately, and we have: In[68]:= Exists[n, EvenQ[n] && PrimeQ[n]] Out[68]= False In[69]:= EvenQ[n] && PrimeQ[n] Out[69]= False So the code isn't really doing what you're expecting it to.

6

I wrote this answer as I was figuring things out. If you just want the answer, copy the definitions of fundQ, Ast, ksFactors, foo, makeOneIndex and magicJ out of the code blocks below. You should have DirichletCharacter[d, magicJ[d], n] == KroneckerSymbol[d, n] Disclaimer 1: This answer is based on plausible interpretations of things not quite said in the ...

6

I get this result as well in both V8 and V9. Product[n^MoebiusMu[n], {n, 1, Infinity}] (* Out: 1/(4*Pi^2) *) It's a simple fact, though, that an infinite product can converge to a non-zero value only if the general term tends to 1. As MoebiusMu takes each of the values $\pm 1$ (as well as zero) infinitly often, this product simply can't converge. We ...

6

I've found that NSum[] takes a bit too long here to compute Riemann's prime-counting function, so I've resorted to generating the terms and summing them: With[{n = 8*^3}, Total[MoebiusMu[Range[n]] N[LogIntegral[1000^(1/Range[n])]/Range[n]], Method -> "CompensatedSummation"]] 168.35915686601484 which gives a result close to that of ...

5

The only trick I can see is a trivial one: if $x$ is the square of a rational, it is also a rational. That's because of the $x = (a/b)^2 = a^2/b^2$. So, I'd write a function testing the rationality, which returns either True, False, or Null (if rationality cannot be established): isRational[x_] := If[Simplify[x ∈ Rationals], True, False, Null] which ...

5

I voted for all three previous answer because they all taught me something. However they, being Compile solutions, are not helpful with big integers. At least on my system, Sal Mangano's code appears reducible to this without loss of speed: isSq2 = Compile[n, Floor@# == # & @ Sqrt @ n]; For big integers between about 2*10^9 and 2*10^11 I am ...

5

I don't think there are any built-in functions for this but the following is probably fast enough for most purposes. isSq = Compile[{{n, _Integer}}, With[{test = Sqrt[n]}, Floor[test] == test]]; Does 1 million integers in under a second. Timing[Table[isSq[i], {i, 1, 1000000}]][[1]] (* 0.76195 *) This is under 2 orders of magnitude faster than the ...

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