ensuring a sequential stack of 3 doesn't appear in a shuffled array of 4?

Question

I have an array of {0,1,2,3} and want to shuffle it. This is working pretty well

Public Function ShuffleArray(ByVal items() As Integer) As Integer()
    Dim ptr As Integer
    Dim alt As Integer
    Dim tmp As Integer
    Dim rnd As New Random()

    ptr = items.Length

    Do While ptr > 1
        ptr -= 1
        alt = rnd.Next(ptr - 1)
        tmp = items(alt)
        items(alt) = items(ptr)
        items(ptr) = tmp
    Loop
    Return items
End Function

some of the time. However, I'm finding that it often produces a stack of {1,2,3,0} where 0 is just placed on the back of the stack. In fact, often enough that this doesn't appear random at all. An "original sequence of 3 in the new randomized array" is not desired.

Is there anyway to improve this so that:

1. An item is never in its original position
2. A stack of 3 sequential items (from the original sequence is never allowed) (or any number of sequential original items)

It could be 6 items or 10 items in the array, but what I'm working with currently is just 4 items. C# or VB.net are fine.

Answer 1

A stack of 3 sequential items (from the original sequence is never allowed)

I assume the result of shuffle(n) is what is used as the starting sequence for shuffle(n+1). This is non trivial because using the same start series results in only 7 valid combinations for {0, 1, 2, 3}. Using a fixed starting sequence when the app starts means the first shuffle can only be one of those 7 (probably varied enough).

A Scrambler class:

Public Class Scrambler
    Private rand As Random

    Public Sub New()
        rand = New Random
    End Sub

    ' FY In-Place integer array shuffle 
    Public Sub Shuffle(items() As Integer)
        Dim tmp As Integer
        Dim j As Integer

        ' hi to low, so the rand result is meaningful
        For i As Integer = items.Length - 1 To 0 Step -1
            j = rand.Next(0, i + 1)        ' NB max param is EXCLUSIVE

            tmp = items(j)
            ' swap j and i 
            items(j) = items(i)
            items(i) = tmp
        Next

    End Sub

    ' build a list of bad sequences

    ' fullfils the "stack of 3 sequential items (from the original sequence..." requirement
    ' nsize - allows for the "(or any number ..." portion though scanning for
    '   a series-of-5 may be fruitless
    Public Function GetBadList(source As Integer(),
                               nSize As Integer) As List(Of String)
        Dim BList As New List(Of String)
        Dim badNums(nSize - 1) As Integer

        For n As Integer = 0 To source.Length - nSize
            Array.Copy(source, n, badNums, 0, badNums.Length)
            BList.Add(String.Join(",", badNums))

            Array.Clear(badNums, 0, badNums.Length)
        Next
        Return BList
    End Function


    Public Function ScrambleArray(items() As Integer, badSize As Integer) As Integer()
        ' FY is an inplace shuffler, make a copy
        Dim newItems(items.Length - 1) As Integer
        Array.Copy(items, newItems, items.Length)

        ' flags
        Dim OrderOk As Boolean = True
        Dim AllDiffPositions As Boolean = True

        Dim BadList As List(Of String) = GetBadList(items, badSize)
        ' build the bad list

        Do
            Shuffle(newItems)

            ' check if they all moved
            AllDiffPositions = True
            For n As Integer = 0 To items.Length - 1
                If newItems(n) = items(n) Then
                    AllDiffPositions = False
                    Exit For
                End If
            Next

            ' check for forbidden sequences
            If AllDiffPositions Then
                Dim thisVersion As String = String.Join(",", newItems)

                OrderOk = True
                For Each s As String In BadList
                    If thisVersion.Contains(s) Then
                        OrderOk = False
                        Exit For
                    End If
                Next

            End If
        Loop Until (OrderOk) And (AllDiffPositions)

        Return newItems
    End Function

End Class

Test code/How to use it:

' this series is only used once in the test loop
Dim theseItems() As Integer = {0, 1, 2, 3}

Dim SeqMaker As New Scrambler         ' allows one RNG used
Dim newItems() As Integer

' reporting
Dim rpt As String = "{0}   Before: {1}   After: {2}  time:{3}"

ListBox1.Items.Clear()

For n As Integer = 0 To 1000
    sw.Restart()
    newItems = SeqMaker.ScrambleArray(theseItems, 3)  ' bad series size==3
    sw.Stop()

    ListBox1.Items.Add(String.Format(rpt, n.ToString("0000"), String.Join(",", theseItems),
                    String.Join(",", newItems), sw.ElapsedTicks.ToString))

    Console.WriteLine(rpt, n.ToString("0000"), String.Join(",", theseItems),
                      String.Join(",", newItems), sw.ElapsedTicks.ToString)

    ' rollover to use this result as next start
    Array.Copy(newItems, theseItems, newItems.Length)

Next

An item is never in its original position this sort of makes sense on small sets. But for larger sets, it rules out a large number of legitimate shuffles (>60%); in some cases just because 1 item is in the same spot.

 Start:   {1,2,8,4,5,7,6,3,9,0}
Result:   {4,8,2,0,7,1,6,9,5,3}

This fails because of the '6', but is it really an invalid shuffle? The series-of-three rule shows up pretty rarely in larger sets (<1%) that it might be a waste of time.

---

Without the listbox and console reports (and some distribution gathering not shown), it is pretty fast.

Std Shuffle, 10k iterations, 10 elements: 12ms  (baseline)
   Modified, 10k iterations, 10 elements: 91ms
   Modified, 10k iterations, 04 elements: 48ms

The modified shuffle relies on reshuffling which I knew would not be time consuming. So, when Rule1 OrElse Rule2 fails, it just reshuffles. The 10 element shuffle has to actually perform 28k shuffles to get 10,000 'good' ones. The 4 element shuffle actually has a higher rejection rate because the rules are easier to break with so few items (34,000 rejects).

That doesnt interest me nearly as much as the shuffle distribution, because if these "improvements" introduce a bias, it is no good. 10k 4 element distribution:

seq: 3,2,1,0  count: 425
seq: 1,0,2,3  count: 406
seq: 3,2,0,1  count: 449
seq: 2,3,1,0  count: 424
seq: 0,1,3,2  count: 394
seq: 3,0,2,1  count: 371
seq: 1,2,3,0  count: 411
seq: 0,3,1,2  count: 405
seq: 2,1,3,0  count: 388
seq: 0,3,2,1  count: 375
seq: 2,0,1,3  count: 420
seq: 2,1,0,3  count: 362
seq: 3,0,1,2  count: 396
seq: 1,2,0,3  count: 379
seq: 0,1,2,3  count: 463
seq: 1,3,0,2  count: 398
seq: 2,3,0,1  count: 443
seq: 1,0,3,2  count: 451
seq: 3,1,2,0  count: 421
seq: 2,0,3,1  count: 487
seq: 0,2,3,1  count: 394
seq: 3,1,0,2  count: 480
seq: 0,2,1,3  count: 444
seq: 1,3,2,0  count: 414

With smaller iterations (1K) you can see a more even distribution vs the modified form. But that is to be expected if you are rejecting certain legit shuffles.

Ten element distribution is inconclusive because there are so many possibilities (3.6 million shuffles). That said, with 10k iterations, there tends to be about 9980 series, with 12-18 having a count of 2.

Answer 2

I believe the following will meet the requirements given. I incorporated @CoderDennis's fix for the initial random value, and for passing in the Random. My VB skills have been tarnished by too many years in C# and JavaScript, so apologies for any obvious syntax errors.

It only filters out sequences of three sequential items, not "(or any number of sequential original items)".

Public Function ShuffleArray(ByVal items() As Integer, ByVal rnd As Random) As Integer()
    Dim original as Integer() = items.ToArray()
    Dim ptr As Integer
    Dim alt As Integer
    Dim tmp As Integer
    Dim stacksOfThree = new List(Of Integer())
    Dim isGood As Boolean = True

    ptr = items.Length

    Do While ptr > 2
        ptr -= 1
        stacksOfThree.Add(new Integer() { items(ptr - 2), items(ptr - 1), items(ptr) })
    Loop

    ptr = items.Length

    Do While ptr > 1
        ptr -= 1
        alt = rnd.Next(ptr)
        tmp = items(alt)
        While items(alt).Equals(items(ptr)) Or items(ptr).Equals(tmp)
            alt = rnd.Next(ptr)
            tmp = items(alt)
        End While
        items(alt) = items(ptr)
        items(ptr) = tmp
    Loop

    ptr = items.Length
    Do While ptr > 1
        ptr -= 1
        If items(ptr).Equals(original(ptr)) Then
            isGood = False
            Exit Do
        End If
    Loop

    If isGood Then
        ptr = items.Length
        Do While ptr > 2
            ptr -= 1
            For Each stack In stacksOfThree
                If stack(2).Equals(items(ptr)) And stack(1).Equals(items(ptr - 1)) And stack(0).Equals(items(ptr - 2)) Then
                    isGood = False
                    Exit For
                End If
            Next 
            If Not isGood Then
                Exit Do
            End If
        Loop
    End If

    If isGood Then
        Return items
    Else
        Return ShuffleArray(original, new Random())
    End If
End Function

Answer 3

Everyone's been addressing your shuffle and missing the actual issue.

With a constraint like this I would simply shuffle and then test if the result met the criteria, shuffling again if it did not. This unfortunately has an indeterminate runtime but so long as the constraint isn't too likely to reject it the real world performance is normally acceptable.

However, in this particular case I would take a different approach entirely. With 4 items in the list there are only 24 possible permutations, 4 of which are definitely invalid. (I'm not sure if you want things like [0, 1, 3, 2] or not.) Thus I would store all the valid permutations of the list, sort the list, pick a random permutation from a list of precalculated ones and "shuffle" the list accordingly.