|
%I #18 Jan 05 2022 00:57:53
%S 0,1,0,0,0,1,1,0,0,0,0,0,0,1,1,1,0,1,0,0,0,0,0,1,0,0,0,0,0,1,0,1,1,1,
%T 0,1,0,0,1,0,0,0,0,0,0,1,1,0,0,1,0,0,0,0,0,0,1,1,0,0,0,0,0,1,1,0,1,0,
%U 1,1,0,0,1,0,0,0,1,0,0,0,0,0,0,0,1,1
%N Concatenation of all 01-words, in the order induced by A032766; 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 = A032766; t = A016789; s' = A004396; t' = A002264;
%C In the following list, W represents the sequence of words w(n) induced by A032766. The list includes five partitions and a self-inverse permutation of the positive integers.
%C length of w(n): A344150;
%C positions in W of words w(n) such that # 0's = # 1's: A344151;
%C positions in W of words w(n) such that # 0's < # 1's: A344152;
%C positions in W of words w(n) such that # 0's > # 1's: A344153;
%C positions in W of words w(n) that end with 0: A344154;
%C positions in W of words w(n) that end with 1: A344155;
%C positions in W of words w(n) such that first digit = last digit: A344156;
%C positions in W of words w(n) such that first digit != last digit: A344157;
%C positions in W of words w(n) such that 1st digit = 0 and last digit 0: A344158;
%C positions in W of words w(n) such that 1st digit = 0 and last digit 1: A344159;
%C positions in W of words w(n) such that 1st digit = 1 and last digit 0: A344160;
%C positions in W of words w(n) such that 1st digit = 1 and last digit 1: A344161;
%C position in W of n-th positive integer (base 2): A344162;
%C positions in W of binary complement of w(n): A344163;
%C sum of digits in w(n): A344164;
%C number of runs in w(n): A344165;
%C positions in W of palindromes: A344166;
%C positions in W of words such that #0's - #1's is odd: A344167;
%C positions in W of words such that #0's - #1's is even: A344168;
%C positions in W of the reversal of the n-th word in W: A344169.
%C For a guide to related sequences, see A341256.
%e The first twenty words w(n): 0, 1, 00, 01, 10, 000, 001, 11, 010, 0000, 100, 0001, 011, 101, 0010, 00000, 110, 0100, 00001, 1000.
%t z = 250;
%t "The sequence s:" (* A001651, (3n/2) *)
%t s = Table[Floor[3 n/2], {n, 1, z}]
%t "The sequence t:" (* A016789; congr to 0 or 1 mod 3; *)
%t t = Complement[Range[Max[s]], s]
%t s1[n_] := Length[Intersection[Range[n - 1], s]];
%t t1[n_] := n - 1 - s1[n];
%t "The sequence s1:"
%t Table[s1[n], {n, 1, z}] (* A004396 *)
%t "The sequence t1:"
%t Table[t1[n], {n, 1, z}] (* A002264 *)
%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 "List tt of all binary words:"
%t tt = Table[w[n], {n, 1, z}] (* all the binary words *)
%t "All the words, concatenated:"
%t Flatten[tt] (* words, concatenated, A344150 *)
%t "Positions of words in which #0's = #1's:" (* A344151 *)
%t Select[Range[Length[tt]], Count[tt[[#]], 0] == Count[tt[[#]], 1] &]
%t "Positions of words in which #0's < #1's:" (* A344152 *)
%t Select[Range[Length[tt]], Count[tt[[#]], 0] < Count[tt[[#]], 1] &]
%t "Positions of words in which #0's > #1's:" (* A344153 *)
%t Select[Range[Length[tt]], Count[tt[[#]], 0] > Count[tt[[#]], 1] &]
%t "Positions of words ending with 0:" (* A344154 *)
%t Select[Range[Length[tt]], Last[tt[[#]]] == 0 &]
%t "Positions of words ending with 1:" (* A344155 *)
%t Select[Range[Length[tt]], Last[tt[[#]]] == 1 &]
%t "Positions of words starting and ending with same digit:" (* A344156 *)
%t Select[Range[Length[tt]], First[tt[[#]]] == Last[tt[[#]]] &]
%t "Positions of words starting and ending with opposite digits:" (* A344157 *)
%t Select[Range[Length[tt]], First[tt[[#]]] != Last[tt[[#]]] &]
%t "Positions of words starting with 0 and ending with 0:" (* A344158 *)
%t Select[Range[Length[tt]], First[tt[[#]]] == 0 && Last[tt[[#]]] == 0 &]
%t "Positions of words starting with 0 and ending with 1:" (* A344159 *)
%t Select[Range[Length[tt]], First[tt[[#]]] == 0 && Last[tt[[#]]] == 1 &]
%t "Positions of words starting with 1 and ending with 0:" (* A344160 *)
%t Select[Range[Length[tt]], First[tt[[#]]] == 1 && Last[tt[[#]]] == 0 &]
%t "Positions of words starting with 1 and ending with 1:" (* A344161 *)
%t Select[Range[Length[tt]], First[tt[[#]]] == 1 && Last[tt[[#]]] == 1 &]
%t "Position of n-th positive integer (base 2) in tt: A344162 "
%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}]]
%t "Position of binary complement of w(n): A344163"
%t comp = Flatten[Table[Position[tt, 1 - w[n]], {n, 1, 50}]]
%t "Sum of digits of w(n): A344164"
%t Table[Total[w[n]], {n, 1, 100}]
%t "Number of runs in w(n): A344165"
%t Map[Length, Table[Map[Length, Split[w[n]]], {n, 1, 100}]]
%t "Palindromes:"
%t Select[tt, # == Reverse[#] &]
%t "Positions of palindromes: A344166"
%t Select[Range[Length[tt]], tt[[#]] == Reverse[tt[[#]]] &]
%t "Positions of words in which #0's - #1's is odd: A344167"
%t Select[Range[Length[tt]], OddQ[Count[w[#], 0] - Count[w[#], 1]] &]
%t "Positions of words in which #0's - #1's is even: A344168"
%t Select[Range[Length[tt]], EvenQ[Count[w[#], 0] - Count[w[#], 1]] &]
%t "Position of the reversal of the n-th word: A344169"
%t Flatten[Table[Position[tt, Reverse[w[n]]], {n, 1, 150}]]
%Y Cf. A032766, A016789, A004396, A002264, A341256.
%K nonn,base
%O 1
%A _Clark Kimberling_, May 11 2021
| 