A076478 The binary Champernowne sequence: concatenate binary vectors of lengths 1, 2, 3, ... in numerical order.
0, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1, 1, 0, 0, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0
Offset: 0
Examples
0, 1, 0,0, 0,1, 1,0, 1,1, 0,0,0, 0,0,1, 0,1,0, 0,1,1, 1,0,0, 1,0,1, ...
References
- Bodil Branner, Dynamics, Chap. IV.14 of The Princeton Companion to Mathematics, ed. T. Gowers, p. 499.
- K. Dajani and C. Kraaikamp, Ergodic Theory of Numbers, Math. Assoc. America, 2002, p. 72.
Links
- Reinhard Zumkeller, Table of n, a(n) for n = 0..10000
- Michael Barnsley and Andrew Vince, Self-similar polygonal tiling, The American Mathematical Monthly 124.10 (2017): 905-921. See page 917.
- Igor Pak, Complexity problems in enumerative combinatorics, arXiv:1803.06636 [math.CO], 2018.
Programs
-
Haskell
import Data.List (unfoldr) a076478 n = a076478_list !! n a076478_list = concat $ tail $ map (tail . reverse . unfoldr (\x -> if x == 0 then Nothing else Just $ swap $ divMod x 2 )) [1..] -- Reinhard Zumkeller, Feb 08 2012
-
Haskell
a076478_row n = a076478_tabf !! n :: [[Int]] a076478_tabf = tail $ iterate (\bs -> map (0 :) bs ++ map (1 :) bs) [[]] a076478_list' = concat $ concat a076478_tabf -- Reinhard Zumkeller, Aug 18 2015
-
Mathematica
d[n_] := Rest@IntegerDigits[n + 1, 2] + 1; -1 + Flatten[Array[d, 50]] (* Clark Kimberling, Feb 07 2012 *) z = 1000; t1 = Table[Tuples[{0, 1}, n], {n, 1, 10}]; "All binary words, lexicographic order:" tt = Flatten[t1, 1]; (* all binary words, lexicographic order *) "All binary words, flattened:" Flatten[tt]; w[n_] := tt[[n]]; "List tt of all binary words:" tt = Table[w[n], {n, 1, z}]; (* all the binary words *) u1 = Flatten[tt]; (* words, concatenated, A076478, binary Champernowne sequence *) u2 = Map[Length, tt]; "Positions of 0^n:" Flatten[Position[Map[Union, tt], {0}]] "Positions of 1^n:" Flatten[Position[Map[Union, tt], {1}]] "Positions of words in which #0's = #1's:" (* A258410 *) "This and the next two sequences partition N." u3 = Select[Range[Length[tt]], Count[tt[[#]], 0] == Count[tt[[#]], 1] &] "Positions of words in which #0's < #1's:" (* A346299 *) u4 = Select[Range[Length[tt]], Count[tt[[#]], 0] < Count[tt[[#]], 1] &] "Positions of words in which #0's > #1's:" (* A346300 *) u5 = Select[Range[Length[tt]], Count[tt[[#]], 0] > Count[tt[[#]], 1] &] "Positions of words ending with 0:" (* A005498 *) u6 = Select[Range[Length[tt]], Last[tt[[#]]] == 0 &] "Positions of words ending with 1:" (* A005843 *) u7 = Select[Range[Length[tt]], Last[tt[[#]]] == 1 &] "Positions of words starting and ending with same digit:" (* A346301 *) u8 = Select[Range[Length[tt]], First[tt[[#]]] == Last[tt[[#]]] &] "Positions of words starting and ending with opposite digits:" (* A346302 *) u9 = Select[Range[Length[tt]], First[tt[[#]]] != Last[tt[[#]]] &] "Positions of words starting with 0 and ending with 0:" (* A346303 *) "This and the next three sequences partition N." u10 = Select[Range[Length[tt]], First[tt[[#]]] == 0 && Last[tt[[#]]] == 0 &] "Positions of words starting with 0 and ending with 1:" (* A171757 *) u11 = Select[Range[Length[tt]], First[tt[[#]]] == 0 && Last[tt[[#]]] == 1 &] "Positions of words starting with 1 and ending with 0:" (* A346304 *) u12 = Select[Range[Length[tt]], First[tt[[#]]] == 1 && Last[tt[[#]]] == 0 &] "Positions of words starting with 1 and ending with 1:" (* A346305 *) u13 = Select[Range[Length[tt]], First[tt[[#]]] == 1 && Last[tt[[#]]] == 1 &] "Position of n-th positive integer (base 2) in tt:" d[n_] := If[First[w[n]] == 1, FromDigits[w[n], 2]]; u14 = Flatten[Table[Position[Table[d[n], {n, 1, 200}], n], {n, 1, 200}]] (* A206332 *) "Position of binary complement of w(n):" u15 = comp = Flatten[Table[Position[tt, 1 - w[n]], {n, 1, 50}]] (* A346306 *) "Sum of digits of w(n):" u16 = Table[Total[w[n]], {n, 1, 100}] (* A048881 *) "Number of runs in w(n):" u17 = Map[Length, Table[Map[Length, Split[w[n]]], {n, 1, 100}]] (* A346307 *) "Palindromes:" Select[tt, # == Reverse[#] &] "Positions of palindromes:" u18 = Select[Range[Length[tt]], tt[[#]] == Reverse[tt[[#]]] &] (* A346308 *) "Positions of words in which #0's - #1's is odd:" u19 = Select[Range[Length[tt]], OddQ[Count[w[#], 0] - Count[w[#], 1]] &] (* A346309 *) "Positions of words in which #0's - #1's is even:" u20 = Select[Range[Length[tt]], EvenQ[Count[w[#], 0] - Count[w[#], 1]] &] (* A346310 *) "Position of the reversal of the n-th word:" (* A081241 *) u21 = Flatten[Table[Position[tt, Reverse[w[n]]], {n, 1, 150}]] (* Clark Kimberling, Jul 18 2011 *)
-
PARI
{m=5; for(d=1,m, for(k=0,2^d-1,v=binary(k); while(matsize(v)[2] -
PARI
listn(n)= my(a=List(), i=0, s=0); while(s<=n, listput(~a, binary(i++)[^1]); s+=#a[#a]); concat(a)[1..n+1]; \\ Ruud H.G. van Tol, Mar 17 2025
-
Python
from itertools import count, product def agen(): for digits in count(1): for b in product([0, 1], repeat=digits): yield from b g = agen() print([next(g) for n in range(105)]) # Michael S. Branicky, Jul 18 2021
Formula
To get the m-th binary vector, write m+1 in base 2 and remove the initial 1. - Clark Kimberling, Feb 07 2010
Extensions
Extended by Klaus Brockhaus, Nov 11 2002
Comments