none
Ayuda acerca de un programa que calcula combinaciones alfanumericas en vb.net 2010 RRS feed

  • Pregunta

  • Buenas noches o tardes:

     Tengo un programa que hace calculos de combinaciones alfanumericas sin repeticiones hecho en un principio en vb6.0 y lo pase a vb.net 2010 (se los paso para el que le pueda servir), el problema radica que si el tamaño de grupo es igual al  numero de la lista del grupo, solo calcula la prmera linea y se sale, ejemplo: el grupo es de solo 2 y la lista es "1,2", en el listbox, solo saca:

    1,2

    y le falta el 2,1. en la funcion CreaGrupos esta el problema, pero, cada vez que lo suprimo o le cambio un valor, me manda error.

    Public Class Form1
        Public TamGrupos As Integer = 2 ' Tamaño de los grupos
        Public ListaDeNumeros As String = "1,2,3,4" ' lista de numeros separados por comas
        Public Parar As Integer

        Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
            Parar = 1
        End Sub
        Private Function CalculaTotal(ByVal TamGrupos As Integer, ByVal MaximoValor As Integer) As Long
            Dim C1 As Double
            Dim C2 As Double
            Dim F As Double

            C1 = 1
            C2 = 1
            For F = 1 To TamGrupos
                C1 = C1 * F
            Next F

            For F = MaximoValor To (MaximoValor - (TamGrupos - 1)) Step -1
                C2 = C2 * F
            Next F
            CalculaTotal = C2 / C1

        End Function


        Private Sub CreaGrupos(ByVal TamGrupos As Integer, ByVal TopeOListaDeNumerosSeparadosPorComas As String, ByRef ListaDevuelta() As String)
            ' Busqueda de combinaciones.
            ' Dados los numeros de TopeOListaDeNumerosSeparadosPorComas,
            ' saca todos los grupos no repetidos de "TamGrupos" numeros
            ' y los devuelve en la matriz Lista()
            ' Por repetido se entiende que "1,2,3" es igual que "1,3,2", igual que "2,1,3", etc...
            ' Ejm: 1,2,3,4 de 2 en 2 = 6 combinaciones
            ' 1,2 - 1,3 - 1,4 - 2,3 - 2,4 - 3,4
            ' Opcionalmente, en lugar de una lista de números puedes poner un solo número.
            ' En ese caso la listadenumeros seran los números desde el 1 hasta el que pongas.

            Dim F As Double
            Dim Linea As String
            Dim Num As Double
            Dim Total As Double
            Dim Ap() As Double
            Dim MaximoValor As Long

            Dim MatrizDeNumeros() As String
            MatrizDeNumeros = Split(TopeOListaDeNumerosSeparadosPorComas, ",")
            MaximoValor = UBound(MatrizDeNumeros) + 1

            If MaximoValor = 1 And Val(MatrizDeNumeros(0)) > 0 Then
                MaximoValor = Val(MatrizDeNumeros(0))
                ReDim MatrizDeNumeros(MaximoValor - 1)
                For F = 1 To MaximoValor
                    MatrizDeNumeros(F - 1) = F
                Next F
            End If

            Total = CalculaTotal(TamGrupos, MaximoValor)

            ReDim Ap(TamGrupos)

            ReDim ListaDevuelta(Total - 1)
            Dim Contador As Long
            Contador = -1

            Parar = 0

            ' Cogemos las primeras
            For F = 1 To TamGrupos
                Ap(F) = F
            Next F

    OtraVez:
            'Preparo la linea con la combinacion
            Linea = ""
            For F = 1 To TamGrupos - 1
                Linea = Linea & MatrizDeNumeros(Ap(F) - 1) & " , "
            Next F
            Linea = Linea & MatrizDeNumeros(Ap(TamGrupos) - 1)

            ' Guardo la combiancion
            Contador = Contador + 1
            ListaDevuelta(Contador) = Linea

            'Label4.Caption = Contador + 1 ' Muestro el progreso

            Application.DoEvents()
            If Parar = 1 Then GoTo Fin

            Num = TamGrupos + 1

    Repetir1:
            Num = Num - 1  ' Cogemos la apuesta(num) (en principio la ultima)

            'La aumentamos...
            Ap(Num) = Ap(Num) + 1

            ' si es mayor de la cuenta...
            If Ap(Num) > (MaximoValor - (TamGrupos - Num)) Then

                ' si es la ap(1) se acaba
                If Num = 1 Then GoTo Fin

                ' ...aumentamos la anterior
                GoTo Repetir1
            End If

            ' Si no llega a su limite se mira si alguna ha llegado
            ' a su maximo
            ' Si NUM no apunta a la ultima AP() es que
            ' alguna ap() ha llegado a su maximo
            ' entonces reiniciamos todas las siguientes...
            If Num <> TamGrupos Then
                For F = Num + 1 To TamGrupos
                    '....dandoles el valor de la anterior + 1...
                    Ap(F) = Ap(F - 1) + 1
                Next F
            End If

            ' ... Y se da por valida
            GoTo OtraVez

    Fin:
            Parar = 1

        End Sub

        Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

            If Parar = 0 Then Parar = 1 : Exit Sub

            Dim Matriz() As String = Nothing ' matriz donde recibiremos la lista

            CreaGrupos(TamGrupos, ListaDeNumeros, Matriz)

            'Aqui manipulas la matriz como quieras
            ' por ejemplo pasandola a un listbox

            ListBox1.Visible = False
            Dim F As Long
            For F = 0 To UBound(Matriz)
                ListBox1.Items.Add(Matriz(F))
            Next F
            ListBox1.Visible = True

        End Sub
    End Class

    De antemano, muchas gracias!!!

    • Cambiado Enrique M. Montejo jueves, 19 de noviembre de 2015 8:29 Pregunta relacionada con aplicación de Windows Forms.
    martes, 17 de noviembre de 2015 3:54

Todas las respuestas

  • No veo el fallo, el programa hace lo que tiene que hacer, la coleccion 1,2 es igual que 2,1
    martes, 17 de noviembre de 2015 9:09
  • Hola, si efectivamente lo hace, pero yo quiero que genere el que hace falta en este caso el 2.1, y cada vez que modifico, no lo hace porque de acuerdo al programa es un numero repetido, pero, yo necesito que en la otra linea del listbox, aparezca el 2.1, ya modfique la funcion que hace la creacion de grupos y no me da, sigue haciendo lo mismo, no se donde esta el error.
    martes, 17 de noviembre de 2015 17:17