How to find the recurring period string of a recurring decimal using VBA

[Juggler_IN]

I want to find the recurring period string of a recurring decimal.

That is, for example:
1/3 = 0.(3) = 0.333333... with a period "3" of length 1.
1/7 = 0.(142857) = 0.142857142857... with a period "142857" of length 6.
1/15 = 0.0(6) = 0.066666... with a period "6" of length 1.

So, if my input string is x=0.142857142857142857142, the code should output 142857.

I have attempted a VBA function with a reference Java code at Periods and the code is:

Function findSequence(x As String) As String

    Dim n As Long, i As Long, j As Long, k As Long

    n = Len(x)

    For i = 1 To n - 1

        For j = i To n - 1

            k = j Mod i: If k = 0 Then k = 1 Else k = k

            If Mid(x, k, 1) <> Mid(x, j, 1) Then
                i = j
            Else
            End If

        Next j

        findSequence = Mid(x, 1, i + 1) ' (The issue appears to be at this line.)
        GoTo x1

    Next i

    findSequence = "Impossible"
    GoTo x1

x1:
    Exit Function

End Function

But, this code is not giving the required output. Any suggestions?

 

[StephenCrump]

Here's my take on this.

I've converted text to numbers to speed up processing, and assumed that you will strip leading zeros.

I have also allowed partial matches, e.g. for 1231231, or 12312312, the answer suggested is 123. If you want to insist on full matches, e.g. 123123 or 123123123 or 123123123 etc, you can add a condition requiring M/L to be integer, where M is the string length, and L is the sub-string length being tested.

	A	B
1		Possible
2	String	Recurring?
3	11	1
4	121	12
5	12312312	123
6	12121	12
7	1212312	12123
8	142857142857	142857
9	1428571428	142857
10	9919929	991992
11	12123121231212312	12123
Sheet1

Cell Formulas
Range	Formula
B3:B11	B3	=FindSequence(A3)

Function FindSequence(s As String) As String
    
    Dim N() As Long, M As Long, i As Long, L As Long, j As Long, k As Long
    Dim bSuccess As Boolean
    
    M = Len(s)
    ReDim N(1 To M)
    
    For i = 1 To M
        N(i) = Mid(s, i, 1)
    Next i
    
    For L = 1 To M - 1
        For j = 1 To Application.RoundUp(M / L, 0) - 1
            For k = 1 To Application.Min(L, M - j * L)
                If N(k) <> N(j * L + k) Then
                    L = j * L + k - 1
                    GoTo EndLoop
                End If
            Next k
        Next j
        bSuccess = True
        GoTo EndFunction
EndLoop:
    Next L
    
EndFunction:
    FindSequence = IIf(bSuccess, Left(s, L), "n/a")
    
End Function

 

[jolivanes]

Is it three full stops (Char 46) or an ellipsis (Char 133)?

 

[Juggler_IN]

Is it three full stops (Char 46) or an ellipsis (Char 133)?

It is three dots . . . to show it is an ongoing number.

 

[Juggler_IN]

@StephenCrump; ... the code addresses one type of non-terminating decimal that has only a period in its expansion.

Meets examples, like 1/3 (0.333333), 1/7 (0.142857) .... these expansions have a period only after the decimal point. 0. followed by (3) and (142857).

But, it does not address expansions that have a pre-period before a period. Example, the decimal of 1/15 = 0.066666... = 0.0(6) and the decimal of 3227/555 which outputs 5.8144144144... = 5.8(144) ... here 144 is repeating infinitely and is the period and 8 is the period.

And, the command ?FindSequence("814414414") outputs n/a but the desired output is 144.

 

[StephenCrump]

Another loop should allow for these possibilities. Try this:

	A	B
1		Possible
2	String	Recurring?
3	1428571428	142857
4	9919929	991992
5	12123121231212312	12123
6	12345454545	45
7	8144144144	144
8	166666	6
9	00778778778	778
Sheet1

Cell Formulas
Range	Formula
B3:B9	B3	=FindSequence(A3)

Function FindSequence(s As String) As String
   
    Dim N() As Long, M As Long, i As Long, L As Long, j As Long, k As Long, p As Long
    Dim bSuccess As Boolean
       
    For p = 0 To Len(s) - 2
        M = Len(s) - p
        ReDim N(1 To M)
       
        For i = 1 To M
            N(i) = Mid(s, i + p, 1)
        Next i
       
        For L = 1 To M - 1
            For j = 1 To Application.RoundUp(M / L, 0) - 1
                For k = 1 To Application.Min(L, M - j * L)
                    If N(k) <> N(j * L + k) Then
                        L = j * L + k - 1
                        GoTo EndLoop
                    End If
                Next k
            Next j
            bSuccess = True
            GoTo EndFunction
EndLoop:
        Next L
    Next p
   
EndFunction:
    FindSequence = IIf(bSuccess, Mid(s, p + 1, L), "n/a")
   
End Function

I haven't allowed for decimal points, but there's no reason to test any integer component for recurrence.

 

[Juggler_IN]

@StephenCrump; thanks this works ... I will test it for other values.

 

[Juggler_IN]

@StephenCrump; is it possible to incorporate the auto-rounding of decimal cases?

What I mean is, for eg, 1/6 = 0.166666666666666666... which is reported by Excel as 0.166666666666667, and 1/7 = 142857142857142857142857... which is reported by Excel as 0.142857142857143.

In the case of 1/6 the last digit 6 is rounded up to 7 and with 1/7 the last digit 2 is rounded up to 3.

 

[StephenCrump]

I changed back to comparing strings - a digit by digit comparison won't work if we allow rounding to flow through.

I haven't tested properly, so give it a good workout and see if you can break it:

	A	B
1	66666	6
2	666667	6
3	595959595	59
4	595959596	59
5	12345123451234	12345
6	12345123451235	12345
7	1428571428	142857
8	1428571429	142857
9	9919929	991992
10	166666	6
11	778778778	778
12	3334	n/a
13	44445	n/a
14	555556	5
15	199200	n/a
16	1995001200	1995001
Sheet1

Cell Formulas
Range	Formula
B1:B16	B1	=FindSequence(A1)

Function FindSequence(s As String) As String
  
    Dim L As Long, M As Long, p As Long
    Dim test1 As String, test2 As String, s1 As String
    Dim bSuccess As Boolean
    Const PREC = 15
      
    For p = 0 To Len(s) - 2
        s1 = Right(s, Len(s) - p)
        M = Len(s1)
        For L = 1 To M - 1
            test1 = Application.Rept(Left(s1, L), 1 + Int(M / L))
            test2 = ""
            If Mid(test1, M + 1, 1) > "4" Then test2 = Left(test1, Application.Max(0, M - PREC)) & Right(Left(test1, M), PREC) + 1
            If Left(test1, M) = s1 Or Left(test2, M) = s1 Then
                bSuccess = s1 <> 0
                GoTo EndFunction
            End If
        Next L
    Next p
  
EndFunction:
    FindSequence = IIf(bSuccess, Left(s1, L), "n/a")
      
End Function

 

[Juggler_IN]

@StephenCrump; Thanks, I will test it and revert.