IsNum
#1
A quick little routine to tell you if a string is a number, or not.

Code: (Select All)
Function IsNum%% (PassedText As String)
    text$ = PassedText
    special$ = UCase$(Left$(text$, 2))
    Select Case special$
        Case "&H", "&B", "&O"
            'check for symbols on right side of value
            r3$ = Right$(text$, 3)
            Select Case r3$
                Case "~&&", "~%%", "~%&" 'unsigned int64, unsigned byte, unsigned offset
                    text$ = Left$(text$, Len(text$) - 3)
                Case Else
                    r2$ = Right$(text$, 2)
                    Select Case r2$
                        Case "~&", "##", "%&", "%%", "~%", "&&" 'unsigned long, float, offset, byte, unsigned integer, int64
                            text$ = Left$(text$, Len(text$) - 2)
                        Case Else
                            r$ = Right$(text$, 1)
                            Select Case r$
                                Case "&", "#", "%", "!" 'long, double, integer, single
                                    text$ = Left$(text$, Len(text$) - 1)
                            End Select
                    End Select
            End Select
            check$ = "0123456789ABCDEF"
            If special$ = "&O" Then check$ = "01234567"
            If special$ = "&B" Then check$ = "01"
            temp$ = Mid$(UCase$(text$), 2)
            For i = 1 To Len(temp$)
                If InStr(check$, Mid$(temp$, i, 1)) = 0 Then Exit For
            Next
            If i <= Len(temp$) Then IsNum = -1
        Case Else
            If _Trim$(Str$(Val(text$))) = text$ Then IsNum = -1
    End Select
End Function


Note that this may fail if you're dealing with values that are so large they translate into scientific notation on you.   "1234567890123456788901234567890" is NOT going to be counted as a number, as QB64 would expect to see this written as "1.234567E30", and your string definitely isn't going to compare to that string.  (And the values probably won't match either, as you lost multiple digits to rounding when it became a scientific notation value.) 

If you look close, you'll see that this function is basically one line of code, unless you happen to be passing it &H, &B, &O values -- in which case it has to work much harder to see if the string you passed it is a valid number, or not.  Wink
Reply
#2
And, if one ever needs to know more than just "Is it a number?", there's always my overengineered NumType function.  It'll tell you everything you ever wanted to know about your string and the number types associated with it -- and probably then some!

Code: (Select All)
Const limit = 16

Dim test(limit) As String

Data "123a.3","-123.456","--234","1.23E15","123","dogfood","678.965","54678","-987134","1E15"
Data "&HFF","&B1001111","&O17","&HFF&&","&B12000222","1.E-12"

For i = 1 To limit
    Read test(i)
Next


For i = 1 To limit
    Print "TEST #"; i; ": "; test(i) + " "
    result = NumType(test(i))
    If result = 0 Then Print "INVALID: "; NumErr$
    If result And 1 Then Print "Valid Unsigned Bit.  ";
    If result And 2 Then Print "Valid Unsigned Byte.  ";
    If result And 4 Then Print "Valid Unsigned Integer.  ";
    If result And 8 Then Print "Valid Unsigned Long.  ";
    If result And 16 Then Print "Valid Unsigned Integer64.  ";
    If result And 32 Then Print "Valid Unsigned Bit.  ";
    If result And 64 Then Print "Valid Signed Byte.  ";
    If result And 128 Then Print "Valid Signed Integer.  ";
    If result And 256 Then Print "Valid Signed Long.  ";
    If result And 512 Then Print "Valid Signed Integer64.  ";
    If result And 1024 Then Print "Valid Single.  ";
    If result And 2048 Then Print "Valid Double.  ";
    If result And 4096 Then Print "Valid Float.  ";
    If result And 8192 Then Print "Valid Unsigned Offset.  ";
    If result And 16384 Then Print "Valid Signed Offset.  ";
    Print
    Print
    Sleep
Next

Function NumType~% (text$)
    Shared NumErr$
    Dim TempNum As Integer
    temp$ = UCase$(_Trim$(text$))
    NumErr$ = "": TempNum = 0

    'First look for manually assigned types
    r1$ = Right$(temp$, 1): r = 1
    r2$ = Left$(Right$(temp$, 2), 1)
    Select Case r1$
        Case "`"
            TestFor = 1 'bit
        Case "%"
            If r2$ = "%" Then
                r = 2
                TestFor = 2 'byte
            Else
                TestFor = 3 'integer
            End If
        Case "&" 'long, int64, offset
            If r2$ = "&" Then
                r = 2
                TestFor = 5 'int64
            ElseIf r2$ = "%" Then
                r = 2
                TestFor = 9 'offset
            Else
                TestFor = 4 'long
            End If
        Case "!" 'single
            TestFor = 6
        Case "#" 'double, float
            If r2$ = "#" Then
                r = 2
                TestFor = 8 'float
            Else
                TestFor = 7 'double
            End If
        Case Else 'there's no set type
            TestFor = 0
            r = 0
    End Select


    temp$ = Left$(temp$, Len(temp$) - r) 'strip off the type symbol
    Select Case TestFor
        Case 1 To 5, 9
            r$ = Right$(temp$, 1)
            If r$ = "~" Then Unsigned = -1: temp$ = Left$(temp$, Len(temp$) - 1)
    End Select

    'check for valid prefixes

    l$ = Left$(temp$, 2)
    Select Case l$
        Case "&H"
            temp$ = Mid$(temp$, 3)
            For i = 1 To Len(temp$)
                t$ = Mid$(temp$, i, 1)
                Select Case t$
                    Case "0" To "9", "A" To "F" 'valid
                    Case Else
                        NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  "
                End Select
            Next
            If NumErr$ <> "" Then Exit Function
            GoTo evaluateintegers
        Case "&B"
            temp$ = Mid$(temp$, 3)
            For i = 1 To Len(temp$)
                t$ = Mid$(temp$, i, 1)
                Select Case t$
                    Case "0", "1" 'only valid bit characters
                    Case Else
                        NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  "
                End Select
            Next
            If NumErr$ <> "" Then Exit Function
            GoTo evaluateintegers
        Case "&O"
            temp$ = Mid$(temp$, 3)
            For i = 1 To Len(temp$)
                t$ = Mid$(temp$, i, 1)
                Select Case t$
                    Case "0" To "7" 'only valid oct characters
                    Case Else
                        NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  "
                End Select
            Next
            If NumErr$ <> "" Then Exit Function
            GoTo evaluateintegers
    End Select


    'Test for easy integers
    'First check for positive/negative values; flag for invalid cases of multiple negation.
    If Mid$(temp$, 1, 1) = "-" Then
        negative = -1: temp$ = Mid$(temp$, 2) 'strip off the initial negative
    ElseIf Mid$(temp$, 1, 1) = "+" Then
        temp$ = Mid$(temp$, 2) 'strip off the initial positive
    End If

    For i = 1 To Len(temp$)
        If Mid$(temp$, i, 1) = "-" Then minus = minus + 1
        If Mid$(temp$, i, 1) = "+" Then plus = plus + 1
        If Mid$(temp$, i, 1) = "." Then period = period + 1 'Go ahead and check for multiple periods while we're at it.
        If Mid$(temp$, i, 1) = "E" Or Mid$(temp$, i, 1) = "D" Then
            Exponent = Exponent + 1
            If Mid$(temp$, i + 1, 1) = "-" Or Mid$(temp$, i + 1, 1) = "+1" Then ExponentSign = -1
        End If
    Next

    If period = 0 And Exponent = 0 Then 'we should only have integers to process
        For i = 1 To Len(temp$)
            t$ = Mid$(temp$, i, 1)
            If t$ < "0" Or t$ > "9" Then NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  ": Exit Function
        Next
        GoTo evaluateintegers
    End If

    'At this point forward, we should only have REAL numbers to process

    If Exponent > 1 Then NumErr$ = NumErr$ + "Multiple E/D exponent characters in string.  ": Exit Function

    If ExponentSign = 0 Then
        If minus Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": Exit Function
        If plus Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": Exit Function
    Else
        If minus > 1 Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": Exit Function
        If plus > 1 Then NumErr$ = NumErr$ + "Multiple negative signs (-) encountered.  ": Exit Function
    End If

    If period > 1 Then NumErr$ = NumErr$ + "Multiple decimal points (.) encountered.  ": Exit Function

    If Exponent And period Then
        e = InStr(temp$, "E")
        If e = 0 Then e = InStr(temp$, "D")
        p = InStr(temp$, ".")
        If p > e Then NumErr$ = NumErr$ + "Decimal points (.) AFTER E/D exponent encountered.  ": Exit Function
    End If


    For i = 1 To Len(temp$)
        t$ = Mid$(temp$, i, 1)
        Select Case t$
            Case "0" To "9", "-", "+", ".", "D", "E" 'we should have validated all these characters earlier
            Case Else 'so anything else is invalid
                NumErr$ = NumErr$ + "Invalid Character (" + t$ + ") encountered.  ": Exit Function
        End Select
    Next

    If NumErr$ <> "" Then Exit Function


    'We should've passed all the error checking by this point -- I think...


    evaluateintegers:
    t## = Val(text$)

    'first compare for all types
    If Int(t##) = t## Then
        If t## = -1 Or t## = 0 Then TempNum = TempNum Or 32 'signed bit
        If t## >= -128 And t## <= 127 Then TempNum = TempNum Or 64 'signed byte
        If t## >= -32768 And t## <= 32767 Then TempNum = TempNum Or 128 'signed integer
        If t## >= -2147483648 And t## <= 2147483647 Then TempNum = TempNum Or 256 'signed long
        If t## >= -9223372036854775808 And t## <= 9223372036854775807 Then
            TempNum = TempNum Or 512 'signed integer64
            TempNum = TempNum Or 16384 'signed offset
        End If
        If t## = 1 Or t## = 0 Then TempNum = TempNum Or 1 'unsigned bit
        If t## >= 0 And t## <= 255 Then TempNum = TempNum Or 2 'unsigned byte
        If t## >= 0 And t## <= 65535 Then TempNum = TempNum Or 4 'unsigned integer
        If t## >= 0 And t## <= 4294967295 Then TempNum = TempNum Or 8 'unsigned long
        If t## >= 0 And t## <= 18446744073709551615 Then
            TempNum = TempNum Or 16 'unsigned integer64
            TempNum = TempNum Or 8192 'unsigned offset
        End If
    End If

    If t## >= -2.802597D45 And t## <= 3.402823D+38 Then
        TempNum = TempNum Or 1024 'single
    End If
    If t## >= -4.490656458412465E324 And t## <= 1.797693134862310E+308 Then TempNum = TempNum Or 2048 'double
    If t## >= -1.18E4932 And t## <= 1.18E+4932 Then TempNum = TempNum Or 4096 'float

    If r Then 'we have specific suffix; only decide if the value is valid for it
        TempNum = 0
        If Not Unsigned Then 'unsigned
            Select Case TestFor
                Case 1
                    If t## = -1 Or t## = 0 Then TempNum = 32 'signed bit
                Case 2
                    If t## >= -128 And t## <= 127 Then TempNum = 64 'signed byte
                Case 3
                    If t## >= -32768 And t## <= 32767 Then TempNum = 128 'signed integer
                Case 4
                    If t## >= -2147483648 And t## <= 2147483647 Then TempNum = 256 'signed long
                Case 5, 9
                    If t## >= -9223372036854775808 And t## <= 9223372036854775807 Then
                        If TestFor = 5 Then
                            TempNum = 512 'signed integer64
                        Else
                            TempNum = 16384 'signed offset
                        End If
                    End If
                Case 6
                    If t## >= -2.802597E-45 And t## <= 3.402823E+38 Then TempNum = 1024 'single
                Case 7
                    If t## >= -4.490656458412465E-324 And t## <= 1.797693134862310E+308 Then TempNum = 2048 'double
                Case 9
                    If t## >= -1.18E-4932 And t## <= 1.18E+4932 Then TempNum = 4096 'float
            End Select
        Else
            Select Case TestFor
                Case 1
                    If t## = 0 Or t## = 1 Then TempNum = 1 'unsigned bit
                Case 2
                    If t## >= 0 And t## <= 255 Then TempNum = 2 'unsigned byte
                Case 3
                    If t## >= 0 And t## <= 65535 Then TempNum = 4 'unsigned integer
                Case 4
                    If t## >= 0 And t## <= 4294967295 Then TempNum = 8 'unsigned long
                Case 5, 9
                    If t## >= 0 And t## <= 18446744073709551615 Then
                        If TestFor = 5 Then
                            TempNum = 16 'unsigned integer64
                        Else
                            TempNum = 8192 'unsigned offset
                        End If
                    End If
            End Select
        End If
        If TempNum = 0 Then NumErr$ = "Invalid Suffix.  "
    End If
    NumType = TempNum
End Function
Reply
#3
Interesting! 

You know, I stumbled on a bunch of C library routines that were from std lib. Maybe these could be helpful too?

Code: (Select All)
DECLARE LIBRARY
                           **'ctime.h**
FUNCTION clock () 'arithmetic type elapsed processor representing time.
FUNCTION difftime# (BYVAL time2 AS _UNSIGNED LONG, BYVAL time1 AS _UNSIGNED LONG)
                                      'seconds between time2 and time1
                           **'ctype.h**
FUNCTION isalnum% (BYVAL c AS INTEGER) 'is an alphabet letter(isalpha(c) or isdigit(c))
FUNCTION isalpha% (BYVAL c AS INTEGER) 'is letter (isupper(c) or islower(c))
FUNCTION isdigit% (BYVAL c AS INTEGER) 'is a decimal digit
FUNCTION isgraph% (BYVAL c AS INTEGER) 'is a printing character other than space
FUNCTION islower% (BYVAL c AS INTEGER) 'is a lower-case letter
FUNCTION isprint% (BYVAL c AS INTEGER) 'is printing character. ASCII: &H20 (" ") to &H7E (~)
FUNCTION ispunct% (BYVAL c AS INTEGER) 'is printing character other than space, letter, digit
FUNCTION isspace% (BYVAL c AS INTEGER) 'is space, formfeed, newline, return, tab, vertical tab
FUNCTION isupper% (BYVAL c AS INTEGER) 'is upper-case letter
FUNCTION isxdigit% (BYVAL c AS INTEGER)'is a hexdecimal digit character(0 thru 9 or A thru F)
FUNCTION tolower% (BYVAL c AS INTEGER) 'return lower-case equivalent
FUNCTION toupper% (BYVAL c AS INTEGER) 'return upper-case equivalent

Are these usable by QB64 somehow? I found these in the wiki. https://qb64phoenix.com/qb64wiki/index.php/C_Libraries

I am not suggesting your code for isNum should be changed, or abandoned. Just asking. isdigit% would be similar?
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#4
You have to copy the file ctype.h into the QB64PE directory I guess to make this work, but it does work.

I found my ctype.h file here: i:\git\QB64pe\internal\c\c_compiler\x86_64-w64-mingw32\include\

Copied that to i:\git\QB64pe\

Then used like this:

Code: (Select All)
DECLARE LIBRARY
FUNCTION isdigit% (BYVAL c AS INTEGER) 'is a decimal digit
END DECLARE

PRINT isdigit%(ASC("$")) ' returns 0
PRINT isdigit%(ASC("7")) ' returns 1
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#5
Most of these are so trivial to write, that it's just not worth the effort to import a DECLARE LIBRARY to do them.  For example:

Code: (Select All)
FUNCTION IsDigit (a AS INTEGER)
   IF a >= 48 AND a <=57 THEN IsDigit = -1
END FUNCTION

Code: (Select All)
FUNCTION IsLower(a AS INTEGER)
  IF a AND 32 Then IsLower = -1
END FUNCTION

Code: (Select All)
FUNCTION ToLower(a AS INTEGER)
  ToLower = a OR 32
END FUNCTION

Code: (Select All)
FUNCTION ToUpper(a AS INTEGER)
    ToUpper = a AND NOT 32
END FUNCTION

(And I got tired of scrolling up and down to look and see what else was in the list of things you had, but they all seem to be about that simple to implement.  Wink )
Reply




Users browsing this thread: 4 Guest(s)