I had an answer posted, then noticed I was missed some key requirements. I added and changed some stuff to address those missing elements.
The core method fails most of the time, but it does so quickly enough that you can do it in a loop until you get a good answer. Depending on the actual values, in cases where there are very few legal results, it seems like you need to luck out.
The steps used:
- Pick a random spot for the longest streak (Win in the example)
- Bracket the streak with losses to prevent extending it when setting leftovers
- Find the indices with enough consecutive slots to hold the loss streak
- Pick a random one and set the loss streak (returns if there are none)
- Set all the Leftovers as
Not the value at n-1
to avoid extending or creating a new streak
So, it becomes hit or miss whether then WinCount and LossCount are correct. That seems easier to stumble upon than streaks of the right size. A wrapper method tests the result to reject and rerun. With the given values, it usually find a winner in the first 10 or so times.
The core method to construct a string representation, and a helper:
' ToDo change to return Bool() = string is easier to read
Private Function FarhamStreaks(winStrk As Int32, loseStrk As Int32, total As Int32) As String
' -1 == not set
Dim result = Enumerable.Repeat(-1, total).ToArray
' set longest streak first
Dim wNDX = RNG.Next(0, total + 1 - winStrk)
For n As Int32 = 0 To winStrk - 1
result(wNDX + n) = 1
Next
' bracket with losers so the w streak cant extend
If wNDX > 0 Then result(wNDX - 1) = 0
If wNDX + winStrk < result.Length - 1 Then result(wNDX + winStrk) = 0
' look for eligible consecutive starting slots
' might be none
Dim lossNdx As New List(Of Int32)
For n As Int32 = 0 To result.Count - 1
Dim count = CountConsecutiveLooserSlotsFrom(n, result)
If (n + 1) < result.Count AndAlso count >= loseStrk Then
lossNdx.Add(n)
End If
Next
If lossNdx.Count = 0 Then
' do over
' the code has never gotten here
' but depends on the mix of values
Return ""
End If
' set losses
Dim lNdx = lossNdx(RNG.Next(0, lossNdx.Count))
For n As Int32 = 0 To loseStrk - 1
result(lNdx + n) = 0
Next
' set the leftovers based on next value to avoid
' extending streaks
For n As Int32 = 0 To result.Length - 1
If result(n) = -1 Then
If n > 0 Then
result(n) = If(result(n - 1) = 0, 1, 0)
Else
result(n) = If(result(n + 1) = 0, 1, 0)
End If
End If
Next
Dim resultString = String.Join(",", result)
' convert to boolean
Dim realResult(total) As Boolean
For n As Int32 = 0 To total - 1
realResult(n) = Convert.ToBoolean(result(n))
Next
Return resultString
End Function
' find candidate slots for the shorter streak:
Private Function CountConsecutiveLooserSlotsFrom(ndx As Integer, theArray As Int32()) As Int32
Dim count As Int32 = 1 ' including ndx
For n As Int32 = ndx To theArray.Length - 2
If theArray(n) <> 1 AndAlso theArray(n + 1) <> 1 Then
count += 1
Else
Exit For
End If
Next
Return count
End Function
The method to validate a result candidate (and performance metrics):
Private Function MakeFarhamStreak(wins As Int32, winStreak As Int32,
lossStreak As Int32,
total As Int32) As String
Const MaxTries As Int32 = 999
Dim losses = (total - wins)
Dim reverse As Boolean = (lossStreak > winStreak)
Dim candidate As String
Dim sw As New Stopwatch
Dim pass, fail As Int32
Dim count As Int32
sw.Start()
For n As Int32 = 0 To MaxTries
If reverse Then
candidate = FarhamStreaks(lossStreak, winStreak, total)
' to do: un-reverse (Not) the results -
Else
candidate = FarhamStreaks(winStreak, lossStreak, total)
End If
Dim result = candidate.Split(","c)
' test win count
count = candidate.Where(Function(f) f = "1").Count
If count <> wins Then
fail += 1
Continue For
End If
' test loss count
count = candidate.Where(Function(f) f = "0").Count
If count <> losses Then
fail += 1
Continue For
End If
Dim tmp = candidate.Replace(","c, "")
' test win streak size
Dim wstreaks = tmp.Select(Function(c, i) tmp.Substring(i).
TakeWhile(Function(q) q = c AndAlso q = "1").
Count()).
Max
If wstreaks <> winStreak Then
fail += 1
Continue For
End If
Dim lstreaks = tmp.Select(Function(c, i) tmp.Substring(i).
TakeWhile(Function(q) q = c AndAlso q = "0").
Count()).
Max
If lstreaks <> lossStreak Then
fail += 1
Continue For
End If
pass += 1
If pass = 1 Then
Console.WriteLine("First Pass in {0}ms (try # {1} = {2})",
sw.ElapsedMilliseconds, n, candidate)
' normally, return at this point
End If
Next
End Function
It is easier to fit the shorter streak around the longer one, so it reverses the parm order as needed. There isnt code to flip/Not the results.
results:
First Pass in 18ms (try # 4 = 1,1,1,1,1,0,0,1,0,1)
Total FAILURES 753 75.38%
Total Pass 247 24.72%
Total time for 999 candidates 29ms
It found the first passing value on try #4 - with the 10, 7w, 5ws, 2ls values it usually finds one in the first 10.