Сопоставление оплаты с суммами разных позиций (выпуск массива)

Question

это моя ситуация:

Я разрабатываю приложение для своей некоммерческой организации для отслеживания покупок в Интернете, в моей организации более 40 различных программ, финансируемых государством, и у нас чуть более 15 различных сайтов. Итак, как вы можете видеть из этого, это означает, что на одно здание приходится более 1 программы.

Таким образом, после совершения покупок (это может быть программа или сайт) мы должны отправлять отчеты источникам финансирования, и то, как они запрашивали эти отчеты, становилось беспорядком, особенно при покупке у Amazon, потому что один заказ может Оказывается, 5 или более различных сборов, и отчет должен соответствовать каждому из этих сборов в банковской выписке. Я создал код, чтобы найти нужные элементы, соответствующие каждому из обвинений, все работает отлично, но мой код не является пуленепробиваемым.

Если у меня много предметов с одинаковой ценой и несколькими платежами, я получаю слишком много комбинаций (я сохраняю каждый из возможных ответов в массиве) и пытаюсь выяснить, какая из них является правильной для каждый из платежей, которые массив несколько раз вырастает за пределы элементов, которые не может содержать массив.

Вот весь код этой процедуры:

Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    Dim List() As Decimal = {49.03, 10.25, 4.6, 15.4, 30.15, 20.1, 20.1, 20.05, 20.25, 10.07, 9, 9, 9, 9, 9}
    Dim Nums() As Decimal = {59.5, 79.35, 106.15}
    Dim Sum1 As Decimal = 0
    Dim Sum2 As Decimal = 0
    For X = 0 To List.Length - 1
        Sum1 = Sum1 + List(X)
    Next

    For X = 0 To Nums.Length - 1
        Sum2 = Sum2 + Nums(X)
    Next
    If Sum1 = Sum2 Then
        StatementMatch(List, Nums)
    Else
        MsgBox("The values doesn't match." & vbCrLf & "The total price of all items is: $" & Sum1.ToString & vbCrLf & "The total of all payments is: $" & Sum2.ToString)
    End If
End Sub

В предыдущем коде я вручную загружал массив List (), который содержит цену каждого из элементов, а массив Nums () - это платежи, указанные в выписке по счету.

Прежде чем продолжить весь процесс, мне нужно убедиться, что общее количество товаров совпадает с суммой платежей.

Public Sub StatementMatch(List() As Decimal, Nums() As Decimal)
    Dim Test As String = ""
    Dim Tot As Decimal = 0
        Dim Result(((2 ^ List.Length) - 1), List.Length) As Decimal
        Dim Occur(,) As String

        For XX = 0 To Result.GetLength(0) - 1
            For Y = 0 To Result.GetLength(1) - 1
                Result(XX, Y) = 0
            Next
        Next


        Tot = 0

        For I = 0 To Result.GetLength(0) - 1
            Test = Convert.ToString(I, 2)

            Do While Test.Length < List.Length
                Test = "0" & Test
            Loop

            For M = Test.Length - 1 To 0 Step -1
                If Test.Substring(M, 1) = 1 Then
                    Tot = Tot + List(Test.Length - 1 - M)
                    Result(I, Test.Length - M) = 1
                End If
            Next

            Result(I, 0) = Tot
            Tot = 0
        Next


        Dim Count(Nums.Length - 1) As Integer
        For Z = 0 To Count.Length - 1
            Count(Z) = 0
        Next

        For XX = 0 To Result.GetLength(0) - 1
            For Y = 0 To Nums.Length - 1
                If Result(XX, 0) = Nums(Y) Then
                    Count(Y) = Count(Y) + 1
                End If
            Next
        Next

        Dim Big As Integer = 0

        For Z = 0 To Count.Length - 1
            If Big < Count(Z) Then
                Big = Count(Z)
            End If
        Next


        ReDim Occur(Nums.Length - 1, Big - 1)
        Dim CountD(Nums.Length - 1) As Integer
        For XX = 0 To CountD.Length - 1
            CountD(XX) = 0
        Next


        For XX = 0 To Occur.GetLength(0) - 1
            For Y = 0 To Occur.GetLength(1) - 1
                Occur(XX, Y) = "NONE"        'llenar el array con NONE
            Next
        Next

        Dim BinValue As String = ""

        For XX = 0 To Result.GetLength(0) - 1
            For Y = 0 To Nums.Length - 1
                If Result(XX, 0) = Nums(Y) Then
                    For Z = 1 To List.Length
                        BinValue = Result(XX, Z).ToString & BinValue
                    Next
                    Occur(Y, CountD(Y)) = BinValue
                    CountD(Y) = CountD(Y) + 1
                    BinValue = ""
                End If
            Next
        Next

        Dim Fill() As ULong = {0}

        ProcessValidResults(Occur, Occur.GetLength(0) - 1, Fill, True, List, Nums)

End Sub

Предыдущий код принимает 2 массива, затем я создал 3-й массив, который будет содержать все возможные результаты, называемый results (,) - это 2-мерный массив, в первом измерении он будет такой же длины, как и многие другие комбинации использовать числа в массиве List (), вторая ось будет такой же длины, как и элементы, которые у меня есть в списке + 1, в индексе 0 второй оси всегда будет результат комбинации, а остальные индексы будут иметь 0 или 1, чтобы сообщить нам, был ли использован этот элемент из List (). Все это делается в коде, для которого For I = 0.

После того, как это будет сделано, я создаю массив count (), который будет подсчитывать, сколько результатов соответствует каждому из Платежей, которые у нас есть в массиве Nums (), после этого я сравниваю, сколько результатов у меня есть для каждого один из платежей и возьмите один с наибольшим количеством результатов и поместите его в переменную Big. Это должно иметь размерность массива Occur (,). Поскольку каждый из платежей не имеет одинакового количества возможных комбинаций, я заполняю массив Occur значением «None», чтобы позже проверить, нет ли там комбинации. (Когда я пишу это, я придумываю способ поставить окончательное значение для пустых, которое я делаю позже, в коде, это ничего не меняет, просто сокращает шаги) Затем я создаю другой массив (массив наркоман, я думаю, что я стал) с именем CountD (), чтобы запомнить, какую позицию массива Occur я уже заполнил. В конце массив Occur (,) будет иметь столько строк (первое измерение), сколько платежей, и столько столбцов, сколько максимальное количество допустимых комбинаций для каждого платежа. Эти столбцы заполняются двоичным числом, которое будет соответствовать элементам списка ()

Наконец, я создаю массив Fill и отправляю его следующей функции, которая будет обрабатывать каждую из комбинаций, и вот здесь все может выйти из-под контроля.

Private Sub ProcessValidResults(Resultados(,) As String, Rows As Integer, Carry() As ULong, Attempt As Boolean, List() As Decimal, Nums() As Decimal)

    Dim Filler As ULong
    Dim POS As Integer = 0

    For Fill = 0 To List.Length - 1
        Filler = Filler * 10 + 1
    Next

    If Rows = 0 And Attempt = False Then
        Dim Final(Resultados.GetLength(1) * Carry.Length - 1) As ULong
        Dim Counter As Integer = 0
        For XX = 0 To Resultados.GetLength(1) - 1
            For Y = 0 To Carry.Length - 1
                If Resultados(Rows, XX) <> "NONE" Then
                    Final(Counter) = Convert.ToInt64(Resultados(Rows, XX)) + Carry(Y)
                Else
                    Final(Counter) = Filler + Carry(Y)
                End If
                Counter = Counter + 1
            Next
        Next

        For Z = 0 To Final.Length - 1
            If Final(Z) = Filler Then
                POS = Z + 1
                MsgBox(POS)
                Exit For
            End If
        Next

        FinalResults(Resultados, POS, List, Nums)
    End If


    If Rows = 1 Then
        Dim Valores1(Resultados.GetLength(1) - 1) As ULong
        Dim Valores2(Resultados.GetLength(1) - 1) As ULong

        For XX = 0 To Resultados.GetLength(1) - 1
            If Resultados(Rows - 1, XX) <> "NONE" Then
                Valores1(XX) = Convert.ToInt64(Resultados(Rows - 1, XX))
            Else
                Valores1(XX) = Filler
            End If
            If Resultados(Rows, XX) <> "NONE" Then
                Valores2(XX) = Convert.ToInt64(Resultados(Rows, XX))
            Else
                Valores2(XX) = Filler
            End If
        Next

        If Attempt = False Then


            Dim Sumas(Valores1.Length * Valores2.Length - 1) As ULong
            Dim Counter As Integer = 0
            For Val1 = 0 To Valores1.Length - 1
                For val2 = 0 To Valores2.Length - 1
                    Sumas(Counter) = Valores1(Val1) + Valores2(val2)
                    Counter = Counter + 1
                Next
            Next

            Dim Final((Convert.ToUInt64(Sumas.Length) * Convert.ToUInt64(Carry.Length) - 1)) As ULong
            Counter = 0
            For XX = 0 To Sumas.Length - 1
                For Y = 0 To Carry.Length - 1
                    Final(Counter) = Sumas(XX) + Carry(Y)
                    Counter = Counter + 1
                Next
            Next

            For Z = 0 To Final.Length - 1
                If Final(Z) = Filler Then
                    POS = Z + 1
                    MsgBox(POS)
                    Exit For
                End If
            Next
        Else
            Dim Final(Valores1.Length * Valores2.Length - 1) As ULong
            Dim Counter As Integer = 0
            For Val1 = 0 To Valores1.Length - 1
                For val2 = 0 To Valores2.Length - 1
                    Final(Counter) = Valores1(Val1) + Valores2(val2)
                    Counter = Counter + 1
                Next
            Next

            For Z = 0 To Final.Length - 1
                If Final(Z) = Filler Then
                    POS = Z + 1
                    MsgBox(POS)
                    Exit For
                End If
            Next
        End If
        FinalResults(Resultados, POS, List, Nums)
    End If

    If Rows >= 2 Then
        Dim Valores1(Resultados.GetLength(1) - 1) As ULong
        Dim Valores2(Resultados.GetLength(1) - 1) As ULong

        For XX = 0 To Resultados.GetLength(1) - 1
            If Resultados(Rows - 1, XX) <> "NONE" Then
                Valores1(XX) = Convert.ToInt64(Resultados(Rows - 1, XX))
            Else
                Valores1(XX) = Filler
            End If
            If Resultados(Rows, XX) <> "NONE" Then
                Valores2(XX) = Convert.ToInt64(Resultados(Rows, XX))
            Else
                Valores2(XX) = Filler
            End If
        Next


        Dim Sumas(Valores1.Length * Valores2.Length - 1) As ULong
        Dim Counter As Integer = 0
        For Val1 = 0 To Valores1.Length - 1
            For val2 = 0 To Valores2.Length - 1
                Sumas(Counter) = Valores1(Val1) + Valores2(val2)
                Counter = Counter + 1
            Next
        Next

        If Attempt = True Then
            ProcessValidResults(Resultados, Rows - 2, Sumas, False, List, Nums)
        Else
            Dim Final(Sumas.Length * Carry.Length - 1) As ULong
            Counter = 0
            For XX = 0 To Sumas.Length - 1
                For Y = 0 To Carry.Length - 1
                    Final(Counter) = Sumas(XX) + Carry(Y)
                    Counter = Counter + 1
                Next
            Next
            ProcessValidResults(Resultados, Rows - 2, Final, False, List, Nums)
        End If
    End If

End Sub

Функция:

ProcessValidResults(Resultados(,) As String, Rows As Integer, Carry() As ULong, Attempt As Boolean, List() As Decimal, Nums() As Decimal)

- рекурсивная функция, которая будет вызывать себя до тех пор, пока не завершит обработку каждой из комбинаций. Массив Results (,) такой же, как Occur (,) из предыдущей функции, то есть с комбинациями для каждого платежа. Строки сообщают нам сумму платежей, это будет определять способ обработки информации, Carry () это новый массив, который будет содержать результаты после каждого прохода этой функции. Попытайтесь просто сообщить нам, выполняется ли функция в первый раз, и с этим мы узнаем, если у нас уже есть значения, которые были обработаны, и нам нужно включить каждый раз, массив List () для создания заполнителя для замены None, который был ранее сохранен в Occur (,), а также для отправки его следующей функции, которая даст нам элементы, используемые для каждого числа, то же самое для массив Nums (), просто для переноса на следующую функцию.

Вот что я делаю, я конвертирую эти двоичные числа в произойти (,) в целое число (прямое преобразование, 111 - это 111, а не 7), затем я начинаю добавлять числа каждой строки со следующей и сохранять их в другом одномерном массиве. Затем функция вызовет сама себя, возьмет этот новый массив и обработает элементы с элементами из другой строки, поместит их в новый массив и снова вызовет себя, пока не завершит обработку всех строк.

В конце массив Final () будет существовать до тех пор, пока существуют комбинации из элементов массива Occur (,). Если мы говорим, что массив Occur равен (7,30), то массив Final будет Final (30 ^ 7), и здесь все развалится, потому что у меня будет больше возможных комбинаций, чем элементов в массиве.

Я сделал это так, потому что тогда я могу пройти через Final () и проверить, что его значение заполнено на 1, например, Final (123) = 1111111 (это число меняется, в нем столько цифр, сколько элементов включено). List ()) Затем, зная, что у индекса есть правильный ответ, я обработаю его, чтобы узнать, какие элементы List () были использованы для сопоставления с каждым из чисел в Nums ().

Private Sub FinalResults(Occur(,) As String, POS As Integer, List() As Decimal, Nums() As Decimal)

    Dim X As Integer = Occur.GetLength(0)
    Dim Y As Integer = Occur.GetLength(1)
    Dim FinalPos(Occur.GetLength(0) - 1) As Integer

    Dim Expo As Integer
    For T = 1 To Occur.GetLength(0)
        Expo = Y ^ (X - T)
        FinalPos(T - 1) = Math.Ceiling(POS / Expo)
        POS = POS - (Expo * (FinalPos(T - 1) - 1))

    Next

    Dim Txt As String = ""

    For Y = 0 To Occur.GetLength(0) - 1
        Txt = Txt & (Y + 1).ToString & " ==> "
        For X = 0 To Occur.GetLength(1) - 1
            Txt = Txt & Occur(Y, X) & " - "
        Next
        Txt = Txt & vbCrLf
    Next
    Txt = Txt & vbCrLf
    For Z = 0 To FinalPos.Length - 1

        Txt = Txt & FinalPos(Z).ToString & " ==> " & Occur(Z, FinalPos(Z) - 1) & vbCrLf
    Next

    Txt = Txt & vbCrLf & vbCrLf

    For X = 0 To List.Length - 1
        Txt = Txt & List(X) & " - "
    Next

    Txt = Txt & vbCrLf & vbCrLf
    For Y = 0 To Nums.Length - 1
        Txt = Txt & Nums(Y) & " = "
        For Z = 0 To List.Length - 1

            If Occur(Y, FinalPos(Y) - 1).ToString.Substring(Z, 1) = "1" Then
                Txt = Txt & List(List.Length - 1 - Z).ToString & " + "
            End If
        Next
        Txt = Txt & vbCrLf
    Next

    MsgBox(Txt)
End Sub

Вот так я обрабатываю позицию в массиве Final () и превращаю ее в элементы, используемые для соответствия каждому из платежей. Начиная со строки:

Dim Txt As String = ""

Это просто показать в MsgBox результаты для целей тестирования. В конце комбинация между массивами Occur (,) и FinalPos () даст мне правильный ответ, Occur (,) найдет возможные комбинации для каждого платежа, а FinalPos () скажет, какой из них тот, который мне нужно использовать для каждого платежа.

Теперь дело в том, что мне нужно найти альтернативу массиву, который может содержать еще больше и больше элементов, другой вариант - изменить что-то в конфигурации, чтобы массивы содержали больше элементов, или найти другой способ решить эту проблему. проблема.

Если вы хотите проверить код, просто создайте форму с помощью кнопки, и это подойдет. Вы можете вручную добавить больше предметов и больше платежей для целей тестирования.

Спасибо.