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
...
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 ...
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], ...
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 <= ...
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
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. ...
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
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).
...
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
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 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
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 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 ...
5
Here's a way to exploit the mediant property of the Farey series. To calculate the mediant:
med[{a_, b_}] := (Numerator[a] + Numerator[b])/(Denominator[a] + Denominator[b]);
Then the Farey series is:
farey[n_] := farey[n] = DeleteCases[ Riffle[
farey[n - 1], med /@ Partition[farey[n - 1], 2, 1]], _?(Denominator[#] > n &)];
with initial ...
5
Here's a functional way to use the property (the property, which has been removed from the original question, was $N'/D' = N/D + 1/D'D$ or equivalently $N'D-D'N=1$):
farey1[n_] :=
NestWhileList[
With[{num0 = Numerator[#], den0 = Denominator[#]},
First @ Minimize[{num/den,
num den0 - num0 den == 1 && 1 <= den <= n && 1 ...
5
In short NSum cannot handle this sort of sequence. Indeed, strictly the series is not convergent, and some notion of summability/regularization needs to be chosen.
Given the nature of MoebiusMu, "Dirichlet" seems appropriate:
Sum[MoebiusMu[k], {k, 1, \[Infinity]}, Regularization -> "Dirichlet"]
(* -2 *)
Here's how one can see NSum is not working ...
5
In order to understand the issue, we should provide the underlying definitions.
Mathematica helps in verifying appropriate relations and definitions. The main functional equation relating Riemann's zeta function $\zeta\;$, to Euler's $\Gamma\;$, established in Riemann's famous paper Über die Anzahl der Primzahlen unter einer gegebener Grösse (1859, English ...
4
For reference, here is the v7 code behind NextPrime, which is hard to read before stripping all the private context names.
NextPrime[1]; (* preload the definition *)
Unprotect[NextPrime];
ClearAttributes[NextPrime, ReadProtected];
$Context = "NumberTheory`NextPrimeDump`";
FullDefinition[NextPrime]
Yields:
Attributes[NextPrime] = {Listable}
NextPrime[-3] ...
4
Here's Eric Weisstein's implementation from MathWorld:
Primorial[0] := 1;
Primorial[1] := 2;
Primorial[n_] := Primorial[n] = Prime[n] Primorial[n - 1];
ChebyshevTheta[n_] := Log[Primorial[PrimePi[n]]]
Plot[ChebyshevTheta[x], {x, 0, 100}]
Many MathWorld pages have attached notebooks linked near the top of the page. That's where this came from.
4
Graham, Knuth, and Patashnik in their book Concrete Mathematics
(pages 118 and 150) discuss the Farey series. Their recurrence
does not require finding Subsets, computing the elements in
order starting with $0/1$ and $1/n$. Although very fast, Subsets
can use too much memory when very large $n$ are required, as for
some PE problems.
...
4
(This is a math question, not a Mathematica question.)
To add to Artes's answer, there is the well-known(!) identity
$$\zeta(-n)=\frac{(-1)^n}{n+1}B_{n+1}$$
so you might as well ask why
$$\begin{align*}
-\frac12\times B_2&=-\frac1{14}\times B_{14}\\
-\frac12\times \frac16&=-\frac1{14}\times \frac76
\end{align*}$$
A justification for the ...
3
Artes's solution is the best, I think. If you just want to treat this as an ordinary Diophantine problem, you can do that with Solve[] (making this approach more or less equivalent to Yves's):
{p, q} = {-4, 11};
{r, s} = {16, -1};
{x, y} /. Solve[{(q - s) x - (p - r) y == -Det[{{p, q}, {r, s}}],
x > 0, y > 0, Min[p, r] < x < ...
3
For part (b) of your question, there is a built-in function:
IntegerPartitions[12, {2}]
(* {{11, 1}, {10, 2}, {9, 3}, {8, 4}, {7, 5}, {6, 6}} *)
For the last part,
deDup1 = DeleteDuplicates[#, #1 == Reverse@#2 &] &;
(* or *)
deDup2 = DeleteDuplicates[#, Union@#1 == Union@#2 &] &;
deDup1@Function[int, {#, int/#} & /@ ...
3
Here's a way to test if a number is a square of a rational, without taking square roots:
SetAttributes[squareQ, Listable];
squareQ[x_] := MatchQ[Head[x], Integer | Rational] &&
And @@ OddQ[DivisorSigma[0, Through[{Numerator, Denominator}[x]]]]
See e.g. this for a proof.
Only top voted, non community-wiki answers of a minimum length are eligible
