kodashi21
16/07/2008, 01:16
Hola a todos, resulta q estoy haciendo un ejercicio de permutaciones, tengo el problema q cuando le digito 8 o más el programa sencillamente se queda o se traba, no hace nada, como veran en el codigo, tengo las variables declaradas como double ya q este tipo de dato no me genera error de "desbordamiento", en si lo q quiero es q me muestre las combinaciones de el numero q ingrese pero no logro arreglarlo, porfavor ayudenme lo he revisado y no se q hacerle o si es la memoria . Ojala alguien pudiera ejecutar el codigo q pongo a continuación en su propio computador para saber si es el mio el q esta fallando o si en realidad es un problema de programación:
necesitan un textbox (tnodos), 2 listbox llamadas (lrutas)(vacia), boton llamado ejecutar
Dim aux As Integer
Dim num As Integer
Dim cantidadnodos As Integer
Dim distancia As Integer ' valor entre "a" y "b"
Dim alfabeto As Integer
Dim numero As Integer
Dim casoletra As Integer
Dim i As String
Dim a As Double
Dim b As Double
Dim c As Double
Dim q As Double
Dim ncombinacion As Double
Private Sub Ejecutar_Click()
If Tnodos.Text = "" Then
MsgBox "Debe digitar la cantidad de nodos", , "ERROR"
Tnodos.SetFocus
Else
If Tnodos.Text < 4 Then
MsgBox "El numero de nodos dede ser mayor a 4 ", , "ERROR"
Tnodos.Text = ""
Tnodos.SetFocus
Else
If Tnodos.Text > 26 Then
MsgBox "El numero de nodos dede ser menor 26", , "ERROR"
Tnodos.Text = ""
Tnodos.SetFocus
Else
'Comienza el algoritmo
cantidadnodos = Val(Tnodos.Text)
permutaciones
End If
End If
End If
End Sub
Sub abecedario()
Select Case alfabeto
Case 1
i = "A"
Case 2
i = "B"
Case 3
i = "C"
Case 4
i = "D"
Case 5
i = "E"
Case 6
i = "F"
Case 7
i = "G"
Case 8
i = "H"
Case 9
i = "I"
Case 10
i = "J"
Case 11
i = "K"
Case 12
i = "L"
Case 13
i = "M"
Case 14
i = "N"
Case 15
i = "O"
Case 16
i = "P"
Case 17
i = "Q"
Case 18
i = "R"
Case 19
i = "S"
Case 20
i = "T"
Case 21
i = "U"
Case 22
i = "V"
Case 23
i = "W"
Case 24
i = "X"
Case 25
i = "Y"
Case 26
i = "Z"
End Select
End Sub
Sub permutaciones()
Dim ruta() As String
Dim q As Double
Dim e As Integer, combinacion As Integer, h As Integer
Dim k As Integer, posicion As Integer
Dim f As String, g As String, m As String
ReDim ruta(cantidadnodos)
c = 1
ncombinacion = 1
numero = cantidadnodos - 2
For combinacion = 2 To numero ' la relacion es nodos 4: combi 2*1=2 : bc, cb, nodos 5: combi 3*resuante "2"=6: bcd, bdc,dbc,dcb,cbd,cdb...
ncombinacion = combinacion * ncombinacion
Next combinacion
For a = 1 To ncombinacion
nuevacombinacion:
' posicion del vector 0 q sea a "A"
e = 1
alfabeto = e
abecedario
ruta(0) = i
' posicion final del vector q sea el nodo final
h = (cantidadnodos - 1)
alfabeto = h + 1
abecedario
ruta(h) = i
For posicion = 1 To numero
' aleatorios
Randomize
e = Int((numero * Rnd) + 2)
alfabeto = e
abecedario
ruta(posicion) = i
f = ruta(posicion)
k = posicion
Do
k = k - 1
' Compara hacia atrás, si está repetido genera un nuevo _
número y lo guarda en el índice del vector _
que estaba repetido, es decir en esa posición
g = ruta(k)
If f = g Then
Randomize
e = Int((numero * Rnd) + 2)
alfabeto = e
abecedario
ruta(posicion) = i
f = ruta(posicion)
k = posicion
End If
Loop Until k = 0
Next posicion
e = 0
For e = LBound(ruta()) To UBound(ruta())
vacia.AddItem ruta(e)
Next e
'imprime ruta
m = Join(ruta)
lrutas.AddItem m
If a >= 2 Then ' comparo las rutas, para q no sean iguales
For b = c To (a - 1)
q = (a - 1)
Do
q = q - 1
' Compara hacia atrás, si está repetido genera un nuevo _
número y lo guarda en el índice del vector _
que estaba repetido, es decir en esa posición
If lrutas.List(b) = lrutas.List(q) Then
lrutas.RemoveItem (b)
GoTo nuevacombinacion
End If
Loop Until q = 0
Next b
c = c + 1
End If
Next a
End Sub
necesitan un textbox (tnodos), 2 listbox llamadas (lrutas)(vacia), boton llamado ejecutar
Dim aux As Integer
Dim num As Integer
Dim cantidadnodos As Integer
Dim distancia As Integer ' valor entre "a" y "b"
Dim alfabeto As Integer
Dim numero As Integer
Dim casoletra As Integer
Dim i As String
Dim a As Double
Dim b As Double
Dim c As Double
Dim q As Double
Dim ncombinacion As Double
Private Sub Ejecutar_Click()
If Tnodos.Text = "" Then
MsgBox "Debe digitar la cantidad de nodos", , "ERROR"
Tnodos.SetFocus
Else
If Tnodos.Text < 4 Then
MsgBox "El numero de nodos dede ser mayor a 4 ", , "ERROR"
Tnodos.Text = ""
Tnodos.SetFocus
Else
If Tnodos.Text > 26 Then
MsgBox "El numero de nodos dede ser menor 26", , "ERROR"
Tnodos.Text = ""
Tnodos.SetFocus
Else
'Comienza el algoritmo
cantidadnodos = Val(Tnodos.Text)
permutaciones
End If
End If
End If
End Sub
Sub abecedario()
Select Case alfabeto
Case 1
i = "A"
Case 2
i = "B"
Case 3
i = "C"
Case 4
i = "D"
Case 5
i = "E"
Case 6
i = "F"
Case 7
i = "G"
Case 8
i = "H"
Case 9
i = "I"
Case 10
i = "J"
Case 11
i = "K"
Case 12
i = "L"
Case 13
i = "M"
Case 14
i = "N"
Case 15
i = "O"
Case 16
i = "P"
Case 17
i = "Q"
Case 18
i = "R"
Case 19
i = "S"
Case 20
i = "T"
Case 21
i = "U"
Case 22
i = "V"
Case 23
i = "W"
Case 24
i = "X"
Case 25
i = "Y"
Case 26
i = "Z"
End Select
End Sub
Sub permutaciones()
Dim ruta() As String
Dim q As Double
Dim e As Integer, combinacion As Integer, h As Integer
Dim k As Integer, posicion As Integer
Dim f As String, g As String, m As String
ReDim ruta(cantidadnodos)
c = 1
ncombinacion = 1
numero = cantidadnodos - 2
For combinacion = 2 To numero ' la relacion es nodos 4: combi 2*1=2 : bc, cb, nodos 5: combi 3*resuante "2"=6: bcd, bdc,dbc,dcb,cbd,cdb...
ncombinacion = combinacion * ncombinacion
Next combinacion
For a = 1 To ncombinacion
nuevacombinacion:
' posicion del vector 0 q sea a "A"
e = 1
alfabeto = e
abecedario
ruta(0) = i
' posicion final del vector q sea el nodo final
h = (cantidadnodos - 1)
alfabeto = h + 1
abecedario
ruta(h) = i
For posicion = 1 To numero
' aleatorios
Randomize
e = Int((numero * Rnd) + 2)
alfabeto = e
abecedario
ruta(posicion) = i
f = ruta(posicion)
k = posicion
Do
k = k - 1
' Compara hacia atrás, si está repetido genera un nuevo _
número y lo guarda en el índice del vector _
que estaba repetido, es decir en esa posición
g = ruta(k)
If f = g Then
Randomize
e = Int((numero * Rnd) + 2)
alfabeto = e
abecedario
ruta(posicion) = i
f = ruta(posicion)
k = posicion
End If
Loop Until k = 0
Next posicion
e = 0
For e = LBound(ruta()) To UBound(ruta())
vacia.AddItem ruta(e)
Next e
'imprime ruta
m = Join(ruta)
lrutas.AddItem m
If a >= 2 Then ' comparo las rutas, para q no sean iguales
For b = c To (a - 1)
q = (a - 1)
Do
q = q - 1
' Compara hacia atrás, si está repetido genera un nuevo _
número y lo guarda en el índice del vector _
que estaba repetido, es decir en esa posición
If lrutas.List(b) = lrutas.List(q) Then
lrutas.RemoveItem (b)
GoTo nuevacombinacion
End If
Loop Until q = 0
Next b
c = c + 1
End If
Next a
End Sub