I believe the "problem" (I shall not remove the quotes) of rounding and/or lack of decimal precision for inline numeric literals has come up here before.
IIRC there is some kind of limit on the number of decimal digits which are accepted at compile time.
Also IIRC, the way to get more decimal precision for constants is to eshew literals by CALCULATING the values in code and using the calculated variable for comparisons and arithmetic.
Announcement
Collapse
No announcement yet.
convert dollar number to dollar string
Collapse
X
-
Hey, "%" sure does look like a 96! That could indeed fool OCR software I believe. And keep in mind: the %%%'s could appear not just in big numbers, but small ones too--if you specify too small of a length in the 2nd parameter.
Also, I think that checking the output isn't really needed. I haven't seen the rounding problem with, say currency values already properly stored as 8 bytes, or in fact any other type (CUX, EXT, DOUBLE). The discrepancies only occur on input of the original values, which is where extra care need be taken.
Added: I may have misunderstood: were you talking above about checking numbers larger than +/-100 trillion? That could be easily added to the function. I thought you were asking about the rounding issue.Last edited by John Gleason; 9 May 2008, 05:44 PM.
Leave a comment:
-
-
Code:#DEBUG OVERFLOW ON FUNCTION Foo.. ON ERROR GOTO Errortrap Z = X * Y ErrorTrap: IF ERR = %ERROR_OVERFLOW THEN xxxxxx
Leave a comment:
-
-
in the above
i believe there are already if then for values so if the above where implemented
the if statement for checking values over a certain amount is already in place to catch the larger numbers and only a if statement at then end to check to routines.
there would be another way to consider.
letting pb handle the conversion on the larger numbers to string.
i do not know what the constraints are that way but if in fact pb does have certain issue and those issues are worked out in the future, that would solve the problem then.
also it might seem ok to let users see the numbers in exponential form as opposed to returning an incorrect string.
paul
added
found this thread
for dealing with extended precision values
and on a last thought
maybe the value if over $$$$$ returnstring is going to be %%%%%%%%%%%%%%%%%%%
to force the programmer to come up with his own way of representing values over a certain amount and which would better server the users and readers.
scientifc notation if not good if you do not know what it stands for and also there possibly could be somebody doing ocr work on printed documents, and i do not really like the %%%%%% it looks like 96 anyways, but what you going to do, huh, anybody having that much money is to old to read it anyways.
the %%%%%%%%%%%%%%%%% way would be staying with a standard of not producing any return strings of values that would not fit.Last edited by Paul Purvis; 9 May 2008, 04:13 PM.
Leave a comment:
-
-
here is a crazy suggest, a brain storm of such right now.
there maybe a way to double check the returned strings.
this is just a thought
if the value of the amount is over or under a certain amount(+-large values).
then try to get the last digits(possibly just the cents) of what value was passed and compare those digits to the string returned.
actually you can incorporate a check feature of a value being out of range too into this as well
example
just throwing some number out there in this
if value>9999999999.99 then
if value>99999999999999.99 then returnstring="%%%%%%%%%%%%":exit function
rem variable doublechecklastdigits as a long 0 or 1
rem variable checklastdigits=00 as a long 00 thru 99
doublechecklastdigits=1
checklastdigits=bla bla bla
end if
if doublechecklastdigits then
bla bla bla
if val(mid$(returnstring,#,2))<>checklastdigits then
returnstring="%%%%%%%%%%%%%%%"
end if
end if
paul
Leave a comment:
-
-
Surprisingly, I discovered these are ok in 8.04 as a workaround:
Code:LOCAL MONEYAMOUNT AS CUR 'or LOCAL MONEYAMOUNT AS CUX 'or LOCAL MONEYAMOUNT AS EXT 'Then use the [B]single[/B] currency @ sign. @@ or ## will not work. moneyamount=99999999999999.99@ 'ok 8.04 moneyamount=99999999999999.99@@ 'not ok moneyamount=99999999999999.99## 'not ok
Leave a comment:
-
-
> the rounding discrepancy...
Code:ptrss=STRPTR(ss) POKE LONG,ptrss+temp2-4, &h30302e30 IF remains>99999 THEN IF temp2<7 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-7,44 IF remains>99999999 THEN IF temp2<11 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE LONG,ptrss+temp2-12, &h20202C20 IF remains>99999999999 THEN IF temp2<15 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-15,44 IF remains>99999999999999 THEN IF temp2<19 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-19,44
I might also do that for performance purposes... in that I do not know how PB casts numeric literals when they appear in an expresssion. If I've already cast the literal to a compatible type for the operation, then that conversion is done at compile time and will not be required at runtime.
Note, I would not be surprised if the compiler already did this, but why guess?
MCM
Leave a comment:
-
-
Paul, here is the situation re. the rounding discrepancy:
Code:moneyamount=99999999999999.99 'this produces an error in the returned string .98 for cents moneyamount=9999999999999999 / 100 'this is ok moneyamount = VAL("99999999999999.99") 'this is ok moneyamount=99999999999999 + .99 'this is ok 'So the max val is 99,999,999,999,999.99 ~100 trillion BUT must be properly fed to function because of issue 'PB support is aware of, and on the case!
Leave a comment:
-
-
Dispelling the rest of the old wives' tales you've heard.......
use byref wherever possible as opposed to byval for speed when passing strings to functions.
where a fixed length string can be used, use it
faster is always better, always remember your program may be used in a high end processing environment
Remember, you might not be the next programmer to have to update or enhance this program.
MCM
Leave a comment:
-
-
Slightly modified quote
if you program, make the code as fast as possible, do not expect a user to have the fastest most current computer of today.
matter of fact, assume he has one of the oldest computers and program for that kind of resource.
wayyyy too many programs assume and even INSIST you have the latest and greatest...and yet some of the cleanest code I have seen (and the fastest) run on an old DOS machine, or Win95 or less
The only good plan is plan with what you have for todays tools, and what you think may work in the future, and adjust to your "Application Scope" as time goes on.
Leave a comment:
-
-
>assign static values using hex numbers.... it must be for speed in the program
If you are talking about inline numeric literals (e.g., LET X = 3) , using hex notation (LET X = &h3) does nothing at runtime because the evaluation is done at compile-time.
Better still, if the value does not change, use an equate. That's why they exist.
Leave a comment:
-
-
some things i learned on this project, a routine that is performed many times in the same program.
it is better sometimes just to have inline code as opposed to a loop of some sort where the loop may have some complicated code and there are not may iterations in the loop you are replacing.
strings take time to build, a lot of time, specially if you are using concatenation.
where a fixed length string can be used, use it, and learn to use pointers or any other routine that can change the byte(s) in the string if possible.
if your program does not work well with a fixed length string, consider a static dynamic string variable and a static integer variable to be used as a flag, then mark the flag once the static dynamic string variable is created on the routines first use.
assign static values using hex numbers
i have not tested this but i would be place bets on it making the program faster. i am self taught, learned by necessity, and i never understood why some programmers defined variables with a hex number. it must be for speed in the program. even if it does not create more speed, you will appear smarter than other programmers(clothes makes the man right).
sorry just hum mering myself.
many times the longest approach to a problem is the shortest path to solving the problem, meaning using some of the simplest programming skills will produce the fastest code.
use a mixture of programming concepts and routines to make your code better, faster is always better, always remember your program may be used in a high end processing environment
use byref wherever possible as opposed to byval for speed when passing strings to functions.
paul
Leave a comment:
-
-
my points to follow in writing routines
point 1
when you have a routine that does a specific job and the routine will be used in a lot of various programs, that routine should be written as efficient as possible and also be tested thoroughly and the routine should useful for many years.
point 2
the program should be written to execute with speed
point 3
the program should be written to have some flexibility so it can be used for multiple purposes if possible
point 4
the program should modular if possible (a function)
point 5
the program if possible should not depend on outside routines that may not be accessible to another programmer or program.
point 6
the program should transverse as many operating systems and compilers as possible
point 7
follow good programming rules
rule 1 thru rule 99
do not look a gift horse in the mouth
some of my programming practices are:
if your program is going to process lots of data, make the code as fast as possible, do not expect a user to have the fastest most current computer of today.
matter of fact, assume he has one of the oldest computers and program for that kind of resource.
never expect your program to be used just for a few years, program it as if you are going to be the one using it and you have to use if for 100 years.
make your program as fast as possible using as little memory as possible.
when it comes to data, plan for your program to be used in a very big way and make the access to that data as fast as possible and where the data can be backed up efficiently(efficiently means fast and the smallest in size of data being backed up and having full recovery). where data maybe old and never be changed again , plan for a way to remove the data from the active data and still have access to data.(in other words, the user should never have to look up something on paper if it was ever stored in the computer, storage device resources will always grow faster than the use of your program).Last edited by Paul Purvis; 8 May 2008, 02:18 PM.
Leave a comment:
-
-
Did you ever notice how the ultimate fastest is always the ultimate un-maintainable?
Sheesh, there's four years worth of GOTOs and multiple EXIT points in that one dinky little routine.
Leave a comment:
-
-
Thanks Paul, I gave it the ol' college try. hehheh. It doesn't wear me out too much because for some reason, my brain thinks about that kind of stuff whether I want it to or not.I'll put your mod there into the code above to make it more bulletproof so when you hit it with a hammer, it won't crack. I think creating the string might need to be moved up a couple lines too.
Leave a comment:
-
-
John, that is tremendous.
i learned a lot from that piece of code too.
i am sure you wore yourself out on that one.
i spent some time trying to crash the program since there was nothing else to write which would be faster.
i believe this should be the only change to the only crash i could get out of it
Code:IF remains=0 THEN IF zerostringblank THEN GOTO exitthefunction IF temp2<1 THEN GOTO exitthefunction ss=SPACE$(TEMP2) ssPtr=STRPTR(ss) POKE BYTE,ssPtr+temp2-1,48 IF temp2=1 THEN GOTO exitthefunction POKE BYTE,ssPtr+temp2-2,48 IF temp2=2 THEN GOTO exitthefunction POKE BYTE,ssPtr+temp2-3,46 IF temp2=3 THEN GOTO exitthefunction POKE BYTE,ssPtr+temp2-4,48 GOTO EXITTHEFUNCTION END IF
Last edited by Paul Purvis; 7 May 2008, 06:25 PM.
Leave a comment:
-
-
fyi for now
here is what i have so far, but still need to add code for exceptions and work on a variable length string returned.
Code:'timermast.bas 'pbcc 4.04 ' #COMPILE EXE #DIM ALL #REGISTER NONE GLOBAL glloopsinasample AS LONG GLOBAL glsamples AS LONG GLOBAL TOTALTIME AS SINGLE DECLARE FUNCTION QueryPerformanceCounter LIB "KERNEL32.DLL" ALIAS "QueryPerformanceCounter" ( lpPerformanceCount AS QUAD ) AS LONG DECLARE FUNCTION QueryPerformanceFrequency LIB "KERNEL32.DLL" ALIAS "QueryPerformanceFrequency" ( lpFrequency AS QUAD ) AS LONG '~~~~~~~~~~~A Variation of Dave Roberts' MACRO Timer~~~~~~~~~~~~~~~~~~~~~~~ MACRO onTimer LOCAL qFreq, qOverhead, qStart, qStop AS QUAD LOCAL f AS STRING f = "#.###" QueryPerformanceFrequency qFreq QueryPerformanceCounter qStart ' Intel suggestion. First use may be suspect QueryPerformanceCounter qStart ' So, wack it twice <smile> QueryPerformanceCounter qStop qOverhead = qStop - qStart ' Relatively small END MACRO MACRO goTimer = QueryPerformanceCounter qStart MACRO stopTimer = QueryPerformanceCounter qStop MACRO showTimer = USING$( f, ( qStop - qStart - qOverhead ) * 1000000 / qFreq / 1000 ) + " milliseconds" '==================================================================================================== DECLARE FUNCTION ConfidenceLimits(x() AS SINGLE) AS STRING 'EDIT HERE 'HERE IS WHERE YOU BASICALLY SET UP YOUR VARIABLES AND CODE FUNCTION initiateloopsvalues( ) AS LONG glloopsinasample = 100000'0 'no of loops in a sample glsamples = 60 'no of samples in a test, the higher the better [ Nope, 60 is just fine. DR ] END FUNCTION FUNCTION dollar2string( BYVAL d2s_dollaramountext AS EXT ,BYVAL d2s_returnstringlength AS LONG ,BYVAL d2s_zerostringblank AS LONG) AS STRING DIM d2s_returnstring AS STRING *25 LOCAL d2s_negative AS LONG DIM d2s_returnstringptr AS BYTE POINTER LOCAL d2s_amountext AS EXT LOCAL d2s_ptramountext AS EXT POINTER LOCAL d2s_variablestring AS STRING IF d2s_dollaramountext=0 THEN IF d2s_zerostringblank THEN IF d2s_returnstringlength THEN FUNCTION=MID$(d2s_returnstring,+26-d2s_returnstringlength,d2s_returnstringlength) EXIT FUNCTION ELSE FUNCTION="" EXIT FUNCTION END IF d2s_returnstringptr=VARPTR(d2s_returnstring) d2s_returnstringptr=d2s_returnstringptr+22 @d2s_returnstringptr=46 INCR d2s_returnstringptr @d2s_returnstringptr=48 INCR d2s_returnstringptr @d2s_returnstringptr=48 IF d2s_returnstringlength THEN FUNCTION=MID$(d2s_returnstring,26-d2s_returnstringlength,d2s_returnstringlength) EXIT FUNCTION ELSE FUNCTION=MID$(d2s_returnstring,23,3) EXIT FUNCTION END IF END IF END IF IF d2s_returnstringlength<4& THEN IF d2s_returnstringlength>0& THEN FUNCTION=STRING$(d2s_returnstringlength,37):EXIT FUNCTION END IF IF d2s_dollaramountext<0 THEN d2s_amountext=ABS(FIX(d2s_dollaramountext*100)) d2s_negative=1 ELSE d2s_amountext=FIX(d2s_dollaramountext*100) END IF d2s_returnstringptr=VARPTR(d2s_returnstring) d2s_returnstringptr=d2s_returnstringptr+22 @d2s_returnstringptr=46 INCR d2s_returnstringptr @d2s_returnstringptr=48 INCR d2s_returnstringptr @d2s_returnstringptr=48 d2s_ptramountext=VARPTR(d2s_amountext) @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 DECR d2s_returnstringptr DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=44 DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=44 DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=44 DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=44 DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative DECR d2s_returnstringptr @d2s_returnstringptr=44 DECR d2s_returnstringptr @d2s_returnstringptr=@d2s_ptramountext MOD 10+48 @d2s_ptramountext=@d2s_ptramountext\10 IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative exitwitherror: d2s_returnstringptr=VARPTR(d2s_returnstring) FOR d2s_returnstringptr= 0 TO 24 @d2s_returnstringptr=37 INCR d2s_returnstringptr NEXT GOTO exitthefunction markifnegative: IF d2s_negative=1 THEN DECR d2s_returnstringptr @d2s_returnstringptr=45 END IF exitthefunction: IF d2s_returnstringlength<26 THEN IF d2s_returnstringlength=0 THEN d2s_variablestring=d2s_returnstring FUNCTION=TRIM$(d2s_variablestring) EXIT FUNCTION ELSE FUNCTION=MID$(d2s_returnstring,26-d2s_returnstringlength,d2s_returnstringlength) END IF ELSE FUNCTION=SPACE$(d2s_returnstringlength-25)+MID$(d2s_returnstring,1,25) END IF END FUNCTION FUNCTION testcode2( BYVAL temp1 AS EXT,TEMP2 AS LONG ,d2s_zerostringblank AS LONG) AS STRING LOCAL digit AS LONG LOCAL digitinthestring AS LONG LOCAL nextdigit AS LONG LOCAL countdigit AS LONG LOCAL remains AS QUAD LOCAL ptrss AS BYTE PTR LOCAL negative AS LONG LOCAL ss AS STRING IF TEMP2<4& THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION ss=SPACE$(TEMP2) IF temp1<0 THEN remains=ABS(TEMP1*100) negative=1 ELSE remains=TEMP1*100 END IF IF remains=0 THEN IF d2s_zerostringblank THEN GOTO exitthefunction ptrss=STRPTR(ss) POKE BYTE,ptrss+temp2-1,48 POKE BYTE,ptrss+temp2-2,48 POKE BYTE,ptrss+temp2-3,46 POKE BYTE,ptrss+temp2-4,48 GOTO EXITTHEFUNCTION END IF ptrss=STRPTR(ss) POKE BYTE,ptrss+temp2-1,48 POKE BYTE,ptrss+temp2-2,48 POKE BYTE,ptrss+temp2-3,46 POKE BYTE,ptrss+temp2-4,48 IF remains>99999 THEN IF temp2<7 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-7,44 IF remains>99999999 THEN IF temp2<11 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-11,44 IF remains>99999999999 THEN IF temp2<15 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-15,44 IF remains>99999999999999 THEN IF temp2<19 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-19,44 END IF END IF END IF END IF countdigit=1 FOR digit = TEMP2 TO 1 STEP -1 NextDigit=Remains MOD 10 digitinthestring=digit-(countdigit\3) IF digitinthestring=0 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION ASC(ss,digitinthestring) = Nextdigit +48 Remains=Remains \ 10 IF remains=0 THEN EXIT FOR INCR countdigit NEXT 'rem i am going to reuse the variable (negative) no longer being used in a FOR NEXT loop IF negative=0 THEN GOTO EXITTHEFUNCTION FOR negative=digit-(countdigit\3) TO 0 STEP -1 IF PEEK(BYTE,ptrss+negative)=32 THEN POKE BYTE,ptrss+negative,45 GOTO exitthefunction END IF NEXT ss=STRING$(TEMP2,"%") exitthefunction: FUNCTION=SS END FUNCTION FUNCTION testcode3( BYVAL temp1 AS EXT,TEMP2 AS LONG,d2s_zerostringblank AS LONG,BYREF ptrss AS LONG ) AS STRING REGISTER digit AS LONG REGISTER ltempvar AS LONG LOCAL negative AS LONG ltempvar=ptrss IF TEMP1=0 THEN IF d2s_zerostringblank THEN EXIT FUNCTION POKE BYTE,ltempvar+temp2-1,48 POKE BYTE,ltempvar+temp2-2,48 POKE BYTE,ltempvar+temp2-3,46 POKE BYTE,ltempvar+temp2-4,48 EXIT FUNCTION END IF IF TEMP2<4& THEN GOTO exitwitherror IF temp1<0 THEN temp1=ABS(TEMP1*100) negative=1 ELSE temp1=TEMP1*100 END IF POKE BYTE,ltempvar+temp2-1,48 POKE BYTE,ltempvar+temp2-2,48 POKE BYTE,ltempvar+temp2-3,46 POKE BYTE,ltempvar+temp2-4,48 IF temp1>99999 THEN IF temp2<7 THEN GOTO exitwitherror POKE BYTE,ltempvar+temp2-7,44 IF temp1>99999999 THEN IF temp2<11 THEN GOTO exitwitherror POKE BYTE,ltempvar+temp2-11,44 IF temp1>99999999999 THEN IF temp2<15 THEN GOTO exitwitherror POKE BYTE,ltempvar+temp2-15,44 IF temp1>99999999999999 THEN IF temp2<19 THEN GOTO exitwitherror POKE BYTE,ltempvar+temp2-19,44 END IF END IF END IF END IF ltempvar=1 'FOR digit = TEMP2 TO 1 STEP -1 ' IF digit-(ltempvar\3)=0 THEN GOTO exitwitherror ' temp1=temp1/10 ' POKE BYTE,ptrss+digit-(ltempvar\3)-1, FIX(FRAC(temp1)*10) +48 ' IF FIX(temp1)=0 THEN EXIT FOR ' INCR ltempvar ' NEXT FOR digit = TEMP2 TO 1 STEP -1 IF digit-(ltempvar\3)=0 THEN GOTO exitwitherror temp1=temp1/10 POKE BYTE,ptrss+digit-(ltempvar\3)-1, FIX(FRAC(temp1)*10) +48 IF FIX(temp1)=0 THEN EXIT FOR INCR ltempvar NEXT IF negative=0 THEN EXIT FUNCTION FOR ltempvar=digit-(ltempvar\3) TO 0 STEP -1 IF PEEK(BYTE,ptrss+ltempvar)=32 THEN POKE BYTE,ptrss+ltempvar,45 EXIT FUNCTION END IF NEXT exitwitherror: FOR ltempvar= 0 TO temp2-1 POKE BYTE,ptrss+ltempvar,37 NEXT END FUNCTION '==================================================================================================== FUNCTION PBMAIN ( ) AS LONG REGISTER I AS LONG REGISTER J AS LONG LOCAL SS AS STRING DIM x( 1 TO 60) AS SINGLE RANDOMIZE initiateloopsvalues LOCAL aa AS STRING LOCAL K AS CUX K=-123456789123456.78 'limits for accuracy 'lower -9999999999999.99 'uppper 9999999999999.99 K=-9999999999999.99 ' k=.00 onTimer TOTALTIME = 0.0 ' We could remove as average available in ConfidenceLimits' xbar J = 0& START1: INCR J gotimer FOR I = 1& TO glloopsinasample '========================================================= 'call to the code tested first goes here 'EDIT HERE ' SS=SPACE$(25) ss=dollar2string(K,0,1) 'print "end" 'print k 'PRINT ss 'WAITKEY$ '========================================================= NEXT I stoptimer x(j) = ( qStop - qStart - qOverhead ) * 1000/qFreq TOTALTIME = TOTALTIME + x(j) SLEEP RND(2,10) IF J < glsamples THEN GOTO START1 STDOUT "-------------------------"; STDOUT "code #1 no of samples" + STR$( glsamples ) STDOUT ConfidenceLimits(x()) STDOUT USING$( f, ( TOTALTIME / glsamples ) ) + " milliseconds" TOTALTIME = 0.0 J = 0& RESET x() START2: INCR J gotimer FOR I = 1& TO glloopsinasample '========================================================= 'call to the code tested second goes here 'EDIT HERE ss=testcode2(K,25,1 ) '========================================================= NEXT I stoptimer x(j) = ( qStop - qStart - qOverhead ) * 1000/qFreq TOTALTIME = TOTALTIME + x(j) SLEEP RND(2,10) IF J < glsamples THEN GOTO START2 STDOUT "-------------------------"; STDOUT "code #2 no of samples" + STR$( glsamples ) STDOUT ConfidenceLimits(x()) STDOUT USING$( f, ( TOTALTIME / glsamples ) ) + " milliseconds" TOTALTIME = 0.0 J = 0& RESET x() START3: INCR J gotimer FOR I = 1& TO glloopsinasample '========================================================= 'call to the code tested second goes here 'EDIT HERE SS=SPACE$(25) testcode3(K,25,0, STRPTR(SS)) '========================================================= NEXT I stoptimer x(j) = ( qStop - qStart - qOverhead ) * 1000/qFreq TOTALTIME = TOTALTIME + x(j) SLEEP RND(2,10) IF J < glsamples THEN GOTO START3 STDOUT "-------------------------"; STDOUT "code #2 no of samples" + STR$( glsamples ) STDOUT ConfidenceLimits(x()) STDOUT USING$( f, ( TOTALTIME / glsamples ) ) + " milliseconds" WAITKEY$ END FUNCTION FUNCTION ConfidenceLimits( x() AS SINGLE ) AS STRING ' Input: x( lb to ub ) ' Output: Empty string if 60 samples not adhered to ' Otherwise "[95%: range]" LOCAL lb, ub, i AS LONG LOCAL sigmaX, sigmaX2, s, xbar, delta, lower, upper AS SINGLE lb = LBOUND(x) : ub = UBOUND(x) IF ub - lb + 1 <> 60 THEN STDOUT "I need exactly 60 samples" EXIT FUNCTION END IF FOR i = lb TO ub sigmaX = sigmaX + x(i) sigmaX2 = sigmaX2 + x(i)*x(i) NEXT xbar = sigmaX/60 s = SQR(sigmaX2/60 - xbar * xbar) delta = s*0.2581989 lower = xbar - delta upper = xbar + delta FUNCTION = "[ 95%: " + FORMAT$(lower,"#####.###") + ", " + FORMAT$(upper, "#####.###") + " ]" END FUNCTION
Leave a comment:
-
-
Sorry to hear about the flooding, Paul. I worked on the function some more, and got rid of nearly all asm (not-too-efficient asm at that) and removed GLOBAL's too. Plus it is now even faster, believe it or not.
Change May 8th: logic change in numb2money.inc when remains = 0
numb2money.inc
Code:'****************************************************************************************************************** 'numb2money.inc 'Formats CUR, CURRENCYX, EXT and other types to the format +/-99,999,999,999,999.99. "+" is a leading space. 'usage: numb2money(value, optional chosenLength, optional zeroAsSpace) 'If chosenLength is longer than the formatted value, spaces pad the left of the number. 'If you chosenLength is too small, eg. numb2money(k, 15) and 15 is too short for EITHER + (with its space) or - numbers, 'the function will return %%%%%%%%%%%%%%% rather than a truncated number. 'The parameters subsequent to k are optional. Numb2money will automatically set length if not specified. 'eg. here are some formatted numbers as they would appear in a file (no leading single-quote) 'using the function without parameters, ie. numb2money(k): '-3,476,889.45 ' 87,341,776.00 '-65,497,396.25 ' 78,345.11 'Here are those same numbers with a length given, eg. numb2money(k, 20): ' -3,476,889.45 ' 87,341,776.00 ' -65,497,396.25 ' 78,345.11 '****************************************************************************************************************** MACRO isTempValid(vlid) = IF temp2<vlid THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION 'is there enough space? MACRO autoSet(optimLen) = ss=SPACE$(optimLen): ssPtr=STRPTR(ss): temp2 = optimLen 'create optimum string length MACRO pokeWrdInc(offset) = POKE WORD, ssPtr + temp2 - offset, ttArr(@rPtr): INCR rPtr '2 digits at a time + INCR MACRO pokeWrd(offset) = POKE WORD, ssPtr + temp2 - offset, ttArr(@rPtr) '2 digits only MACRO pokeDot(offset) = POKE BYTE, ssPtr + temp2 - offset, 46 '"." poke decimal pt. MACRO pokeCom(offset) = POKE BYTE, ssPtr + temp2 - offset, 44 '"," poke a comma MACRO pokeSpc(offset) = POKE BYTE, ssPtr + temp2 - offset, 32 '" " poke a space MACRO pokeNeg(offset) IF negative = 1 THEN POKE BYTE, ssPtr + temp2 - offset, 45 '"-" poke a minus sign GOTO EXITTHEFUNCTION END MACRO MACRO convert2decimal 'convert the whole EXT variable to packed decimal using intrinsic processor function !fld tbyte remains ;load ext var (remains) into fpu !fbstp remains ;convert the binary "remains" into its packed decimal version !mov eax, brPtr !mov rPtr, eax ;rPtr = brPtr END MACRO FUNCTION numb2money( BYVAL temp1 AS EXT, OPTIONAL BYVAL TEMP2 AS LONG, OPTIONAL BYVAL zerostringblank AS LONG) AS STRING STATIC tTable, ss AS STRING '^ automatically optional, but just showing it. STATIC onceThru, ttPtr, negative AS LONG STATIC rPtr AS BYTE PTR STATIC remains AS EXT 'make variables static that are ok as static. Avoids resetting them redundantly. STATIC brPtr, ssPtr AS LONG 'none '6053 These !nop operations align the function for (hopefully) more speed. You can time yourself 0-16 nops. ' My testing showed no real improvement, but feel free to try, ie. uncomment and test for speed. '!nop '6122 '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop '!nop IF onceThru = 0 THEN 'translation table (lookup table) so we can avoid complex asm. tTable = "00010203040506070809............10111213141516171819............20212223242526272829............30313233343536373839............40414243444546474849............" & _ "50515253545556575859............60616263646566676869............70717273747576777879............80818283848586878889............90919293949596979899" ttPtr = STRPTR(tTable) brPtr = VARPTR(remains) DIM ttArr(&h99) AS STATIC WORD AT ttPtr ' DIM ttArr(308) AS STATIC BYTE AT ttPtr onceThru = 1 'only create this table, array, and other info once per program run END IF IF temp1<0 THEN remains=-TEMP1*100 negative=1 ELSE remains=TEMP1*100 negative = 0 END IF IF remains=0 THEN 'May 8th change here ss=SPACE$(TEMP2) IF zerostringblank THEN GOTO exitthefunction IF temp2<1 THEN GOTO exitthefunction ssPtr=STRPTR(ss) POKE BYTE,ssPtr+temp2-1,48 IF temp2=1 THEN GOTO exitthefunction POKE BYTE,ssPtr+temp2-2,48 IF temp2=2 THEN GOTO exitthefunction POKE BYTE,ssPtr+temp2-3,46 IF temp2=3 THEN GOTO exitthefunction POKE BYTE,ssPtr+temp2-4,48 GOTO EXITTHEFUNCTION END IF IF temp2 = 0 GOTO autoLen 'makes string length automatically if none given IF TEMP2<4& THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION ss=SPACE$(TEMP2) ssPtr=STRPTR(ss) ' get size of remains for correct POKE sequence IF remains>999999999 THEN IF remains>999999999999999THEN isTempValid(22) GOTO n2s16 ELSEIF remains>99999999999999 THEN isTempValid(21) GOTO n2s15 ELSEIF remains>9999999999999 THEN isTempValid(19) GOTO n2s14 ELSEIF remains>999999999999 THEN isTempValid(18) GOTO n2s13 ELSEIF remains>99999999999 THEN isTempValid(17) GOTO n2s12 ELSEIF remains>9999999999 THEN isTempValid(15) GOTO n2s11 ELSE isTempValid(14) GOTO n2s10 END IF ELSE IF remains>99999999 THEN isTempValid(13) GOTO n2s9 ELSEIF remains>9999999 THEN isTempValid(11) GOTO n2s8 ELSEIF remains>999999 THEN isTempValid(10) GOTO n2s7 ELSEIF remains>99999 THEN isTempValid(9) GOTO n2s6 ELSEIF remains>9999 THEN isTempValid(7) GOTO n2s5 ELSEIF remains>999 THEN isTempValid(6) GOTO n2s4 ELSE isTempValid(5) GOTO n2s3 END IF END IF autoLen: ' get size of remains for correct POKE sequence and to set proper string length IF remains>999999999 THEN IF remains>999999999999999THEN autoSet(22) GOTO n2s16 ELSEIF remains>99999999999999 THEN autoSet(21) GOTO n2s15 ELSEIF remains>9999999999999 THEN autoSet(19) GOTO n2s14 ELSEIF remains>999999999999 THEN autoSet(18) GOTO n2s13 ELSEIF remains>99999999999 THEN autoSet(17) GOTO n2s12 ELSEIF remains>9999999999 THEN autoSet(15) GOTO n2s11 ELSE autoSet(14) GOTO n2s10 END IF ELSE IF remains>99999999 THEN autoSet(13) GOTO n2s9 ELSEIF remains>9999999 THEN autoSet(11) GOTO n2s8 ELSEIF remains>999999 THEN autoSet(10) GOTO n2s7 ELSEIF remains>99999 THEN autoSet(9) GOTO n2s6 ELSEIF remains>9999 THEN autoSet(7) GOTO n2s5 ELSEIF remains>999 THEN autoSet(6) GOTO n2s4 ELSE autoSet(5) GOTO n2s3 END IF END IF n2s16: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeWrd(15) : pokeWrdInc(16): pokeWrdInc(18): pokeWrd(21) pokeDot(3) : pokeCom(7) : pokeCom(11) : pokeCom(15) : pokeCom(19) : pokeNeg(22) n2s15: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeWrd(15) : pokeWrdInc(16): pokeWrdInc(18): pokeWrd(21) pokeDot(3) : pokeCom(7) : pokeCom(11) : pokeCom(15) : pokeCom(19) : pokeSpc(21): pokeNeg(21) n2s14: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeWrd(15) : pokeWrdInc(16): pokeWrd(18) pokeDot(3) : pokeCom(7) : pokeCom(11) : pokeCom(15) : pokeNeg(19) n2s13: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeWrd(15) : pokeWrdInc(16): pokeWrd(18) pokeDot(3) : pokeCom(7) : pokeCom(11) : pokeCom(15) : pokeSpc(18): pokeNeg(18) n2s12: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeWrd(15) : pokeWrd(16) pokeDot(3) : pokeCom(7) : pokeCom(11) : pokeCom(15) : pokeNeg(17) n2s11: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeWrd(15) pokeDot(3) : pokeCom(7) : pokeCom(11) : pokeSpc(15) : pokeNeg(15) n2s10: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeDot(3) : pokeCom(7) : pokeCom(11): pokeNeg(14) n2s9: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrdInc(10) : pokeWrdInc(13): pokeDot(3) : pokeCom(7) : pokeCom(11): pokeSpc(13): pokeNeg(13) n2s8: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrd(10) : pokeDot(3) : pokeCom(7) : pokeNeg(11) n2s7: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrdInc(8) pokeWrd(10) : pokeDot(3) : pokeCom(7) : pokeSpc(10) : pokeNeg(10) n2s6: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) : pokeWrd(8) pokeDot(3) : pokeCom(7) : pokeNeg(9) n2s5: convert2decimal: pokeWrdInc(2) : pokeWrdInc(5): pokeWrd(7) pokeDot(3) : pokeSpc(7) : pokeNeg(7) n2s4: convert2decimal: pokeWrdInc(2) : pokeWrd(5) pokeDot(3) : pokeNeg(6) n2s3: convert2decimal: pokeWrdInc(2) : pokeWrd(5) pokeDot(3) : pokeSpc(5) : pokeNeg(5) exitthefunction: FUNCTION=SS END FUNCTION
Code:'number2money.bas 'pb 8.04 '#COMPILE EXE #DIM ALL '#REGISTER NONE 'not necessary for numb2money. It's ok (and for me often faster) to let 'compiler do register optimizations. #INCLUDE "numb2money.inc" GLOBAL glloopsinasample AS LONG GLOBAL glsamples AS LONG GLOBAL TOTALTIME AS SINGLE DECLARE FUNCTION QueryPerformanceCounter LIB "KERNEL32.DLL" ALIAS "QueryPerformanceCounter" ( lpPerformanceCount AS QUAD ) AS LONG DECLARE FUNCTION QueryPerformanceFrequency LIB "KERNEL32.DLL" ALIAS "QueryPerformanceFrequency" ( lpFrequency AS QUAD ) AS LONG '~~~~~~~~~~~A Variation of Dave Roberts' MACRO Timer~~~~~~~~~~~~~~~~~~~~~~~ MACRO onTimer LOCAL qFreq, qOverhead, qStart, qStop AS QUAD LOCAL f AS STRING f = "#.###" QueryPerformanceFrequency qFreq QueryPerformanceCounter qStart ' Intel suggestion. First use may be suspect QueryPerformanceCounter qStart ' So, wack it twice <smile> QueryPerformanceCounter qStop qOverhead = qStop - qStart ' Relatively small END MACRO MACRO goTimer = QueryPerformanceCounter qStart MACRO stopTimer = QueryPerformanceCounter qStop MACRO showTimer = USING$( f, ( qStop - qStart - qOverhead ) * 1000 / qFreq ) + " milliseconds" '==================================================================================================== DECLARE FUNCTION ConfidenceLimits(x() AS SINGLE) AS STRING FUNCTION initiateloopsvalues( ) AS LONG glloopsinasample = 100000'0 'no of loops in a sample glsamples = 60 'no of samples in a test, the higher the better [ Nope, 60 is just fine. DR ] END FUNCTION FUNCTION testcode3( BYVAL temp1 AS EXT,TEMP2 AS LONG,zerostringblank AS LONG,BYREF SS AS STRING ) AS LONG LOCAL aa AS STRING IF temp1=0.00 THEN IF zerostringblank=1 THEN EXIT FUNCTION IF temp2<4 THEN SS=STRING$(TEMP2,"%"):EXIT FUNCTION SS=SPACE$(temp2-4)+"0.00" EXIT FUNCTION END IF aa =USING$("#,.##",temp1) exitthefunction: IF LEN(aa)>temp2 THEN SS=STRING$(TEMP2,"%"):EXIT FUNCTION ELSE RSET ss=aa END IF END FUNCTION '==================================================================================================== FUNCTION PBMAIN ( ) AS LONG LOCAL I AS LONG LOCAL J AS LONG LOCAL SS, aStr AS STRING DIM x( 1 TO 60) AS SINGLE initiateloopsvalues LOCAL aa AS STRING LOCAL K AS DOUBLE '12345678901234567 k = 12345678901234.56 onTimer TOTALTIME = 0.0 ' We could remove as average available in ConfidenceLimits' xbar J = 0& START2: INCR J gotimer FOR I = 1& TO glloopsinasample '========================================================= 'call to the code tested second goes here 'EDIT HERE numb2money(K,25) '========================================================= NEXT I stoptimer x(j) = ( qStop - qStart - qOverhead ) * 1000/qFreq TOTALTIME = TOTALTIME + x(j) IF J < glsamples THEN GOTO START2 ? "code #2 no of samples" + STR$( glsamples ) & $CRLF & _ ConfidenceLimits(x()) & $CRLF & _ USING$( f, ( TOTALTIME / glsamples ) ) + " milliseconds" TOTALTIME = 0.0 J = 0& RESET x() START3: INCR J gotimer FOR I = 1& TO glloopsinasample '========================================================= 'call to the code tested second goes here 'EDIT HERE SS=SPACE$(25) testcode3(K,25,0, SS) '========================================================= NEXT I stoptimer x(j) = ( qStop - qStart - qOverhead ) * 1000/qFreq TOTALTIME = TOTALTIME + x(j) IF J < glsamples THEN GOTO START3 ? "code #3 no of samples" + STR$( glsamples ) & $CRLF & _ ConfidenceLimits(x()) & $CRLF & _ USING$( f, ( TOTALTIME / glsamples ) ) + " milliseconds" END FUNCTION FUNCTION ConfidenceLimits( x() AS SINGLE ) AS STRING ' Input: x( lb to ub ) ' Output: Empty string if 60 samples not adhered to ' Otherwise "[95%: range]" LOCAL lb, ub, i AS LONG LOCAL sigmaX, sigmaX2, s, xbar, delta, lower, upper AS SINGLE lb = LBOUND(x) : ub = UBOUND(x) IF ub - lb + 1 <> 60 THEN ? "I need exactly 60 samples" EXIT FUNCTION END IF FOR i = lb TO ub sigmaX = sigmaX + x(i) sigmaX2 = sigmaX2 + x(i)*x(i) NEXT xbar = sigmaX/60 s = SQR(sigmaX2/60 - xbar * xbar) delta = s*0.2581989 lower = xbar - delta upper = xbar + delta FUNCTION = "[ 95%: " + FORMAT$(lower,"#####.###") + ", " + FORMAT$(upper, "#####.###") + " ]" END FUNCTION
Leave a comment:
-
-
John, i see you worked on the code, so did i.
I am at another location briefly, i have a little flood water where i am at, in the house, the Mississippi River along with strong south wind and 2+ inches of rain this morning was more than the land and bayous could handle. i did see your code and will have to review iy later, the new code i will post, as you said, iy stays with the extended variable, becase not much speed gained in speed, but i did make much improvements, with out having to have a global or a string passed by byref or pointer. the function handles it all now and i have just a little extra work to do on checking that the string length return requested is large enough and the newer version will return a variable length string as well as a fixed length string, which will make a far better all in one function. i also cleaned up the variable names to make it easier to alter the program as a gosub for speed. the change away from passed string to the function will probably make it much safer for multithread programming and i guess a dll, which i have not written one yet for my programming purposes.
i am at my end of this routine except for seeing your code and minor adjustments to mine. it is the weekend and time for a break, but i am in high hopes you will take a once over to see what i have done. my newest code is straight line, i got ride of many if statements and got ride of the loop to insert digits.
thanks for the time spent on the asm, i like most, have no experience to use it.
paulLast edited by Paul Purvis; 3 May 2008, 06:34 PM.
Leave a comment:
-
-
Well, I got it 135% faster than the testcode3 (USING..) function--up from 50% faster in my earlier post--and I've tested it greatly. Uncomment the test code to test it further if you wish. Use function parameter as EXT only, not DOUBLE. Not much speed difference either way.
Code:'number2string.bas 'pb 8.04 '#COMPILE EXE #DIM ALL #REGISTER NONE GLOBAL glloopsinasample AS LONG GLOBAL glsamples AS LONG GLOBAL TOTALTIME AS SINGLE GLOBAL cntDigit() AS LONG DECLARE FUNCTION QueryPerformanceCounter LIB "KERNEL32.DLL" ALIAS "QueryPerformanceCounter" ( lpPerformanceCount AS QUAD ) AS LONG DECLARE FUNCTION QueryPerformanceFrequency LIB "KERNEL32.DLL" ALIAS "QueryPerformanceFrequency" ( lpFrequency AS QUAD ) AS LONG '~~~~~~~~~~~A Variation of Dave Roberts' MACRO Timer~~~~~~~~~~~~~~~~~~~~~~~ MACRO onTimer LOCAL qFreq, qOverhead, qStart, qStop AS QUAD LOCAL f AS STRING f = "#.###" QueryPerformanceFrequency qFreq QueryPerformanceCounter qStart ' Intel suggestion. First use may be suspect QueryPerformanceCounter qStart ' So, wack it twice <smile> QueryPerformanceCounter qStop qOverhead = qStop - qStart ' Relatively small END MACRO MACRO goTimer = QueryPerformanceCounter qStart MACRO stopTimer = QueryPerformanceCounter qStop MACRO showTimer = USING$( f, ( qStop - qStart - qOverhead ) * 1000000 / qFreq / 1000 ) + " milliseconds" '==================================================================================================== DECLARE FUNCTION ConfidenceLimits(x() AS SINGLE) AS STRING 'EDIT HERE 'HERE IS WHERE YOU BASICALLY SET UP YOUR VARIABLES AND CODE FUNCTION initiateloopsvalues( ) AS LONG glloopsinasample = 100000'0 'no of loops in a sample glsamples = 60 'no of samples in a test, the higher the better [ Nope, 60 is just fine. DR ] END FUNCTION FUNCTION testcode2( BYVAL temp1 AS EXT, BYVAL TEMP2 AS LONG ,BYVAL zerostringblank AS LONG) AS STRING LOCAL digit AS LONG LOCAL digitinthestring AS LONG LOCAL nextdigit AS LONG LOCAL countdigit AS LONG LOCAL remains AS EXT LOCAL remaLong, remaLong2 AS LONG LOCAL ptrss AS BYTE PTR LOCAL negative AS LONG LOCAL ss AS STRING 'alignment nops. I did it based on timing. ~3% faster !nop !nop !nop !nop !nop !nop !nop !nop !nop !nop !nop !nop !nop !nop !nop !nop IF TEMP2<4& THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION ss=SPACE$(TEMP2) IF temp1<0 THEN remains=-TEMP1*100 negative=1 ELSE remains=TEMP1*100 END IF IF remains=0 THEN IF zerostringblank THEN GOTO exitthefunction ptrss=STRPTR(ss) POKE BYTE,ptrss+temp2-1,48 POKE BYTE,ptrss+temp2-2,48 POKE BYTE,ptrss+temp2-3,46 POKE BYTE,ptrss+temp2-4,48 GOTO EXITTHEFUNCTION END IF ptrss=STRPTR(ss) POKE LONG,ptrss+temp2-4, &h30302e30 IF remains>99999 THEN IF temp2<7 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-7,44 IF remains>99999999 THEN IF temp2<11 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE LONG,ptrss+temp2-12, &h20202C20 IF remains>99999999999 THEN IF temp2<15 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-15,44 IF remains>99999999999999 THEN IF temp2<19 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss+temp2-19,44 END IF END IF END IF END IF !fld tbyte remains ;load ext var (remains) into fpu !fbstp remains ;convert the binary "remains" into its packed decimal version countdigit=1 !lea eax, remains ;"remains" address !mov ecx, [eax+4] ;high dword of "remains" decimal version !mov remaLong2, ecx ;save it to test later FOR digit = TEMP2 TO 1 STEP -1 !lea eax, remains ;get decimal digits one at a time (not greatest efficiency, but asm is quite fast) !mov ecx, digit ;which digit !sub ecx, temp2 ; " !neg ecx ; " !cmp ecx, 7 ;8 or more? !ja short nxtHalf ;if 8 or more, goto hi dword !mov edx, [eax] ;lo decimal dword !shl ecx, 2 ;mul by 4 !shr edx, cl ;align !mov eax, edx ;copy edx !and edx, &h0f ;digit we want !and eax, &hfffffff0 ;our hint to exit: if eax = 0, we're done !mov nextDigit, edx ;got the digit finally !mov remaLong, eax ;save so we know when to exit later !jmp short digDone nxtHalf: !and ecx, 7 ;no shift > 7 allowed !mov edx, [eax+4] ;hi decimal dword !shl ecx, 2 ;mul by 4 !shr edx, cl ;align !mov eax, edx ;copy edx !and edx, &h0f ;our digit !and eax, &hfffffff0 ;our hint to exit: if eax = 0, we're done !mov nextDigit, edx ;got digit !mov remaLong2, eax ;so save eax to test when to exit later digDone: digitinthestring=digit-(cntDigit(countdigit)) 'replaces countdigit\3 IF digitinthestring=0 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION POKE BYTE,ptrss + digitinthestring - 1, Nextdigit + 48 IF remaLong=0 THEN !cmp remaLong2, 0 !je short exitFor END IF INCR countdigit NEXT exitFor: 'rem i am going to reuse the variable (negative) no longer being used in a FOR NEXT loop IF negative=0 THEN GOTO EXITTHEFUNCTION FOR negative=digit-(cntDigit(countdigit)) TO 0 STEP -1 IF PEEK(BYTE,ptrss+negative)=32 THEN POKE BYTE,ptrss+negative,45 GOTO exitthefunction END IF NEXT ss=STRING$(TEMP2,"%") exitthefunction: FUNCTION=SS END FUNCTION FUNCTION testcode3( BYVAL temp1 AS EXT,TEMP2 AS LONG,zerostringblank AS LONG,BYREF SS AS STRING ) AS LONG LOCAL aa AS STRING IF temp1=0.00 THEN IF zerostringblank=1 THEN EXIT FUNCTION IF temp2<4 THEN SS=STRING$(TEMP2,"%"):EXIT FUNCTION SS=SPACE$(temp2-4)+"0.00" EXIT FUNCTION END IF aa =USING$("#,.##",temp1) exitthefunction: IF LEN(aa)>temp2 THEN SS=STRING$(TEMP2,"%"):EXIT FUNCTION ELSE RSET ss=aa END IF END FUNCTION '==================================================================================================== FUNCTION PBMAIN ( ) AS LONG REGISTER I AS LONG REGISTER J AS LONG LOCAL SS, aStr AS STRING DIM x( 1 TO 60) AS SINGLE DIM cntDigit(20) AS LONG RANDOMIZE FOR i = 3 TO 20 cntDigit(i) = i \ 3 'use this array rather than x \ 3 NEXT initiateloopsvalues LOCAL aa AS STRING LOCAL K AS CUR k = 99999999999999.99 ' '****************************************************************************************** ' 'uncomment this section to test. Remove only 1st comment for full run ' 'I show accuracy now to 99,999,999,999,999.99 (~100 trillion--16 digits) if decimal point is present, ' 'and if decimal point is not present, 14 digits, or ~100 trillion. ' 'accuracy check--it's accurate to the penny 100% of the time, but only if k is FIX'ed to exact digits. ' FOR i = 1 TO 10000000 ' local maxk, mink as ext ' k = fix(RND * val("1" & string$(rnd(1, 16), &h30))) * -1 ' k = k / 100 ' IF RND < .5 THEN k = k * -1 ' aStr = testcode2(K,25,0) ' SS=SPACE$(25) ' testcode3(K,25,0,SS) ' IF aStr <> ss THEN ' ? FORMAT$(k, "0.00") & $CRLF & aStr & $CRLF & ss & " " & STR$(i) 'whoops ' IF ABS(VAL(RETAIN$(aStr, ANY "1234567890")) - VAL(RETAIN$(ss, ANY "1234567890"))) > 1 THEN ? "error" ' END IF ' NEXT ' ? "ok" ' EXIT FUNCTION ' '****************************************************************************************** onTimer TOTALTIME = 0.0 ' We could remove as average available in ConfidenceLimits' xbar J = 0& START2: INCR J gotimer FOR I = 1& TO glloopsinasample '========================================================= 'call to the code tested second goes here 'EDIT HERE testcode2(K,25,0 ) '========================================================= NEXT I stoptimer x(j) = ( qStop - qStart - qOverhead ) * 1000/qFreq TOTALTIME = TOTALTIME + x(j) SLEEP RND(2,10) IF J < glsamples THEN GOTO START2 ' ? "-------------------------" ? "code #2 no of samples" + STR$( glsamples ) & $CRLF & _ ConfidenceLimits(x()) & $CRLF & _ USING$( f, ( TOTALTIME / glsamples ) ) + " milliseconds" TOTALTIME = 0.0 J = 0& RESET x() START3: INCR J gotimer FOR I = 1& TO glloopsinasample '========================================================= 'call to the code tested second goes here 'EDIT HERE SS=SPACE$(25) testcode3(K,25,0, SS) '========================================================= NEXT I stoptimer x(j) = ( qStop - qStart - qOverhead ) * 1000/qFreq TOTALTIME = TOTALTIME + x(j) SLEEP RND(2,10) IF J < glsamples THEN GOTO START3 ? "code #3 no of samples" + STR$( glsamples ) & $CRLF & _ ConfidenceLimits(x()) & $CRLF & _ USING$( f, ( TOTALTIME / glsamples ) ) + " milliseconds" END FUNCTION FUNCTION ConfidenceLimits( x() AS SINGLE ) AS STRING ' Input: x( lb to ub ) ' Output: Empty string if 60 samples not adhered to ' Otherwise "[95%: range]" LOCAL lb, ub, i AS LONG LOCAL sigmaX, sigmaX2, s, xbar, delta, lower, upper AS SINGLE lb = LBOUND(x) : ub = UBOUND(x) IF ub - lb + 1 <> 60 THEN ? "I need exactly 60 samples" EXIT FUNCTION END IF FOR i = lb TO ub sigmaX = sigmaX + x(i) sigmaX2 = sigmaX2 + x(i)*x(i) NEXT xbar = sigmaX/60 s = SQR(sigmaX2/60 - xbar * xbar) delta = s*0.2581989 lower = xbar - delta upper = xbar + delta FUNCTION = "[ 95%: " + FORMAT$(lower,"#####.###") + ", " + FORMAT$(upper, "#####.###") + " ]" END FUNCTION
Leave a comment:
-
Leave a comment: