0
$\begingroup$

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?

Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ Look at "RealDigits" or if you only want the expansion at "BaseForm" $\endgroup$
    – Daniel Huber
    Nov 4, 2020 at 14:42

3 Answers 3

Reset to default
2
$\begingroup$

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"}
Improve this answer
$\endgroup$
1
$\begingroup$

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}}
*)
Improve this answer
$\endgroup$
1
$\begingroup$

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"
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.