Thanks to the help of this great Stack Overflow community, I have this code that locates circular subtractions of 3 values from an initial sequence numbers, with 1, 2, and 3 subtracted from them, respectively. For instance, given the input 902837642085732 the code might select 3, 2, and 5, and return a new sequence (3-1)(2-2)(5-3) i.e 202.
The "circular" refers to the math being modulo 10, with negative numbers wrapping around (e.g. 1-3 = 8, or 2-5 = 7)
I would now like to extend that from picking 3 numbers and subtracting 1 through 3, to picking 9 numbers and subtracting 1 through 9.
I have the following code already, but don't know how to proceed from here...
Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click
Dim examples = {
(initial:="988735928", resulting:="735858908"),
(initial:="9820791711", resulting:="9820790798"),
(initial:="123456789", resulting:="123456759"),
(initial:="123479", resulting:="123467")}
For Each example In examples
MsgBox($"{example.initial} --> {example.resulting}")
Dim results = FindSubtractions(example.initial, example.resulting)
For Each result In results
MsgBox(result)
Next
'Console.WriteLine()
Next
End Sub
Private Function FindSubtractions(initialValue As String, reducedValue As String) As List(Of String)
Dim initialFrequency = New Integer(9) {}
Dim resultingFrequency = New Integer(9) {}
' Count frequency of each digit
For Each c In initialValue
initialFrequency(Asc(c) - Asc("0"c)) += 1
Next
For Each c In reducedValue
resultingFrequency(Asc(c) - Asc("0"c)) += 1
Next
' Get lists of changed and unchanged digits
Dim initialDigits = New List(Of Integer)()
Dim resultingDigits = New List(Of Integer)()
Dim unchangedDigits = New List(Of Integer)()
For i = 0 To 9
Dim changes = resultingFrequency(i) - initialFrequency(i)
If changes < 0 Then 'initial > resulting
For j = 0 To -changes - 1
initialDigits.Add(i)
Next
For j = 0 To initialFrequency(i) + changes - 1
unchangedDigits.Add(i)
Next
ElseIf changes > 0 Then 'resulting > initial
For j = 0 To changes - 1
resultingDigits.Add(i)
Next
For j = 0 To resultingFrequency(i) - changes - 1
unchangedDigits.Add(i)
Next
Else
For j = 0 To initialFrequency(i) - 1
unchangedDigits.Add(i)
Next
End If
Next
If initialDigits.Count > 9 Then
Console.WriteLine("Too many digits changed. Maximum allowed is 9.")
ElseIf initialDigits.Count <> resultingDigits.Count Then
Console.WriteLine("The size of the set of initial and resulting changed digits must be equal")
ElseIf initialDigits.Count = 0 Then
Return New List(Of String)
End If
Dim complementedDigitSets = ComplementSets(initialDigits, resultingDigits, unchangedDigits)
Dim results = New HashSet(Of String)()
Dim testResult = New List(Of Integer)()
For Each complementedSet In complementedDigitSets
Dim initial = complementedSet.intial
Dim resulting = complementedSet.resulting
Dim permutations = GetSubtractionPermutations(initial.Count)
resulting.Sort()
If permutations IsNot Nothing Then
For p = 0 To permutations.GetLength(0) - 1
testResult.Clear()
For i = 0 To initial.Count - 1
testResult.Add((initial(i) + permutations(p, i) + 10) Mod 10)
Next
testResult.Sort()
If testResult.SequenceEqual(resulting) Then
results.Add(String.Join(", ", initial.[Select](Function(d, i) $"{d}{permutations(p, i)}={(d + permutations(p, i) + 10) Mod 10}").OrderBy(Function(str) str)))
End If
Next
End If
Next
Return results.OrderBy(Function(str) str).ToList()
End Function
' If the count of changing digits is less than 3, we create synthetic sets with more digits
' to find more intricate solutions.
Private Function ComplementSets(ByVal initialDigits As List(Of Integer),
ByVal resultingDigits As List(Of Integer),
ByVal unchangedDigits As List(Of Integer)
) As List(Of (intial As List(Of Integer), resulting As List(Of Integer)))
Dim sets = New List(Of (List(Of Integer), List(Of Integer))) From {
(initialDigits, resultingDigits)
}
Select Case initialDigits.Count
Case 1 ' Create 2-sets and from those also 3-sets (recursively)
For Each d In unchangedDigits.Distinct()
' Create 2-set
Dim i2 = New List(Of Integer)(initialDigits)
Dim r2 = New List(Of Integer)(resultingDigits)
i2.Add(d)
r2.Add(d)
sets.Add((i2, r2))
'Create 3-sets recursively
Dim u = New List(Of Integer)(unchangedDigits)
u.Remove(d)
Dim sets3 = ComplementSets(i2, r2, u)
sets.AddRange(sets3)
Next
Case 2 ' Create 3-sets
For Each d In unchangedDigits.Distinct()
Dim i3 = New List(Of Integer)(initialDigits)
Dim r3 = New List(Of Integer)(resultingDigits)
i3.Add(d)
r3.Add(d)
sets.Add((i3, r3))
Next
End Select
Return sets
End Function
Private Function GetSubtractionPermutations(count As Integer) As Integer(,)
Dim permutations(,) As Integer
Select Case count
Case 1
permutations = New Integer(2, 0) { ' One digit changed
{-1},
{-2},
{-3}}
Case 2
permutations = New Integer(5, 1) { ' Two digits changed
{-1, -2},
{-1, -3},
{-2, -1},
{-2, -3},
{-3, -1},
{-3, -2}}
Case 3
permutations = New Integer(5, 2) { ' Three digits changed
{-1, -2, -3},
{-1, -3, -2},
{-2, -1, -3},
{-2, -3, -1},
{-3, -1, -2},
{-3, -2, -1}}
Case Else
permutations = New Integer(-1, -1) {}
End Select
Return permutations
End Function