[Src-PoC] Buscar en un Array Ordenado

[BlackZeroX]

.
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 (vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

option explicit

Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
   Else
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
   End If
End Function

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
   Select Case vValue
       Case vBuff&(l&)
           p& = l&
           ExitsInArrayR = True
       Case vBuff&(u&)
           p& = u&
           ExitsInArrayR = True
       Case Else
           p = (l& + u&) / 2
           If p <> l& And p& <> u& Then
               If vBuff&(p&) < vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
               ElseIf vBuff&(p&) > vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
               ElseIf vBuff&(p&) = vValue& Then
                   ExitsInArrayR = True
               End If
           End If
   End Select
End Function



Forma con Do ... Loop

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

option explicit

Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       Dim t                           As Long
       t = lng_Ub
       lng_Ub = lng_lb
       lng_lb = t
   End If
   Do Until ExitsInArrayNR
       Select Case vValue
           Case vBuff&(lng_lb&)
               p& = lng_lb&
               ExitsInArrayNR = True
           Case vBuff&(lng_Ub&)
               p& = lng_Ub&
               ExitsInArrayNR = True
           Case Else
               p = (lng_lb& + lng_Ub&) / 2
               If p <> lng_lb& And p& <> lng_Ub& Then
                   If vBuff&(p&) < vValue& Then
                       lng_lb = p
                   ElseIf vBuff&(p&) > vValue& Then
                       lng_Ub = p
                   ElseIf vBuff&(p&) = vValue& Then
                       ExitsInArrayNR = True
                   End If
               Else
                   Exit Do
               End If
       End Select
   Loop
End Function




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

Código (Vb) [Seleccionar] Expandir



'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandesido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Option Explicit

Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub Form_Load()
Dim vBuff&(0 To 99999)
Dim i&, p&
Dim l&
Dim vStr$
   For i& = LBound(vBuff&()) To UBound(vBuff&())
       vBuff(i&) = (99999 * 3) - (i * 3)
   Next i&
   l& = GetTickCount()
   For i& = LBound(vBuff&()) To 999
       Call ExitsInArrayLento(i&, vBuff&(), p&)
   Next i&
   vStr$ = GetTickCount - l&
   l& = GetTickCount()
   For i& = LBound(vBuff&()) To 999
       ' // ExitsInArrayNR es un poquito mas rapido... que ExitsInArray
       Call ExitsInArray(i&, vBuff&(), p&)
   Next i&
   l& = GetTickCount - l&
   MsgBox "ExitsInArrayLento " & vStr$ & vbCrLf & _
          "ExitsInArray " & l
End Sub


Public Function ExitsInArray(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p)
   Else
       ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p)
   End If
End Function

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
   Select Case vValue
       Case vBuff&(l&)
           p& = l&
           ExitsInArrayR = True
       Case vBuff&(u&)
           p& = u&
           ExitsInArrayR = True
       Case Else
           p = (l& + u&) / 2
           If p <> l& And p& <> u& Then
               If vBuff&(p&) < vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p)
               ElseIf vBuff&(p&) > vValue& Then
                   ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p)
               ElseIf vBuff&(p&) = vValue& Then
                   ExitsInArrayR = True
               End If
           End If
   End Select
End Function



Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
   lng_lb = LBound(vBuff&())
   lng_Ub = UBound(vBuff&())
   If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
       Dim t                           As Long
       t = lng_Ub
       lng_Ub = lng_lb
       lng_lb = t
   End If
   Do Until ExitsInArrayNR
       Select Case vValue
           Case vBuff&(lng_lb&)
               p& = lng_lb&
               ExitsInArrayNR = True
           Case vBuff&(lng_Ub&)
               p& = lng_Ub&
               ExitsInArrayNR = True
           Case Else
               p = (lng_lb& + lng_Ub&) / 2
               If p <> lng_lb& And p& <> lng_Ub& Then
                   If vBuff&(p&) < vValue& Then
                       lng_lb = p
                   ElseIf vBuff&(p&) > vValue& Then
                       lng_Ub = p
                   ElseIf vBuff&(p&) = vValue& Then
                       ExitsInArrayNR = True
                   End If
               Else
                   Exit Do
               End If
       End Select
   Loop
End Function

Private Function ExitsInArrayLento(ByRef Value As Long, ByRef ArrayCollection() As Long, Optional ByRef OutInIndex As Long) As Boolean
   For OutInIndex = LBound(ArrayCollection) To UBound(ArrayCollection)
       If ArrayCollection(OutInIndex) = Value Then
           ExitsInArrayLento = True
           Exit Function
       End If
   Next
End Function



Temibles Lunas!¡.
.

[Psyke1]

Me encantó Black!
Como te dije por el msn postearé mi función en estos dias

Código (vb) [Seleccionar] Expandir

' // ExitsInArrayNR es un poquito mas rapido... que ExitsInArray

Solo un poquito, yo diría un muchito más bien...

DoEvents!