|
%I #30 Jan 26 2017 02:48:58
%S 1,0,1,1,0,0,0,1,1,0,0,1,0,1,1,1,0,1,0,0,0,0,1,1,1,1,0,0,1,0,0,1,0,1,
%T 0,1,1,1,1,1,0,1,0,1,1,0,1,1,1,0,0,0,0,0,0,1,1,0,1,0,0,0,1,1,1,1,1,1,
%U 0,0,0,0,0,0,0,0,1,0,1,0,0,1,1,0,1,1,0
%N A pseudorandom binary sequence with maximal uniformity of the distribution of all subsequences.
%C after the first term a(1)=1, each subsequent term is chosen so as to minimize the variance of the histogram that accumulates the occurrences of all possible subsequences taken over the sequence considered as a circular sequence. If the variance doesn't change with different choices for the next term, then the complement of the previous term is used.
%C Among the first 1000 terms there are 485 1's. - _Lars Blomberg_, Jan 26 2017
%H Lars Blomberg, <a href="/A280816/b280816.txt">Table of n, a(n) for n = 1..1000</a>
%t (* SubSeq[x,i,k] gives the Subsequence of length k starting at position i of circular sequence x *)
%t SubSeq[x_, i_, k_] := RotateLeft[x, i - 1][[1 ;; k]];
%t (* BinaryPattern[n,len] gives the n-th binary pattern of length len. *)
%t (* Example: The first binary pattern correspond to the digital
%t representation of 0 with len bits *)
%t (* Note: 0 <= n <= 2^len and len >= Log[2,n] >= 1 *)
%t BinaryPattern[n_, len_] := IntegerDigits[n - 1, 2, len];
%t (* VarOfSeq[x] gives the variance of the histogram that accumulates the occurrences of all possible subsequences taken over the sequence considered as a circular sequence *)
%t VarOfSeq[x_] := Module[{slen, myhcomplete, myhreduced},
%t slen = Length[x];
%t myhcomplete =
%t Table[Table[{i, j, BinaryPattern[j, i], 0}, {j, 1, 2^i }], {i, 1,
%t slen}];
%t Do[Do[Do[
%t If[myhcomplete[[k]][[m]][[3]] == SubSeq[x, i, k],
%t myhcomplete[[k]][[m]][[4]]++]
%t , {i, 1, slen}], {m, 1, 2^k }], {k, 1, slen}];
%t myhreduced =
%t Table[Table[myhcomplete[[i]][[j + 1]][[4]], {j, 0, 2^i - 1 }], {i,
%t 1, Length[myhcomplete]}];
%t (Variance@Flatten@myhreduced) // Return];
%t nmax=21;(* the execution time grows exponentially with the number of terms !*)
%t a = {1};
%t (* The Print function allows monitoring the progress of the algorithm's execution *)
%t Do[
%t If[VarOfSeq[Append[a, 1]] < VarOfSeq[Append[a, 0]], AppendTo[a, 1],
%t If[VarOfSeq[Append[a, 1]] > VarOfSeq[Append[a, 0]], AppendTo[a, 0],
%t AppendTo[a, Mod[1 + a[[-1]], 2]]]];
%t Print[a, " ", VarOfSeq[a] // N ], {j, 1, nmax}]
%Y Cf. A280711.
%K nonn,base,hard
%O 1,1
%A _Andres Cicuttin_, Jan 14 2017
%E More terms from _Lars Blomberg_, Jan 25 2017
|
