[Src] IsInArray

Iniciado por Psyke1, 9 Mayo 2011, 14:24 PM

0 Miembros y 1 Visitante están viendo este tema.

Psyke1

Cita de: BlackZeroX▓▓▒▒░░ en  2 Junio 2011, 04:47 AM
.
Actualice el código de mi función.

Temibles Lunas!¡.
Muy bueno, buen trabajo. :)
Resulta muy divertido empezar a sacar versiones de una misma cosa a ver quien lo hace mejor. :)
Veo que te basaste en la mía... :silbar:

DoEvents! :P

BlackZeroX

#11
.
De hecho solo saque la lógica de comparar lpos, si se genera dos veces entonces se haría un bucle infinito que no tendría caso alguno, lo demás es lo mismo de mi código.

Solo reemplace las lineas sombreadas... aun que si quitaba la 2da linea entonces tendria que meter un rango de comparacion...

Código (Vb,15,25,33,34,35) [Seleccionar]


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



Para que veas también quedaría con una simple modificación sin aplicar nada ni sacar nada de tu código (aun que a mi me gusto la lógica de comparar lpos con su anterior valor); aun sigue siendo mas rápida que tu función con esta simple modificación...

Código (vb,27,40) [Seleccionar]


option explicit

Private Sub SwapVals(ByRef lVal1 As Long, ByRef lval2 As Long)
    lval2 = lval2 Xor lVal1
    lVal1 = lVal1 Xor lval2
    lval2 = lval2 Xor lVal1
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 Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
        SwapVals lng_lb, lng_Ub
    End If
   
    Select Case vValue
        Case vBuff&(lng_lb&)
            p& = lng_lb&
            ExitsInArray = True
        Case vBuff&(lng_Ub&)
            p& = lng_Ub&
            ExitsInArray = True
        Case Else
            Do Until ExitsInArray
                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
                        ExitsInArray = True
                    End If
                Else
                    Exit Do
                End If
            Loop
    End Select
End Function



por otro lado en tu código:

La variable c debería espesar desde lngLB ya que esta toma el valor desde lngStart, aun que aun asi estaría bien pero bueno no afecta en lo absoluto en nada.

No entiendo para que es el parámetro bolFindStart deberías documentar un poco tu código (parámetros de entrada, trabajo de la función y resultados de la misma, mas no linea a linea)

Dulces Lunas!¡.
The Dark Shadow is my passion.