Announcement

Collapse
No announcement yet.

convert dollar number to dollar string

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

  • convert dollar number to dollar string

    a routine to convert dollars to a particular length string.

    i could not find a another routine and/or faster code to do this, it would have been nice to find code to do this. i did not post the code in the source code section in the case somebody else had a better or faster way.

    after David Roberts posted his code to convert a number to a string, i was able to use his method to create the main part of building the string.

    the reason for the code was that i wanted something faster than what i could have created using a predefined compiler function and also i wanted a function to return a blank string as an option if the amount was equal to zero.

    the program returns a string filled with the percent(%) characters if there are is not enough room in the string for the full length of the number.

    the returned string has to be at least 4 characters long for all numbers, such as .01 will respond to "0.01", because that at least a zero dollar digit will be be returned.

    the program has a way to return a blank string if the amount is equal to 0.00(zero).

    an alteration of David Roberts code on converting numbers to strings is used here.

    if somebody can increases the speed of this program, please do so.


    Code:
    'dollar2string
    'pbcc 4.04
    '
    #COMPILE EXE
    #DIM ALL
    #REGISTER NONE
    
    FUNCTION dollar2string( temp1 AS EXT,TEMP2 AS LONG,zerostringblank AS LONG) AS STRING
    REGISTER digit AS LONG
    REGISTER digitinthestring AS LONG
    REGISTER 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 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
     IF negative=0 THEN 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,"%"):GOTO EXITTHEFUNCTION
    exitthefunction:
    FUNCTION=SS
    END FUNCTION
    '---------------------------------------------------------------------------
    FUNCTION PBMAIN ( ) AS LONG
      LOCAL K AS EXT
        'limits for accuracy
        'lower  -9999999999999.99
        'uppper  9999999999999.99
         K= 9999999999999.99
         PRINT k
         PRINT dollar2string(K,25,0)
         K=-9999.99
         PRINT k
         PRINT dollar2string(K,25,0)
         k=-100000000.00
         PRINT k
         PRINT dollar2string(K,25,0)
         K=1.99
         PRINT dollar2string(K,25,1)
         K=11111.99
         PRINT dollar2string(K,5,1)
         PRINT "there is not enough length in string to place then number "
         k=.01
         PRINT dollar2string(K,3,1)
         k=-.00
         PRINT k
         PRINT dollar2string(K,9,0)
           k=-.00
         PRINT k
         PRINT dollar2string(K,1,1)
         PRINT "the last string is filled with spaces because of an option in the funciton"
          WAITKEY$
    
    END FUNCTION
    p purvis

  • #2
    ???
    Code:
    MACRO fmt_money (curval) = RSET$(FORMAT$(curval, "$#,.00"),12)
    MACRO fmt_money2 (curval)= RSET$(FORMAT$(curval, "$#,.00 ;$#,.00-"),12) ' gives '0' in dollar position
    MACRO fmt_money3 (curval)= RSET$(FORMAT$(curval, "$#,.00 ;$#,.00-; "),12) ' gives 'blank when zero'
    ???
    Michael Mattias
    Tal Systems (retired)
    Port Washington WI USA
    [email protected]
    http://www.talsystems.com

    Comment


    • #3
      I ran some tests, comparing
      Code:
      MACRO fmt_money (curval) = RSET$(FORMAT$(curval, "#,.00"),25)
      to
      Code:
      dollar2string(K,25,0)
      and the dollar2string(K,25,0) ran almost exactly 700% faster. That's pretty quick! I'll see if I can spot any further optimizations and will post any found.
      Last edited by John Gleason; 29 Apr 2008, 03:57 PM. Reason: changed 800 to 700%. 8x faster is 700% faster

      Comment


      • #4
        to MCM:
        that would probably be a good way to go if there were not many uses of the code in a program , but because i have found using the FORMAT$ is slow for achieving the results of a string in dollar format. so where if a program calls FORMAT$ many times in a program, i would look for an alternative. but i will still take a look at it.

        to MCM and others
        i have to deal with a lot of dollar string variables, so speed is an issue.
        i know the above code i listed in the first post can go faster, i just have not figured it out yet.

        Here is an alternative to the above code
        it also returns a string filled with the percent(%) if the return string is shorter than the correct/actual string length needed to represent the number/dollar.

        i think i am going to try and make this program return a shorter length than 4 characters, so this program can be used to return values of between 1.00 and -1.00, and then the program could be used for other purposes as well. maybe like returning a percentage, but that is a thought for tomorrow.

        here is an alternative making use of the USING$ statement.
        comparing this code to code in first post
        this routine is twice FASTER, when(in better MCM terms) the return string gives blank when zero
        this routine is a fraction SLOWER, when the value is zero (in better MCM terms) the return string gives 0.00 when zero
        this routine is 4 or more times SLOWER, when the value is none zero.

        maybe a hybrid of this one and the one above would be a better way to go.
        but here is the alternative code anyways for those wanting more simple code and where there is a lot of zero values and you want a result of a blank string if value is zero.

        please pardon the lack of better variable names, i use mostly simple variable names while testing

        this code is nice(speedy and simple), it just does not have the speed when a value given is not zero.
        Code:
        FUNCTION testcode3( temp1 AS EXT,TEMP2 AS LONG,zerostringblank AS LONG ) AS STRING
        LOCAL ss AS STRING
        LOCAL aa AS STRING
        IF temp1=0.00 THEN
          IF zerostringblank=1 THEN
             FUNCTION=SPACE$(temp2)
             EXIT FUNCTION
          END IF
          IF temp2<4 THEN FUNCTION=STRING$(TEMP2,"%"):EXIT FUNCTION
          FUNCTION=SPACE$(temp2-4)+"0.00"
          EXIT FUNCTION
        END IF
        aa =USING$("#,.##",temp1)
        exitthefunction:
        IF LEN(aa)>temp2 THEN
            FUNCTION=STRING$(TEMP2,"%"):EXIT FUNCTION
            ELSE
            ss=SPACE$(temp2)
            RSET ss=aa
        END IF
        
        'print temp1
        'print len(ss)
        'print ss
        'waitkey$
        FUNCTION=ss
        END FUNCTION
        Last edited by Paul Purvis; 29 Apr 2008, 05:17 PM.
        p purvis

        Comment


        • #5
          to MCM and anybody wanting to listen

          thanks for posting those lines

          i am still new with pb and in the process of converting code to pb. even though i found your code slower while running the code with many program calls to the routine, it would be very handy in areas of where one is programming a input from a user or displaying a input back to a user. FORMAT$ is a very powerful function.
          but on the other end where maybe you are displaying numbers on a screen rapidly or inside of a loop or maybe you have a website where you expect many users and need that extra bit of speed(lower cpu usage).
          i believe for the most of use, we are so close to the programming for the internet more than we want to be, these faster routines will serve us well due to all the handling of strings.
          besides being faster, where making use of the internet is concerned, on larger program runs where timeouts may occur, fast string routines need to be in place along with more efficient(fast) code. we never know how well our programs are going to be accepted in the market place and i would want my programs as large a load as possible right up front.

          i perceive mobile devices being using to interact more with in house operations, and basically that means a in house device being used as a server by more users at the same time.

          well i do not want to start discussion here on the above last few sentences, but that is one of the thoughts motivating me for faster code.

          paul

          added:
          one problem or concern i also have with the use of FORMAT$ is that if your return string is not large enough, i do not see a way of detecting an error, such that might be done by returning a string that includes a bad character such as the percent("%), and i am only using that character with my routines to try to keep some standardization with other routines returning the percent(%) character as error in formating. maybe a better choice would of have been the tilde"~" character if support on all printing devices is there along with no conflicts to other major programming languages and operation systems or a letter of the alphabet, maybe as lowercase G(g).
          Last edited by Paul Purvis; 29 Apr 2008, 06:28 PM.
          p purvis

          Comment


          • #6
            Strangely enough, I use those money-formatting routines when I am writing to the screen, writing to a printer or writing to disk.

            And strangely enough, the formatting time is miniscule when compared to the I-O time, since screens, printers and disk are all relatively slow devices.

            Then again, I have no clue why you'd format numbers if you weren't writing to one of those types of devices.

            That is, a loop that does nothing but format numbers without writing them to the device on which they are to be displayed is pointless; and demonstrates exactly nothing.

            (ADDED)
            Ok, don't take my word for it. Run this program and prove it to yourself:
            Code:
            ' Demo_format_versus_write.bas
            '
            #COMPILE EXE
            #DIM     ALL
            #TOOLS   ON
            
            MACRO fmt_money3 (curval)= RSET$(FORMAT$(curval, "$#,.00 ;$#,.00-; "),12) ' gives 'blank when zero'
            
            FUNCTION Write_To_DIsk (hFile AS LONG, s AS STRING) AS LONG
                
                PRINT #hFile, S
                
            END FUNCTION
            
            FUNCTION  GetFormattedMoney (c AS CUR) AS STRING
                FUNCTION= fmt_money3 (C)
            END FUNCTION
            
            FUNCTION PBMAIN () AS LONG
                
                LOCAL I AS LONG,  S AS STRING, C AS CUR
                LOCAL hOut AS LONG
                
                
                hOut = FREEFILE
                OPEN "formatted_output.txt" FOR OUTPUT AS hOut
                
                FOR C  = [email protected] TO [email protected] STEP .01
                    S = getFormattedMoney (C)
                    Write_To_disk  hOut, S
                    
                NEXT
                CLOSE hOut
                
                PROFILE  "demo_profile.txt"
                
                hOut = SHELL ("Notepad.exe demo_profile.txt")
                
            END FUNCTION
            Last edited by Michael Mattias; 29 Apr 2008, 06:27 PM.
            Michael Mattias
            Tal Systems (retired)
            Port Washington WI USA
            [email protected]
            http://www.talsystems.com

            Comment


            • #7
              ok Michael do mine
              this time
              you have 100000 accounts, maybe some are active maybe some are not, bu you want them all.

              each account has 30 dollar items to them
              imagine this.
              you want to save on memory so you want to save the information to a file, sort it(those fixed strings will make it easier to sort, right).
              look at your cpu usage not just the time , and if this was on a web server,a cgi program, well you might even get a timeout, or a timeout if your program runs over the internet.

              we did not even add the time of this program if the files where on a file server and with that extra time, i do not like having to add 20 extra seconds to that time either.

              with kindest regards
              paul

              Code:
              ' Demo_format_versus_write.bas
              '
              #COMPILE EXE
              #DIM     ALL
              #TOOLS   ON
              
              MACRO fmt_money3 (curval)= RSET$(FORMAT$(curval, "#,.00 ;#,.00-; "),12) ' gives 'blank when zero'
              
              
              FUNCTION testcode1( temp1 AS CUR,TEMP2 AS LONG ,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 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 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,"%"):GOTO EXITTHEFUNCTION
              exitthefunction:
              FUNCTION=SS
              END FUNCTION
              
              
              FUNCTION Write_To_DIsk (hFile AS LONG, s AS STRING) AS LONG
              
                  PRINT #hFile, S
              
              END FUNCTION
              
              FUNCTION  GetFormattedMoney (c AS CUR) AS STRING
                  FUNCTION= fmt_money3 (C)
              END FUNCTION
              
              FUNCTION PBMAIN () AS LONG
              
                  LOCAL I AS LONG,  S AS STRING, C AS CUR
                  LOCAL hOut AS LONG
                  LOCAL t AS STRING
                  LOCAL y AS LONG
                  
                  hOut = FREEFILE
                  OPEN "formatted_output.txt" FOR OUTPUT AS hOut
              
                  y=TIMER
                  FOR i=1 TO 100000
                  s=""
                  FOR C  = [email protected] TO [email protected] STEP .01
                      S = s+getFormattedMoney (C)
                       NEXT
                         Write_To_disk  hOut, s
                  NEXT
                  PRINT "timed"
                  PRINT TIMER-y
               
                     y=TIMER
                  FOR i=1 TO 100000
                  s=""
                  FOR C  = [email protected] TO [email protected] STEP .01
                      S = s+testcode1(c,12,1)
                       NEXT
                         Write_To_disk  hOut, s
                  NEXT
                  PRINT "timed"
                  PRINT TIMER-y
              
              
                  CLOSE hOut
                  WAITKEY$
                  PROFILE  "demo_profile.txt"
              
                  hOut = SHELL ("Notepad.exe demo_profile.txt")
              
              END FUNCTION
              added:
              let us really trim the fat
              sorry for the spaghetti code but i am short of time, thanks though Michael for taking time to create that demo.
              variables for the gosub should have more specific variable names

              removed functions being use on both number to string routines
              Code:
              ' Demo_format_versus_write.bas
              '
              #COMPILE EXE
              #DIM     ALL
              #TOOLS   ON
              
              MACRO fmt_money3 (curval)= RSET$(FORMAT$(curval, "#,.00 ;#,.00-; "),12) ' gives 'blank when zero'
              
              
              FUNCTION testcode1( temp1 AS CUR,TEMP2 AS LONG ,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 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 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,"%"):GOTO EXITTHEFUNCTION
              exitthefunction:
              FUNCTION=SS
              END FUNCTION
              
              
              FUNCTION Write_To_DIsk (hFile AS LONG, s AS STRING) AS LONG
              
                  PRINT #hFile, S
              
              END FUNCTION
              
              FUNCTION  GetFormattedMoney (c AS CUR) AS STRING
                  FUNCTION= fmt_money3 (C)
              END FUNCTION
              
              FUNCTION PBMAIN () AS LONG
              
                  LOCAL I AS LONG,  S AS STRING, C AS CUR
                  LOCAL hOut AS LONG
                  LOCAL t AS STRING
                  LOCAL y AS LONG
                  LOCAL temp1 AS CUR
                  LOCAL temp2 AS LONG
                  LOCAL zerostringblank AS LONG
                  LOCAL ss AS STRING
                  hOut = FREEFILE
                  OPEN "formatted_output.txt" FOR OUTPUT AS hOut
              
                  y=TIMER
                  FOR i=1 TO 100000
                  s=""
                  FOR C  = [email protected] TO [email protected] STEP .01
                      S = s+fmt_money3 (C)
              
                     's=s+getFormattedMoney (C)
                       NEXT
                         Write_To_disk  hOut, s
                  NEXT
                  PRINT "timed"
                  PRINT TIMER-y
              
                     y=TIMER
                  FOR i=1 TO 100000
                  s=""
                  FOR C  = [email protected] TO [email protected] STEP .01
                    temp1=c:temp2=12:zerostringblank=1
                    GOSUB anumber2string
                      S = s+ss
                   '    s=s+testcode1(c,12,1)
                       NEXT
                         Write_To_disk  hOut, s
                  NEXT
                  PRINT "timed"
                  PRINT TIMER-y
              
              
                  CLOSE hOut
                  WAITKEY$
                  PROFILE  "demo_profile.txt"
              
                  hOut = SHELL ("Notepad.exe demo_profile.txt")
                  EXIT FUNCTION
              
              anumber2string:
              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
              IF TEMP2<4& THEN  ss=STRING$(TEMP2,"%"):RETURN
              ss=SPACE$(TEMP2)
              IF temp1<0 THEN
                    remains=ABS(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 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 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:
              RETURN
              
              END FUNCTION
              also i want to mention that this number to string routine takes time to verify the length of strings and returns an error string, this all take a large bit of time also and that code is not in FORMAT$. i hope we never see the inflation other countries have had in their past, talk about messing up some programs, but as a programmer, this should be allowed for none the less.
              Last edited by Paul Purvis; 29 Apr 2008, 08:01 PM.
              p purvis

              Comment


              • #8
                here is the latest code i have created for number2string
                there are 3 different functions of dollar2string are testcode1, testcode2, testcode3 for using or testing

                the biggest speed improvement is to create a blank string in advance before calling a number2string function
                the functions

                the fastest is testcode1

                i found some speed by changing testcode1's method of retrieving digits from a number as opposed to testcode2 method.
                i used the FRAC and FIX statements where the MOD statement was used and i also i had to change a few lines of code near
                those pieces of code to shift the digits from the left side of the period to the right side of the period.

                i was also able to consolidate some lines of code into one line of code in testcode2 where the digits are extracted from the value
                to be placed into the string, thereby providing a little extra speed as well.

                the testcode3 function uses the more basic style string functions and has been especially increased in speed when compared to simulate the FORMAT$ statement and it has great speed when returning a blank string for a zero number.



                Code:
                'number2string.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 testcode1( BYVAL temp1 AS EXT,BYVAL TEMP2 AS LONG ,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 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
                
                 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 testcode2( BYVAL temp1 AS EXT,TEMP2 AS LONG ,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 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,zerostringblank AS LONG,BYREF SS AS STRING ) AS STRING
                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 AS STRING
                  DIM x( 1 TO 60) AS SINGLE
                
                   RANDOMIZE
                
                  initiateloopsvalues
                  LOCAL aa AS STRING
                
                  LOCAL K AS CUR
                    K=-123456789123456.78
                    'limits for accuracy
                    'lower  -9999999999999.99
                    'uppper  9999999999999.99
                          K= 9999999999999.99
                '     k=-123456789123456.78
                 '    k=123123.12
                
                 ' k=00
                PRINT k
                  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)
                     testcode1(K,25,0,STRPTR(SS))
                     
                'print ss
                'print k
                '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
                      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
                
                  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$(12)
                      testcode3(K,12,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
                
                  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
                the main function in above code

                Code:
                FUNCTION testcode1( BYVAL temp1 AS EXT,BYVAL TEMP2 AS LONG ,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 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
                
                 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
                
                LOCAL K AS CUR
                  'limits for accuracy
                  'lower  -9999999999999.99
                  'uppper  9999999999999.99
                  
                 K= 9999999999999.99
                'K=-9999999999999.99
                ' K=123123.12
                ' K=00
                 
                    FOR I = 1& TO glloopsinasample
                       SS=SPACE$(25)
                     testcode1(K,25,0,STRPTR(SS))
                Last edited by Paul Purvis; 30 Apr 2008, 06:05 AM.
                p purvis

                Comment


                • #9
                  Paul (Purvis), that's not the same code.
                  Code:
                   
                  FOR C  = [email protected] TO [email protected] STEP .01
                          S = s+fmt_money3 (C)
                  
                         's=s+getFormattedMoney (C)
                           NEXT
                             Write_To_disk  hOut, s
                  What you do here is introduce one string concatenation per loop into the job. Profile it writing each formatted string to the disk one at a time.

                  My point was more these items:

                  1. Formatting numeric strings is only done when you want to write those strings to an output device, and it's likely the I-O will have a more signficant cost in time than the actual formatting.

                  2. PROFILE is a powerful, powerful tool, and not all that hard to use. (One line of code). It lets you identify where your optimization efforts should be directed.

                  Also...
                  ok Michael do mine
                  this time you have 100000 accounts, maybe some are active maybe some are not, but you want them all.

                  each account has 30 dollar items to them
                  you want to save on memory so you want to save the information to a file, sort it(those fixed strings will make it easier to sort, right).
                  Well, no. I would never convert to strings to sort, I'd sort when they were still numbers and write the data to file in sorted order.

                  100,000 8-byte CURRENCY data types is less than 1 Mb of memory so 'saving memory' is hardly a concern.

                  But let's just say 'saving memory' does matter. Well, let's see... seems to me 100,000 8-byte CURRENCY items will use less memory than will 100,000 ten- or twelve- byte formatted strings.

                  FWIW, here's a demo which involves using a work file to avoid using "lots of memory." This does sorting, string building and output. It also is written so that you can easily PROFILE it.

                  Count unique keys and occurrences thereof in sequential file

                  (Oh, shoot. I just looked at that and it's another one of my demos which got cheesed up during the forum conversion. Oh, well, at least that one won't fail because I need case-sensitive string literals).

                  MCM
                  P.S. I sent correction to webmaster via support as previously requested by TPBPTB
                  Last edited by Michael Mattias; 30 Apr 2008, 09:49 AM.
                  Michael Mattias
                  Tal Systems (retired)
                  Port Washington WI USA
                  [email protected]
                  http://www.talsystems.com

                  Comment


                  • #10
                    >What you do here is introduce one string concatenation per loop into the job

                    Oops, I just saw that you have some lines commented out.

                    What you do is create the formatted string 30 times, but only write it to disk once.

                    So... today's speed tip is therefore "Don't do twenty-nine string formats which net out to doing nothing."
                    Michael Mattias
                    Tal Systems (retired)
                    Port Washington WI USA
                    [email protected]
                    http://www.talsystems.com

                    Comment


                    • #11
                      MCM from your quote...I think by your last post should make it clear
                      1. Formatting numeric strings is only done when you want to write those strings to an output device, and it's likely the I-O will have a more signficant cost in time than the actual formatting.
                      AKA...NEVER Write to device (Floppy, Serial, USB, Tape, etc) if its not the answer...only write when you get the answer

                      This can easily be checked by writing all answers to a floppy, vs only write when you got the answer...the speed increase is ....hmmm whats a good word??? "Warp Drive"????

                      Engineer's Motto: If it aint broke take it apart and fix it

                      "If at 1st you don't succeed... call it version 1.0"

                      "Half of Programming is coding"....."The other 90% is DEBUGGING"

                      "Document my code????" .... "WHYYY??? do you think they call it CODE? "

                      Comment


                      • #12
                        we still use dos programs too, matter of fact, more time is spent, 80% actually in dos software. although pbcc 4.04 is not a dos compiler, i am using pbcc to work through performance issues. one reason is for David Roberts timing routines for evaluating code speed and a few other reasons as well. when i am done i would like to have as much generic code as possible for dos compiler and possibly for any future compilers pb may make. i have been making some post with different code in case the code fits somebody needs.

                        although all the codes above should return a string with a number, the returned dynamic strings are left padded on the left because the strings are set to be a specific length, i will be working on a string with a formated number with decimals, dollars will be first on the list, to be returned in a variable length string.

                        after refreshing up on pointer variables, i am going back into my code give them another try, using pb dos, POKE and PEEK are usually slower than using pointer variables.

                        paul
                        Last edited by Paul Purvis; 30 Apr 2008, 10:15 PM.
                        p purvis

                        Comment


                        • #13
                          Paul here is what i did (and still use to be compatible) with dos and windos
                          versions of my programs
                          Code:
                          dim amount as double
                          dim dollar as long
                          dim cent as long
                          dollar=amount
                          cent=(amount-dollar)*100
                          if cent<0 then
                            dollar=dollar-1
                            cent=cent+100
                          end if
                          st$=MKL(dollar)+chr$(cent)
                          'decode
                          dollar=CVI(mid$(st$,1,4))+ASC(RIGHT$(ST$,1))/100
                          This was before currency types and the st$ can be saved to a file using
                          5 bytes. Of course since long variables are stored as 4 byte the MKL and
                          CVI are not necessary if stored in a type def.
                          Type dollar_amount
                          WholeDollar as long
                          cents as string * 1
                          end type

                          then
                          Code:
                          dim savedollars as dollar_amount
                          dollar=amount
                          cent=(amount-dollar)*100
                          if cent<0 then
                            dollar=dollar-1
                            cent=cent+100
                          end if
                          SaveDollars.wholedollar=dollar
                          SaveDollars.cents=chr$(cent)
                          
                          Amount=SaveDollars.Wholedollar+asc(SaveDollars.cents)/100
                          Client Writeup for the CPA

                          buffs.proboards2.com

                          Links Page

                          Comment


                          • #14
                            This post has been updated here: new and improved version

                            I optimized testcode2 some, and it is ~ 50% faster now than testcode3. For some reason, both occasionally (1.5% each) mis-round the last penny. I show accuracy to 10^15.

                            Code:
                            'number2string.bas
                            'pbcc 4.04
                            '#COMPILE EXE
                            #DIM ALL
                            #REGISTER NONE
                            
                            GLOBAL glloopsinasample  AS LONG
                            GLOBAL glsamples         AS LONG
                            GLOBAL TOTALTIME         AS SINGLE
                            GLOBAL div10             AS EXT
                            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 ) * 1000 / qFreq ) + " 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, Remains2 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 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
                            
                              countdigit=1
                            
                              FOR digit = TEMP2 TO 1 STEP -1
                                Remains2=FIX(Remains * div10)                                        'replaces Remains \ 10
                                NextDigit=Remains - remains2 * 10
                                digitinthestring=digit-(cntDigit(countdigit))                        'replaces countdigit\3
                                IF digitinthestring=0 THEN ss=STRING$(TEMP2,"%"):GOTO EXITTHEFUNCTION
                                POKE BYTE,ptrss + digitinthestring - 1, Nextdigit + 48
                                Remains=remains2
                                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-(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
                            
                              div10 = 1 / 10         'use fix(x * div10) rather than x \ 10
                              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=-123456789123456.78
                                'limits for accuracy
                                'lower  -9999999999999.99
                                'uppper  9999999999999.99
                                      K=   9999999999999.99
                            '     k=-123456789123456.78
                             '    k=123123.12
                            
                             ' k=00
                            ' '******************************************************************************************
                            ' 'uncomment this section to test. Remove only 1st comment for full run
                            ' 'I show accuracy to 999,999,999,999,999.99 (almost 1 quadrillion)
                            ' 'accuracy check--for some reason it's only accurate to the penny 97% of the time
                            ' '3% of the time one or the other rounds the wrong way, each being wrong 1.5% of the time
                            ' for i = 1 to 10000000
                            '    k = rnd * 1000000000000000
                            '    if rnd < .5 then k = k * -1
                            '     aStr = testcode2(K,25,0)
                            '      SS=SPACE$(25)
                            '      testcode3(K,25,0,SS)
                            '      if aStr <> ss then
                            ' '   ? STR$(k, 18) & $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
                            ' '******************************************************************************************
                            '? STR$(k, 16)
                              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"
                            
                              '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
                                ? "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:01 PM. Reason: new version

                            Comment


                            • #15
                              John,
                              i have not had to do some work on these routines.
                              if you change TEMP1 from a EXT variable to a double, the increase is doubled also.
                              Fred's idea of dealing with the dollars and cents maybe more applicable for large numbers.

                              if testcode1's code was made longer as is by including code to work with temp1 being a double variable or temp1 being a extended variable that would produce speed in half except when working with large numbers.

                              as you might of found out the speed bumps are dealing with strings to and from the routine and in retrieving the single digits from the amount(value/temp1) to plug the string with.


                              paul
                              p purvis

                              Comment


                              • #16
                                Paul Dixons FastLong2Str asm code might be modified. It is very fast.

                                http://www.powerbasic.com/support/pb...han+STR&page=2
                                How long is an idea?

                                Comment


                                • #17
                                  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, 05:39 PM. Reason: alignment nops

                                  Comment


                                  • #18
                                    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, 07:34 PM.
                                    p purvis

                                    Comment


                                    • #19
                                      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, 08:42 AM. Reason: changed IF remains=0 THEN... logic

                                      Comment


                                      • #20
                                        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
                                        p purvis

                                        Comment

                                        Working...
                                        X