匹配来自不同项目总和的付款(阵列问题)

时间:2019-06-30 00:35:43

标签: arrays vb.net multidimensional-array

这是我的情况:

我正在为我的非营利组织开发一个应用程序,以便跟踪在线购买,我的组织有40多个由国家资助的计划,我们有15个以上的不同站点。因此,您可以从中看到,这意味着每个建筑物有多个程序。

因此,在完成购买后(可以通过计划或网站进行购买),我们必须将报告发送至资金来源,并且他们要求这些报告的方式在从亚马逊购买时特别混乱,因为单个订单可以原来是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维数组,在1维中的长度与我将要使用的许多不同组合一样长使用数组List()中的数字,第二个轴与我在列表中的项+ 1一样长,第二个轴的索引0将始终具有组合的结果,其余索引将具有0或1告诉我们是否使用了List()中的该项。这些都是在For I = 0的代码中完成的。

完成此操作后,我创建一个数组count(),该数组将计算多少结果与数组Nums()中的每笔付款相匹配,然后,我比较每个结果中有多少结果付款中的一项,取结果最多的一项,并将其放在变量Big上。这将具有数组Occur(,)的尺寸。因为每笔付款都没有相同数量的可能组合,所以我用“无”填充数组Occur,以便稍后检查那里是否没有组合。 (编写此代码时,我想出了一种方法,可以将稍后要在代码中使用的空值确定值,它不会改变任何内容,只需减少步骤即可)然后创建另一个数组(我认为我是数组迷)成为一个名为CountD()的对象,以记住我已经填充了数组的哪个位置。最后,数组Occur(,)将具有与付款一样多的行(第一维),以及与每次付款的有效组合的最大数量一样多的列。此列将填充一个二进制数字,该数字将与list()上的项一样长

最后,我创建了数组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(,)相同,即每个付款都有组合的行,Rows告诉我们付款金额,这将确定如何处理信息Carry()是一个新数组,该数组将在每次传递此函数后包含结果,请尝试将其告知我们是否是第一次执行该函数,并以此来知道是否已经处理了值,并且需要包含每次,用List()数组创建Filler来替换以前存储在Occur(,)中的None,并将其发送到下一个函数,该函数将为我们提供用于每个数字的项目,对于数组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()可以告诉我其中哪一个是我需要用于每次付款的那个。

现在的问题是,我需要找到可以容纳越来越多项目的数组并作为替代,其他选择是更改配置上的某些内容以使数组容纳更多项目,或者找出解决此问题的其他方法问题。

如果要测试代码,只需创建一个带有按钮的表单即可。您可以手动添加更多项目和更多付款以进行测试。

谢谢。

0 个答案:

没有答案