Announcement

Collapse
No announcement yet.

convert dollar number to dollar string

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Michael Mattias
    replied
    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.

    Leave a comment:


  • John Gleason
    replied
    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:


  • Michael Mattias
    replied
    Code:
    #DEBUG OVERFLOW ON
    FUNCTION Foo..
    
    
     ON ERROR  GOTO Errortrap
     Z = X * Y
    
    ErrorTrap:
      IF ERR = %ERROR_OVERFLOW THEN
        xxxxxx
    My bad, I forgot: #DEBUG OVERFLOW ON is still in the New Feature Suggestion box.

    Leave a comment:


  • Paul Purvis
    replied
    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
    http://www.powerbasic.com/support/pb...ad.php?t=23740
    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:


  • Paul Purvis
    replied
    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:


  • John Gleason
    replied
    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.
    [email protected]  'ok 8.04
    [email protected]@ 'not ok
    moneyamount=99999999999999.99## 'not ok

    Leave a comment:


  • Michael Mattias
    replied
    > 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
    To eliminate rounding errors in that kind of code, a good step is to explicity type your numeric literals, eg "999999999&" or "99999999!", not just "9999999".

    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:


  • John Gleason
    replied
    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:


  • Michael Mattias
    replied
    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.
    Not universally true; depends on how many times the parameter is referenced in the function.
    where a fixed length string can be used, use it
    Not universally true; depends on the application. FWIW, when performing a string operation (eg LEFT$, MID$) on a fixed string variable the compiler creates and destroys a temporary string anyway.

    faster is always better, always remember your program may be used in a high end processing environment
    Absolutely untrue. In a 'batch' program, a few seconds difference of run-time is immaterial; resource (memory, disk) usage and maintainability should get more 'weight' when choosing your coding technique.

    Remember, you might not be the next programmer to have to update or enhance this program.

    MCM

    Leave a comment:


  • Cliff Nichols
    replied
    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.
    BINGO< BANGO< BONGO

    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:


  • Michael Mattias
    replied
    >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:


  • Paul Purvis
    replied
    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:


  • Paul Purvis
    replied
    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:


  • Michael Mattias
    replied
    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:


  • John Gleason
    replied
    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:


  • Paul Purvis
    replied
    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:


  • Paul Purvis
    replied
    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)
    
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        DECR d2s_returnstringptr
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
    
        DECR d2s_returnstringptr
        @d2s_returnstringptr=44
    
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
    
        DECR d2s_returnstringptr
        @d2s_returnstringptr=44
    
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
    
        DECR d2s_returnstringptr
        @d2s_returnstringptr=44
    
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
    
        DECR d2s_returnstringptr
        @d2s_returnstringptr=44
    
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_ptramountext\10
        IF FIX(@d2s_ptramountext)=0 THEN GOTO markifnegative
    
        DECR d2s_returnstringptr
        @d2s_returnstringptr=44
    
        DECR d2s_returnstringptr
        @[email protected]_ptramountext MOD 10+48
        @[email protected]_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:


  • John Gleason
    replied
    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
    number2money.bas
    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
    Last edited by John Gleason; 8 May 2008, 07:42 AM. Reason: changed IF remains=0 THEN... logic

    Leave a comment:


  • Paul Purvis
    replied
    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.
    paul
    Last edited by Paul Purvis; 3 May 2008, 06:34 PM.

    Leave a comment:


  • John Gleason
    replied
    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
    Last edited by John Gleason; 3 May 2008, 04:39 PM. Reason: alignment nops

    Leave a comment:

Working...
X