Tag Info

Hot answers tagged

18

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


14

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


13

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


12

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


11

Szabolcs found a page that does animated transitions between the diagrams in JavaScript here. Here's an iterative implementation of the diagrams and some basic animated transitions between them. DynamicModule[{shapes, t, n, next, keyframes}, shapes[i_] := Thread@{Table[ ColorData["BlueGreenYellow"]@Rescale[a, {1, i}], {a, i}], Disk /@ First@ ...


10

A naive approach would be this: primePower[n_] := Count[ Range @ n, _?PrimePowerQ] This function works well however it might be very inefficient for large n. It takes a bit to evaluate e.g. primePower[10^6] 78734 which is only a little bigger than PrimePi[10^6] 78498 The latter is much more efficient since it uses advanced algorithms for ...


9

Number theory questions are always a huge accumulator for up votes. :) From my experience I can say that the builtin MangoldtLambda function is pretty slow. So let's define a Mangoldt function on our own. The Mangoldt function is defined by: $\Lambda(n) \equiv \left\{ \begin{array}{1 1} ln\ p & \quad \text{if n = $p^k$ for p a prime}\\ 0 & \quad ...


8

Even though Mathematica has a broad range of powerful capabilites (see e.g. this comparison of computer algebra systems) in related fields (number theory, quantifier elimination) it sometimes doesn't appear to be clever enough to prove simple theorems, e.g. this should yield False however we get back the input: Resolve[ Exists[p, p ∈ Integers && ...


8

By using a pregenerated list of prime numbers: lst = Prime[Range@PrimePi[25]]; Select[Union@Flatten[lst*# & /@ lst], # < 50 &] (* {4, 6, 9, 10, 14, 15, 21, 22, 25, 26, 33, 34, 35, 38, 39, 46, 49} *)


8

NumberForm[N[1/243,135],DigitBlock->27] 0.004115226337448559670781893 004115226337448559670781893 004115226337448559670781893 004115226337448559670781893 004115226337448559670781893 00 let x = 0.004115226337448559670781893... then for it to repeat forever would require that eqn = (10^27 -1) x == 4115226337448559670781893; Solve[eqn, x] ...


8

Let me start by saying that this problem is probably best solved with a procedural backtracking algorithm, like the one given here. This makes Mathematica a poor choice for tackling it. In fact, judging from this sci.math topic from 1994 the people who originally derived the complete list of PPDIs did it in C. But since we're here to talk about Mathematica, ...


8

Count[IntegerDigits[#!], 0] & /@ Range[1, 100000, 2000] // ListLogPlot


7

Following Daniel's comment, I post my solution: PolynomialCRT[pol_List, mod_List, x_] := Module[{m, q, l}, l = Length[pol]; m = Table[Times @@ Drop[mod, {i}], {i, l}]; q = Table[PolynomialExtendedGCD[m[[i]], mod[[i]], x][[2, 1]], {i, l}]; Simplify[(q pol).m] ] There is no error checking code (for instance, pol and mod have the same length).


7

Perfect numbers: Select[ Range[10^6], Total[Divisors @ #] == 2 # &] {6, 28, 496, 8128} abundant numbers: Select[ Range[10^3], Total[ Most @ Divisors @ #] > # &]//Short { 12, 18, 20, 24, 30, 36, 40, 42, 48, <<228>>, 968, 972, 978, 980, 984, 990, 992, 996, 1000} I used Short to to get only a few since there are: ...


7

Updated answer Indeed, the method linked to by Artes can be modified (Generating pairs of additive and multiplicative factors for integers) f1[n_] := Last[{#, n/#} & /@ First@Partition[#, Ceiling[Length[#]/2]] &@ Divisors[n]] Which also works nicely for squares, such as 36 giving {6,6} which is an improvement over the original answer I gave ...


7

Counting Strings may be faster, so I propose the string version: countZeros[x_Integer] := StringCount[IntegerString[x!], "0"] Then: countZeros[1000] 472


6

We can use Reduce to give us: expr = (2^p - (2^2) (3^2))/(3^3); Reduce[{expr == n, n ∈ Integers}, p, Integers] (n | p) ∈ Integers && n >= -1 && p == Log2[9 (4 + 3 n)] Since the only x such that Log2[x] ∈ Integers are powers of two, we must have 9 (4 + 3 n) equal a power of two while n is simultaneously an integer. This clearly ...


6

One can implement a general formula: $$ x = a_1 + \cfrac{b}{a_2 + \cfrac{b}{a_3 + \cfrac{b}{\ddots + \cfrac{b}{a_n} } } } $$ continuedFraction[x_, n_, b_: 1] := Sign[b] Reap[NestWhile[b/# - Sow@Floor[b/#] &, Abs[b]/x, # != 0 &, 1, n]][[2, 1]]; If b = 1 it is the regular continued fraction ContinuedFraction[Sqrt[2], 10] ...


6

A faster approach to finding Perfect numbers using DivisorSigma Select[Range[10^6], DivisorSigma[1, #] == 2 # &] {6, 28, 496, 8128} Here's an even faster approach: Pick[#, MapThread[Equal, {DivisorSigma[1, #], 2 #}], True] &[Range[10^6]] and a little bit faster: Pick[#, DivisorSigma[1, #] - 2 #, 0] &@Range[10^6] For Abundant ...


6

Here's a fancy memoized solution: Clear[primePowerCount, primePowerCount`cache, iPrimePowerCount] iPrimePowerCount[n1_, n2_] := Count[Range[n1, n2], _?PrimePowerQ] primePowerCount`cache = {1}; primePowerCount[1] = 0; primePowerCount[n_?Positive] := Module[{n0, res}, n0 = First@Nearest[primePowerCount`cache, n]; If[n0 < n, res = ...


6

Here's some code which produces an image depicting the density of 5-smooth numbers with bright pixels on a dark background, with higher numbers on the right side of the image. size = 200; Image @ Transpose @ Partition[ If[Max @ First @ Transpose @ FactorInteger @ # <= 5, 0.75, 0] & /@ Range[size^2], size/2] If an integer ...


6

The $n^{th}$ triangle number satisfies Binomial[n+1,2], therefore, solving for m=Binomial[n+1,2] and checking if the solution is an integer gives the answer directly. triangularQ[m_] := IntegerQ@(n /. First@Solve[Binomial[n + 1, 2] == m, n]) {#, triangularQ[#]} & /@ Range[2, 28] // TableForm reference: http://en.wikipedia.org/wiki/Triangular_number ...


5

Or how about the connection between even perfect numbers and Mersenne primes? With[{p = Prime[Range[20]]}, Pick[p, PrimeQ[2^p - 1]] /. q_ -> 2^(q - 1) (2^q - 1)]


5

!! WARNING !! Given the above circumstances the answer below is completely wrong and should not be replicated rather than used for guideline. The problem lies in the fact that Assumptions DON'T affect summation indices hence they are disregarded in the code below. You can evaluate the series using the following snippet: Sum[1/(k n (k + n)^2), {k, 1, ∞}, ...


5

If I understand correctly: f[n_] := 13 + Ceiling[n, 4]/2; f[Range[20]] {15, 15, 15, 15, 17, 17, 17, 17, 19, 19, 19, 19, 21, 21, 21, 21, 23, 23, 23, 23} More general approach: sample = {15, 15, 15, 15, 17, 17, 17, 17, 19, 19, 19, 19, 21, 21, 21, 21}; linrec = FindLinearRecurrence[sample] {1, 0, 0, 1, -1} f2[n_] := LinearRecurrence[linrec, ...


5

I can't complete with Artes's mathematical knowledge and approach, but simply as a point of reference, for formulating a brute-force approach it will be more memory efficient to use Sum, though it will still be very slow for large input. Sum[Boole @ PrimePowerQ @ i, {i, 5*^6}] // Timing MaxMemoryUsed[] {46.535, 348940} 15083688


5

Module[{n = 1, results}, While[(results = Sqrt[IntegerPartitions[#, {n}, Range@Floor@Sqrt[#]^2]]) == {}, n++]; results] &[999] (* {{31, 6, 1, 1}, {31, 5, 3, 2}, {30, 9, 3, 3}, {30, 7, 7, 1}, {30, 7, 5, 5}, {29, 11, 6, 1}, {29, 10, 7, 3}, {27, 15, 6, 3}, {27, 14, 7, 5}, {27, 13, 10, 1}, {27, 11, 10, 7}, {26, 17, 5, 3}, {26, 15, 7, 7}, ...


5

Shamelessly stealing, but using a built-in function Block[{n = 1, results}, While[(results = PowersRepresentations[#, n, 2]) == {}, n++]; results] &[999]


5

Since belisarius specifically refused to expound on his answer, which arguably would make my editing it for such purpose tantamount to vandalism, I shall post my own. Regarding RealDigits: For integers and rational numbers with terminating digit expansions, RealDigits[x] returns an ordinary list of digits. For rational numbers with non-terminating digit ...


5

There is an especially useful function HarmonicNumber appearing most likely the best approach in similar tasks since its implementation is optimized and it has close relations to number theoretic functions like the Riemann zeta function ζ represented in Mathematica by Zeta, basically HarmonicNumber tends to Zeta for Re[z] > 1 : Limit[ HarmonicNumber[n, ...



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