A266089 Lexicographically smallest permutation of natural numbers such that in binary representation the number of ones of adjacent terms differ exactly by one.
0, 1, 3, 2, 5, 4, 6, 7, 9, 8, 10, 11, 12, 13, 15, 14, 17, 16, 18, 19, 20, 21, 23, 22, 24, 25, 27, 26, 29, 28, 30, 31, 39, 35, 33, 32, 34, 37, 36, 38, 40, 41, 43, 42, 45, 44, 46, 47, 51, 49, 48, 50, 53, 52, 54, 55, 57, 56, 58, 59, 60, 61, 63, 62, 71, 67, 65
Offset: 0
Examples
. n | a(n) | A007088(a(n)) | A266161(n) . ----+-------+---------------+------------ . 0 | 0 | 0 | 0 . 1 | 1 | 1 | 1 . 2 | 3 | 11 | 2 . 3 | 2 | 10 | 1 . 4 | 5 | 101 | 2 . 5 | 4 | 100 | 1 . 6 | 6 | 110 | 2 . 7 | 7 | 111 | 3 . 8 | 9 | 1001 | 2 . 9 | 8 | 1000 | 1 . 10 | 10 | 1010 | 2 . 11 | 11 | 1011 | 3 . 12 | 12 | 1100 | 2 . 13 | 13 | 1101 | 3 . 14 | 15 | 1111 | 4 . 15 | 14 | 1110 | 3 . 16 | 17 | 10001 | 2 .
Links
Programs
-
Haskell
import Data.List (delete) a266089 n = a266089_list !! n a266089_list = 0 : f 0 (zip [1..] $ tail a000120_list) where f x zws = g zws where g (yw@(y, w) : yws) | abs (x - w) /= 1 = g yws | otherwise = y : f w (delete yw zws) -
Mathematica
a[0] = 0; a[n_] := a[n] = Module[{bw = DigitCount[a[n - 1], 2, 1], k = 1}, While[!FreeQ[Array[a, n - 1], k] || Abs[DigitCount[k, 2, 1] - bw] != 1, k++]; k]; Array[a, 100, 0] (* Amiram Eldar, Jul 18 2023 *)