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

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


13

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


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


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


11

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


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


9

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


9

Clear[fa, ga]; fa = Total[{#, # + 1}^2] &; ga = Total[{#, # + 1, # + 2}^2] &; Update: A closed form function soln = Assuming[{C[1] ∈ Integers && C[1] >= 0 && x > 0 && y > 0}, Simplify@ Reduce[Total[{x, x + 1}^2] == Total[{y, y + 1, y + 2}^2], {x, y}, Integers]] /. C[1] -> n; ...


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

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


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

A nice trick to force Mathematica to use a given precision is to use Block and make $MinPrecision equal to $MaxPrecision. So you can write your result1 as: Block[{$MinPrecision = 10, $MaxPrecision = 10}, FixedPointList[N[1/2 Sqrt[10 - #^3] &, 10], 1.5`10]] {1.500000000, 1.286953768, 1.402540804, 1.345458374, 1.375170253, 1.360094193, ...


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

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


6

Mathematica is using an exhaustive search for your first example, testing each value of n from 2 to 2^10. By default it won't use this method if the number of test cases exceeds 10000. So in your second example it cannot resolve the Exists expression and returns it unchanged. You can increase the maximum number of points for the exhaustive search using ...


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

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

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


4

Late again, but ... In addition toPrimePowerQ, the built-inMangoldtLambda[n]also works as in n - Count[MangoldtLambda[Range[n]], 0] where n is the upper limit. However, these functions are both too slow. The answer by @Artes usesPrimePieffectively for much faster results. A cool method given by Riemann himself is to usePrimePion fractional powers of the ...


4

<< Combinatorica` SetPartitions[{a, b, c, d}] ru = Thread[{a, b, c, d} -> {2, 3, 5, 7}] Apply[Times, SetPartitions[{a, b, c, d}] /. ru, {2}] should do what you asked.


4

SetAttributes[cubeFreeQ, Listable] cubeFreeQ[n_Integer] := Max@FactorInteger[n][[All, 2]] < 3 seems straightforward To find all the cube-free numbers in the first 1000 integers, do Select[Range[1000], cubeFreeQ]


4

I'll assume the definition of "two largest" is defined by your example results since you don't define this explicitly. This is a bit faster if you're after a large range of results. f = (ArrayPad[#, -Ceiling[(Length@#)/2 - 1]] /. {x_} :> {x, x}) &@Divisors[#] & f /@ {10, 12, 16, 52, 60, 66, 70, 72, 98} {{2, 5}, {3, 4}, {4, 4}, {4, 13}, {6, ...



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