elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.


 


Tema destacado: Guía actualizada para evitar que un ransomware ataque tu empresa


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [source] Numeros Aleatorio desde X a Y con excepciones.
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [source] Numeros Aleatorio desde X a Y con excepciones.  (Leído 3,062 veces)
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.128


I'Love...!¡.


Ver Perfil WWW
[source] Numeros Aleatorio desde X a Y con excepciones.
« en: 24 Mayo 2011, 08:08 »

.
Lo que hace este código es que crea numero aleatorio desde un valor mínimo a uno valor máximo pero si se encuentra un numero Z entre los mismo JAMAS saldrá como numero aleatorio.

Una breve introducción antes del código fuente...

Aun no pruebo la velocidad...

OJO: Las esecciones no deben repetirse.

Código:
NumerosAleatoriosEx (Numero Inicio, Numero Final, Array de valores a no considerar) {
MatrixRangos() = Realizar una búsqueda de valores para verificar si alguno de los numeros del array estan entre el valor de Inicio o el valor del Final: (un For Next bastara) , y generamos cortes de array's por ejemplo (  Inicio=0 final=10 array={5,8}  este paso genera 3 array que son:  {0,4},{6,7},{9,10} )
iIndice = Generamos un numero aleatorio desde Lbound(MatrixRangos()) hasta Ubound(MatrixRangos())
Retornamos el numero que se genera un numero aleatorio según los rangos que indique MatrixRangos( iIndice )(0) y MatrixRangos( iIndice )(1)
}

Código
  1.  
  2. Option Explicit
  3.  
  4. Private Type stRangos
  5.    lValIni         As Long
  6.    lValEnd         As Long
  7. End Type
  8.  
  9. Public Sub swapNumbers(ByRef lValOne As Long, ByRef lValTwo As Long)
  10. Dim lValTmp         As Long
  11.    lValTmp = lValOne
  12.    lValOne = lValTwo
  13.    lValTwo = lValTmp
  14. End Sub
  15.  
  16. Public Function FixNumbers(ByRef lValMin As Long, lValMax As Long) As Boolean
  17.    If lValMax < lValMin Then
  18.        Call swapNumbers(lValMin, lValMax)
  19.        FixNumbers = True
  20.    End If
  21. End Function
  22.  
  23. Public Function NumeroAleatorio(lValMin As Long, lValMax As Long) As Long
  24.    Call FixNumbers(lValMin, lValMax)
  25.    Call Randomize
  26.    NumeroAleatorio = (lValMin - lValMax) * Rnd + lValMax
  27. End Function
  28.  
  29. Public Function NumeroAleatorioEx(ByVal lValIni As Long, ByVal lValEnd As Long, ParamArray aNoRepet() As Variant) As Long
  30. '   //  Debera pasarse el parametro {aNoRepet} ordenado de menor a mayor ( indice lbound siendo el valor menor y ubound el valor mayor ).
  31. '   //  La funcion Si no puede generar un numero aleatorio retornara {lValIni-1}
  32. On Error GoTo GetNumber
  33. Dim avArray()       As Variant
  34. Dim lUB             As Long
  35. Dim lNextVal        As Long
  36. Dim li              As Long, lIndex         As Long
  37. Dim tRangos()       As stRangos
  38.  
  39.    If (Not IsMissing(aNoRepet)) Then
  40.        If (IsArray(aNoRepet(0))) Then
  41.            avArray = aNoRepet(0)
  42.        Else
  43.            avArray = aNoRepet
  44.        End If
  45.  
  46.        lUB = UBound(avArray)
  47.        Call Start_QuickSort(avArray, AcendetOrder)     '   //  http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=14:artquicksortybublesort&catid=2:catprocmanager&Itemid=8
  48.  
  49.        ReDim tRangos(0 To (lUB + 1))                   '   //  Cache de memoria...
  50.        With tRangos(0)
  51.            .lValIni = lValIni
  52.            .lValEnd = lValEnd
  53.        End With
  54.        lNextVal = lValIni
  55.        lIndex = 0
  56.  
  57.        For li = 0 To lUB
  58.            If (avArray(li) <= lValEnd And _
  59.                avArray(li) > lValIni And _
  60.                lNextVal <> avArray(li)) Then
  61.                If (lNextVal > lValIni) Then
  62.                    lIndex = lIndex + 1
  63.                    With tRangos(lIndex)
  64.                        .lValIni = lNextVal
  65.                        .lValEnd = avArray(li) - 1
  66.                    End With
  67.                    lNextVal = (avArray(li) + 1)
  68.  
  69.                ElseIf (lNextVal = lValIni) Then
  70.                    tRangos(lIndex).lValEnd = avArray(li) - 1
  71.                    lNextVal = (avArray(li) + 1)
  72.  
  73.                End If
  74.            ElseIf (avArray(li) = tRangos(0).lValIni) Then
  75.                lIndex = lIndex - 1
  76.                lNextVal = tRangos(0).lValIni + 1
  77.            Else
  78.                lNextVal = lNextVal + 1
  79.            End If
  80.        Next
  81.  
  82.        If (lIndex > -1) Then
  83.            If ((tRangos(lIndex).lValEnd + 1) <= lValEnd And lNextVal <= lValEnd) Then
  84.                lIndex = lIndex + 1
  85.                ReDim Preserve tRangos(0 To lIndex)
  86.                With tRangos(lIndex)
  87.                    .lValIni = avArray(lUB) + 1
  88.                    .lValEnd = lValEnd
  89.                End With
  90.            Else
  91.                ReDim Preserve tRangos(0 To lIndex)
  92.            End If
  93.  
  94.        ElseIf (lNextVal > lValEnd) Then
  95.            NumeroAleatorioEx = lValIni - 1
  96.            Exit Function
  97.  
  98.        Else
  99.            lIndex = 0
  100.            tRangos(lIndex).lValIni = lNextVal
  101.  
  102.        End If
  103.  
  104.        li = NumeroAleatorio(0, lIndex)
  105.        NumeroAleatorioEx = NumeroAleatorio(tRangos(li).lValIni, tRangos(li).lValEnd)
  106.        Exit Function
  107.  
  108.    End If
  109. GetNumber:
  110.    NumeroAleatorioEx = NumeroAleatorio(lValIni, lValEnd)
  111. End Function
  112.  
  113. Private Sub Form_Load()
  114. Dim ii              As Integer
  115. Dim lres            As Long
  116. Dim vArray()        As Variant
  117.  
  118. Const lValIni       As Long = 5
  119. Const lValEnd       As Long = 10
  120.  
  121.    lres = NumeroAleatorioEx(lValIni, lValEnd)
  122.    ReDim vArray(0 To 0)
  123.    vArray(ii) = lres
  124.    Debug.Print lres
  125.    For ii = 1 To 11
  126.        lres = NumeroAleatorioEx(lValIni, lValEnd, vArray)
  127.        ReDim Preserve vArray(0 To ii)
  128.        vArray(ii) = lres
  129.        If (lres = (lValIni - 1)) Then
  130.            Debug.Print "Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones."
  131.        Else
  132.            Debug.Print lres
  133.        End If
  134.    Next ii
  135. End Sub
  136.  
  137.  

Salida del ejemplo:

Código:

 10
 7
 9
 8
 6
 5
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.
Ya no se pueden crear mas numeros aleatorios, las esecciones llenan todas las opciones.


Temibles Lunas!¡.


« Última modificación: 27 Mayo 2011, 02:13 por seba123neo » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [source] Numeros Aleatorio desde X a Y con esecciones.
« Respuesta #1 en: 26 Mayo 2011, 12:08 »

 :o
Precioso, justo yo también estaba intentando hacer algo así. :xD :silbar:
Pero mi idea era llenar ya directamente la matriz, con excepciones incluidas, me explico:
Código
  1. sub CargarMatrizAleatoria(Min as long, Max as long, Excepciones() as long, lOutputArr() as long)
La semana que viene a ver si tengo tiempo e intento hacer algo. :)

DoEvents! :P


« Última modificación: 26 Mayo 2011, 12:25 por Psyke1 » En línea

seba123neo
Moderador
***
Desconectado Desconectado

Mensajes: 3.621


"No quiero creer, quiero saber" - Carl Sagan


Ver Perfil WWW
Re: [source] Numeros Aleatorio desde X a Y con excepciones.
« Respuesta #2 en: 27 Mayo 2011, 02:16 »

estoy tratando de descifrar todavia que es la palabra "esecciones"  :xD, te modifique el titulo del post...me falto cambiar esa palabra en el codigo.
En línea

La característica extraordinaria de las leyes de la física es que se aplican en todos lados, sea que tú elijas o no creer en ellas. Lo bueno de las ciencias es que siempre tienen la verdad, quieras creerla o no.

Neil deGrasse Tyson
BlackZeroX (Astaroth)
Wiki

Desconectado Desconectado

Mensajes: 3.128


I'Love...!¡.


Ver Perfil WWW
Re: [source] Numeros Aleatorio desde X a Y con excepciones.
« Respuesta #3 en: 27 Mayo 2011, 04:55 »

@Psyke1

Mas que una matriz quedaría precioso en una clase... al rato lo traslado a una clase para aumentar la velocidad de procesamiento, ya que de este modo se le aumenta el peformance ( en relación procesador/tiempo, pero no memoria ) con una clase.

@seba123neo

Te juro que busque con google como escribirla....
.

Dulces Lunas!¡.
« Última modificación: 27 Mayo 2011, 08:19 por BlackZeroX▓▓▒▒░░ » En línea




CScript (Actualizado 26/06/2013).

FileX <-- Re-modelando...
Web Principal-->[ Blog(VB6/C/C++) | Host File | Scan Port) ]

The Dark Shadow is my passion.
El infierno es mi Hogar, mi novia es Lilit y el metal mi relig
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines