A mysterious sequence of 1s and 2s

James Tanton (@jamestanton ) asked the folllowing question on Twitter, Wednesday, August 8, 2018

Which N have a factor k<N so that N and k have the same number of 1s in binary? (Each power of two: Yes. Each odd prime: No.)

To investigate this computationally (in the absence of any other thoughts) I defined a function, TantonQ, in Mathematica that would tell me if an integer was one of those sought by James’ question:

TantonQ[n_] := Length[Cases[IntegerDigits[Divisors[n], 2], L_ /; Count[L, 1] == Count[IntegerDigits[n, 2], 1]]] > 1 

This just takes all the base 2 representations of the divisors of an integer n, and selects those with the same number of 1s as in the base 2 representation of n. Of course there’s always at least one of these, coming from n itself, so n is of the type to fulfill James’ criterion if, and only if, there at least two such.

With this function in hand we can select from the first 500 integers, for example, those for which TantonQ is true:

T = Cases[Range[500], n_ /; TantonQ[n]]

with the result

{2, 4, 6, 8, 9, 10, 12, 14, 16, 18, 20, 21, 22, 24, 26, 28, 30, 32, 33, 34, 35, 36, 38, 40, 42, 44, 45, 46, 48, 49, 50, 52, 54, 56, 58, 60, 62, 64, 65, 66, 68, 70, 72, 74, 75, 76, 78, 80, 82, 84, 86, 88, 90, 92, 93, 94, 96, 98, 100, 102, 104, 105, 106, 108, 110, 112, 114, 116, 118, 120, 122, 124, 126, 128, 129, 130, 132, 133, 134, 135, 136, 138, 140, 142, 144, 146, 148, 150, 152, 153, 154, 155, 156, 158, 160, 161, 162, 164, 165, 166, 168, 170, 172, 174, 176, 178, 180, 182, 184, 186, 188, 189, 190, 192, 194, 195, 196, 198, 200, 202, 204, 206, 208, 210, 212, 214, 216, 217, 218, 220, 222, 224, 225, 226, 228, 230, 232, 234, 236, 238, 240, 242, 244, 246, 248, 250, 252, 254, 256, 258, 259, 260, 262, 264, 266, 267, 268, 270, 272, 273, 274, 276, 278, 279, 280, 282, 284, 286, 288, 290, 292, 294, 295, 296, 297, 298, 300, 302, 304, 306, 308, 309, 310, 312, 314, 315, 316, 318, 320, 322, 324, 326, 327, 328, 330, 332, 334, 336, 338, 340, 341, 342, 344, 345, 346, 348, 350, 352, 354, 356, 358, 360, 362, 364, 366, 368, 370, 372, 374, 376, 378, 380, 381, 382, 384, 385, 386, 387, 388, 390, 392, 394, 395, 396, 398, 400, 402, 403, 404, 406, 408, 410, 412, 414, 416, 417, 418, 420, 422, 424, 426, 428, 430, 432, 434, 436, 438, 440, 441, 442, 444, 446, 448, 450, 452, 453, 454, 456, 458, 460, 462, 464, 465, 466, 468, 470, 472, 474, 476, 478, 480, 482, 484, 486, 488, 490, 492, 494, 496, 498, 500}

This sequence of numbers is not – at the time of writing – in the Online Encyclopedia of Integer Sequences (OEIS).

A cursory glance indicates that these numbers jump about by 1s and 2s: each integer in the list, beyond the first, is either 1 or 2 greater then the integer before it.

To check this we can form a list of successive differences:

diffs = T[[2 ;; -1]] – T[[1 ;; -2]]

with the result

{2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 1, 1, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 1, 1, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 2, 2, 2, 2, 2, 1, 1, 2, 2, 1, 1, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 1, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 1, 1, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2}

and – as we would expect – this sequence is also not in OEIS.

A plot of the sequence of 2s and 1s shows no obvious pattern in their arrangement:

 

Thinking that the running means of the sequence of 2s and 1s might converge I plotted the running mean, increasing n from 500 to 10,000:

N[Table[Mean[diffs[[1 ;; k]]], {k, 1, Length[diffs]}]];
ListPlot[%]

Not much indication of convergence there!

In summary, the numbers James Tanton seeks in his question can be obtained by starting with 2 and successively adding the terms of the sequence of 2s and 1s, above.

But to date, I have no real idea of the behavior of this sequence of 2s and 1s.

Postscript

August 9, 2018

What about runs of 2s and 1s? How long can runs be?

Pushing n to 10,000,000 we can calculate the values of the number of runs of 2s and 1s:

T = Cases[Range[10000000], n_ /; TantonQ[n]];
diffs = T[[2 ;; -1]] – T[[1 ;; -2]];
S = Split[diffs];
CountRunsOnes = Map[Length, Cases[S, L_ /; MemberQ[L, 1]]];
CountRunsTwos = Map[Length, Cases[S, L_ /; MemberQ[L, 2]]];
Union[CountRunsOnes]
Union[CountRunsTwos]

with the result:

{2, 4, 6, 8, 10, 12, 14, 16, 18, 20, 22}

{1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 139, 141, 142, 143, 144, 145, 146, 149, 151, 153, 154, 155, 156, 158, 159, 160, 161, 162, 163, 164, 167, 169, 171, 173, 174, 175, 179, 183, 185, 187, 188, 190, 191, 192, 193, 194, 195, 201, 204, 207, 215, 217, 219, 221, 223, 224, 225, 227, 232, 240, 243, 247, 249, 251, 252, 253, 254, 255, 256, 257, 258, 261, 265, 287, 289, 290, 293, 295, 303, 309, 316, 319, 338, 349, 351, 367, 379, 381, 382, 383, 384, 399, 403, 412, 413, 415, 421, 431, 449, 507, 509, 515, 539, 557, 560, 575, 751, 759, 891, 951, 981, 1403, 1887, 2047}

so, to hazard a guess, I would imagine:

• the runs of 1s have even length, and there are runs of 1s of any given even length;
• there are runs of 2s of any given length.

How often do 1s and 2s appear in the list of differences?

Print[“1s occur about “, N[Count[diffs, 1]/Length[diffs], 3]*100, “% of the time”]
Print[“2s occur about “, N[Count[diffs, 2]/Length[diffs], 3]*100, “% of the time”]

1s occur about 34.7% of the time
2s occur about 65.3% of the time

So, an approximate ratio of 2:1 in favor of the 2s.