# Tag Info

## Hot answers tagged number-theory

47

If you want to make several sequences of the Collatz function for turning it into a graph, you probably want to memorize, which parts you already calculated. What we try to do is to create a graph like this (image from xkcd) When we would calculate the whole chain for each number until it (hopefully) reaches the end sequence 8,4,1 we do a lot of work over ...

28

This is the Collatz function I know: Collatz[1] := {1} Collatz[n_Integer] := Prepend[Collatz[3 n + 1], n] /; OddQ[n] && n > 0 Collatz[n_Integer] := Prepend[Collatz[n/2], n] /; EvenQ[n] && n > 0 Generating a graph from this is easy: Graph[(DirectedEdge @@@ Partition[Collatz[#], 2, 1]) & /@ Range[500] // Flatten // Union, ...

24

I can't take much credit for this answer--I hadn't even got version 10.2 installed until J. M. commented to me that these functions could be written efficiently in terms of the Hamming weight function. But, it is understandable that he doesn't want to write an answer using a smartphone. The definition of the built-in ThueMorse is: ThueMorse[n_Integer] := ...

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

18

As far as obtaining a True/False answer: Element[Sqrt[2], Rationals] (* False *)

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

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

11

It looks like you want to plot the phase-only information of a complex function. Using the following helper functions for plotting the phase-only information complex functions: hue = Compile[{{z, _Complex}}, {Mod[3 π/2 + Arg[z], 2 π]/(2 π), 1, If[Abs[z] > 10^-3, 1, 0]}, CompilationTarget -> "C", RuntimeAttributes -> {Listable}]; ...

11

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

10

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

10

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

10

A graph representation: opts = {VertexLabels -> "Name", ImagePadding -> 10}; g[n_] := Graph[Flatten[Thread[DirectedEdge[#, Most@Divisors@#]] & /@ Divisors@n], opts] aa = g[30] Then (v10 only, thanks to @billc for running it for me): fp = FindPath[aa, 30, 1, Infinity, All] (* {{30, 1}, {30, 15, 1}, {30, 10, 1}, {30, 6, 1}, {30, 5, 1}, ...

10

There are several problems with your code. The first one is that you are missing a couple of semicolons to suppress output and delineate substatements in a compound function. The second problem is that you are trying to assign a new value to x within the function definition. This doesn't work. x already has the value of whatever number you give. You need ...

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

9

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

9

I'll assume the title reflects the goal, as opposed to the example. If this is not the case, comment and I'll delete. distPrimePart[n_] := Module[{l = 1, p}, Join @@ Reap[While[(p =Prime@Range@(PrimePi@(n - Tr@Prime@Range@(l - 1)))) != {}, Sow[Select[IntegerPartitions[n, {l}, p], Length@# == Length@DeleteDuplicates@# &]]; l++]][[2, 1]]]; ...

9

Brute forcing it: (The edit at the end is a much faster alternative) n = 9; IntegerPartitions[n + 1, {3}] (* {{8, 1, 1}, {7, 2, 1}, {6, 3, 1}, {6, 2, 2}, {5, 4, 1}, {5, 3, 2}, {4, 4, 2}, {4, 3, 3}}*) are the ways to split ten digits. The numbers on the first row can't produce viable sums, so we need to check only the partitions on the bottom row. ...

8

(* 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]] ... 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 ... 8 Never use pattern matching unless you absolutely have to. Using Cases instead of Select can make a huge difference. Vectorize operations. Use Range instead of Table if you can. Test several things at once. And[test1, test2, test3] will abort when it can for maximum efficiency ("short circuit evaluation"). Taking this into consideration your code looks ... 8 You're setting x as a side-effect and that (I believe) makes your code difficult to follow. This one is equivalent using a "more functional" programing style. As @Guesswhoitis suggested, NestList[] is your friend. a[n_] := 3 n - (5 + (-1)^n)/2 b[m_] := IntegerExponent[m, 2] nextSeq[n_] := (#/2^b@#) &[1 + 3 n] full[j_] := NestList[nextSeq, a@j, b[a@j ... 8 Not very efficient, but you may find it useful for some experiments. I perused the code from the link you provided (kuba's), although there are better alternatives in the answers. ClearAll[spiral, genTri, mp]; spiral[n_?OddQ] := Nest[ With[{d = Length@#, l = #[[-1, -1]]}, Composition[ Insert[#, l + 3 d + 2 + Range[d + 2], -1] &, ... 8 As this is a special-functions question, I feel justified in using a bit of heavy artillery. Here goes nothing... In effect, what the OP seems to want to do is to evaluate $$\sum_{n=1}^\infty \frac{(q^{n+1};q)_\infty}{(q^n;q)_\infty} q^{n-1}$$ (where$(a;q)_n$is the$q$-Pochhammer symbol) by approximating it with its partial sums. However, there is a ... 7 Here's another perspective for you. cf[x_] := ColorData[{"DeepSeaColors", {2, 0}}][Mod[Sqrt[8 x + 1] + 1, 2]]; Graphics[{PointSize[Small], cf[#], Point[ulamCoords[#]]} & /@ Range[1024], Background -> Black] This color function allows us to (visually) trace "triangularity level curves" of a sort, where the brightest points are triangular ... 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 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 = ... 6 Select[ NestWhileList[NextPrime, 100, # < 9999 &], And @@ PrimeQ[FromDigits[Permutations[IntegerDigits[#]]]] & ] {113, 131, 199, 311, 337, 373, 733, 919, 991} 6 With modest preprocessing we get a factor of 9 or so for large inputs just by chunking into 12 bit pieces and using a compiled lookup function. m = 12; Timing[tmLookup = Table[Mod[Total[IntegerDigits[j, 2]], 2], {j, 0, 2^m - 1}];] (* Out[49]= {0.00157, Null} *) Some of the option settings are probably overkill. tmLookupCSmall = With[{tmtable = ... 6 This works for all numbers which are not multiples of$\text{lcm}(1, \dots, 20) = 232792560$: smallest[n_] := LengthWhile[Range[3, 20], Divisible[n, #] &] + 3 If you use$50$instead of$20$, you get$3099044504245996706400\$ as the forbidden number, which might be more acceptable to you. You could compile this to get something which might be faster. ...

6

You made a few mistakes. jk[0] should be 0 in your code and your function tr is wrong. Corrected version: t[0] = 0; t[1] = 0; t[2] = 1; t[n_] := t[n] = LengthWhile[Range[1, 11], Divisible[n, #1] &] + 1 Sum[Nest[t, m, 3], {m, 1, 2006}] 1171 10x faster version: t[n_] := t[n] = Module[{i = 1}, While[MemberQ[Divisors[n], i], i++]; i];

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