[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]


'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // 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]


'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // 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]


'
'   /////////////////////////////////////////////////////////////
'   //                                                         //
'   // 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!¡.
.