elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Recuerda que debes registrarte en el foro para poder participar (preguntar y responder)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [RETO] CompWordsAlphabetically
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] 2 3 4 Ir Abajo Respuesta Imprimir
Autor Tema: [RETO] CompWordsAlphabetically  (Leído 10,014 veces)
Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
[RETO] CompWordsAlphabetically
« en: 11 Marzo 2011, 10:44 am »

¿Qué pasa? :huh: ¿Donde están los retos que caracterizan a  esta sección? :-( :xD
A ver que os parece este:

Parte 1:

Crear una función que compare dos palabras (sin importar mayúsculas) y devuelva:
Código:
0 : Error
1 : La 1ª palabra va antes en el abecedario
2 : La 2ª palabra va antes en el abecedario
3 : Ambas palabras son iguales

Ejemplos:
Código:
"rana"        - ""		-> 0
"hola"        - "holas" -> 1
"bienvenido"  - "bienvenida" -> 2
"Ejemplo"     - "eJempLIficar"  -> 2
"igual"       - "igual"         -> 3
"PALABRA"     - "palabra"       -> 3

Espero haber sido claro...;) Si hay alguna duda preguntad.
Por supuesto vale todo y el más rápido gana :)

PD: La Parte 2 la propondré cuando esté la parte 1 finalizada... :rolleyes:

DoEvents! :P


« Última modificación: 11 Marzo 2011, 14:01 pm por Mr.Frog™ » En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] CompWordsAlphabetically
« Respuesta #1 en: 11 Marzo 2011, 14:09 pm »

HOLA!!!

Listo!!!

Código
  1. Private Function FirstWord7913(W1 As String, W2 As String) As Long
  2.  
  3.    If LenB(W1) = 0 Then
  4.            FirstWord7913 = 0
  5.            Exit Function
  6.    End If
  7.  
  8.    If LenB(W2) = 0 Then
  9.            FirstWord7913 = 0
  10.            Exit Function
  11.    End If
  12.  
  13. Dim ST1 As Byte
  14. Dim ST2 As Byte
  15.    ST1 = LCase$(W1)
  16.    ST2 = LCase$(W2)
  17.    If LenB(ST1) = LenB(ST2) Then
  18.        If InStrB(1, ST1, ST2, vbBinaryCompare) Then
  19.            FirstWord7913 = 3
  20.            Exit Function
  21.        End If
  22.    End If
  23.  
  24. Dim B1() As Byte
  25. Dim B2() As Byte
  26. B1 = ST1
  27. B2 = ST2
  28. Dim X As Long
  29.    If UBound(B1) > UBound(B2) Then
  30.        For X = 1 To UBound(B2) Step 2
  31.            If B1(X) < B2(X) Then
  32.                FirstWord7913 = 1
  33.                Exit Function
  34.            ElseIf B1(X) > B2(X) Then
  35.                FirstWord7913 = 2
  36.                Exit Function
  37.            End If
  38.        Next
  39.        FirstWord7913 = 2
  40.        Exit Function
  41.    Else
  42.        For X = 1 To UBound(B1) Step 2
  43.            If B1(X) < B2(X) Then
  44.                FirstWord7913 = 1
  45.                Exit Function
  46.            ElseIf B1(X) > B2(X) Then
  47.                FirstWord7913 = 2
  48.                Exit Function
  49.            End If
  50.        Next
  51.        FirstWord7913 = 1
  52.        Exit Function
  53.    End If
  54.  
  55. End Function

GRACIAS POR LEER!!!


« Última modificación: 4 Mayo 2012, 18:58 pm por 79137913 » En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [RETO] CompWordsAlphabetically
« Respuesta #2 en: 11 Marzo 2011, 15:00 pm »

@79137913: No creo que esa versión sea demasiado rápida :xD
Código:
LenB(W1) / 2 = 0
:o Por que divides entre 2? :-\


Código
  1. Option Explicit
  2.  
  3. Sub Main()
  4.    Debug.Print kCompare("rana", "")
  5.    Debug.Print kCompare("hola", "holas")
  6.    Debug.Print kCompare("bienvenido", "bienvenida")
  7.    Debug.Print kCompare("Ejemplo", "eJempLIficar")
  8.    Debug.Print kCompare("igual", "igual")
  9.    Debug.Print kCompare("PALABRA", "palabra")
  10. End Sub
  11.  
  12. Public Static Function kCompare(ByRef s1 As String, ByRef s2 As String) As Long
  13.    Dim b()     As Long
  14.    If (LenB(s1) <> 0) And (LenB(s2) <> 0) Then
  15.        If (Not Not b) = False Then
  16.            ReDim b(-1 To 1)
  17.            b(-1) = 1
  18.            b(1) = 2
  19.            b(0) = 3
  20.        End If
  21.        kCompare = b(StrComp(s1, s2, vbTextCompare))
  22.    End If
  23. End Function

Si no hubieses elegido esos numeros todo seria mas fácil :xD
« Última modificación: 11 Marzo 2011, 19:39 pm por Karcrack » En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] CompWordsAlphabetically
« Respuesta #3 en: 11 Marzo 2011, 15:11 pm »

HOLA!!!

XD se me paso Karcrack, lo vi despues :P

De a poco la voy a ir optimizando

Funcion actualizada:
Cambiado Asc por AscW
Funcion convertida a Long
Agregada comparacion por InstrB

GRACIAS POR LEER!!!
« Última modificación: 11 Marzo 2011, 15:52 pm por 79137913 » En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Edu


Desconectado Desconectado

Mensajes: 1.082


Ex XXX-ZERO-XXX


Ver Perfil
Re: [RETO] CompWordsAlphabetically
« Respuesta #4 en: 11 Marzo 2011, 15:54 pm »

Cuando aprendere a programar como ustedes :( no se rien q todavia q lo hago jaja:

Código
  1. Option Explicit
  2.  
  3. Private Sub Form_Load()
  4.  
  5.    Debug.Print CheckWord("elfo", "elefante")
  6.    Debug.Print CheckWord("ave", "zorro")
  7.    Debug.Print CheckWord("hola", "")
  8.    Debug.Print CheckWord("zero", "zerocool")
  9.    Debug.Print CheckWord("feo", "    ")
  10.    Debug.Print CheckWord("frog", "frog")
  11.    Debug.Print CheckWord("faso", "fasa")
  12.    Debug.Print CheckWord("JOJO", "jojo")
  13.  
  14.  
  15. End Sub
  16.  
  17. Function CheckWord(sFirst As String, sSecond As String) As Long
  18.    Dim i       As Integer
  19.    Dim max     As Integer
  20.  
  21.    sFirst = LCase$(Trim$(sFirst))
  22.    sSecond = LCase$(Trim$(sSecond))
  23.  
  24. ' Verificar error
  25.    If sFirst = "" Or sSecond = "" Then
  26.        CheckWord = 0: Exit Function
  27.    End If
  28.  
  29. ' Establecer valor maximo del bucle
  30.    If Len(sFirst) < Len(sSecond) Then
  31.        max = Len(sFirst)
  32.    Else
  33.        max = Len(sSecond)
  34.    End If
  35.  
  36. 'Bucle
  37. For i = 1 To max
  38.  
  39.    If (Left(sFirst, i) < Left(sSecond, i)) Then
  40.        CheckWord = 1
  41.        Exit Function
  42.  
  43.    ElseIf (Left(sFirst, i) > Left(sSecond, i)) Then
  44.        CheckWord = 2
  45.        Exit Function
  46.  
  47. ' Si por ahora es igual..
  48.    ElseIf (Left(sFirst, i) = Left(sSecond, i)) Then
  49.  
  50.        If i = max Then ' Si ya termina el bucle comprobamos..
  51.  
  52.            If Len(sFirst) > Len(sSecond) Then
  53.                CheckWord = 2
  54.                Exit Function
  55.            End If
  56.  
  57.            If Len(sFirst) < Len(sSecond) Then
  58.                CheckWord = 1
  59.                Exit Function
  60.            End If
  61.  
  62. ' Por descarte..
  63.  
  64.            CheckWord = 3
  65.            Exit Function
  66.  
  67.        End If
  68.    End If
  69.  
  70. Next i
  71.  
  72. End Function
  73.  


Salida:

Código:
 2 
 1
 0
 1
 1
 3
 2
 3

Edit: Ahora veo q me falto lo de comparar con las mayusculas fuck, conrazon se mataban ustedes jaja, no creo q me den las bolas para hacer :)
« Última modificación: 11 Marzo 2011, 16:40 pm por XXX-ZERO-XXX » En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] CompWordsAlphabetically
« Respuesta #5 en: 11 Marzo 2011, 15:56 pm »

HOLA!!!

Jajaja, no me habia percatado del strcomp XD ya fue voy a seguir viendo, GRANDE Karcrack :P

GRACIAS POR LEER!!!
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Edu


Desconectado Desconectado

Mensajes: 1.082


Ex XXX-ZERO-XXX


Ver Perfil
Re: [RETO] CompWordsAlphabetically
« Respuesta #6 en: 11 Marzo 2011, 15:58 pm »

Ma q asco q das Karcrack xD !!
En línea

Karcrack


Desconectado Desconectado

Mensajes: 2.416


Se siente observado ¬¬'


Ver Perfil
Re: [RETO] CompWordsAlphabetically
« Respuesta #7 en: 11 Marzo 2011, 16:12 pm »


PROBLEM? :xD :xD

PD: Quien haga las pruebas de velocidad que sea bondadoso y desactive la comprobacion de tamaño del buffer y esas cositas para que todo sea mas rapido y divertido :laugh:
« Última modificación: 11 Marzo 2011, 16:20 pm por Karcrack » En línea

Psyke1
Wiki

Desconectado Desconectado

Mensajes: 1.089



Ver Perfil WWW
Re: [RETO] CompWordsAlphabetically
« Respuesta #8 en: 11 Marzo 2011, 16:32 pm »

 :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬ :¬¬
Mi forma era igual que la tuya! :(
Te odio, pero me buscaré la vida para hacerlo diferente, quizás no más rapido pero si diferente. :P
Asi que no testeeis aun... >:(
Por la tarde posteo la parte 2 del reto :)

Gracias por participar... :-*

DoEvents! :P
En línea

79137913


Desconectado Desconectado

Mensajes: 1.169


4 Esquinas


Ver Perfil WWW
Re: [RETO] CompWordsAlphabetically
« Respuesta #9 en: 11 Marzo 2011, 16:34 pm »

HOLA!!!

Con razon el "Por supuesto vale todo:¬¬

GRACIAS POR LEER!!!
En línea

"Como no se puede igualar a Dios, ya he decidido que hacer, ¡SUPERARLO!"
"La peor de las ignorancias es no saber corregirlas"

 79137913                          *Shadow Scouts Team*
Páginas: [1] 2 3 4 Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Reto ;)
Ingeniería Inversa
NeoKiller 3 3,201 Último mensaje 15 Agosto 2004, 23:12 pm
por NeoKiller
Reto!!
Ingeniería Inversa
HaCkZaTaN 2 3,215 Último mensaje 10 Septiembre 2004, 09:30 am
por Ðevastador
Reto vB
Ingeniería Inversa
nhouse 2 3,708 Último mensaje 16 Marzo 2005, 09:41 am
por 4rS3NI(
reto en VB6
Ingeniería Inversa
ellolo 1 2,823 Último mensaje 15 Abril 2005, 10:03 am
por UnpaCker!
Un reto !!! « 1 2 3 »
Programación Visual Basic
VirucKingX 24 9,251 Último mensaje 8 Mayo 2006, 23:36 pm
por Kizar
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines