As best as my memory serves me these days, I think this is or is close to the ledger formula I made 30 years ago...
I put is Steve's side by side to compare result.
Edit: I found some unacceptable results in both my function and Steve's on an expanded level. I'll post an example in a bit...
Here's the glitch I found in Steve's function results Mark posted, using an extended testing range. Run it and it will beep and pause at the first error. Click the left mouse button to continue. It will beep and pause one more time. Note in the first case a sequence is skipped and in the second case a number is duplicated. I experienced similar errors at slightly different places in my function results.
Now this could easily be a case of apples and oranges. If Steve's function is for rounding a single number instead of for use in adjusting the output sequence generated in a decimal loop, it isn't the right tool for this particular task.
I'll wait until some more eyes get into this. I've pulled an all-nighter (no, not 'highlighter' you dumb ass spell check...) working on some code and none code related stuff, and for all I know I'm imagining being on the forum typing this post. That's right, sleep coding again!
Pete
I put is Steve's side by side to compare result.
Edit: I found some unacceptable results in both my function and Steve's on an expanded level. I'll post an example in a bit...
Code: (Select All)
$CONSOLE:ONLY
DIM x
FOR x = 1 TO -0.001 STEP -.01
PRINT x;: LOCATE , 25: PRINT "Pete = "; pete$(x);: LOCATE , 45: PRINT "Steve = "; Round2$(x, -2)
NEXT x
'-----------------------------------------------------------------------
FUNCTION pete$ (x)
tmp1$ = ".00"
tmp2$ = LTRIM$(STR$(INT(x * 100 + .5) / 100))
IF INSTR(tmp2$, ".") THEN
MID$(tmp1$, 2, LEN(tmp2$)) = MID$(tmp2$, INSTR(tmp2$, ".") + 1)
tmpint$ = MID$(tmp2$, 1, INSTR(tmp2$, ".") - 1)
ELSE
tmpint$ = tmp2$
END IF
pete$ = tmpint$ + tmp1$
END FUNCTION
'-----------------------------------------------------------------------
FUNCTION N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
'SMcNeill Jan 7, 2020 ref: https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989
'Last Function in code marked Best Answer (removed debug comments and blank lines added these 2 lines.)
REDIM t$, sign$, l$, r$, r&&
REDIM dp AS LONG, dm AS LONG, ep AS LONG, em AS LONG, check1 AS LONG, l AS LONG, i AS LONG
t$ = LTRIM$(RTRIM$(EXP$))
IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
IF check1 < 1 OR check1 > 1 THEN N2S = _TRIM$(EXP$): EXIT FUNCTION 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
SELECT CASE l 'l now tells us where the SN starts at.
CASE IS < dp: l = dp
CASE IS < dm: l = dm
CASE IS < ep: l = ep
CASE IS < em: l = em
END SELECT
l$ = LEFT$(t$, l - 1) 'The left of the SN
r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
IF INSTR(l$, ".") THEN 'Location of the decimal, if any
IF r&& > 0 THEN
r&& = r&& - LEN(l$) + 2
ELSE
r&& = r&& + 1
END IF
l$ = LEFT$(l$, 1) + MID$(l$, 3)
END IF
SELECT CASE r&&
CASE 0 'what the heck? We solved it already?
'l$ = l$
CASE IS < 0
FOR i = 1 TO -r&&
l$ = "0" + l$
NEXT
l$ = "." + l$
CASE ELSE
FOR i = 1 TO r&&
l$ = l$ + "0"
NEXT
l$ = l$
END SELECT
N2S$ = sign$ + l$
END FUNCTION
FUNCTION Round2$ (anyNumber AS _FLOAT, dp AS LONG) ' uses N2S$
' 5 and up at decimal place dp+1 > +1 at decimal place 4 and down > +0 at dp
'2 1 0.-1 -2 -3 -4 ... pick dp like this for this Round$ Function
DIM sn$, dot, predot, postdot, rtn$
sn$ = N2S$(STR$(anyNumber + .5 * 10 ^ dp)) 'get rid of sci notation, steve trims it so next find dot
dot = INSTR(sn$, ".")
IF dot THEN
predot = dot - 1
postdot = LEN(sn$) - (dot + 1)
ELSE
predot = LEN(sn$)
postdot = 0
END IF
' xxx.yyyyyy dp = -2
' ^ dp
IF dp >= 0 THEN
rtn$ = MID$(sn$, 1, predot - dp) + STRING$(dp, "0")
ELSE
rtn$ = MID$(sn$, 1, predot) + "." + MID$(sn$, dot + 1, -dp)
END IF
IF rtn$ = "" THEN Round2$ = "0" ELSE Round2$ = rtn$
END FUNCTIONHere's the glitch I found in Steve's function results Mark posted, using an extended testing range. Run it and it will beep and pause at the first error. Click the left mouse button to continue. It will beep and pause one more time. Note in the first case a sequence is skipped and in the second case a number is duplicated. I experienced similar errors at slightly different places in my function results.
Code: (Select All)
DIM x
cnt = 10000
FOR x = 100 TO -0.001 STEP -.01
a$ = Round2$(x, -2)
PRINT cnt, x;: LOCATE , 30: PRINT "Steve = "; a$
REM IF cnt <> VAL(MID$(a$, 1, INSTR(a$, ".") - 1) + MID$(a$, INSTR(a$, ".") + 1)) THEN DO: WHILE _MOUSEINPUT: WEND: LOOP UNTIL _MOUSEBUTTON(1): _DELAY .1
IF LEN(olda$) AND ABS(VAL(a$) - VAL(olda$)) <> .01 THEN BEEP: DO: WHILE _MOUSEINPUT: WEND: LOOP UNTIL _MOUSEBUTTON(1): _DELAY .1
cnt = cnt - 1
olda$ = a$
NEXT
FUNCTION N2S$ (EXP$) 'remove scientific Notation to String (~40 LOC)
'SMcNeill Jan 7, 2020 ref: https://www.qb64.org/forum/index.php?topic=1555.msg112989#msg112989
'Last Function in code marked Best Answer (removed debug comments and blank lines added these 2 lines.)
REDIM t$, sign$, l$, r$, r&&
REDIM dp AS LONG, dm AS LONG, ep AS LONG, em AS LONG, check1 AS LONG, l AS LONG, i AS LONG
t$ = LTRIM$(RTRIM$(EXP$))
IF LEFT$(t$, 1) = "-" OR LEFT$(t$, 1) = "N" THEN sign$ = "-": t$ = MID$(t$, 2)
dp = INSTR(t$, "D+"): dm = INSTR(t$, "D-")
ep = INSTR(t$, "E+"): em = INSTR(t$, "E-")
check1 = SGN(dp) + SGN(dm) + SGN(ep) + SGN(em)
IF check1 < 1 OR check1 > 1 THEN N2S = _TRIM$(EXP$): EXIT FUNCTION 'If no scientic notation is found, or if we find more than 1 type, it's not SN!
SELECT CASE l 'l now tells us where the SN starts at.
CASE IS < dp: l = dp
CASE IS < dm: l = dm
CASE IS < ep: l = ep
CASE IS < em: l = em
END SELECT
l$ = LEFT$(t$, l - 1) 'The left of the SN
r$ = MID$(t$, l + 1): r&& = VAL(r$) 'The right of the SN, turned into a workable long
IF INSTR(l$, ".") THEN 'Location of the decimal, if any
IF r&& > 0 THEN
r&& = r&& - LEN(l$) + 2
ELSE
r&& = r&& + 1
END IF
l$ = LEFT$(l$, 1) + MID$(l$, 3)
END IF
SELECT CASE r&&
CASE 0 'what the heck? We solved it already?
'l$ = l$
CASE IS < 0
FOR i = 1 TO -r&&
l$ = "0" + l$
NEXT
l$ = "." + l$
CASE ELSE
FOR i = 1 TO r&&
l$ = l$ + "0"
NEXT
l$ = l$
END SELECT
N2S$ = sign$ + l$
END FUNCTION
FUNCTION Round2$ (anyNumber AS _FLOAT, dp AS LONG) ' uses N2S$
' 5 and up at decimal place dp+1 > +1 at decimal place 4 and down > +0 at dp
'2 1 0.-1 -2 -3 -4 ... pick dp like this for this Round$ Function
DIM sn$, dot, predot, postdot, rtn$
sn$ = N2S$(STR$(anyNumber + .5 * 10 ^ dp)) 'get rid of sci notation, steve trims it so next find dot
dot = INSTR(sn$, ".")
IF dot THEN
predot = dot - 1
postdot = LEN(sn$) - (dot + 1)
ELSE
predot = LEN(sn$)
postdot = 0
END IF
' xxx.yyyyyy dp = -2
' ^ dp
IF dp >= 0 THEN
rtn$ = MID$(sn$, 1, predot - dp) + STRING$(dp, "0")
ELSE
rtn$ = MID$(sn$, 1, predot) + "." + MID$(sn$, dot + 1, -dp)
END IF
IF rtn$ = "" THEN Round2$ = "0" ELSE Round2$ = rtn$
END FUNCTIONNow this could easily be a case of apples and oranges. If Steve's function is for rounding a single number instead of for use in adjusting the output sequence generated in a decimal loop, it isn't the right tool for this particular task.
I'll wait until some more eyes get into this. I've pulled an all-nighter (no, not 'highlighter' you dumb ass spell check...) working on some code and none code related stuff, and for all I know I'm imagining being on the forum typing this post. That's right, sleep coding again!
Pete