问题
My recursive isn't that good I had to add a list which contains all failed paths to exit other recursive paths quickly, could probably do it without that if it was smarter.
Anyways what I'm trying to do is every time a duplicate is detected it either drops to the next row or goes all the way to the top and tries to fill in the duplicate value only if its possible to keep the values unique. Then I get a bunch of rows all uniquely sorted. Now I coded all this properly and it works just fine.. the problem is undoing this to get back the same solution, there could be multiple answers I want to be able to list all the possible answers which are the same length as the input list.
If the bitstream contains like 2 zero's and when decoding this it can't insert 2 unique values in the row as some value is already previously used then the whole current node gets skipped as being the wrong answer.
Say I got this number
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 1 3 0 4 2 0 4 1 0 0 2 0 4 6 3 1 3
The Bits are 0 for unique and 1 for duplicate
0 0 0 0 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1
The rows look like this
(Row 0): 1 9 4 2 3 0
(Row 1): 4 2 1 3 0
(Row 2): 4 2 1 0 3
(Row 3): 2 4 3
(Row 4): 2 4 1
(Row 5): 2 3 4 0
(Row 6): 4 2 0
(Row 7): 4 1 0 2
(Row 8): 4 6 3 1
All the rows combined into a single string for passing it to program
1 9 4 2 3 0 4 2 1 3 0 4 2 1 0 3 2 4 3 2 4 1 2 3 4 0 4 2 0 4 1 0 2 4 6 3 1
I run this function by pressing Button2
3 textbox'stxtUndoPlaintext.Text = "1 9 4 2 3 0 4 2 1 3 0 4 2 1 0 3 2 4 3 2 4 1 2 3 4 0 4 2 0 4 1 0 2 4 6 3 1"txtUndoBitMask.Text = "0 0 0 0 1 0 1 0 0 1 0 0 1 0 0 1 0 0 0 1 1 0 0 1 0 0 1 0 0 1 1 1 1 0 0 0 1"
txtOutput (this one is multi-line) where the answers print out.
The answer I get back is
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 1 3 0 4 2 0 4 1 0 0 2 0 4 6 3 1 3
which checking with the original is off where its 0 2 to 2 0 on index 30
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 1 3 0 4 2 0 4 1 0 0 0 2 4 6 3 1 3
My problem is I only get back one answer how do I get all answers back?
Here is my code
Public bitmask() As Byte
Public FailedPaths As New List(Of String)
Public Uniques()() As Byte
Public Function GetUniquesAt(uniques()() As Byte, CurrentRow As UInteger, ProcessedBits()() As Byte) As Byte()
Dim eachUniqueIndex As Integer = 0
Dim UniquesUsed() As Byte
'ReDim UniquesUsed(0)
For eachUniqueIndex = 0 To UBound(uniques(CurrentRow), 1)
If ProcessedBits(CurrentRow)(eachUniqueIndex) = 1 Then
'Add a new number to this row
If UniquesUsed Is Nothing Then
ReDim Preserve UniquesUsed(0)
Else
ReDim Preserve UniquesUsed(UniquesUsed.Length)
End If
Dim LastValueInRow As Integer = UniquesUsed.Length
UniquesUsed(LastValueInRow - 1) = uniques(CurrentRow)(eachUniqueIndex)
End If
Next
Return UniquesUsed
End Function
Public Function GetCurrentOffsetForRow(uniques()() As Byte, CurrentRow As UInteger, ProcessedBits()() As Byte) As UInteger
Dim eachUniqueIndex As Integer = 0
For eachUniqueIndex = 0 To UBound(uniques(CurrentRow), 1)
If ProcessedBits(CurrentRow)(eachUniqueIndex) = 0 Then
Return eachUniqueIndex
End If
Next
Return eachUniqueIndex
End Function
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
txtUndoPlaintext.Text = Replace(txtUndoPlaintext.Text, " ", " ")
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimStart(CChar(" "))
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimEnd(CChar(" "))
Dim UniqueList() As Byte = Split(txtUndoPlaintext.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
txtUndoBitMask.Text = Replace(txtUndoBitMask.Text, " ", " ")
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimStart(CChar(" "))
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimEnd(CChar(" "))
bitmask = Split(txtUndoBitMask.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Clear uniques from previous runs.
Uniques = Nothing
Dim PreviousRow As UInteger = 0
'Check if unique exists from first row to current row
Dim CurrentRow As UInteger = 0
Dim ContainsValueInRow As Boolean = False
'if uniques current row isn't initialized then initialize it.
If Uniques Is Nothing Then
ReDim Uniques(CurrentRow)
Uniques(CurrentRow) = New Byte() {}
End If
Dim ProcessedBits()() As Byte
ReDim ProcessedBits(CurrentRow)
ProcessedBits(CurrentRow) = New Byte() {}
'Load uniques up in the Uniques List
For Each Value In UniqueList
ContainsValueInRow = False
'Check row if it contains the current Value if it does change to next row.
For eachUniqueIndex = 0 To UBound(Uniques(CurrentRow), 1)
If Uniques(CurrentRow)(eachUniqueIndex) = Value Then
ContainsValueInRow = True
Exit For
End If
Next
If ContainsValueInRow Then
CurrentRow += 1
ReDim Preserve Uniques(CurrentRow)
Uniques(CurrentRow) = New Byte() {}
ReDim Preserve ProcessedBits(CurrentRow)
ProcessedBits(CurrentRow) = New Byte() {}
End If
Dim LastValueInRow As Integer = Uniques(CurrentRow).Length
'Add new number to this row
ReDim Preserve Uniques(CurrentRow)(LastValueInRow)
Uniques(CurrentRow)(LastValueInRow) = Value
ReDim Preserve ProcessedBits(CurrentRow)(LastValueInRow)
ProcessedBits(CurrentRow)(LastValueInRow) = 0
Next
FailedPaths.Clear()
CurrentRow = 0
Dim CurrentProcessedByte As Long = 0
Dim CurrentOffset As Long = 0
Dim FinalString As String = ""
Dim ExitedTooSoon As Boolean = False
ProcessTreeNodes(FinalString, ProcessedBits, CurrentProcessedByte, PreviousRow, CurrentRow)
Dim output As String
output = output & "Final Decoded Answer: " & FinalString & vbCrLf
output = output & "Stopped at row: " & CurrentRow & vbCrLf
txtOutput.Text = txtOutput.Text & output
End Sub
Public Sub ProcessTreeNodes(_FinalString As String, _ProcessedBits()() As Byte, CurrentProcessedByte As Byte, PreviousRow As UInteger, CurrentRow As UInteger)
'Clone Data to get rid of References, so we always copy here
Dim ProcessedBits(_ProcessedBits.GetUpperBound(0))() As Byte
For i = 0 To _ProcessedBits.Length - 1
ProcessedBits(i) = _ProcessedBits(i).Clone()
Next
Dim FinalString As String = _FinalString.Clone()
Dim LoopTwo As Boolean = False
Dim ExitedTooSoon As Boolean = False
Dim CurrentOffset As UInteger = GetCurrentOffsetForRow(Uniques, CurrentRow, ProcessedBits)
While True
'If finished with everything just simply exit this loop
If bitmask.Length = CurrentProcessedByte Then Exit While
'Unique currently on this row no need any extra processing
If bitmask(CurrentProcessedByte) = 0 Then
'Bad Sub Node.. exit it
If Uniques(CurrentRow).Length = CurrentOffset Then
ExitedTooSoon = True
Exit While
End If
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
End If
'Switch to a new row
If bitmask(CurrentProcessedByte) = 1 Then
CurrentOffset = 0
PreviousRow = CurrentRow
'If Blank Row -> Build a next Row Or Start from Top.
'If the row is Row 0, then next row is Row 1, but if Row 1.. then next row to check is Row 0 etc..
If CurrentRow = 0 Then
CurrentRow = 1
ElseIf CurrentRow > 0 Then
CurrentRow = 0
End If
Dim MainRowUniquesUsed() As Byte
Dim CurrentRowUniques() As Byte
'Do crazy loop checks to see whats the next value.
While True
If FailedPaths.Contains(FinalString) Then
ExitedTooSoon = True
Exit While
End If
MainRowUniquesUsed = GetUniquesAt(Uniques, PreviousRow, ProcessedBits)
CurrentRowUniques = GetUniquesAt(Uniques, CurrentRow, ProcessedBits)
CurrentOffset = GetCurrentOffsetForRow(Uniques, CurrentRow, ProcessedBits)
If LoopTwo Then
'Get a list of all Rows used +1
Dim listsOfUniquesUsed As New List(Of Byte())
Dim LastRow As Long = 0
Dim IsPossible As Boolean = True
For row As Long = 0 To ProcessedBits.Length - 1
'Get a list of every value used in every row
'Don't process the tree until at least 2 rows are used.. then it will use the 3rd row if possible
If ProcessedBits.Length > 1 AndAlso ProcessedBits(1)(0) = 0 Then
Exit For
End If
If ProcessedBits(row)(0) = 1 Then
listsOfUniquesUsed.Add(GetUniquesAt(Uniques, row, ProcessedBits))
'Get the first value of a un-used Row just to checking if it's a possible answer too.
ElseIf ProcessedBits(row)(0) = 0 Then
listsOfUniquesUsed.Add(New Byte() {Uniques(row)(0)})
LastRow = row
Exit For
End If
'Hit last row and last row is already used so this whole thing is not possible
If row = ProcessedBits.Length - 1 AndAlso ProcessedBits(row)(0) = 1 Then
IsPossible = False
End If
Next
If IsPossible Then
'This checks to make sure all the commons that are partially in all lists.
Dim list() As Byte = listsOfUniquesUsed.SelectMany(Function(x) x).Distinct().Where(Function(item) listsOfUniquesUsed.All(Function(l) l.Contains(item))).ToArray()
'If a possible match is found
'make sure there Is a row below the current row, If no point in doing it.
'If list.Count > 0 AndAlso PreviousRow + 1 < Uniques.Length AndAlso FailedPaths.Where(Function(c) c.StartsWith(FinalString)).Count = 0 Then
If list.Count > 0 AndAlso PreviousRow + 1 < Uniques.Length AndAlso Not FailedPaths.Contains(FinalString) Then
'CurrentOffset Spoofed
Dim PreviousRowSpoofed As UInteger = CurrentRow
Dim CurrentRowSpoofed As UInteger = LastRow
'Possible 2 answers are possible!
ProcessTreeNodes(FinalString, ProcessedBits, CurrentProcessedByte, PreviousRowSpoofed, CurrentRowSpoofed)
End If
End If
End If
'Quick fix
If MainRowUniquesUsed Is Nothing Then
CurrentRow = PreviousRow
CurrentOffset = GetCurrentOffsetForRow(Uniques, CurrentRow, ProcessedBits)
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
LoopTwo = True
Exit While
End If
'Next Row is blank, then its just a fresh entry
If CurrentRowUniques Is Nothing Then
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
LoopTwo = True
Exit While
'Scan this row if its a possible insert here or possible go to next
ElseIf CurrentRowUniques IsNot Nothing Then
Dim ValueNotUsed() As Byte = Uniques(CurrentRow) _
.Select(Function(item, index) New With {.Item = item, .Index = index}) _
.Where(Function(x) ProcessedBits(CurrentRow)(x.Index) = 0) _
.Select(Function(x) x.Item).ToArray()
'If no values are possible, then go check next row.
If ValueNotUsed.Length = 0 Then
'If the Next Row is the Row we were in, just before this one Jump 2 rows
If CurrentRow + 1 = PreviousRow Then
CurrentRow = CurrentRow + 2
Else
CurrentRow = CurrentRow + 1
End If
'This quick fix isn't checked could be wrong
'it just starts from the top if it hit a row past the last row.
If CurrentRow >= Uniques.Length Then
CurrentRow = 0
End If
Continue While
'This is a possible answer area (where it would spawn multiple nodes to keep recursively finishing it.)
ElseIf ValueNotUsed.Length > 0 Then
If Not MainRowUniquesUsed.Contains(ValueNotUsed(0)) Then
'The next pattern isn't found in this Row, so we hope next row.
'Keep hopping rows until we hit the row which is the farthest one
'Then we could exit out.
'If the Next Row is the Row we were in, just before this one Jump 2 rows
If CurrentRow + 1 = PreviousRow Then
CurrentRow = CurrentRow + 2
Else
CurrentRow = CurrentRow + 1
End If
If CurrentRow + 1 > PreviousRow Then
'Hit the row we currently on and still no match so its a bad loop
ExitedTooSoon = True
Exit While
ElseIf CurrentRow >= Uniques.Length Then
'Probably does not work?
CurrentRow = 0
End If
Continue While
End If
'Scan Previous Rows for the same answer as in this Row.
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
LoopTwo = True
Exit While
End If
End If
End While
End If
If ExitedTooSoon Then
Exit While
End If
CurrentOffset += 1
CurrentProcessedByte += 1
End While
If ExitedTooSoon Then
FailedPaths.Add(FinalString)
Exit Sub
End If
Dim output As String
output = output & "TreeNode Decoded Answer: " & FinalString & vbCrLf
output = output & "Stopped at row: " & CurrentRow & vbCrLf
txtOutput.Text = txtOutput.Text & output
End Sub
If you need the value generator here it is I made and I have no problem with it. (can't post it in this question as it exceeds the size limit) https://pastebin.com/raw/0y2DnRhi
回答1:
Actually, It gets all the answers (I Hope) at least it gets the right answer and the second right answer I found with the previous code.
But some answers it finds are not even right, so it's not really a good answer. Here is the code anyways anyone wishes to modify it to work better please go ahead.
Original Answer:
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 1 3 0 4 2 0 4 1 0 0 2 0 4 6 3 1 3
Finds these correct answers
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 1 3 0 4 2 0 4 1 0 0 0 2 4 6 3 1 3
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 1 3 0 4 2 0 4 1 0 0 2 0 4 6 3 1 3
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 1 3 0 4 2 0 4 1 0 2 0 0 4 6 3 1 3
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 4 2 0 4 1 0 1 3 0 0 0 2 4 6 3 1 3
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 4 2 0 4 1 0 1 3 0 0 2 0 4 6 3 1 3
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 4 2 0 4 1 0 1 3 0 2 0 0 4 6 3 1 3
Finds these wrong answers too
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 4 2 0 1 3 0 4 1 0 0 0 2 4 6 3 1 3
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 4 2 0 1 3 0 4 1 0 0 2 0 4 6 3 1 3
1 9 4 2 4 2 4 2 1 2 4 3 2 4 1 2 3 4 0 3 4 2 0 1 3 0 4 1 0 2 0 0 4 6 3 1 3
I guess the wrong answers could also be possible in some way.. so I guess there is no way to avoid it.
'New algorithm
Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click
txtUndoPlaintext.Text = Replace(txtUndoPlaintext.Text, " ", " ")
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimStart(CChar(" "))
txtUndoPlaintext.Text = txtUndoPlaintext.Text.TrimEnd(CChar(" "))
Dim UniqueList() As Byte = Split(txtUndoPlaintext.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
txtUndoBitMask.Text = Replace(txtUndoBitMask.Text, " ", " ")
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimStart(CChar(" "))
txtUndoBitMask.Text = txtUndoBitMask.Text.TrimEnd(CChar(" "))
bitmask = Split(txtUndoBitMask.Text, " ").[Select](Function(n) Byte.Parse(n)).ToArray()
'Clear uniques from previous runs.
Uniques = Nothing
Dim PreviousRow As UInteger = 0
'Check if unique exists from first row to current row
Dim CurrentRow As UInteger = 0
Dim ContainsValueInRow As Boolean = False
'if uniques current row isn't initialized then initialize it.
If Uniques Is Nothing Then
ReDim Uniques(CurrentRow)
Uniques(CurrentRow) = New Byte() {}
End If
Dim ProcessedBits()() As Byte
ReDim ProcessedBits(CurrentRow)
ProcessedBits(CurrentRow) = New Byte() {}
'Load uniques up in the Uniques List
For Each Value In UniqueList
ContainsValueInRow = False
'Check row if it contains the current Value if it does change to next row.
For eachUniqueIndex = 0 To UBound(Uniques(CurrentRow), 1)
If Uniques(CurrentRow)(eachUniqueIndex) = Value Then
ContainsValueInRow = True
Exit For
End If
Next
If ContainsValueInRow Then
CurrentRow += 1
ReDim Preserve Uniques(CurrentRow)
Uniques(CurrentRow) = New Byte() {}
ReDim Preserve ProcessedBits(CurrentRow)
ProcessedBits(CurrentRow) = New Byte() {}
End If
Dim LastValueInRow As Integer = Uniques(CurrentRow).Length
'Add new number to this row
ReDim Preserve Uniques(CurrentRow)(LastValueInRow)
Uniques(CurrentRow)(LastValueInRow) = Value
ReDim Preserve ProcessedBits(CurrentRow)(LastValueInRow)
ProcessedBits(CurrentRow)(LastValueInRow) = 0
Next
FailedPaths.Clear()
CurrentRow = 0
Dim CurrentProcessedByte As Long = 0
Dim CurrentOffset As Long = 0
Dim FinalString As String = ""
Dim ExitedTooSoon As Boolean = False
Process(FinalString, ProcessedBits, CurrentProcessedByte, PreviousRow, CurrentRow)
Dim output As String
output = output & "Final Decoded Answer: " & FinalString & vbCrLf
output = output & "Stopped at row: " & CurrentRow & vbCrLf
txtOutput.Text = txtOutput.Text & output
End Sub
Public Sub Process(_FinalString As String, _ProcessedBits()() As Byte, CurrentProcessedByte As Byte, PreviousRow As UInteger, CurrentRow As UInteger)
'Clone Data to get rid of References, so we always copy here
Dim ProcessedBits(_ProcessedBits.GetUpperBound(0))() As Byte
For i = 0 To _ProcessedBits.Length - 1
ProcessedBits(i) = _ProcessedBits(i).Clone()
Next
Dim FinalString As String = _FinalString.Clone()
Dim LoopTwo As Boolean = False
Dim ExitedTooSoon As Boolean = False
Dim CurrentOffset As UInteger = GetCurrentOffsetForRow(Uniques, CurrentRow, ProcessedBits)
Dim solutionsRows As New List(Of UInteger)
While True
'If finished with everything just simply exit this loop
If bitmask.Length = CurrentProcessedByte Then Exit While
'Unique currently on this row no need any extra processing
If bitmask(CurrentProcessedByte) = 0 Then
'Bad Sub Node.. exit it
If Uniques(CurrentRow).Length = CurrentOffset Then
ExitedTooSoon = True
Exit While
End If
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
End If
'Switch to a new row
If bitmask(CurrentProcessedByte) = 1 Then
'Get all possible solutions first
solutionsRows.Clear()
PreviousRow = CurrentRow
Dim MainRowUniquesUsed() As Byte
MainRowUniquesUsed = GetUniquesAt(Uniques, PreviousRow, ProcessedBits)
CurrentRow = 0
If LoopTwo Then
'Get all the right value each row solutions
Dim LastRowUsed As Boolean = False
While True
If CurrentRow >= Uniques.Length Then Exit While
'Is Row accessible, like does the row come after a row that was used previously.
If ProcessedBits(CurrentRow)(0) = 1 OrElse ((CurrentRow - 1 >= 0) AndAlso ProcessedBits(CurrentRow - 1)(0) = 1) Then
LastRowUsed = True
End If
If LastRowUsed Then
Dim ValueNotUsed() As Byte = Uniques(CurrentRow) _
.Select(Function(item, index) New With {.Item = item, .Index = index}) _
.Where(Function(x) ProcessedBits(CurrentRow)(x.Index) = 0) _
.Select(Function(x) x.Item).ToArray()
If ValueNotUsed.Length > 0 AndAlso MainRowUniquesUsed.Contains(ValueNotUsed(0)) Then
solutionsRows.Add(CurrentRow)
End If
End If
'Row incrementer
If CurrentRow + 1 = PreviousRow Then
CurrentRow = CurrentRow + 2
Else
CurrentRow = CurrentRow + 1
End If
LastRowUsed = False
End While
CurrentRow = 0
'Run sub-nodes on every possible solution.
For Each Row In solutionsRows
Dim PreviousRowSpoofed As UInteger = PreviousRow
Dim CurrentRowSpoofed As UInteger = Row
Process(FinalString, ProcessedBits, CurrentProcessedByte, PreviousRowSpoofed, CurrentRowSpoofed)
Next
End If
Dim CurrentRowUniques() As Byte
While True
MainRowUniquesUsed = GetUniquesAt(Uniques, PreviousRow, ProcessedBits)
If (PreviousRow = CurrentRow) AndAlso CurrentRow = 0 Then
CurrentRow = 1
ElseIf (PreviousRow = CurrentRow) AndAlso CurrentRow > 0 Then
CurrentRow = 0
End If
CurrentRowUniques = GetUniquesAt(Uniques, CurrentRow, ProcessedBits)
CurrentOffset = GetCurrentOffsetForRow(Uniques, CurrentRow, ProcessedBits)
'Quick fix
If MainRowUniquesUsed Is Nothing Then
CurrentRow = PreviousRow
CurrentOffset = GetCurrentOffsetForRow(Uniques, CurrentRow, ProcessedBits)
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
LoopTwo = True
Exit While
End If
'Next Row is blank, then its just a fresh entry
If CurrentRowUniques Is Nothing Then
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
LoopTwo = True
Exit While
'Scan this row if its a possible insert here or possible go to next
End If
If CurrentRowUniques IsNot Nothing Then
Dim ValueNotUsed() As Byte = Uniques(CurrentRow) _
.Select(Function(item, index) New With {.Item = item, .Index = index}) _
.Where(Function(x) ProcessedBits(CurrentRow)(x.Index) = 0) _
.Select(Function(x) x.Item).ToArray()
'If no values are possible, then go check next row.
If ValueNotUsed.Length = 0 Then
'If the Next Row is the Row we were in, just before this one Jump 2 rows
If CurrentRow + 1 = PreviousRow Then
CurrentRow = CurrentRow + 2
Else
CurrentRow = CurrentRow + 1
End If
'This quick fix isn't checked could be wrong
'it just starts from the top if it hit a row past the last row.
If CurrentRow >= Uniques.Length Then
ExitedTooSoon = True
Exit While
End If
Continue While
'This is a possible answer area (where it would spawn multiple nodes to keep recursively finishing it.)
ElseIf ValueNotUsed.Length > 0 Then
If Not MainRowUniquesUsed.Contains(ValueNotUsed(0)) Then
'The next pattern isn't found in this Row, so we hope next row.
'Keep hopping rows until we hit the row which is the farthest one
'Then we could exit out.
'If the Next Row is the Row we were in, just before this one Jump 2 rows
If CurrentRow + 1 = PreviousRow Then
CurrentRow = CurrentRow + 2
Else
CurrentRow = CurrentRow + 1
End If
If CurrentRow + 1 > PreviousRow Then
'Hit the row we currently on and still no match so its a bad loop
ExitedTooSoon = True
Exit While
ElseIf CurrentRow >= Uniques.Length Then
ExitedTooSoon = True
Exit While
End If
Continue While
End If
'Scan Previous Rows for the same answer as in this Row.
FinalString = FinalString & " " & Uniques(CurrentRow)(CurrentOffset)
'Mark as processed for future calculations
ProcessedBits(CurrentRow)(CurrentOffset) = 1
LoopTwo = True
Exit While
End If
End If
If FailedPaths.Contains(FinalString) Then
ExitedTooSoon = True
Exit While
End If
End While
End If
If ExitedTooSoon Then
Exit While
End If
CurrentOffset += 1
CurrentProcessedByte += 1
End While
If ExitedTooSoon Then
FailedPaths.Add(FinalString)
Exit Sub
End If
Dim output As String
output = output & "TreeNode Decoded Answer: " & FinalString & vbCrLf
output = output & "Stopped at row: " & CurrentRow & vbCrLf
txtOutput.Text = txtOutput.Text & output
End Sub
回答2:
Simply make a array to hold your solutions then loop each one to create a new call to the same data like so
For Each Row In solutionsRows
Process(FinalString, ProcessedBits, CurrentProcessedByte, PreviousRow, Row)
Next
来源：https://stackoverflow.com/questions/53473623/show-all-multiple-solutions-using-a-nested-recursive-algorithm-vb-net