trouble with a do until loop

[moosemaster23]

ok so I've got this code which is aiming to work out the length of the first n collatz sequences. See: Collatz conjecture - Wikipedia, the free encyclopedia

Essentially for a given integer x, the sequence is as follows:

first term: x
second term: if x is even, x/2, if x is odd, 3x+1
continue until you get to 1

My code tries to do the following:

Going through the numbers 1 to n it checks whether I've already calculated the length of the sequence starting with n, if so it goes to the next number (n+1), if it has not calculated the length of the sequence starting with n then it runs through the sequence until hitting a number which we do have the length of. It then puts in all the values of these numbers into my array. It stops when the second column of the array is full (second column is either 0 or 1, 0 representing a number whose sequence length I haven't found and 1 representing a number whose sequence length I've found.


The bit that I'm having troubles with is in the middle (high lighted in bold). The code is not stopping when f(k,2)=1, instead (for 3 for example the code gives the following output:

3
10
5
16
8
4
2
1
4
2
1
4
2
1
4
2
1
...

Any ideas on how to fix?

Sub problem()

n = Cells(1, 2).Value
ReDim f(1 To n, 1 To 2)
ReDim g(1 To n)
f(1, 1) = 1
f(1, 2) = 1
l = n
m = 1
Do Until Application.WorksheetFunction.Sum(g) = n
 
If f(m, 2) = 0 Then
    k = m
    x = 1
[B]    Do Until f(k, 2) = 1
    
    Cells(x, 3) = k
    Cells(x, 4) = x
    
    
        If k Mod 2 = 0 Then
        
        k = k / 2
        Else
        k = 3 * k + 1
        
        End If
    
    x = x + 1
    
        If k > l Then
        ReDim f(1 To k, 1 To 2)
        End If
    
    Loop[/B]
 

    For r = 1 To x - 1
    
    f(Cells(r, 3).Value, 1) = f(k, 1) + x - Cells(r, 4).Value
    
    
    f(Cells(r, 3).Value, 2) = 1
    
    Next
End If

For i = 1 To n
g(i) = f(i, 2)
Next
m = m + 1
Loop
 
End Sub

 

[Norie]

I don't have time for a proper look but there is one thing that might (or might not) be relevant.

When you use Redim on it's own then the newly dimensioned array will be empty, all the existing values lost.

If you want to keep the existing values use Redim Preserve.

 

[moosemaster23]

I don't have time for a proper look but there is one thing that might (or might not) be relevant.

When you use Redim on it's own then the newly dimensioned array will be empty, all the existing values lost.

If you want to keep the existing values use Redim Preserve.

That'll be it!

Thanks again Norie!

 

[MickG]

This may help with the basic code:-

[COLOR="Navy"]Sub[/COLOR] MG18Feb13
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
 n = 3
[COLOR="Navy"]Do[/COLOR] Until n = 1
    c = c + 1
    Cells(c, 1) = n
    n = IIf(n Mod 2 = 0, n / 2, 3 * n + 1)
[COLOR="Navy"]Loop[/COLOR]
Cells(c + 1, 1) = n
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[moosemaster23]

This may help with the basic code:-

[COLOR=navy]Sub[/COLOR] MG18Feb13
[COLOR=navy]Dim[/COLOR] n [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
 n = 3
[COLOR=navy]Do[/COLOR] Until n = 1
    c = c + 1
    Cells(c, 1) = n
    n = IIf(n Mod 2 = 0, n / 2, 3 * n + 1)
[COLOR=navy]Loop[/COLOR]
Cells(c + 1, 1) = n
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

Hi Mick,

I'm not really sure which bits of code your code is supposed to clear up? Could you explain a little further?

Back to my original code (now modified thanks to Norie's hint!):

Sub collatz()

n = Cells(1, 2).Value
ReDim f(1 To 2, 1 To n)
ReDim g(1 To n)
f(1, 1) = 1
f(2, 1) = 1
l = n
m = 1
Do Until Application.WorksheetFunction.Sum(g) = n
 
If f(2, m) = 0 Then
    k = m
    x = 1
    Do Until f(2, k) = 1
    
    Cells(x, 3) = k
    Cells(x, 4) = x
    
    
        If k Mod 2 = 0 Then
        
        k = k / 2
        Else
        k = 3 * k + 1
        
        End If
    
    x = x + 1
    
        If k > l Then
        ReDim Preserve f(1 To 2, 1 To k)
        End If
    
    Loop

    For r = 1 To x - 1
    
[B]    f(1, Cells(r, 3).Value) = f(1, k) + x - Cells(r, 4).Value[/B]
    
    
    f(2, Cells(r, 3).Value) = 1
    
    Next
End If

For i = 1 To n
g(i) = f(2, i)
Next
m = m + 1
Loop
 
End Sub

I now get an error that "Subscript is out of range" for the code in bold when the program is run.

I don't really understand why, the third and fourth columns in excel have the following data in them

3	1
10	2
5	3
16	4
8	5
4	6

<tbody>
</tbody>

The reason that 4 is the last number is that the next (2) has already been calculated, so the code is doing half of what it should be!

I now get a "subscript out of range" error on the text in bold. I don't understand why as the array should be 2 by 16. The values of r k and x at the time of crash are 2, 2 and 7 respectively.

Any ideas what's causing the problem?

 

[Norie]

What's n at the start of the code?

Why are you using the value from Cells(r, 3) for the array f?

 

[moosemaster23]

n is the base number. I'm trying to find the length of all sequences with numbers starting at or below n.


I think it's easier to explain why I'm using cells(r,3) with an example.

In the case where the starting value (m) is equal to 3 we get the following sequence:

3 10 5 16 8 4 2 1

Now. Given this sequence for 3, we can work out the lengths of 10, 5, 16, 8, 4 and 2. By chasing the sequence in excel I can then put back into my array the values of the lengths of 3, 10, 5, 16, 8, 4 and 2. Do you follow?

The point is that the length of the sequence starting with 3 is the length of the sequence starting with 10 +1 which is the length of the sequence starting with 5 +1... and so on.

 

[Norie]

Yes, but what number are you using when you get the error?

When you get the error, if you start at 3, then the code is looking for f(1, 10).

The array f has dimensions 1x2 by 1x4 so there is no f(1,10).

 

[moosemaster23]

Yes, but what number are you using when you get the error?

When you get the error, if you start at 3, then the code is looking for f(1, 10).

The array f has dimensions 1x2 by 1x4 so there is no f(1,10).

n is 6.

Ok. Why does f have dimensions 1x2 by 1x4? My code was supposed to redim if k>L.

Hmm.

 

[moosemaster23]

Yes, but what number are you using when you get the error?

When you get the error, if you start at 3, then the code is looking for f(1, 10).

The array f has dimensions 1x2 by 1x4 so there is no f(1,10).

fixed. My code:

  If k > l Then
        ReDim Preserve f(1 To 2, 1 To k)
        End If

should have been

  If k > l Then
        l = k
        ReDim Preserve f(1 To 2, 1 To k)
        End If

woo!