Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: BlackZeroX en 31 Diciembre 2010, 00:06 am


Título: [Src-PoC] Buscar en un Array Ordenado
Publicado por: BlackZeroX 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 (http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=14:artquicksortybublesort&catid=2:catprocmanager&Itemid=8) 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!¡.
.

Título: Re: [Src-PoC] Buscar en un Array Ordenado
Publicado por: Psyke1 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


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