How to display the solution to this challenge

[Aussiebear]

This challenge to you is to show a solution to the following question.

"Delroy the cat is taking a snooze, dreaming he is encircled by 13 mice — 12 brown, 1 white. Delroy's owner says he can eat all of the mice except the white one. Delroy must also count in a circle and only eat every 13th mouse. Where should Delroy begin counting to ensure he eats the 12 brown mice? How many times around the circle does Delroy need to count?"

How would you go about calculating an answer?

[jdelano]

Hack code of, white mouse is in position 9 and start counting at position 2

Private Sub CommandButton1_Click()


    Dim eatenCount As Integer
    Dim mouseCount As Integer
    Dim sheetRow As Integer
    Dim mouseColor As String
    Dim mouseStatus As String
    
    Sheet1.Range("C3:C15").Value = ""
    Sheet1.Cells(3, 4).Value = 0
    
    mouseCount = 1
    sheetRow = Sheet1.Cells(2, 6).Value
    eatenCount = 0
    
    Do While True
        mouseColor = Sheet1.Cells(sheetRow, 1).Value
        mouseStatus = Sheet1.Cells(sheetRow, 3).Value
        
        ' count only the uneaten meece
        If mouseStatus = "" Then
            If mouseCount = 13 And mouseColor = "Brown" Then
                ' this is okay to eat
                Sheet1.Cells(3, 4).Value = Sheet1.Cells(3, 4).Value + 1
                Sheet1.Cells(sheetRow, 3).Value = "Eaten (" & Sheet1.Cells(3, 4).Value & ")"
                mouseCount = 0


            ElseIf mouseCount = 13 And mouseColor = "White" Then
                ' can't eat the white one
                MsgBox "13th mouse is white"
                Exit Sub
            End If
            
            sheetRow = sheetRow + 1
           
            mouseCount = mouseCount + 1
        Else
            ' still need to move the row
            sheetRow = sheetRow + 1
        End If
        
        If sheetRow = 16 Then
            sheetRow = Sheet1.Cells(2, 6).Value - 1 ' go back to the top of the list
            If sheetRow = 2 Then sheetRow = 3 ' don't start a loop on the headings
        End If
        
        If mouseCount = 14 Then Exit Do
        
    Loop
    
    MsgBox "exited loop"
    
End Sub

[Aussiebear]

Thank you jdelano, that's one version. Anyone else like to have a crack at it?

From the graphic below, I was thinking that with the White Mouse in position 1 and the Brown Mice occupying Positions 2 to 13, and starting the victims at Position 2, all is well until day 11 in which our infamous mouse becomes "Main Course of the Day". Position 10 appears to be the best option for the White Mouse.

How do I prove this with vba?

Screenshot 2025-03-08 at 09.45.08.jpg

[Aussiebear]

Okay maybe this will suffice

Sub DelroyMouse()
    Dim numMice As Integer
    Dim skipCount As Integer
    Dim mice() As Boolean
    Dim currentPosition As Integer
    Dim count As Integer
    Dim rounds As Integer
    Dim startingPosition As Integer
    Dim i As Integer
    numMice = 13
    skipCount = 13
    ' Test starting positions from 1 to 13
    For startingPosition = 1 To numMice
        ReDim mice(1 To numMice)
        For i = 1 To numMice
            mice(i) = True
            ' Initialize all mice as edible
        Next i
        mice(numMice) = False
        ' Mark the white mouse as inedible
        currentPosition = startingPosition
        count = 0
        rounds = 0
        Do While True
            count = count + 1
            currentPosition = ((currentPosition + skipCount - 2) Mod numMice) + 1 'Adjusted for VBA 1 based arrays.
            If mice(currentPosition) Then
                mice(currentPosition) = False
                If Not HasTrue(mice) Then
                    ' Check if all brown mice are eaten
                    MsgBox "Delroy should start counting from mouse number " & startingPosition & "." & vbCrLf & _ 
                    "Delroy needs to count around the circle " & rounds & " times."
                    Exit Sub
                End If
            End If
            If currentPosition = 1 Then
                rounds = rounds + 1
            End If
        Loop
    Next startingPosition
End Sub

Function HasTrue(arr() As Boolean) As Boolean
    Dim i As Integer
    For i = LBound(arr) To UBound(arr)
        If arr(i) = True Then
            HasTrue = True
            Exit Function
        End If
    Next i
    HasTrue = False
End Function

[jdelano]

Nice!