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


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

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


9

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


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

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

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


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

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

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

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


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

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

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


4

I am late to the party here and just for terseness: f[x_] := {#, x/#} & @@ Nearest[Divisors[x], Sqrt[x]] So: f /@ Range[10, 98, 2] yields: {{2, 5}, {3, 4}, {2, 7}, {4, 4}, {3, 6}, {4, 5}, {2, 11}, {4, 6}, {2, 13}, {4, 7}, {5, 6}, {4, 8}, {2, 17}, {6, 6}, {2, 19}, {5, 8}, {6, 7}, {4, 11}, {2, 23}, {6, 8}, {5, 10}, {4, 13}, {6, 9}, {7, 8}, {2, ...


4

Here is another approach (based on $t_n=\frac{n(n+1)}{2}$): fn[x_] := Mod[Sqrt[1 + 8 x], 2] == 1 For the test example fn[3003] is true: Just for fun (but factoring extremely large numbers an issue): an[x_?(# > 0 &)] := Abs[# - 2 x/#] & @@ Nearest[Divisors[ 2 x], Sqrt[2 x]] == 1 an[0] := True Just for illustration (and not proof but are ...


4

The best analytic built-in approximation is the Riemann Prime Counting Function; it is implemented in Mathematica as RiemannR. So far we know exact values of $\pi$ prime counting function for n < 10^25, however in Mathematica its counterpart PrimePi[n] can be computed exactly to much lower values i.e. up to 25 10^13 -1, see e.g. What is so special about ...


4

Mathematical operations on numbers of a given precision cannot guarantee the output to maintain the precision of the input numbers. In general precision will decrease. The amount of decrease depends on the operations and some operations will cause precision to decrease significantly. If you want a specific precision on the final result then the working ...


4

This is not particularly fast but works: f = (-1 + Sqrt[3 + 6 #^2])/2 &; q = IntegerQ /@ (f /@ Range[1000000]); answer = Pick[Range[1000000], q] yields the triples : {1, 11, 109, 1079, 10681, 105731} fanswer = f /@ answer {1, 13, 133, 1321, 13081, 129493} Dropping first case which is 0^2+1^2+2^2=1^2+2^2: trip = Rest[{(# - 1), #, # + 1} & /@ ...


4

Edit: Since now even I have understood the reasoning of the elf requiring more information because after measuring the tree the solution is not unique, I can give a full implementation too. When n is the magical number 2450, then we can create all possibilities with Union[Sort /@ Select[Tuples[Divisors[n], {3}], Times @@ # === n &]] Now, what's ...



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