# Repeating Digits

I have written

RepeatingDigits[n_Integer] :=
Module[{id = IntegerDigits @ n, x},
x = Differences /@ Map[Partition[id, #] &, Range[Length[id]/2]];
If[# === {}, Return @ False, x = Length @ First @ #] &[Catenate @ Cases[x, {{0 ...} ...}]];
If[IntegerQ[#], {Take[id, x], #}, False] &[Length[id] /x]]

RepeatingDigits /@ {1, 11, 212212, 2122126}


{False, {{1}, 2}, {{2, 1, 2}, 2}, False}

I feel there should be a simpler way to find cycles in a list like  {1, 2, 1, 1, 2, 1}.

How can I avoid to run through multiple partitions?

How can I shorten my code? .

f[x_] := Module[ {s = IntegerDigits@x, s1},
s1 = s /. {y__ ..} :> {y};
{s1, Length@s/Length@s1}]

f@212212212212
(* {{2, 1, 2}, 4}*)

• It doesn't function for f. +1 anyway for {y__ ..} :> {y} :) – eldo Oct 11 '14 at 14:34
• @eldo Well, I forgot you wanted a special False answer when the digits are non repeating. You may add a /. {_, 1} -> False as ybeltukov did, but I hate functions with inhomogeneous return types because then you need IF[exp, trueCase, falseCase, otherCases] to treat all special cases in the program – Dr. belisarius Oct 11 '14 at 14:40
• Interesting point. And if you would return {} or {{}} instead of False? – eldo Oct 11 '14 at 14:46
• @eldo That may be better, at least things like Map[] would work easier with that kind of results. However I still prefer returning {{1,2,3,4},1} for an input of 1234 because later I'll be able rebuild the original number using the same procedure always. – Dr. belisarius Oct 11 '14 at 14:55
• @eldo I always hate having to check whether Solve[] have returned a result or not when working with a recursive algorithm. See for example the odd code here – Dr. belisarius Oct 11 '14 at 14:59

Nice problem! Maybe something like this:

repeatingdigits[n_Integer] := Module[{digits = IntegerDigits[n], res = False, div},
div = Divisors[Length[digits]];
Do[With[{z = Partition[digits, d]},
If[Equal @@ z, res = {z[], Length[z]}; Break[]]],
{d, Reverse[Most[div]]}];
res]

repeatingdigits /@ {1, 11, 212212, 2122126}

(* {False, {{1}, 2}, {{2, 1, 2}, 2}, False} *)


f[n_] := IntegerDigits@n /. l : {x__ ..} :> {{x}, Length@l/Length@{x}} /. {_, 1} -> False

f
(* {{1, 2, 3}, 2} *)

f
(* False *)

• Just perfect :) – eldo Oct 11 '14 at 14:35

I have tried some String manipulation functions :

StringCases["342121212136" , s : (x__ ~~ (x_) ..) -> {x, s}]


gives the longest cycle in the string :{{2121, 21212121}}

If you want the shortest cycle :

StringCases["342121212136" , s : (Shortest@x__ ~~ (x_) ..) -> {x, s}]


gives : {{21, 21212121}}

If you are not interested in extracting cycles from within a string, you can do that that :

StringCases["342121212136" , s : (StartOfString ~~ x__ ~~ (x_) .. ~~ EndOfString) -> {x, s}]


gives : {}

Also StringMatchQ can tell you if it is exactly cyclic :

StringMatchQ["342121212136" , s : (x__ ~~ (x_) ..)]


gives : False

StringMatchQ["21212121" , s : (x__ ~~ (x_) ..)]


gives :True

but does not give the pattern which was found.

Finally this is what I propose :

cycL[num_] := StringCases[ToString@num, s : (StartOfString ~~ x__ ~~ (x_) .. ~~ EndOfString) :> {x, StringLength@s/StringLength@x}];

cycL /@ {1, 11, 212212, 2122126}


gives : {{}, {{1, 2}}, {{212, 2}}, {}} .

• cycQ is an awesome answer! First time that I dated StartOfString and EndOfString. I hope cycQ will get the upvotes it deserves. +1. You should, however, remove the remaining quotation marks :) – eldo Oct 11 '14 at 18:42
• @eldo Thanks ! The best answer was already given, i had to invent something else ;) I renamed cycQ, the function is not a predicate. – SquareOne Oct 11 '14 at 23:09

To get the longest repeating subsequence and the number of its repetitions:

ClearAll[rDF]
rDF[a : Repeated[Longest[x__], {2, Infinity}]] := {{x}, Length[{a}]/Length[{x}]}
rDF[___] := False

rDF @@@ IntegerDigits[{1, 11, 212212, 2122126, 212212212212,  2122122122125}]
(* {False,{{1},2},{{2,1,2},2},False,{{2,1,2,2,1,2},2},False} *)


To get the shortest repeating subsequence and the number of its repetitions:

ClearAll[rDFb]
rDFb[a : Repeated[x__, {2, Infinity}]] := {{x}, Length[{a}]/Length[{x}]}
rDFb[___] := False

rDFb @@@ IntegerDigits[{1, 11, 212212, 2122126, 212212212212,  2122122122125}]
(* {False,{{1},2},{{2,1,2},2},False,{{2,1,2},4},False} *)


In the original post below and in Fred's answer, change {d, Reverse[Most[div]]} to {d, Most[div]} to get the same output as rDFb.

Original post:

Using Divisors and a Do loop as in @Fred Simons's answer, but instead of Partitioning and checking Equality of all pieces, just checking if a number is equal to itself when RotateRighted by some amount:

ClearAll[rDF2];
rDF2[n_Integer] := Module[{str = ToString[n], res = False, sl = StringLength[ToString@n]},
With[{div = Divisors[sl]},
Do[If[str == StringRotateLeft[str, d],
res = {FromDigits@StringTake[str, d], sl/d}; Break[]],
{d, Reverse[Most[div]]}]];
res];

rDF2 /@ {1, 11, 212212, 2122126, 212212212212, 2122122122125}
(* {False,{1,2},{212,2},False,{212212,2},False} *)


And a variation of Fred's repeatingdigits:

repeatingdigits2[n_Integer] :=
Module[{digits = IntegerDigits[n], res = False, div},
len = Length@digits; div = Divisors[Length[digits]];
Do[If[digits == RotateLeft[digits, d],
res = {digits[[;; d]], len/d}; Break[]],
{d, Reverse[Most[div]]}];
res]

repeatingdigits2 /@ {1, 11, 212212, 2122126, 212212212212,  2122122122125}
(* {False,{1,2},{212,2},False,{212212,2},False} *)

• It doesn't seem desirable to return {212212,2} rather than {212, 4} -- would you explain? – Mr.Wizard Oct 11 '14 at 17:45
• @Mr.Wizard, good point. I assumed -- as, it seems, few others did -- the desired result was longest repeating prefix together with the number of repetitions. I conjecture the case you are suggesting can be handled by changing Longest to Shortest, or scanning the divisor list in the opposite order. – kglr Oct 11 '14 at 17:55
• @Mr.Wizard, just updated the answer covering both cases. Thanks for the good catch. – kglr Oct 11 '14 at 18:04