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

 

 


Tema destacado: Entrar al Canal Oficial Telegram de elhacker.net


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Src-PoC] Buscar en un Array Ordenado
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Src-PoC] Buscar en un Array Ordenado  (Leído 2,238 veces)
BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
[Src-PoC] Buscar en un Array Ordenado
« en: 31 Diciembre 2010, 00:06 am »

.
Andaba buscando la manera de buscar en un Array de la forma mas RAPIDA posible y bueno, recordando el QuickSort arme este algoritmo que busca en un Array ordenado de forma Ascendente o Desendente un valor en el mismo lo hace de forma Extremadamente rapida...

Se lo dejo en Dos versiones... Recursiva y con un Do... Loop

Aqui se los dejo:

Forma Recursiva (Gasta memoria...)

Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   //                                                         //
  5. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo                 //
  13. '   /////////////////////////////////////////////////////////////
  14.  
  15. option explicit
  16.  
  17. Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
  18. Dim lng_lb                      As Long
  19. Dim lng_Ub                      As Long
  20.    lng_lb = LBound(vBuff&())
  21.    lng_Ub = UBound(vBuff&())
  22.    If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
  23.        ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
  24.    Else
  25.        ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
  26.    End If
  27. End Function
  28.  
  29. Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean
  30.    Select Case vValue
  31.        Case vBuff&(l&)
  32.            p& = l&
  33.            ExitsInArrayR = True
  34.        Case vBuff&(u&)
  35.            p& = u&
  36.            ExitsInArrayR = True
  37.        Case Else
  38.            p = (l& + u&) / 2
  39.            If p <> l& And p& <> u& Then
  40.                If vBuff&(p&) < vValue& Then
  41.                    ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
  42.                ElseIf vBuff&(p&) > vValue& Then
  43.                    ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
  44.                ElseIf vBuff&(p&) = vValue& Then
  45.                    ExitsInArrayR = True
  46.                End If
  47.            End If
  48.    End Select
  49. End Function
  50.  
  51.  

Forma con Do ... Loop

Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   //                                                         //
  5. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo                 //
  13. '   /////////////////////////////////////////////////////////////
  14.  
  15. option explicit
  16.  
  17. Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
  18. Dim lng_lb                      As Long
  19. Dim lng_Ub                      As Long
  20.    lng_lb = LBound(vBuff&())
  21.    lng_Ub = UBound(vBuff&())
  22.    If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
  23.        Dim t                           As Long
  24.        t = lng_Ub
  25.        lng_Ub = lng_lb
  26.        lng_lb = t
  27.    End If
  28.    Do Until ExitsInArrayNR
  29.        Select Case vValue
  30.            Case vBuff&(lng_lb&)
  31.                p& = lng_lb&
  32.                ExitsInArrayNR = True
  33.            Case vBuff&(lng_Ub&)
  34.                p& = lng_Ub&
  35.                ExitsInArrayNR = True
  36.            Case Else
  37.                p = (lng_lb& + lng_Ub&) / 2
  38.                If p <> lng_lb& And p& <> lng_Ub& Then
  39.                    If vBuff&(p&) < vValue& Then
  40.                        lng_lb = p
  41.                    ElseIf vBuff&(p&) > vValue& Then
  42.                        lng_Ub = p
  43.                    ElseIf vBuff&(p&) = vValue& Then
  44.                        ExitsInArrayNR = True
  45.                    End If
  46.                Else
  47.                    Exit Do
  48.                End If
  49.        End Select
  50.    Loop
  51. End Function
  52.  
  53.  


Prueba de Velocidad en comparacion a un Simple For Next...


Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   //                                                         //
  5. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo                 //
  13. '   /////////////////////////////////////////////////////////////
  14.  
  15. Option Explicit
  16.  
  17. Private Declare Function GetTickCount Lib "kernel32" () As Long
  18.  
  19. Private Sub Form_Load()
  20. Dim vBuff&(0 To 99999)
  21. Dim i&, p&
  22. Dim l&
  23. Dim vStr$
  24.    For i& = LBound(vBuff&()) To UBound(vBuff&())
  25.        vBuff(i&) = (99999 * 3) - (i * 3)
  26.    Next i&
  27.    l& = GetTickCount()
  28.    For i& = LBound(vBuff&()) To 999
  29.        Call ExitsInArrayLento(i&, vBuff&(), p&)
  30.    Next i&
  31.    vStr$ = GetTickCount - l&
  32.    l& = GetTickCount()
  33.    For i& = LBound(vBuff&()) To 999
  34.        ' // ExitsInArrayNR es un poquito mas rapido... que ExitsInArray
  35.        Call ExitsInArray(i&, vBuff&(), p&)
  36.    Next i&
  37.    l& = GetTickCount - l&
  38.    MsgBox "ExitsInArrayLento " & vStr$ & vbCrLf & _
  39.           "ExitsInArray " & l
  40. End Sub
  41.  
  42.  
  43. Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
  44. Dim lng_lb                      As Long
  45. Dim lng_Ub                      As Long
  46.    lng_lb = LBound(vBuff&())
  47.    lng_Ub = UBound(vBuff&())
  48.    If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
  49.        ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
  50.    Else
  51.        ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
  52.    End If
  53. End Function
  54.  
  55. Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean
  56.    Select Case vValue
  57.        Case vBuff&(l&)
  58.            p& = l&
  59.            ExitsInArrayR = True
  60.        Case vBuff&(u&)
  61.            p& = u&
  62.            ExitsInArrayR = True
  63.        Case Else
  64.            p = (l& + u&) / 2
  65.            If p <> l& And p& <> u& Then
  66.                If vBuff&(p&) < vValue& Then
  67.                    ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
  68.                ElseIf vBuff&(p&) > vValue& Then
  69.                    ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
  70.                ElseIf vBuff&(p&) = vValue& Then
  71.                    ExitsInArrayR = True
  72.                End If
  73.            End If
  74.    End Select
  75. End Function
  76.  
  77.  
  78.  
  79. Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
  80. Dim lng_lb                      As Long
  81. Dim lng_Ub                      As Long
  82.    lng_lb = LBound(vBuff&())
  83.    lng_Ub = UBound(vBuff&())
  84.    If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
  85.        Dim t                           As Long
  86.        t = lng_Ub
  87.        lng_Ub = lng_lb
  88.        lng_lb = t
  89.    End If
  90.    Do Until ExitsInArrayNR
  91.        Select Case vValue
  92.            Case vBuff&(lng_lb&)
  93.                p& = lng_lb&
  94.                ExitsInArrayNR = True
  95.            Case vBuff&(lng_Ub&)
  96.                p& = lng_Ub&
  97.                ExitsInArrayNR = True
  98.            Case Else
  99.                p = (lng_lb& + lng_Ub&) / 2
  100.                If p <> lng_lb& And p& <> lng_Ub& Then
  101.                    If vBuff&(p&) < vValue& Then
  102.                        lng_lb = p
  103.                    ElseIf vBuff&(p&) > vValue& Then
  104.                        lng_Ub = p
  105.                    ElseIf vBuff&(p&) = vValue& Then
  106.                        ExitsInArrayNR = True
  107.                    End If
  108.                Else
  109.                    Exit Do
  110.                End If
  111.        End Select
  112.    Loop
  113. End Function
  114.  
  115. Private Function ExitsInArrayLento(ByRef Value As Long, ByRef ArrayCollection() As Long, Optional ByRef OutInIndex As Long) As Boolean
  116.    For OutInIndex = LBound(ArrayCollection) To UBound(ArrayCollection)
  117.        If ArrayCollection(OutInIndex) = Value Then
  118.            ExitsInArrayLento = True
  119.            Exit Function
  120.        End If
  121.    Next
  122. End Function
  123.  
  124.  

Temibles Lunas!¡.
.


« Última modificación: 31 Diciembre 2010, 00:27 am por BlackZeroX▓▓▒▒░░ » En línea

The Dark Shadow is my passion.
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [Src-PoC] Buscar en un Array Ordenado
« Respuesta #1 en: 31 Diciembre 2010, 00:34 am »

Me encantó Black! ;-)
Como te dije por el msn postearé mi función en estos dias :D

Código
  1. ' // ExitsInArrayNR es un poquito mas rapido... que ExitsInArray
:xD
Solo un poquito, yo diría un muchito más bien... :laugh:

DoEvents! :P


En línea

Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Array [Ir apilando valores y buscar un valor]
Java
Debci 6 6,224 Último mensaje 12 Septiembre 2009, 11:27 am
por Debci
Buscar links y meter en un array!
PHP
A2Corp 3 3,757 Último mensaje 11 Mayo 2010, 06:03 am
por A2Corp
Buscar en un array
Programación Visual Basic
kay19 1 1,722 Último mensaje 18 Mayo 2010, 02:17 am
por Psyke1
Problema al buscar menor en un array y puntuar
Programación General
raleva 0 1,602 Último mensaje 3 Febrero 2016, 11:09 am
por raleva
Buscar elemento k-esimo en un array no ordenado
Java
lRetro 3 8,348 Último mensaje 10 Noviembre 2017, 22:13 pm
por Serapis
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines