login
Concatenation of all 01-words, in the order induced by A016777; see Comments.
22

%I #10 Mar 23 2021 16:20:36

%S 0,1,1,0,0,0,1,1,1,1,0,0,1,1,0,0,1,1,1,0,1,0,1,1,1,0,1,0,1,0,0,0,1,1,

%T 0,0,1,1,1,1,0,1,1,1,0,1,0,1,1,1,1,0,0,1,1,0,1,1,0,1,1,0,0,0,0,0,1,1,

%U 1,1,0,0,1,1,1,1,1,0,1,0,0,1,0,1,1,1

%N Concatenation of all 01-words, in the order induced by A016777; see Comments.

%C Let s = (s(n)) be a strictly increasing sequence of positive integers with infinite complement, t = (t(n)).

%C For n >= 1, let s'(n) be the number of s(i) that are <= n-1 and let t'(n) be the number of t(i) that are <= n-1.

%C Define w(1) = 0, w(t(1)) = 1, and w(n) = 0w(s'(n)) if n is in s, and w(n) = 1w(t'(n)) if n is in t. Then (w(n)) is the "s-induced ordering" of all 01-words.

%C s = A016777; t = A007494; s' = A002264; t' = A004523;

%C In the following list, W represents the sequence of words w(n) induced by A016777. The list includes five partitions and two permutations of the positive integers.

%C positions of 1-free words in W: A003462;

%C positions of 0-free words in W: A134342 (conjectured);

%C positions in W of words w(n) such that # 0's = # 1's: A342732;

%C positions in W of words w(n) such that # 0's < # 1's: A342733;

%C positions in W of words w(n) such that # 0's > # 1's: A342734;

%C positions in W of words w(n) such that first digit = last digit: A342735;

%C positions in W of words w(n) such that first digit != last digit: A342736;

%C length of w(n): A342739;

%C positions in W of words w(n) that end with 0: A342740;

%C positions in W of words w(n) that end with 1: A342741;

%C positions in W of words w(n) such that 1st digit = 0 and last digit 0: A342742;

%C positions in W of words w(n) such that 1st digit = 0 and last digit 1: A342743;

%C positions in W of words w(n) such that 1st digit = 1 and last digit 0: A342744;

%C positions in W of words w(n) such that 1st digit = 1 and last digit 1: A342745;

%C position in W of n-th positive integer (base 2): A342746;

%C positions in W of binary complement of w(n): A342747;

%C sum of digits in w(n): A342748;

%C number of runs in w(n): A342749;

%C positions in W of palindromes: A342750;

%C positions in W of words such that #0's - #1's is odd: A342751;

%C positions in W of words such that #0's - #1's is even: A342752.

%C For a guide to related sequences, see A341256.

%e The first twenty words w(n): 0, 1, 10, 00, 11, 110, 01, 100, 111, 010, 1110, 101, 000, 1100, 1111, 011, 1010, 11110, 0110, 1101.

%t z = 250; s = Table[3 n - 2, {n, 1, z}] (* A016777 *)

%t t = Complement[Range[Max[s]], s] (* A007494 *)

%t s1[n_] := Length[Intersection[Range[n - 1], s]];

%t t1[n_] := n - 1 - s1[n];

%t Table[s1[n], {n, 1, z}] (* A002264 *)

%t Table[t1[n], {n, 1, z}] (* A004523 *)

%t w[1] = {0}; w[t[[1]]] = {1};

%t w[n_] := If[MemberQ[s, n], Join[{0}, w[s1[n]]], Join[{1}, w[t1[n]]]]

%t tt = Table[w[n], {n, 1, z}] (* A341334, all binary words *)

%t Flatten[tt] (* A341334, words concatenated *)

%t Flatten[Position[Map[Union, tt], {0}]] (* A003462 *)

%t Flatten[Position[Map[Union, tt], {1}]] (* A134342 conjectured *)

%t zz = Range[Length[tt]];

%t Select[zz, Count[tt[[#]], 0] == Count[tt[[#]], 1] &] (* A342732 *)

%t Select[zz, Count[tt[[#]], 0] < Count[tt[[#]], 1] &] (* A342733 *)

%t Select[zz, Count[tt[[#]], 0] > Count[tt[[#]], 1] &] (* A342734 *)

%t Select[zz, First[tt[[#]]] == Last[tt[[#]]] &] (* A342735 *)

%t Select[zz, First[tt[[#]]] != Last[tt[[#]]] &] (* A342736 *)

%t Map[Length, tt] (* A342739 *)

%t Select[zz, Last[tt[[#]]] == 0 &] (* A342740 *)

%t Select[zz, Last[tt[[#]]] == 1 &] (* A342741 *)

%t Select[zz, First[tt[[#]]] == 0 && Last[tt[[#]]] == 0 &] (* A342742 *)

%t Select[zz, First[tt[[#]]] == 0 && Last[tt[[#]]] == 1 &] (* A342743 *)

%t Select[zz, First[tt[[#]]] == 1 && Last[tt[[#]]] == 0 &] (* A342744 *)

%t Select[zz, First[tt[[#]]] == 1 && Last[tt[[#]]] == 1 &] (* A342745 *)

%t d[n_] := If[First[w[n]] == 1, FromDigits[w[n], 2]];

%t Flatten[Table[Position[Table[d[n], {n, 1, 200}], n], {n, 1, 200}]] (* A342746 *)

%t comp = Flatten[Table[Position[tt, 1 - w[n]], {n, 1, 50}]] (* A342747 *)

%t Table[Total[w[n]], {n, 1, 100}] (* A342748 *)

%t Map[Length, Table[Map[Length, Split[w[n]]], {n, 1, 100}]] (* A342749 *)

%t Select[zz, tt[[#]] == Reverse[tt[[#]]] &] (* A342750 *)

%t Select[zz, OddQ[Count[w[#], 0] - Count[w[#], 1]] &] (* A342751 *)

%t Select[zz, EvenQ[Count[w[#], 0] - Count[w[#], 1]] &] (* A342752 *)

%Y Cf. A016777, A007494, A134352 (conjectured), A341256.

%K nonn

%O 1

%A _Clark Kimberling_, Mar 20 2021