At Daily Dose of Excel Dick K. looks at a VBA solution to this problem:
Problem description: Take a stack of coins all heads up. Upturn the topmost coin, place back on the stack and then proceed: take the top 2 coins and upturn as a single stack (tail, head becomes when upturned and placed back on the stack tail, head (the two coins are flipped as if glued together)). Now in the same way flip the top 3 coins and place back on the stack (you get: tail, tail, head (and if there were 4 coins that would be tail, tail, tail, head). When you upturn the whole stack begin again with the first coin. Continue until you return to a stack with all heads up.
Dick’s macro produced this output for 1 to 50 coins:
I thought I’d see if I could come up with a reasonably tidy macro-free solution. The formula I came up with is:
This treats a zero as a head, and a 1 as a tail. The formula was entered into cell D2 and copied into D2:I7 (for a 6 coin stack), with numbers 1 to 6 in D1:I1 zeros in A2:A7, 1 to 6 in B2:B7 and zeros in C2:C7 :
Next cells D2:I7 were copied to D9:I14; =I2 was entered in C9 and copied down to C14; =A2+7 was entered in A9 and copied down to A14, and 1 to 6 entered in B9:B14
This block of 6×9 cells (A9:I14) can then be copied down as often as required:
Having done that, I thought I’d try a similar approach in VBA. Here’s the code:
Sub CoinStack2() Dim StackA() As Long, NumCoins As Long, Numtails As Long, NumIts As Long Dim i As Long, j As Long, k As Long, L As Long, ItTable() As Long, NumOut As Long Const MaxLoops As Long = 1000000 NumOut = 300 ReDim ItTable(1 To NumOut, 1 To 2) For L = 1 To NumOut NumCoins = L ReDim StackA(1 To NumCoins, 1 To NumCoins + 1) Numtails = 0 NumIts = 0 For i = 1 To MaxLoops For j = 1 To NumCoins StackA(j, 1) = StackA(j, NumCoins + 1) Next j For j = 1 To NumCoins NumIts = NumIts + 1 For k = 1 To j StackA(k, j + 1) = (StackA(j - k + 1, j) + 1) Mod 2 Numtails = Numtails - StackA(k, j) + StackA(k, j + 1) Next k For k = j + 1 To NumCoins StackA(k, j + 1) = StackA(k, j) Next k If Numtails = 0 Then ItTable(L, 1) = L ItTable(L, 2) = NumIts GoTo nextstack End If Next j Next i nextstack: Next L Range("stacka").Resize(L - 1, 2) = ItTable End Sub
Output for up to 300 coins is shown below:
The trend seen in Dick’s graph is continued, in fact the number of flips required to return to all heads is never more than n^2 (where n is the number of coins), but the peaks are more often n^2-1, and the number of points between peaks doesn’t seem to have any clear trend. Also the trend for the minimum number apparent in the 1-50 coin graph seems to have disappeared.
Correction: Following Mawdo’s comment I had another look at the minimums, and there is a pattern, and it is more regular than the maximums. For the integers 1,2,3 … m:
- Coin stacks with (2^m)-1 coins are at a minimum
- The number of flips required is ((2^m)-1)(m+1); i.e. number of coins x (m+1)
- The next stack (with 2^m coins) requires only (2^m)(m+1)-1 flips; i.e. number of coins x (m+1)-1
- There are no other stacks that require less than (number of coins) x (m+1) flips.
I have added these minimum points to the chart below: