Repeating strings and shifts of these

Question

I am dealing with things coded as a binary strings. We can think of these as binary expansions of angles on the circle.

Suppose I take something with a repeating binary expansion like $\frac{3}{7} = \overline{011}$. Is there a way to get Mathematica to give me the truncation of length $n$? So say I wanted the length 5 truncation of the above binary expansion, I would get back $01101$.

Is there also a way to get all shifts of the sequence and length $n$ truncations of these?

Example: Take $\overline{011}$ again. This has shifts $\overline{110}$ and $\overline{101}$. Then the level 5 truncations would be $11011$ and $10110$.

For the first part (again for the string $\overline{011}$) I thought about using StringJoin and some condition like "If $n \equiv 1 \text{ mod} \text{ Length}[``011"]$ then do StringJoin["011","0"], if $n \equiv 2 \text{ mod} \text{ Length}[``011"]$ then do StringJoin["011","01"] etc but this would need some sort of recursive element also, I think.

This seems quite messy and probably tricky to encode in general (especially if our strings get longer). Is there some better way to do this?

Answer 1

Assuming that you already converted the binary strings into lists of digits you could use

truncations[digits_List,n_Integer/;n>0]:=Flatten[ConstantArray[digits,Ceiling[n/Length[digits]]]][[1;;n]]
shifts[digits_List]:=Complement[Permutations[digits],{digits}]

which for

{0, 1, 1}
truncations[%, 5]
shifts[%%]
truncations[#, 5] & /@ %

yields the desired results:

{0, 1, 1}
{0, 1, 1, 0, 1}
{{1, 0, 1}, {1, 1, 0}}
{{1, 0, 1, 1, 0}, {1, 1, 0, 1, 1}}

One possible Mathematica implementation based on Strings of the above is

truncations[digits_String,n_Integer/;n>0]:=StringJoin[Flatten[ConstantArray[Characters@digits,Ceiling[n/Length[Characters@digits]]]][[1;;n]]]
shifts[digits_String]:=StringJoin[#]&/@Complement[Permutations[Characters@digits],{Characters@digits}]

which for

"011"
truncations[%, 5]
shifts[%%]
truncations[#, 5] & /@ %

yields the results:

"011"
"01101"
{"101", "110"}
{"10110", "11011"}

Answer 2

The following function does not use strings, but takes a rational number and returns the required lists:

f[x_Rational, t_] := (
  a = Map[Take[Join @@ Table[#, t], t] &, 
    b = DeleteDuplicates[
      NestList[RotateLeft[#, 1] &, j = RealDigits[x, 2][[1, -1]], 
       Length[j]]]];
  If[Depth[j] != 2, Return["Non-repeating"]];
  Column[Partition[Riffle[b, a], 2]]
  )

Examples:

f[3/7,5]
(*
{{1,1,0},{1,1,0,1,1}}
{{1,0,1},{1,0,1,1,0}}
{{0,1,1},{0,1,1,0,1}}
*)

f[3/6,5]
(* Non-repeating *)

f[5/9,12]
(*
{{1,0,0,0,1,1},{1,0,0,0,1,1,1,0,0,0,1,1}}
{{0,0,0,1,1,1},{0,0,0,1,1,1,0,0,0,1,1,1}}
{{0,0,1,1,1,0},{0,0,1,1,1,0,0,0,1,1,1,0}}
{{0,1,1,1,0,0},{0,1,1,1,0,0,0,1,1,1,0,0}}
{{1,1,1,0,0,0},{1,1,1,0,0,0,1,1,1,0,0,0}}
{{1,1,0,0,0,1},{1,1,0,0,0,1,1,1,0,0,0,1}}
*)

Answer 3

You can use StringPadRight, StringRotateLeft and StringRotateRight as follows:

ClearAll[sPadRight]
sPadRight = StringPadRight[##, #] &;

sPadRight["011", 7]

"0110110"

sPadRight[StringRotateLeft @ "011", 7]

"1101101"

sPadRight[StringRotateRight @ "011", 7]

"1011011"