[RETO] Alternativa a Instr()

[BlackZeroX]

.
Plagiador pense que no la hibas a poner ¬¬", es en cierta manera IGUAL a la primera que puse, solo que tu usas Len a cada rato ¬¬".

Bueno, dejo mi segunda manera de hacerlo...

Código (vb) [Seleccionar] Expandir

Private Function InstrMrFrog02&(ByVal Start&, ByVal String1$, ByVal String2$)
Dim lTemp&, lenStr1&
    lenStr1& = VBA.Len(String1$)
    If CBool(lenStr1&) Then
        If CBool(VBA.LenB(String2$)) Then
            lTemp& = Len(VBA.Split(String1$, String2$)(&H0&))
            If Not (lTemp& = lenStr1&) Then
                InstrMrFrog02& = (lTemp& + &H1&)
            End If
        End If
    End If
End Function


Creo que sería conveniente no testear casi a cada función que se añade, mejor esperar al final y hacerlo todo de una vez, ¿no?

DoEvents!

Teoricamente lo que estas haciendo e slo mismo que yo hice...  ¬¬".

http://foro.elhacker.net/programacion_visual_basic/reto_alternativa_a_instr-t315420.0.html;msg1562191#msg1562191

Código (Vb) [Seleccionar] Expandir



Public Function RetInstr(ByVal Start As String, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long
Dim lng_ST1  As Long
    lng_ST1 = Len(String1)
    If Not Start > lng_ST1 Then
        RetInstr = Start + Len(Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)(0)) + 1
        If RetInstr > lng_ST1 Then RetInstr = 0
    End If
End Function



Temibles Lunas!¡.

[Psyke1]

@Black
No me fije en la tuya para hacerlo, no soy tan descarado...  
Pero ahora que lo dices : sí, son practicamente iguales, esta no cuenta...  

@Tenient101

Me refiero al 4 argumento que trae el Instr()   :

Código (vb) [Seleccionar] Expandir

Compare As VbCompareMethod

DoEvents!

[BlackZeroX]

.
No hay problema el algoritmo que te dige trae errores que corregi en mi otro algoritmo

http://foro.elhacker.net/programacion_visual_basic/reto_alternativa_a_instr-t315420.0.html;msg1562386#msg1562386

Código (Vb) [Seleccionar] Expandir



Public Function RetInstr(ByVal Start As Long, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long
Dim lng_ST1  As Long
    lng_ST1 = Len(String1)
    If Not Start > lng_ST1 Then
        If Start = 1 Then
            RetInstr = (Start + Len(Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)(0))) + 1
        Else
            RetInstr = (Start + Len(Split(Right$(String1, lng_ST1 - Start + 1), String2, 2, Compare)(0)))
        End If
        If RetInstr > lng_ST1 Then RetInstr = 0
    End If
End Function



Temibles Lunas!¡.
.

[raul338]

Alguien deberia hacer limpieza aca

Mejore el sistemita de pruebas, y agrego una prueba mas (gracias BlackZeroX) se busca un string nulo (se pueden hacer mas pruebas, ej buscar "abc" en "a", etc pero habria que modificar mas, hacerlo mas personalizable xD).

Y agregue que se ordene automaticamente los resultados

Código [Seleccionar] Expandir



============ RETO INSTR 01/01/2011 - 11:19:42 p.m. ============
Nº de vueltas: 250
String donde buscar: Baila baila baila como Juana, baila la cubana, parece refresco de cola, a mi me parece que estás bien buena.
3 Llamadas, cada una con los siguientes parametros en 'start': 1 10 20

=== PRUEBA 1 ================
String a buscar: col
============ COMPROBACION ============
InStr: 67 67 67
Los siguientes no devuelven los mismos valores, seguido de su devolucion
============ VELOCIDAD ============
00 InStr               00,526022
01 Tenient101          02,011307
02 Tokes v2            02,248696
03 BlackZeroX          02,377656
04 Mr Frog(BlackZeroX) 02,381506
05 Raul338             02,476462
06 79137913            02,662523
07 Miseryk             03,857809
08 Tokes               03,988052
09 gaston93            06,426102
10 krabby              06,745615


=== PRUEBA 2 ================
String a buscar: la
============ COMPROBACION ============
InStr: 4 10 34
Los siguientes no devuelven los mismos valores, seguido de su devolucion
Mr. Frog(b0x) 4 4 4
============ VELOCIDAD ============
00 InStr               00,507416
01 Tenient101          02,110754
02 BlackZeroX          02,410378
03 Mr Frog(BlackZeroX) 02,412944 ' No paso la comprobacion
04 Tokes v2            02,450156
05 Raul338             02,522015
06 79137913            02,820355
07 Miseryk             03,936725
08 Tokes               04,002167
09 gaston93            05,453448
10 krabby              07,029840


=== PRUEBA 3 ================
String a buscar: Ñ
============ COMPROBACION ============
InStr: 0 0 0
Los siguientes no devuelven los mismos valores, seguido de su devolucion
============ VELOCIDAD ============
00 InStr               00,742880
01 Mr Frog(BlackZeroX) 02,393055
02 BlackZeroX          02,406528
03 gaston93            02,632368
04 krabby              02,923010
05 Raul338             22,377361
06 Tokes v2            22,565989
07 79137913            27,793681
08 Tenient101          28,396136
09 Tokes               45,295668
10 Miseryk             87,607375


=== PRUEBA 4 ================
String a buscar:
============ COMPROBACION ============
InStr: 1 10 20
Los siguientes no devuelven los mismos valores, seguido de su devolucion
Miseryk 0 0 0
gaston93 0 0 0
Mr. Frog(b0x) 0 0 0
Tokes 0 0 0
79137913 0 0 0
Tokes(raul338) -1 -1 -1
Tenient101 -1 -1 -1
BlackZeroX 0 0 0
krabby 0 0 0
============ VELOCIDAD ============
00 Miseryk             00,173146 ' No paso la comprobacion
01 79137913            00,206509 ' No paso la comprobacion
02 Raul338             00,216133
03 Tenient101          00,232173 ' No paso la comprobacion
04 krabby              00,333544 ' No paso la comprobacion
05 Mr Frog(BlackZeroX) 00,381664 ' No paso la comprobacion
06 Tokes v2            00,406686
07 InStr               00,425934
08 BlackZeroX          01,805356 ' No paso la comprobacion
09 gaston93            02,109471 ' No paso la comprobacion
10 Tokes               36,895304 ' No paso la comprobacion

Test made by Raul338. Thanks to BlackZeroX


http://www.mediafire.com/?sws0gx764h4xake

Modifique 2 lineas de mi funcion tambien!

[krabby]

propongo que para no estar codeando a cada rato haciendo pequeñas mejoras, mejor averiguamos todo lo que hace el instr , luego ponemos a prueba el instr en distintos casos para ver lo que resulta, por ejmplo: que es lo que devuelve cuando se busca cadenas vacias, o que devuelve cuando se le pasa una posicion mayor a la cadena de busqueda, etc... y luego tratamos de igualar, o mejor dicho imitar al instr y despues vemos cual de todos los codes es el mejor.


editado: Mr Frog. anda pensando en otro reto, y lo lanzas despues de este.

[BlackZeroX]

.
* Si String1 = "" y String2 = "" entonces se retorna 0
* Si String1 <> "" y String = "" entonces; Segun el siguiente caso
  Si Start = 1  se retorna Start
  Si Start > 1 se retorna Start
* Si string1 = "" y String2 <> "" entonces se retorna 0
* El Caso que falta Son por logica y ya esta hecho... es decir la busqueda pertiente y Retornar 0 si no se encontro o retornar la posicion donde se encontro.

Código (Vb) [Seleccionar] Expandir



Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long

Public Function RetInstr2(ByVal Start As Long, ByVal String1 As String, ByVal String2 As String, Optional ByVal Compare As VbCompareMethod = VbCompareMethod.vbBinaryCompare) As Long
Dim lng_ST1  As Long
Dim lng_ST2  As Long
    lng_ST1 = lstrlenW(StrPtr(String1))
    lng_ST2 = lstrlenW(StrPtr(String2))
    If Start < 0 Then Start = 0
    If lng_ST2 > 0 Then
        If Not Start > lng_ST1 Then
            If Start = 1 Then
                If lng_ST2 > 1 Then
                    RetInstr2 = (Start + lstrlenW(StrPtr(Split(Right$(String1, lng_ST1 - Start), String2, 2, Compare)(0)))) + 1
                Else
                    RetInstr2 = (Start + lstrlenW(StrPtr(Split(Right$(String1, lng_ST1), String2, 2, Compare)(0))))
                End If
            Else
                RetInstr2 = (Start + lstrlenW(StrPtr(Split(Right$(String1, lng_ST1 - Start + 1), String2, 2, Compare)(0))))
            End If
            If RetInstr2 > lng_ST1 Then RetInstr2 = 0
        End If
    ElseIf lng_ST1 > 0 Then
        RetInstr2 = Start
    Else
        RetInstr2 = 0
    End If
End Function



editado: Mr Frog. anda pensando en otro reto, y lo lanzas despues de este.

tengo uno y se llama zig zag mañana lo pongo...

[krabby]

Bien pues ... ya son las 2:35 am por aki y me kgo de sueño, mañana espero el reto zig zag (me suena a encriptacion) , pero weno qué será? qué será?
hasta mañana.

[Karcrack]

@BlackZeroX▓▓▒▒░░: Hasta donde yo se usar la funcion Len() de VB es mucho mas rapido, ya que VB automaticamente mete un DWORD con el tamaño de la cadena antes de ella

Y para todos aquellos que utilizamos un Array... recordad compilar desactivando la comprobacion de seguridad en los Arrays... si no cada vez que haces cualquier acceso al Array comprueba que el tamaño sea mayor que el indice... y eso relentiza mucho

[Psyke1]

@Black
Tiene razón Karcry... testeé velocidad y se nota un ligera tardanza usando api lstrlenW() respecto a Len() de vb.

@karcry
http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=30761&lngWId=1

This code runs as much as 5000 times faster than VB's InStr function!

Jamas podreis superar a InStr()!!!

Te lo dedico


Fue divertido el reto, a ver si retomamos los retos poco a poco en esta sección, que es una forma divertida de pasar el rato y mejorar/aprender...
Ahora a por el de Black!
http://goo.gl/7Wkqb

DoEvents!

[raul338]

Veo que varios usaron Split, sin embargo creo recordar que habiamos puesto un reto tratando de reemplazar a Split

Nose si podriamos juntarlos (no encuetro el thread) nose , se me ocurre