Tag Info

Hot answers tagged

21

PrimeQ and FactorInteger use different algorithms. In general asking whether a number is prime is an easier problem than finding its factors. To quote the documentation, "PrimeQ first tests for divisibility using small primes, then uses the Miller–Rabin strong pseudoprime test base 2 and base 3, and then uses a Lucas test", while "FactorInteger switches ...


19

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


17

I want to answer the part of the question, "How could my son be expected to find a prime factor?" Well, this depends on what your son has been taught, of course. A first thing to notice is that, since 99! is divisible by every prime less than 99, 99! - 1 is not divisible by any of those primes; so 101 is the smallest prime which could be a factor of it. So ...


16

As far as obtaining a True/False answer: In[11]:= Element[Sqrt[2], Rationals] Out[11]= False


15

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


15

Let us try to produce the solution without applying brute force, similar to mgamer's answer (that did not actually use Mathematica). Reduce[Mod[10^r - 1, 37] == 0, r, Integers] (* -> C[1] \[Element] Integers && C[1] >= 0 && r == 3 C[1] *) We see that the value of r can in fact be any nonnegative multiple of 3. The result sought is ...


13

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


12

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


10

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


10

You are asking for a solution to the equation $10^r\equiv 1$, mod $n$, where in your particular case $n=37$. The multiplicative order is the smallest exponent $r$ such that $x^r\equiv 1$, mod $n$. The multiplicative order is given by the Mathematica command MultiplicativeOrder[x,n], and corresponds to the "Foo" you asked for in your comment to @mgamer. ...


9

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


9

Find the first positive integer that satisfies the condition: NestWhile[# + 1 &, 1, ! Element[(10^# - 1)/37, Integers] &] 3 Or r = 0; NestWhile[Element[(10^(++r) - 1)/37, Integers] &, False, Not]; r 3 Or Block[{r = 1}, While[! Element[(10^r++ - 1)/37, Integers]]; r - 1] 3


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


8

In a nutshell, factoring integers is a harder problem than determining primality. This seeming asymmetry is exploited as a component in modern computer security systems (in the form of the RSA cryptosystem). Determining primality has long been known to be doable in polynomial time using a variety of probabilistic algorithms, many of which (as mentioned by ...


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


7

This is quite good: f[d_, n_] := With[{x = Pick[d, Thread[Accumulate[d] - n < 0]]}, Scan[f[x, n - Total[#]] &, Subsets[Complement[d, x], {1, Infinity}]]] f[_, 0] := Throw @ True; weird[n_] := (DivisorSigma[1, n] > 2 n) && ! TrueQ @ Catch @ f[Most @ Divisors[n], n] Select[Range[10000], weird] // AbsoluteTiming (* {1.450002, {70, 836, ...


7

(* Input: Range of even numbers --- Output: Primitive weird numbers *) Block[{$RecursionLimit=Infinity}, subOfSum[ss_, kk_, rr_]:= Module[{s=ss, k=kk, r=rr}, If[ s+w[[k]] >=mm && s +w[[k]] <=m, t=False; Goto[ done](*Found*), If[s +w[[k]]+w[[k +1]] <=m, subOfSum[s +w[[k]], k+1, r-w[[k]]]]; If[s+r -w[[k]] ...


6

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


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


6

Instead of a brute-force approach on larger and larger powers of ten, this constructs the multiplier digit by digit by dividing from the bottom up. There is only one choice for each digit. This is much faster than the brute-force approach when the number of digits is large. nines[n_ /; n > 2 && OddQ[n] && ! Divisible[n, 5]] := ...


6

There is a simpler function instead of GCD that allows you to skip the comparison with 1: CoprimeQ. Using it, we can do this: Z[n_] := With[{i = Range[n]}, Pick[i, CoprimeQ[i, n]]] Z[21] (* ==> {1, 2, 4, 5, 8, 10, 11, 13, 16, 17, 19, 20} *) Here I deliberately tried to avoid any cryptic symbols (although perhaps that should be par for the course in a ...


6

How about FullSimplify[ Exists[{a, b}, Element[a, Integers] && Element[b, Integers] && ! MemberQ[Divisors[b], a] && a^2/b^2 == 2]] (* False *)


5

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


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

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

SumFact[n_: Integer] := Apply[Plus, Map[#[[1]] #[[2]] &, FactorInteger[n]]]; A = {}; lastFac = SumFact[10^7 - 1]; Do[ If[(z = SumFact[n]) == lastFac, AppendTo[A, n]]; lastFac = z, {n, 10^7 + 1, 10^8, 2}]; A This took about 15 minutes on my MacPro and gave 417 candidates. There should be no problem parallelizing this code and getting up to n = ...



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