[RETO] Reemplazo de Funcion IsNumeric

Iniciado por 79137913, 10 Agosto 2011, 16:37 PM

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

79137913

HOLA!!!

Viendo como ha decaido la actividad y nivel en el foro, me propongo aunque sea a que las nuevas mentes que hay aqui hagan un pequeño reto que les propongo...

El Reto es hacer una funcion que remplace efectivamente a la funcion IsNumeric que viene de fabrica en vb...

Deberan usar para nombrar la funcion un metodo como este:
Código (vb) [Seleccionar]
Private Function IsNumeric_SuNickReducido(str As String) As Boolean
'Ejemplos:
'Raul338:
Private Function IsNumeric_r338(str As String) As Boolean
'79137913:
Private Function IsNumeric_7913(str As String) As Boolean


Ejemplos de lo que devuelve la funcion original:
IsNumeric("asdf") ->False
IsNumeric("a12f") ->False
IsNumeric("12,12") ->True
IsNumeric("12.12") ->True
IsNumeric("12,23,34") ->False
IsNumeric("133.23.330") ->True
IsNumeric("36.658,30") ->True
IsNumeric("81,838.59") ->True


Espero que hayan entendido, TODOS pueden participar...

Es un reto dentro de todo simple...

Cuando esten todas las funciones se competira para encontrar al que hizo el codigo mas rapido(se mide con ctiming), luego se tomara de referencia la funcion original para ver si alguien la supera.

Notas:
·Las funciones y variables booleanas se inicializan en False.
·Se recomienda usar APIs.
·Se recomienda usar InStr.
·Se recomienda utilizar arrays de bytes.
·Se vale usar BadTypeConvert // EvilTypeConvert
·Recuerden que el tipo numerico mas rapido en vb es el Entero Largo (Long).


GRACIAS POR LEER!!!
"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*

Sanlegas

#1
Código (vb) [Seleccionar]
Public Function Is_NumberT(ByRef Str As String) As Boolean
On Error GoTo err
        Str = Str + 0
        Is_NumberT = True
        Exit Function
err:
End Function



Salu2  :-*

79137913

HOLA!!!

No crei que a nadie se le ocurriera eso XD mi forma es Casi igual, justo estaba hablando con Raul338 y me dijo que era Magia Negra eso XD Pero me gusta asi...

En fin... Mi codigo:

Código (vb) [Seleccionar]
Private Function IsNumeric_7913(str As String) As Boolean
Dim x As Double
On Error GoTo Nonum
    x = str
    IsNumeric_7913 = True
Nonum:
End Function


GRACIAS POR LEER!!!
"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*

AlxSpy

Código (vb) [Seleccionar]
Option Explicit


Private Sub Command1_Click()
   Dim Dato As String
   Dato = Text1.Text
   MsgBox IsNumeric_Alx(Dato)
End Sub

Public Function IsNumeric_Alx(byval Dato As Variant) As Boolean
   Dim Temporal As String, X As Long
   Temporal = Dato
   For X = 0 To 9
       Temporal = Replace(Temporal, X, "")
   Next X
   If Len(Temporal) = 0 Then IsNumeric_Alx = True
End Function

raul338

#4
Código (vb) [Seleccionar]

Option Explicit
Private Const leTest As String = "asdf|a12f|12,12|12.12|12,23,34|133.23.330|36.658,30|81,838.59|11111111111111111111|1..3"
Private Const leSep As String = "|"

Private Sub Form_Load()
   Dim sTest() As String, i As Integer
   sTest = Split(leTest, leSep)
   For i = LBound(sTest) To UBound(sTest)
       Debug.Print sTest(i), IsNumeric_r338(sTest(i))
   Next
End Sub

' ==================================

Private Function IsNumeric_r338(str As String) As Boolean
   Dim cReg As Object
   Set cReg = CreateObject("VBScript.RegExp")
   With cReg
       ' Testeamos con . como separador de miles y , como separador de decimales
       ' Personalmente seria para mi "^-?(?:\d{1,3}(?:\.\d{3})*|\d+)(?:\,\d+)?$"
       ' ya que 133.23.330 no es un numero aunque IsNumeric diga que si ¬¬
       .Pattern = "^-?(?:\d{1,3}(?:\.\d{1,3})*|\d+)(?:\,\d+)?$"
       .Global = True
       .IgnoreCase = True
   End With
   IsNumeric_r338 = cReg.Test(str)
   If Not IsNumeric_r338 Then
       ' Testeamos con , como separador de miles y . como separador de decimales
       cReg.Pattern = "^(?:\d{1,3}(?:\,\d{3})*|\d+)(?:\.\d+)?$"
       IsNumeric_r338 = cReg.Test(str)
   End If
   Set cReg = Nothing
End Function


Soporta tantas cifras como caracteres que soporta string. Y números negativos :D


asdf          False
a12f          False
12,12         True
12.12         True
12,23,34      False
133.23.330    True
36.658,30     True
81,838.59     True
11111111111111111111        True
1..3          False

TGa.

#5
hola ;D aca esta mi funcion

Código (vb) [Seleccionar]

Private Function IsNumeric_TGa(str As String) As Boolean
   Dim sAux As String
   Dim lPos As Long, lCont As Long, lAsc As Long
   lPos = 1

   Do While lPos <= Len(str)
       IsNumeric_TGa = True
       sAux = Mid$(str, lPos, 1)
       lAsc = Asc(sAux)
       If (lAsc >= 48 And lAsc <= 57) Or (lAsc >= 43 And lAsc <= 46) Then
           If lAsc = 44 Then
               lCont = lCont + 1
               If lCont > 1 Then
                   IsNumeric_TGa = False
                   Exit Function
               End If
           End If
       Else
           IsNumeric_TGa = False
           Exit Function
       End If
       lPos = lPos + 1
   Loop
End Function


Modificado: Espero que ahora funcione

BlackZeroX

#6
No usar esta funcion para el test, usar la 2.1

http://foro.elhacker.net/programacion_visual_basic/reto_reemplazo_de_funcion_isnumeric-t336067.0.html;msg1651317#new

Hace mucho que no participo en retos aqui dejo mi codigo.

Es mucho codigo pero trabaja rapido e identico que isNumeric de VB.



Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 1.0
Dim lChar   As Long
Dim lPos    As Long
Dim lLn     As Long
Dim lSwich  As Long     '   //  Switcher

Const PUNTO_DECIMAL As Long = &H1
Const SIGNO_SUMA    As Long = &H2
Const SIGNO_RESTA   As Long = &H4
Const ENTER_BEGIN   As Long = &H8
'Const ENTER_END     As Long = &H10 '   //  Sin uso...

   lLn = Len(sString)
   If (lLn = 0) Then Exit Function
   For lPos = 1 To lLn
       lChar = Asc(Mid$(sString, lPos, 1))      ' // <--- Esta linea es seguro que redusca la velocidad del algoritmo...
       Select Case lChar
           Case Is >= 48 And cChar <= 57
               isNumeric_Black = True
               
           Case 32
               If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
               
           Case 46            '   //  "."  Solo 1
               If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
               If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
               lSwich = (lSwich Or PUNTO_DECIMAL)
               
           Case 43            '   //  "+" Solo 1
               If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
               If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
               If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
               If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
               lSwich = (lSwich Or SIGNO_SUMA)
               
           Case 45            '   //  "-"  Solo 1
               If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
               If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
               If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
               If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
               lSwich = (lSwich Or SIGNO_RESTA)
               
           Case 9              '   //  vbTab       Se permite la cantidad que sea.
               If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN)
               
           Case 13
               If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then Exit Function
               lSwich = (lSwich Or ENTER_BEGIN)
               
           Case 10
               If ((lSwich And ENTER_BEGIN) = ENTER_BEGIN) Then lSwich = (lSwich Xor ENTER_BEGIN) Else Exit For
           
           Case Else
               Exit For
       End Select
   Next
End Function



Codigo completo de mi test:



Private Sub Form_Load()

   Debug.Print isNumeric_Black("+.0"),
   Debug.Print isNumeric("+.0")
   
   Debug.Print isNumeric_Black("+."),
   Debug.Print isNumeric("+.")
   
   Debug.Print isNumeric_Black("+"),
   Debug.Print isNumeric("+")
   
   Debug.Print isNumeric_Black("-"),
   Debug.Print isNumeric("-")
   
   Debug.Print isNumeric_Black("."),
   Debug.Print isNumeric(".")
   
   Debug.Print isNumeric_Black(vbTab & " .+0"),
   Debug.Print isNumeric(vbTab & " .+0")
   
   Debug.Print isNumeric_Black(".0"),
   Debug.Print isNumeric(".0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0")
   
   Debug.Print isNumeric_Black(vbTab & Space(10) & vbNewLine & " +-+-.+.0"),
   Debug.Print isNumeric(vbTab & Space(10) & vbNewLine & " +-+-.+.0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0")

End Sub



OutPut:



Verdadero     Verdadero
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero



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

BlackZeroX

#7
No usar esta funcion para el test, usar la 2.1

http://foro.elhacker.net/programacion_visual_basic/reto_reemplazo_de_funcion_isnumeric-t336067.0.html;msg1651317#new


Actualizo el codigo a una version 1.1...




Public Function isNumeric_Black(ByRef sString As String) As Boolean
'   //  Version 1.1 (Fixed)
Dim lChar   As Long
Dim lPos    As Long
Dim lLn     As Long
Dim lSwich  As Long     '   //  Switcher

Const PUNTO_DECIMAL As Long = &H1
Const SIGNO_SUMA    As Long = &H2
Const SIGNO_RESTA   As Long = &H4

   lLn = Len(sString)
   If (lLn = 0) Then Exit Function
   For lPos = 1 To lLn
       lChar = Asc(Mid$(sString, lPos, 1))     '   //  <--Esta linea puede reducir la velocidad del algoritmo..
       If (lChar >= 48 And lChar <= 57) Then
           isNumeric_Black = True
       Else
           Select Case lChar
               Case 46            '   //  "."  Solo 1
                   If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                   lSwich = (lSwich Or PUNTO_DECIMAL)
                   
               Case 43            '   //  "+" Solo 1
                   If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                   If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                   If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                   lSwich = (lSwich Or SIGNO_SUMA)
                   
               Case 45            '   //  "-"  Solo 1
                   If ((lSwich And SIGNO_SUMA) = SIGNO_SUMA) Then Exit Function
                   If ((lSwich And SIGNO_RESTA) = SIGNO_RESTA) Then Exit Function
                   If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                   lSwich = (lSwich Or SIGNO_RESTA)
                   
               '   //  Espacio, Tabulador, (13 + 10) = vbNewLine
               Case 32, 9, 13, 10, 11, 12, 36, 38, 160   '   //   Despues del 10 son otros Espacios en Blanco
                   If ((lSwich And PUNTO_DECIMAL) = PUNTO_DECIMAL) Then Exit Function
                   
               Case Else
                   Exit For
                   
           End Select
       End If
   Next
End Function



Nuevo Codigo de test...



Private Sub Form_Load()
Dim i As Integer

   Debug.Print isNumeric_Black("0"),
   Debug.Print isNumeric("0")
   
   For i = 0 To 255
       If (isNumeric_Black(Chr(i) & "0") <> isNumeric(Chr(i) & "0")) Then
           Debug.Print isNumeric_Black(Chr(i) & "0"); isNumeric(Chr(i) & "0")
           Debug.Print Chr(i); i
       End If
   Next i
   
   Debug.Print isNumeric_Black("+0."),
   Debug.Print isNumeric("+0.")
   
   Debug.Print isNumeric_Black("+.  0"),
   Debug.Print isNumeric("+.  0")
   
   Debug.Print isNumeric_Black("+"),
   Debug.Print isNumeric("+")
   
   Debug.Print isNumeric_Black("+  0"),
   Debug.Print isNumeric("+  0")
   
   Debug.Print isNumeric_Black(Chr(10) & "-0"),
   Debug.Print isNumeric(Chr(10) & "-0")
   
   Debug.Print isNumeric_Black("."),
   Debug.Print isNumeric(".")
   
   Debug.Print isNumeric_Black(vbTab & " .+0"),
   Debug.Print isNumeric(vbTab & " .+0")
   
   Debug.Print isNumeric_Black(".0"),
   Debug.Print isNumeric(".0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " .+0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +.0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " +00.0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & vbNewLine & vbTab & vbNewLine & " --.0")
   
   Debug.Print isNumeric_Black(vbTab & Space(10) & vbNewLine & " +-+-.+.0"),
   Debug.Print isNumeric(vbTab & Space(10) & vbNewLine & " +-+-.+.0")
   
   Debug.Print isNumeric_Black(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0"),
   Debug.Print isNumeric(vbTab & vbNewLine & vbTab & Space(10) & vbTab & vbNewLine & " +.0")

End Sub



Output:



Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero
Falso         Falso
Verdadero     Verdadero
Verdadero     Verdadero
Falso         Falso
Falso         Falso
Verdadero     Verdadero



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

Sanlegas

Cita de: 79137913 en 10 Agosto 2011, 18:24 PM
HOLA!!!

No crei que a nadie se le ocurriera eso XD mi forma es Casi igual, justo estaba hablando con Raul338 y me dijo que era Magia Negra eso XD Pero me gusta asi...

En fin... Mi codigo:

Código (vb) [Seleccionar]
Private Function IsNumeric_7913(str As String) As Boolean
Dim x As Double
On Error GoTo Nonum
    x = str
    IsNumeric_7913 = True
Nonum:
End Function


GRACIAS POR LEER!!!

:xD , y se me habia ocurrido sumarle 0, pero no se me ocurrio que al sumarle "0" es como si no hubiera pasado nada matematicamente y lo pudiera eliminar dejandolo igual que tu code  :laugh:

habria que testear la velocidad... un saludo!.

LeandroA

Hola, esta solo implementa una forma de comprobar el tipo de variable, pero al final utiliza el error para comprovar
Private Function IsNumeric_LeandroA(Expression) As Boolean
    Select Case VarType(Expression)
        Case vbBoolean, vbByte, vbInteger, vbLong, vbCurrency, vbDecimal, vbDouble, vbNull, vbEmpty, vbError
            IsNumeric_LeandroA = True
        Case vbArray, vbDataObject, vbDate, vbObject, vbUserDefinedType
            IsNumeric_LeandroA = False
        Case vbString
            If Val(Expression) <> 0 Then
                IsNumeric_LeandroA = True
            Else
                On Error Resume Next
                IsNumeric_LeandroA = Abs(Expression) + 1
            End If
    End Select
End Function


lo unico que gana en velocidad es si el parametro no fue definido como string.


IsNumeric_LeandroA(85.54778)
IsNumeric_LeandroA(-85.54778)
IsNumeric_LeandroA(8554778)
IsNumeric_LeandroA(me)