### Author Topic: NumType -- The Overengineered 'Is it a number' FUNCTION.  (Read 1179 times)

0 Members and 1 Guest are viewing this topic.

#### SMcNeill

• QB64 Developer
• Forum Resident
• Posts: 3572
##### NumType -- The Overengineered 'Is it a number' FUNCTION.
« on: January 06, 2019, 11:43:46 AM »
Inspired by the topic here: https://www.qb64.org/forum/index.php?topic=896.0  ("Does a Is Number function exist in QB64?")

Code: QB64: [Select]
1. CONST limit = 16
2.
3. DIM test(limit) AS STRING
4.
5. DATA "123a.3","-123.456","--234","1.23E15","123","dogfood","678.965","54678","-987134","1E15"
6. DATA "&HFF","&B1001111","&O17","&HFF&&","&B12000222","1.E-12"
7.
8. FOR i = 1 TO limit
9.     READ test(i)
10.
11.
12. FOR i = 1 TO limit
13.     PRINT "TEST #"; i; ": "; test(i) + " "
14.     result = NumType(test(i))
15.     IF result = 0 THEN PRINT "INVALID: "; NumErr\$
16.     IF result AND 1 THEN PRINT "Valid Unsigned Bit.  ";
17.     IF result AND 2 THEN PRINT "Valid Unsigned Byte.  ";
18.     IF result AND 4 THEN PRINT "Valid Unsigned Integer.  ";
19.     IF result AND 8 THEN PRINT "Valid Unsigned Long.  ";
20.     IF result AND 16 THEN PRINT "Valid Unsigned Integer64.  ";
21.     IF result AND 32 THEN PRINT "Valid Unsigned Bit.  ";
22.     IF result AND 64 THEN PRINT "Valid Signed Byte.  ";
23.     IF result AND 128 THEN PRINT "Valid Signed Integer.  ";
24.     IF result AND 256 THEN PRINT "Valid Signed Long.  ";
25.     IF result AND 512 THEN PRINT "Valid Signed Integer64.  ";
26.     IF result AND 1024 THEN PRINT "Valid Single.  ";
27.     IF result AND 2048 THEN PRINT "Valid Double.  ";
28.     IF result AND 4096 THEN PRINT "Valid Float.  ";
29.     IF result AND 8192 THEN PRINT "Valid Unsigned Offset.  ";
30.     IF result AND 16384 THEN PRINT "Valid Signed Offset.  ";
31.
32. FUNCTION NumType~% (text\$)
33.     SHARED NumErr\$
34.     temp\$ = UCASE\$(_TRIM\$(text\$))
35.     NumErr\$ = "": NumType = 0
36.
37.     'First look for manually assigned types
38.     r1\$ = RIGHT\$(temp\$, 1): r = 1
39.     r2\$ = LEFT\$(RIGHT\$(temp\$, 2), 1)
40.     SELECT CASE r1\$
41.         CASE "`"
42.             TestFor = 1 'bit
43.         CASE "%"
44.             IF r2\$ = "%" THEN
45.                 r = 2
46.                 TestFor = 2 'byte
47.                 TestFor = 3 'integer
48.         CASE "&" 'long, int64, offset
49.             IF r2\$ = "&" THEN
50.                 r = 2
51.                 TestFor = 5 'int64
52.             ELSEIF r2\$ = "%" THEN
53.                 r = 2
54.                 TestFor = 9 'offset
55.                 TestFor = 4 'long
56.         CASE "!" 'single
57.             TestFor = 6
58.         CASE "#" 'double, float
59.             IF r2\$ = "#" THEN
60.                 r = 2
61.                 TestFor = 8 'float
62.                 TestFor = 7 'double
63.         CASE ELSE 'there's no set type
64.             TestFor = 0
65.             r = 0
66.
67.
68.     temp\$ = LEFT\$(temp\$, LEN(temp\$) - r) 'strip off the type symbol
69.     SELECT CASE TestFor
70.         CASE 1 TO 5, 9
71.             r\$ = RIGHT\$(temp\$, 1)
72.             IF r\$ = "~" THEN Unsigned = -1: temp\$ = LEFT\$(temp\$, LEN(temp\$) - 1)
73.
74.     'check for valid prefixes
75.
76.     l\$ = LEFT\$(temp\$, 2)
77.         CASE "&H"
78.             temp\$ = MID\$(temp\$, 3)
79.             FOR i = 1 TO LEN(temp\$)
80.                 t\$ = MID\$(temp\$, i, 1)
81.                     CASE "0" TO "9", "A" TO "F" 'valid
82.                         NumErr\$ = NumErr\$ + "Invalid Character (" + t\$ + ") encountered.  "
83.             IF NumErr\$ <> "" THEN EXIT FUNCTION
84.             GOTO evaluateintegers
85.         CASE "&B"
86.             temp\$ = MID\$(temp\$, 3)
87.             FOR i = 1 TO LEN(temp\$)
88.                 t\$ = MID\$(temp\$, i, 1)
89.                     CASE "0", "1" 'only valid bit characters
90.                         NumErr\$ = NumErr\$ + "Invalid Character (" + t\$ + ") encountered.  "
91.             IF NumErr\$ <> "" THEN EXIT FUNCTION
92.             GOTO evaluateintegers
93.         CASE "&O"
94.             temp\$ = MID\$(temp\$, 3)
95.             FOR i = 1 TO LEN(temp\$)
96.                 t\$ = MID\$(temp\$, i, 1)
97.                     CASE "0" TO "7" 'only valid oct characters
98.                         NumErr\$ = NumErr\$ + "Invalid Character (" + t\$ + ") encountered.  "
99.             IF NumErr\$ <> "" THEN EXIT FUNCTION
100.             GOTO evaluateintegers
101.
102.
103.     'Test for easy integers
104.     'First check for positive/negative values; flag for invalid cases of multiple negation.
105.     IF MID\$(temp\$, 1, 1) = "-" THEN
106.         negative = -1: temp\$ = MID\$(temp\$, 2) 'strip off the initial negative
107.     ELSEIF MID\$(temp\$, 1, 1) = "+" THEN
108.         temp\$ = MID\$(temp\$, 2) 'strip off the initial positive
109.
110.     FOR i = 1 TO LEN(temp\$)
111.         IF MID\$(temp\$, i, 1) = "-" THEN minus = minus + 1
112.         IF MID\$(temp\$, i, 1) = "+" THEN plus = plus + 1
113.         IF MID\$(temp\$, i, 1) = "." THEN period = period + 1 'Go ahead and check for multiple periods while we're at it.
114.         IF MID\$(temp\$, i, 1) = "E" OR MID\$(temp\$, i, 1) = "D" THEN
115.             Exponent = Exponent + 1
116.             IF MID\$(temp\$, i + 1, 1) = "-" OR MID\$(temp\$, i + 1, 1) = "+1" THEN ExponentSign = -1
117.
118.     IF period = 0 AND Exponent = 0 THEN 'we should only have integers to process
119.         FOR i = 1 TO LEN(temp\$)
120.             t\$ = MID\$(temp\$, i, 1)
121.             IF t\$ < "0" OR t\$ > "9" THEN NumErr\$ = NumErr\$ + "Invalid Character (" + t\$ + ") encountered.  ": EXIT FUNCTION
122.         GOTO evaluateintegers
123.
124.     'At this point forward, we should only have REAL numbers to process
125.
126.     IF Exponent > 1 THEN NumErr\$ = NumErr\$ + "Multiple E/D exponent characters in string.  ": EXIT FUNCTION
127.
128.     IF ExponentSign = 0 THEN
129.         IF minus THEN NumErr\$ = NumErr\$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
130.         IF plus THEN NumErr\$ = NumErr\$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
131.         IF minus > 1 THEN NumErr\$ = NumErr\$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
132.         IF plus > 1 THEN NumErr\$ = NumErr\$ + "Multiple negative signs (-) encountered.  ": EXIT FUNCTION
133.
134.     IF period > 1 THEN NumErr\$ = NumErr\$ + "Multiple decimal points (.) encountered.  ": EXIT FUNCTION
135.
136.     IF Exponent AND period THEN
137.         e = INSTR(temp\$, "E")
138.         IF e = 0 THEN e = INSTR(temp\$, "D")
139.         p = INSTR(temp\$, ".")
140.         IF p > e THEN NumErr\$ = NumErr\$ + "Decimal points (.) AFTER E/D exponent encountered.  ": EXIT FUNCTION
141.
142.
143.     FOR i = 1 TO LEN(temp\$)
144.         t\$ = MID\$(temp\$, i, 1)
145.             CASE "0" TO "9", "-", "+", ".", "D", "E" 'we should have validated all these characters earlier
146.             CASE ELSE 'so anything else is invalid
147.                 NumErr\$ = NumErr\$ + "Invalid Character (" + t\$ + ") encountered.  ": EXIT FUNCTION
148.
149.     IF NumErr\$ <> "" THEN EXIT FUNCTION
150.
151.
152.     'We should've passed all the error checking by this point -- I think...
153.
154.
155.     evaluateintegers:
156.     t## = VAL(text\$)
157.
158.     'first compare for all types
159.     IF INT(t##) = t## THEN
160.         IF t## = -1 OR t## = 0 THEN NumType = NumType OR 32 'signed bit
161.         IF t## >= -128 AND t## <= 127 THEN NumType = NumType OR 64 'signed byte
162.         IF t## >= -32768 AND t## <= 32767 THEN NumType = NumType OR 128 'signed integer
163.         IF t## >= -2147483648 AND t## <= 2147483647 THEN NumType = NumType OR 256 'signed long
164.         IF t## >= -9223372036854775808 AND t## <= 9223372036854775807 THEN
165.             NumType = NumType OR 512 'signed integer64
166.             NumType = NumType OR 16384 'signed offset
167.         IF t## = 1 OR t## = 0 THEN NumType = NumType OR 1 'unsigned bit
168.         IF t## >= 0 AND t## <= 255 THEN NumType = NumType OR 2 'unsigned byte
169.         IF t## >= 0 AND t## <= 65535 THEN NumType = NumType OR 4 'unsigned integer
170.         IF t## >= 0 AND t## <= 4294967295 THEN NumType = NumType OR 8 'unsigned long
171.         IF t## >= 0 AND t## <= 18446744073709551615 THEN
172.             NumType = NumType OR 16 'unsigned integer64
173.             NumType = NumType OR 8192 'unsigned offset
174.
175.     IF t## >= -2.802597D45 AND t## <= 3.402823D+38 THEN
176.         NumType = NumType OR 1024 'single
177.     IF t## >= -4.490656458412465E324 AND t## <= 1.797693134862310E+308 THEN NumType = NumType OR 2048 'double
178.     IF t## >= -1.18E4932 AND t## <= 1.18E+4932 THEN NumType = NumType OR 4096 'float
179.
180.     IF r THEN 'we have specific suffix; only decide if the value is valid for it
181.         NumType = 0
182.         IF NOT Unsigned THEN 'unsigned
183.             SELECT CASE TestFor
184.                 CASE 1
185.                     IF t## = -1 OR t## = 0 THEN NumType = 32 'signed bit
186.                 CASE 2
187.                     IF t## >= -128 AND t## <= 127 THEN NumType = 64 'signed byte
188.                 CASE 3
189.                     IF t## >= -32768 AND t## <= 32767 THEN NumType = 128 'signed integer
190.                 CASE 4
191.                     IF t## >= -2147483648 AND t## <= 2147483647 THEN NumType = 256 'signed long
192.                 CASE 5, 9
193.                     IF t## >= -9223372036854775808 AND t## <= 9223372036854775807 THEN
194.                         IF TestFor = 5 THEN
195.                             NumType = 512 'signed integer64
196.                             NumType = 16384 'signed offset
197.                 CASE 6
198.                     IF t## >= -2.802597E-45 AND t## <= 3.402823E+38 THEN NumType = 1024 'single
199.                 CASE 7
200.                     IF t## >= -4.490656458412465E-324 AND t## <= 1.797693134862310E+308 THEN NumType = 2048 'double
201.                 CASE 9
202.                     IF t## >= -1.18E-4932 AND t## <= 1.18E+4932 THEN NumType = 4096 'float
203.             SELECT CASE TestFor
204.                 CASE 1
205.                     IF t## = 0 OR t## = 1 THEN NumType = 1 'unsigned bit
206.                 CASE 2
207.                     IF t## >= 0 AND t## <= 255 THEN NumType = 2 'unsigned byte
208.                 CASE 3
209.                     IF t## >= 0 AND t## <= 65535 THEN NumType = 4 'unsigned integer
210.                 CASE 4
211.                     IF t## >= 0 AND t## <= 4294967295 THEN NumType = 8 'unsigned long
212.                 CASE 5, 9
213.                     IF t## >= 0 AND t## <= 18446744073709551615 THEN
214.                         IF TestFor = 5 THEN
215.                             NumType = 16 'unsigned integer64
216.                             NumType = 8192 'unsigned offset
217.         IF NumType = 0 THEN NumErr\$ = "Invalid Suffix.  "
218.

Never one to shy from a challenge, and being one who loves to over-engineer a simple project, I bring you the glorious FUNCTION NumType!

Pass it a string and watch as it not only decides IF it's a number for you, but what TYPE of number you gave it!  It detects bits, bytes, integers, singles, floats, offsets...  Signed and unsigned!

It works with &H, &B, &O values.

You can set your string a suffix like 123&& and see if it's a valid _INTEGER64...

It generates error messages, so you can see WHY it's not a number!

It's my over-engineered "Is it a number" Function....

Test it out, and let me know if it generates false positives for anything.

One important note:

A value such as 1E3 *will* be listed as a valid INTEGER.  In the end, it's nothing more than 1,000 -- and that's a perfectly fine integer.  Just because you WRITE an integer in scientific notation, doesn't mean it stops being an integer...

&HFF is an integer.  (255)

2.55E2 is also the same integer.  (255)

Don't think it's a glitch -- it's actually working as intended (to my way of thinking), in these instances.  If 1E2 isn't an integer, then why is &H10??
« Last Edit: January 06, 2019, 11:57:56 AM by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### Cobalt

• Forum Resident
• Posts: 750
• At 60 I become highly radioactive!
##### Re: NumType -- The Overengineered 'Is it a number' FUNCTION.
« Reply #1 on: January 08, 2019, 07:24:55 PM »
Maybe we need a Rube Goldberg programing challenge!
Granted after becoming radioactive I only have a half-life!

#### EricR

• Newbie
• Posts: 13
• Loading humor.sys should be mandatory at boot
##### Re: NumType -- The Overengineered 'Is it a number' FUNCTION.
« Reply #2 on: January 26, 2019, 07:20:15 PM »
Maybe we need a Rube Goldberg programing challenge!

I am not sure Steve would like that.  He might go and try to out Rube Rube.  Then again, he may find a way to out complex something useful.   For me the query is a simple one, will anyone besides Steve step up for the challenge?  I am not sure anyone would.