10
$\begingroup$

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? `.

| improve this question | | | | |
$\endgroup$
10
$\begingroup$
f[x_] := Module[ {s = IntegerDigits@x, s1},
                s1 = s /. {y__ ..} :> {y};
                {s1, Length@s/Length@s1}]

f@212212212212
(* {{2, 1, 2}, 4}*)
| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ It doesn't function for f[12126]. +1 anyway for {y__ ..} :> {y} :) $\endgroup$ – eldo Oct 11 '14 at 14:34
  • 1
    $\begingroup$ @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 $\endgroup$ – Dr. belisarius Oct 11 '14 at 14:40
  • $\begingroup$ Interesting point. And if you would return {} or {{}} instead of False? $\endgroup$ – eldo Oct 11 '14 at 14:46
  • $\begingroup$ @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. $\endgroup$ – Dr. belisarius Oct 11 '14 at 14:55
  • $\begingroup$ @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 $\endgroup$ – Dr. belisarius Oct 11 '14 at 14:59
7
$\begingroup$

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[[1]], Length[z]}; Break[]]], 
    {d, Reverse[Most[div]]}];
  res]

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

(* {False, {{1}, 2}, {{2, 1, 2}, 2}, False} *)
| improve this answer | | | | |
$\endgroup$
7
$\begingroup$

An alternative to belisarius's answer

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

f[123123]
(* {{1, 2, 3}, 2} *)

f[1]
(* False *)
| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ Just perfect :) $\endgroup$ – eldo Oct 11 '14 at 14:35
3
$\begingroup$

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}}, {}} .

| improve this answer | | | | |
$\endgroup$
  • $\begingroup$ 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 :) $\endgroup$ – eldo Oct 11 '14 at 18:42
  • $\begingroup$ @eldo Thanks ! The best answer was already given, i had to invent something else ;) I renamed cycQ, the function is not a predicate. $\endgroup$ – SquareOne Oct 11 '14 at 23:09
1
$\begingroup$

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} *)
| improve this answer | | | | |
$\endgroup$
  • 2
    $\begingroup$ It doesn't seem desirable to return {212212,2} rather than {212, 4} -- would you explain? $\endgroup$ – Mr.Wizard Oct 11 '14 at 17:45
  • $\begingroup$ @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. $\endgroup$ – kglr Oct 11 '14 at 17:55
  • 2
    $\begingroup$ @Mr.Wizard, just updated the answer covering both cases. Thanks for the good catch. $\endgroup$ – kglr Oct 11 '14 at 18:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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