How to complete the code so that instead of finding 3 circular subtractions, it finds 9 circular subtractions?

51 Views Asked by At

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
0

There are 0 best solutions below