A355857 The smallest number in A355852 whose binary value shares n out of n+1 bits with the concatenation of the binary values of its divisors' product.
39, 78, 156, 312, 539, 1053, 2106, 4212, 8299, 16598, 32889, 65778, 131499, 262605, 525210, 1049073, 2098146, 4196292, 8392584, 16785168, 33556449, 67112898, 134225465, 268450930
Offset: 5
Examples
a(5) = 39 as 39 = 100111_2 = 13 * 3 = 1101_2 * 11_2, and "100111" has five bits out of six in common with "110111". a(7) = 156 as 156 = 10011100_2 = 13 * 12 = 1101_2 * 1100_2, and "10011100" has seven bits out of eight in common with "11011100". a(10) = 1053 as 1053 = 10000011101_2 = 81 * 13 = 1010001_2 * 1101_2, and "10000011101" has ten bits out of eleven in common with "10100011101". Table showing a(n) in binary, replacing 0's with "." to accentuate the pattern of 1's: Binary Decimal 1..111 = 39 1..111. = 78 1..111.. = 156 1..111... = 312 1....11.11 = 539 1.....111.1 = 1053 1.....111.1. = 2106 1.....111.1.. = 4212 1......11.1.11 = 8299 1......11.1.11. = 16598 1........1111..1 = 32889 1........1111..1. = 65778 1........11.1.1.11 = 131499 1.........111..11.1 = 262605 1.........111..11.1. = 525210 1...........11111...1 = 1049073 1...........11111...1. = 2098146 1...........11111...1.. = 4196292 1...........11111...1... = 8392584 1...........11111...1.... = 16785168 1..............111111....1 = 33556449 1..............111111....1. = 67112898 1..............1111...111..1 = 134225465 1..............1111...111..1. = 268450930 ...
Programs
-
Mathematica
s = Select[Range[2^16], Function[{m, d}, 0 < Count[Map[Join @@ IntegerDigits[{##}, 2] & @@ {#, m/#} &, Divisors[m]], ?(Length[#] == Length[d] && Total[BitXor @@ {#, d}] == 1 &)]] @@ {#, IntegerDigits[#, 2]} &]; t = Array[Function[{m, d, k}, Length[#] - FirstPosition[#, 1][[1]] & /@ Select[Map[BitXor @@ {#, d} &, Select[Map[Apply[Join, IntegerDigits[{#, m/#}, 2]] &, Most@ Rest@ Divisors[#1]], Length[#] == k &]], Total@ # == 1 &]] @@ {#1, #2, Length[#2]} & @@ {#, IntegerDigits[#, 2]} &@ s[[#]] &, Length[s]][[All, 1]]; Map[s[[FirstPosition[t, #][[1]]]] &, Union@ FoldList[Max, t]] (* _Michael De Vlieger, Jul 22 2022 *)
Comments