Tag Info

Hot answers tagged

29

If not assumed otherwise m and n can be whatever, so you can do e.g. this : Solve[ Prime[n] + Prime[m] == 100, {n, m}, Integers] {{n -> 2, m -> 25}, {n -> 5, m -> 24}, {n -> 7, m -> 23}, {n -> 10, m -> 20}, {n -> 13, m -> 17}, {n -> 15, m -> 16}, {n -> 16, m -> 15}, {n -> 17, m -> 13}, {n -> 20, m ...


20

This answer should be read upside down, since the last edit has the fastest, neatest and shortest answer Module[{$guard = True}, happyQ[i_] /; $guard := Block[{$guard = False, appeared}, appeared[_] = False; happyQ[i] ] ] e : happyQ[_?appeared] := e = False; happyQ[1] = True; e : happyQ[i_] := e = (appeared[i] = True; ...


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


14

I believe this is correct, and very fast: fn[x_Integer, n_Integer] := Complement[Range @ x, Join @@ Range[#, x, #]] & @ Prime @ Range @ n Test: fn[10000, 1223] {1, 9929, 9931, 9941, 9949, 9967, 9973} It seems I am a bit late to return to this problem and Simon Woods already provided a memory optimized approach. His sieve is comparatively ...


14

This is competitive with Mr Wizards code and seems faster in some cases: fn2[x_Integer, n_Integer] := Module[{y = Range @ x}, (y[[# ;; x ;; #]] = 0) & /@ Prime[Range @ Min[n, PrimePi @ x]]; SparseArray[y]["NonzeroValues"]] AbsoluteTiming[fn[10000, 1223];] (* {0.004000, Null} *) AbsoluteTiming[fn2[10000, 1223];] (* {0.010001, Null} *) ...


12

This probably counts as cheating, since it uses the fact that all unhappy numbers end up in a cycle including 4. But I like it for simplicity... happyQ[1]=True; happyQ[4]=False; happyQ[n_]:=happyQ[n]=happyQ[#.#&@IntegerDigits[n]] This works with Leonid's happyPrimeN function.


12

Simple top-level solution Here is a simplistic completely top-level code: ClearAll[happyQ]; happyQ[n_] := Block[{appeared}, appeared[_] = False; Take[ NestWhileList[ Total[IntegerDigits[#]^2] &, n, (! appeared[#] && (appeared[#] = True)) & ], -2] == {1, 1}]; Clear[happyPrimeN]; ...


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

I prefer Bold and Larger in Style: Animate[ Grid[ Partition[ Table[ Style[i, Bold, Larger, If[i > j, Black, If[ PrimeQ @ i, Blue, Gray]]], {i, 100}], 10], Spacings -> {1, 1}], {j, 0, 100}, Paneled -> False] but if you like delete from ...


10

Clear[happyPrimeN]; happyPrimeN[2000] = 137653; happyPrimeN[2000] // AbsoluteTiming {0., 137653} But seriously, here's a memoised, recursive happyQ that can be used with Leonid's happyPrimeN Clear[sos, happyQ]; sos[k_Integer] := sos[k] = #.# &[IntegerDigits[k]]; happyQ[k_Integer] := happyQ[k] = happyQ[k, {}]; happyQ[1, history_List] := True; ...


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

Here's my take: (* Brent's algorithm for cycle detection *) happyQ[start_Integer] := Module[{cyc, f, hare, pow, tortoise}, f = Total[IntegerDigits[#]^2] &; cyc = pow = 1; tortoise = start; hare = f[start]; While[tortoise =!= hare, If[pow == cyc, tortoise = hare; pow *= 2; cyc = 0;]; ...


9

You can do : Reduce[Prime[n] + Prime[m] == 100, {n, m}, Integers]


8

Artes's answer is just fine. This variation works as follows. When you click on a number, the background of that number turns yellow and that of each of its divisors turns light blue. DynamicModule[{s = 101}, Grid[Partition[Dynamic@Button[Style[#, 16], (s = #), Background -> Which[ # == s, Yellow, Divisible[s, #], LightBlue, True, White], Appearance ...


8

Might be faster to do batches by checking for nontrivial gcds. Below I group 100 primes into each batch, take their products, and do a gcd computation until finding that there is a divisor. The example sieves a million primes. random = RandomPrime[10^1000]; list = Table[k random + 1, {k, 1, 2000}]; pprods = Apply[Times, Partition[Prime[Range[10^6]], 10^3], ...


8

Here is my method (not sure it counts): happyPrimeN = Import["http://oeis.org/A035497/b035497.txt", "table"][[#, 2]] & happyPrimeN[2000] // AbsoluteTiming Out[14]= {0.7490428, 137653}


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


7

initial side note: As J.M. correctly points out this is not an efficient implementation and serves only to illustrate behavior similar to the Python function all. If you are looking for a similar definition to the Python code you give, then you could use this: isPrime[n_] := And @@ Table[Mod[n, i] != 0, {i, Range[2, n - 1]}] This creates a table of ...


7

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


7

Try to use lowercase names at least for the initial letter of your functions. My timings are different than yours. Probably your computer is much faster than mine. In your code pro is calculated in 144 seconds and GCD[func[160001],pro] needs another 34 seconds so a total of 178 seconds. Of course pro is calculated only once but the same happens in the ...


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

From Some Notes On Internal Implementation: Prime and PrimePi use sparse caching and sieving. For large $n$, the Lagarias-Miller-Odlyzko algorithm for PrimePi is used, based on asymptotic estimates of the density of primes, and is inverted to give Prime.


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

What I really wanted to post was an alternative way of generating the grid. In my humble opinion, it's better to do it with Table without Partition as it looks better in code. But since Animate has already been dealt with, three times over, let me also use an alternative method for that: color[n_] := Style[n, Which[100 Clock[1, 10] < n, Black, PrimeQ@n, ...


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


5

Starting with a styling funtion: st = Style[#, If[PrimeQ@#, {Bold, Blue}, Gray]] &; For fast operations and small tables you can use MapAt: Animate[ MapAt[st, Range@100, List /@ Range@i] ~Partition~ 10 // Grid, {i, 0, 100, 1} ] In version 9 you can use Span for better performance: Animate[ MapAt[st, Range@100, ;; i] ~Partition~ 10 // Grid, {i, ...


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

Divisible is Listable, so a slight speedup (about a factor of 3) can be gained using something like: result = Fold[Pick[#, Divisible[#, #2], False] &, list, Prime@Range@200000]


5

a short functional style solution: HappyQ[n_Integer?Positive] := NestWhile[ Total[IntegerDigits[#]^2] &, n, Unequal, All ] == 1 NextHappyPrime[n_Integer?Positive] := NestWhile[ NextPrime, NextPrime[n], Composition[Not, HappyQ] ] HappyPrimeN[n_Integer?Positive] := Nest[NextHappyPrime, 7, n - 1] HappyPrimeN[2000]



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