Announcement

Collapse
No announcement yet.

Phone Letters to Numbers

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

  • Phone Letters to Numbers

    I'm sure this little routine has been posted here before but I couldn't find any. Maybe someone will find it of use.

    '
    Code:
    #Compile Exe  
    #Include "WIN32API.INC"
     
     
    Sub Phone_Letters_to_Numbers(P$) 
      Local ctr&, x$
      p$ = UCase$(p$)'JIC any lower case
      For ctr =1 To Len(p$)'check whole length
         x$ = Mid$(p$, ctr, 1)'check each character
         Select Case x$ 'Is it a letter?
           Case "A", "B", "C"
             x$ = "2"
           Case "D", "E", "F"
             x$ = "3"
           Case "G", "H", "I"
             x$ = "4"
           Case "J", "K", "L"
             x$ = "5"
           Case "M", "N", "O"
             x$ = "6"
           Case "P", "Q", "R", "S"
             x$ = "7"
           Case "T", "U", "V"
             x$ = "8"
           Case "W", "X", "Y", "Z"
             x$ = "9"
         End Select 
         Mid$(p$, ctr, 1) = x$'Now put character back
      Next ctr
    End Sub
     
     
     
    Function PBMain
     Local p$, Phone$                   
     Phone$ = "1-800-Call Me Now"          
     p$ = Phone$ 'hold it to check later
     Call Phone_Letters_to_Numbers(Phone$) 
     ? p$ & $CrLf & Phone$
    End Function
    '
    ============================================
    Charm is a glow within a woman
    that casts a most becoming light on others.
    John Mason Brown
    ============================================
    It's a pretty day. I hope you enjoy it.

    Gösta

    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

  • #2
    'Without the string manipulations
    Code:
    $s = CHR$(50,50,50,51,51,51,52,52,52,53,53,53,54,54,54,55,55,55,55,56,56,56,57,57,57,57)
    SUB Test(p AS STRING)
      LOCAL ctr AS LONG, x AS LONG
      FOR ctr = 1 TO LEN(p)
        x = ASC(p,ctr)
        IF x > 96 AND x< 123 THEN x = x - 32 'convert to upper case
        IF x > 64 AND x < 91 THEN ASC(p,ctr) = ASC($s,x-64)
      NEXT
    END SUB
     
    FUNCTION PBMAIN
      LOCAL p$, Phone$
      Phone$ = "1-800-Call Me Now"
      p$ = Phone$ 'hold it to check later
      test phone
      ? p & $CRLF & Phone
    END FUNCTION
    '

    Comment


    • #3
      Neat code, Mike. Avonding the use of string manipulation, which we all know is inherently faster. Very fast indeed. (see example)

      Maybe someone can come up with a pointer example that's even faster again.

      '
      Code:
      #Compile Exe  
      #Include "WIN32API.INC"
      $s = Chr$(50,50,50,51,51,51,52,52,52,53,53,53,54,54,54,55,55,55,55,56,56,56,57,57,57,57)
      Sub Test(p As String)
        Local ctr As Long, x As Long
        For ctr = 1 To Len(p)
          x = Asc(p,ctr)
          If x > 96 And x< 123 Then x = x - 32 'convert to upper case
          If x > 64 And x < 91 Then Asc(p,ctr) = Asc($s,x-64)
        Next
      End Sub
       
      Sub Phone_Letters_to_Numbers(P$) 
        Local ctr&, x$
        p$ = UCase$(p$)'JIC any lower case
        For ctr =1 To Len(p$)'check whole length
           x$ = Mid$(p$, ctr, 1)'check each character
           Select Case x$ 'Is it a letter?
             Case "A", "B", "C"
               x$ = "2"
             Case "D", "E", "F"
               x$ = "3"
             Case "G", "H", "I"
               x$ = "4"
             Case "J", "K", "L"
               x$ = "5"
             Case "M", "N", "O"
               x$ = "6"
             Case "P", "Q", "R", "S"
               x$ = "7"
             Case "T", "U", "V"
               x$ = "8"
             Case "W", "X", "Y", "Z"
               x$ = "9"
           End Select 
           Mid$(p$, ctr, 1) = x$'Now put character back
        Next ctr
      End Sub
       
      Function PBMain
       Local u$, p$, p1$, p2$, Phone$, tmr#, tmr1#, tmr2#
       
       tmr# = Timer                   
       Phone$ = "1-800-Call Me Now"          
       p$ = Phone$ 'hold it to check later
       Call Phone_Letters_to_Numbers(Phone$)
        tmr1 = Timer - tmr#  'time to do               
        p1$ = Phone$  'hold for later
       
       tmr# = Timer                   
       Phone$ = "1-800-Call Me Now"          
       p$ = Phone$ 'hold it to check later
       Call Test(phone$)
        tmr2 = Timer - tmr# 'time to do test
        p2$ = Phone$
       
        u$ = p1$ & Using$("      Using Strings took .######## seconds", tmr1) & _
              $CrLf & _
              p2$ & Using$(" Not using Strings took .######## seconds", tmr2) 
       
        ?u$,, "'1-800-Call Me Now' conversion to numbers"          
       
       
      End Function
      '
      ======================================
      "But at my back I always hear
      Time's winged chariot hurrying near."
      Andrew Marvell (1621-1678)
      ======================================
      It's a pretty day. I hope you enjoy it.

      Gösta

      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

      Comment


      • #4
        'Test using GetTickCount using multiple iterations
        Code:
        #COMPILE EXE
        #INCLUDE "WIN32API.INC"
        $s = CHR$(50,50,50,51,51,51,52,52,52,53,53,53,54,54,54,55,55,55,55,56,56,56,57,57,57,57)
        SUB Test(p AS STRING)
          LOCAL ctr AS LONG, x AS LONG
          FOR ctr = 1 TO LEN(p)
            x = ASC(p,ctr)
            IF x > 96 AND x< 123 THEN x = x - 32 'convert to upper case
            IF x > 64 AND x < 91 THEN ASC(p,ctr) = ASC($s,x-64)
          NEXT
        END SUB
        SUB Phone_Letters_to_Numbers(P$)
        LOCAL ctr&, x$
        p$ = UCASE$(p$)'JIC any lower case
        FOR ctr =1 TO LEN(p$)'check whole length
        x$ = MID$(p$, ctr, 1)'check each character
        SELECT CASE x$ 'Is it a letter?
        CASE "A", "B", "C"
        x$ = "2"
        CASE "D", "E", "F"
        x$ = "3"
        CASE "G", "H", "I"
        x$ = "4"
        CASE "J", "K", "L"
        x$ = "5"
        CASE "M", "N", "O"
        x$ = "6"
        CASE "P", "Q", "R", "S"
        x$ = "7"
        CASE "T", "U", "V"
        x$ = "8"
        CASE "W", "X", "Y", "Z"
        x$ = "9"
        END SELECT
        MID$(p$, ctr, 1) = x$'Now put character back
        NEXT ctr
        END SUB
        FUNCTION PBMAIN
        LOCAL u$, p$, p1$, p2$, Phone$, tmr#, tmr1#, tmr2#
        LOCAL x AS LONG
        tmr# = GetTickCount
        ' ? str$(tmr)
        FOR x = 1 TO 99999
        Phone$ = "1-800-Call Me Now"
        p$ = Phone$ 'hold it to check later
        CALL Phone_Letters_to_Numbers(Phone$)
        p1$ = Phone$ 'hold for later
        NEXT
        tmr1 = GetTickCount - tmr# 'time to do
         
        tmr# = GetTickCount
        ' ? str$(tmr)
        FOR x = 1 TO 99999
        Phone$ = "1-800-Call Me Now"
        p$ = Phone$ 'hold it to check later
        CALL Test(phone$)
         
        p2$ = Phone$
        NEXT
        tmr2 = GetTickCount - tmr# 'time to do test
        u$ = p1$ & USING$(" Using Strings took .######## ticks", tmr1) & _
        $CRLF & _
        p2$ & USING$(" Not using Strings took .######## ticks", tmr2)
        ?u$,, "'1-800-Call Me Now' conversion to numbers"
         
        END FUNCTION
        '

        Comment


        • #5
          WOW! Not using strings is almost 40 times faster. But it takes almost infinitely longer (couple seconds) to count the ticks to find out it's faster. {rue}

          Now if somebody would post a string pointer example, it would probably be hundreds of times faster and only take an hour to test the time/tick advantage.

          Ain't programming fun?

          =====================================
          "The use of COBOL cripples the mind;
          its teaching should therefore
          be regarded as a criminal offense."
          Edsgar Dijkstra
          =====================================
          It's a pretty day. I hope you enjoy it.

          Gösta

          JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
          LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

          Comment


          • #6
            Code:
             
            SUB Phone_Letters_To_Numbers( BYREF strSource AS STRING )
             DIM lngIndex AS LONG
             DIM pstrSource AS BYTE PTR
             DIM pstrTable AS BYTE PTR
             DIM strTable AS STRING
             DIM bytValue AS BYTE
             pstrSource = STRPTR( StrSource )
             strTable = "22233344455566677778889999"
             pstrTable = STRPTR( strTable )
             FOR lngIndex = 0 TO LEN( strSource ) - 1
              bytValue = @pstrSource [ lngIndex ]
              IF bytValue > 64 AND bytValue < 91 THEN
               @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 65 ]
              ELSEIF bytValue > 96 AND bytValue < 123 THEN
               @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 97 ]
              END IF
             NEXT lngIndex
            END SUB
            Now just waiting for the Wayne Diamond Assembly version
            Last edited by George Bleck; 10 Aug 2008, 03:01 PM. Reason: Corrected error on two lines of code (Line 13=64 to 65, Line=15 95 to 97)
            <b>George W. Bleck</b>
            <img src='http://www.blecktech.com/myemail.gif'>

            Comment


            • #7
              Code:
              FUNCTION PBMAIN() AS LONG
                  CALL TestPhoneDigits
              END FUNCTION
              
              $KEYPAD = "   ABCDEFGHIJKLMNOPRSTUVWYZ"   ' no X or Q on keypad
              ' starts with three spaces
              $DIGITS  = "0123456789"
              
              FUNCTION LetterToDigit ( D AS STRING) AS STRING
               LOCAL iPos AS LONG
               LOCAL X AS STRING
               
               X    = UCASE$(D)
               iPos = INSTR ($DIGITS, X)  ' is it a digit, as in [b]1-800[/b]-HELPME-RHONDA
               IF ISTRUE iPos THEN        ' yes, it is a digit
                   FUNCTION = x
               ELSE
                    iPos = INSTR ($KEYPAD, X)      ' is it a supported letter?
                    IF iPos THEN                   ' yes it is a supported letter
                        FUNCTION = FORMAT$(iPos\3+ IIF&(ipos MOD 3, 1, 0))  ' A(pos4) ==>"2"; Z (pos 27)==> "9"
                    ELSE
                       FUNCTION = D  ' must be a non-digit non-supported letter; just return what we got
                    END IF
               END IF
              
              END FUNCTION
              
              FUNCTION TestPhoneDigits () AS LONG
                  
                  LOCAL Z AS LONG, L AS STRING, D AS STRING, S AS STRING, C AS STRING
                  
                  LOCAL TT AS STRING
                  
                    TT = "Uppper-case Letter Test"
                    FOR Z = 1 TO 26
                        C = CHR$ (64 + Z)
                        D = LettertoDigit ( C)
                        S = S & USING$ ("&=&", C, D) & $CRLF
                    NEXT
                    MSGBOX S,,TT
                    
                    TT = "DIGIT TEST"
                    S = ""
                    FOR Z = &h30  TO  &h39
                        C = CHR$(Z)
                        D = LettertoDigit ( C)
                        S = S & USING$ ("&=&", C, D) & $CRLF
                    NEXT
                    MSGBOX S,,TT
                    
                    
                    TT = "Lower-case letter test"
                    S = ""
                    FOR Z = 1 TO 26
                        C = CHR$ (96 + Z)
                        D = LettertoDigit ( C)
                        S = S & USING$ ("&=&", C, D) & $CRLF
                    NEXT
                    MSGBOX S,,TT
                    
              
              END FUNCTION
              Michael Mattias
              Tal Systems (retired)
              Port Washington WI USA
              [email protected]
              http://www.talsystems.com

              Comment


              • #8
                Probably the most simple way to do it using just PB statements. Just one statement and 2 strings:

                StSrc$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
                StDst$ = "2223334445556667777888999922233344455566677778889999"

                REPLACE ANY StSrc$ WITH StDst$ IN Phone$
                Bye!
                -- The universe tends toward maximum irony. Don't push it.

                File Extension Seeker - Metasearch engine for file extensions / file types
                Online TrID file identifier | TrIDLib - Identify thousands of file formats

                Comment


                • #9
                  >REPLACE ANY ..

                  Outstanding!
                  Michael Mattias
                  Tal Systems (retired)
                  Port Washington WI USA
                  [email protected]
                  http://www.talsystems.com

                  Comment


                  • #10
                    Originally posted by Marco Pontello View Post
                    Probably the most simple way to do it using just PB statements. Just one statement and 2 strings:
                    WOW! WOW!! WOW!!!

                    ============================================
                    "A pound of pluck is worth a ton of luck."
                    Garfield
                    ============================================
                    It's a pretty day. I hope you enjoy it.

                    Gösta

                    JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                    LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                    Comment


                    • #11
                      Many artists, many brushes...same exact painting
                      <b>George W. Bleck</b>
                      <img src='http://www.blecktech.com/myemail.gif'>

                      Comment


                      • #12
                        All are fast (untimeable really) but Marco wins hands down (elegance).

                        George, there appears to be an error in your code. It returns a different number.

                        MCM, I didn't include your code in the test (too much code to play with) but I'm sure it's even faster. Maybe even picks up the phone on the other end, or direct connects somehow bypassing the phone company or something else as esoteric.

                        '
                        Code:
                        #Compile Exe  
                        #Include "WIN32API.INC"
                        $s = Chr$(50,50,50,51,51,51,52,52,52,53,53,53,54,54,54,55,55,55,55,56,56,56,57,57,57,57)
                        
                        'George Bleck                                
                           'Phone_Letters_to_Numbers
                        Sub George_Bleck( ByRef strSource As String )
                         Dim lngIndex As Long
                         Dim pstrSource As Byte Ptr
                         Dim pstrTable As Byte Ptr
                         Dim strTable As String
                         Dim bytValue As Byte
                         pstrSource = StrPtr( StrSource )
                         strTable = "22233344455566677778889999"
                         pstrTable = StrPtr( strTable )
                         For lngIndex = 0 To Len( strSource ) - 1
                          bytValue = @pstrSource [ lngIndex ]
                          If bytValue > 64 And bytValue < 91 Then
                           @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 64 ]
                          ElseIf bytValue > 96 And bytValue < 123 Then
                           @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 95 ]
                          End If
                         Next lngIndex
                        End Sub
                        'Mike Doty
                        Sub Test(p As String)
                          Local ctr As Long, x As Long
                          For ctr = 1 To Len(p)
                            x = Asc(p,ctr)
                            If x > 96 And x< 123 Then x = x - 32 'convert to upper case
                            If x > 64 And x < 91 Then Asc(p,ctr) = Asc($s,x-64)
                          Next
                        End Sub
                        'Gösta 
                        Sub Phone_Letters_to_Numbers(P$) 
                          Local ctr&, x$
                          p$ = UCase$(p$)'JIC any lower case
                          For ctr =1 To Len(p$)'check whole length
                             x$ = Mid$(p$, ctr, 1)'check each character
                             Select Case x$ 'Is it a letter?
                               Case "A", "B", "C"
                                 x$ = "2"
                               Case "D", "E", "F"
                                 x$ = "3"
                               Case "G", "H", "I"
                                 x$ = "4"
                               Case "J", "K", "L"
                                 x$ = "5"
                               Case "M", "N", "O"
                                 x$ = "6"
                               Case "P", "Q", "R", "S"
                                 x$ = "7"
                               Case "T", "U", "V"
                                 x$ = "8"
                               Case "W", "X", "Y", "Z"
                                 x$ = "9"
                             End Select 
                             Mid$(p$, ctr, 1) = x$'Now put character back
                          Next ctr
                        End Sub
                        'Marco Pontello
                        Sub Marco(Phone$)
                         Local StSrc$, StDst$
                         StSrc$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvw xyz"
                         StDst$ = "2223334445556667777888999922233344455566677778889 999"
                          Replace Any StSrc$ With StDst$ In Phone$  
                        End Sub
                        ' 
                        Function PBMain
                         Local u$, p$, p1$, p2$, p3$, p4$, Phone$ 
                         Local tmr#, tmr1#, tmr2#, tmr3#, tmr4#
                         
                         tmr# = Timer                   
                         Phone$ = "1-800-Call Me Now"          
                         p$ = Phone$ 'hold it to check later
                         Call Phone_Letters_to_Numbers(Phone$)
                          tmr1 = Timer - tmr#  'time to do               
                          p1$ = Phone$  'hold for later
                         
                         tmr# = Timer                   
                         Phone$ = "1-800-Call Me Now"          
                         Call Test(phone$)
                          tmr2 = Timer - tmr# 'time to do test
                          p2$ = Phone$
                         tmr# = Timer                   
                         Phone$ = "1-800-Call Me Now"          
                         Call George_Bleck(phone$)
                          tmr3 = Timer - tmr# 'time to do test
                          p3$ = Phone$
                         tmr# = Timer                   
                         Phone$ = "1-800-Call Me Now"          
                         Call Marco(phone$)
                          tmr4 = Timer - tmr# 'time to do test
                          p4$ = Phone$
                         
                          u$ = p1$ & Using$("     GHL Using Strings took .######## seconds", tmr1) & $CrLf & _
                               p2$ & Using$("  MD Not using Strings took .######## seconds", tmr2) & $CrLf & _
                               p3$ & Using$("     GB Using Pointers took .######## seconds", tmr3) & $CrLf & _
                               p4$ & Using$(" Marco just being cool took .######## seconds", tmr4) & $CrLf 
                                
                          ?u$,, "'1-800-Call Me Now' conversion to numbers"          
                         
                         
                        End Function
                        '
                        =======================================================================================================================
                        "Grove giveth and Gates taketh away."
                        Bob Metcalfe (inventor of Ethernet) on the trend of hardware speedups not being able to keep up with software demands
                        =======================================================================================================================
                        It's a pretty day. I hope you enjoy it.

                        Gösta

                        JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                        LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                        Comment


                        • #13
                          Bah, darn typos... did it without testing sorry. Corrected two lines in my posting...works as expected now.
                          And the winner is...

                          Code:
                          #COMPILE EXE
                          #INCLUDE "WIN32API.INC"
                          $s = CHR$( 50, 50, 50, 51, 51, 51, 52, 52, 52, 53, 53, 53, 54, 54, 54, 55, 55, 55, 55, 56, 56, 56, 57, 57, 57, 57 )
                          'George Bleck
                          'Phone_Letters_to_Numbers
                          SUB George_Bleck( BYREF strSource AS STRING )
                           DIM lngIndex AS LONG
                           DIM pstrSource AS BYTE PTR
                           DIM pstrTable AS BYTE PTR
                           DIM strTable AS STRING
                           DIM bytValue AS BYTE
                           pstrSource = STRPTR( StrSource )
                           strTable = "22233344455566677778889999"
                           pstrTable = STRPTR( strTable )
                           FOR lngIndex = 0 TO LEN( strSource ) - 1
                            bytValue = @pstrSource [ lngIndex ]
                            IF bytValue > 64 AND bytValue < 91 THEN
                             @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 65 ]
                            ELSEIF bytValue > 96 AND bytValue < 123 THEN
                             @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 97 ]
                            END IF
                           NEXT lngIndex
                          END SUB
                          'Mike Doty
                          SUB Test( p AS STRING )
                           LOCAL ctr AS LONG, x AS LONG
                           FOR ctr = 1 TO LEN( p )
                            x = ASC( p, ctr )
                            IF x > 96 AND x < 123 THEN x = x - 32  'convert to upper case
                            IF x > 64 AND x < 91 THEN ASC( p, ctr ) = ASC( $s, x - 64 )
                           NEXT
                          END SUB
                          'Gösta
                          SUB Phone_Letters_to_Numbers( P$ )
                           LOCAL ctr&, x$
                           p$ = UCASE$( p$ )  'JIC any lower case
                           FOR ctr = 1 TO LEN( p$ )  'check whole length
                            x$ = MID$( p$, ctr, 1 )  'check each character
                            SELECT CASE x$  'Is it a letter?
                             CASE "A", "B", "C"
                              x$ = "2"
                             CASE "D", "E", "F"
                              x$ = "3"
                             CASE "G", "H", "I"
                              x$ = "4"
                             CASE "J", "K", "L"
                              x$ = "5"
                             CASE "M", "N", "O"
                              x$ = "6"
                             CASE "P", "Q", "R", "S"
                              x$ = "7"
                             CASE "T", "U", "V"
                              x$ = "8"
                             CASE "W", "X", "Y", "Z"
                              x$ = "9"
                            END SELECT
                            MID$( p$, ctr, 1 ) = x$  'Now put character back
                           NEXT ctr
                          END SUB
                          'Marco Pontello
                          SUB Marco( Phone$ )
                           LOCAL StSrc$, StDst$
                           StSrc$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvw xyz"
                           StDst$ = "2223334445556667777888999922233344455566677778889 999"
                           REPLACE ANY StSrc$ WITH StDst$ IN Phone$
                          END SUB
                          FUNCTION PBMAIN
                           LOCAL u$, p$, p1$, p2$, p3$, p4$, Phone$
                           LOCAL tmr#, tmr1#, tmr2#, tmr3#, tmr4#
                           iterations& = 500000
                           ' Test 1
                           Phone$ = "1-800-Call Me Now"
                           tmr# = TIMER
                           FOR t& = 1 TO iterations& : CALL Phone_Letters_to_Numbers( Phone$ ) : NEXT t%
                           tmr1# = TIMER - tmr#  'time to do
                           p1$ = Phone$  'hold for later
                           ' Test 2
                           Phone$ = "1-800-Call Me Now":
                           tmr# = TIMER
                           FOR t& = 1 TO iterations& : CALL Test( phone$ ) : NEXT T&
                           tmr2# = TIMER - tmr#  'time to do test
                           p2$ = Phone$
                           'Test 3
                           Phone$ = "1-800-Call Me Now"
                           tmr# = TIMER
                           FOR t& = 1 TO iterations& : CALL George_Bleck( phone$ ) : NEXT T&
                           tmr3# = TIMER - tmr#  'time to do test
                           p3$ = Phone$
                           'Test 4
                           Phone$ = "1-800-Call Me Now"
                           tmr# = TIMER
                           FOR t& = 1 TO iterations& : CALL Marco( phone$ ) : NEXT T&
                           tmr4# = TIMER - tmr#  'time to do test
                           p4$ = Phone$
                           u$ = p1$ & USING$( "     GHL Using Strings took .######## seconds", tmr1# ) & $CRLF & _
                             p2$ & USING$( "  MD Not using Strings took .######## seconds", tmr2# ) & $CRLF & _
                             p3$ & USING$( "     GB Using Pointers took .######## seconds", tmr3# ) & $CRLF & _
                             p4$ & USING$( " Marco just being cool took .######## seconds", tmr4# ) & $CRLF
                           ?u$,, "'1-800-Call Me Now' conversion to numbers"
                          END FUNCTION
                          Last edited by George Bleck; 10 Aug 2008, 03:17 PM.
                          <b>George W. Bleck</b>
                          <img src='http://www.blecktech.com/myemail.gif'>

                          Comment


                          • #14
                            It's several times faster but 100x less elegant than Marco's quewool one-liner, but what the heck, here's my 2 centavos.
                            Code:
                            #COMPILE EXE
                            #DIM ALL
                            
                            FUNCTION PBMAIN () AS LONG
                                LOCAL phonStr, phoneIn AS STRING, pPtr AS BYTE PTR, ii AS LONG
                                phoneIn = "1{800}Call the Hotline !"
                                
                                pPtr = STRPTR(phoneIn)
                            
                                phonStr = _     'this is a lookup table which is basically asm fast.
                            "................................ !""#$%&'()*+,-./0123456789:;<+>[email protected][\]^_`22233344455566677778889999{|}~" & _
                            "................................................................................................................................."
                                DIM phon(255) AS BYTE AT STRPTR(phonStr)
                            
                                FOR ii = 1 TO LEN(phoneIn)
                                   @pPtr = phon(@pPtr)
                                   INCR pPtr
                                NEXT
                            
                                ? phoneIn
                            END FUNCTION

                            Comment


                            • #15
                              MCM, I didn't include your code in the test (too much code to play with) but I'm sure it's even faster.
                              Don't even bother testing it: it's not what I would have written were I going for "fast."

                              I was going for "simple." But the even simpler "REPLACE ANY" idea never even occurred to me.
                              Michael Mattias
                              Tal Systems (retired)
                              Port Washington WI USA
                              [email protected]
                              http://www.talsystems.com

                              Comment


                              • #16
                                Just in case anyone gets ticked off

                                Using Mike's GetTickCount 99999 times each:

                                '
                                Code:
                                #Compile Exe  
                                #Include "WIN32API.INC"
                                #Include "C:\Power Basic\Includes\clipboard.inc"
                                $s = Chr$(50,50,50,51,51,51,52,52,52,53,53,53,54,54,54,55,55,55,55,56,56,56,57,57,57,57)
                                
                                'George Bleck                                
                                   'Phone_Letters_to_Numbers
                                Sub George_Bleck( ByRef strSource As String )
                                 DIM lngIndex AS LONG
                                 Dim pstrSource As Byte Ptr
                                 Dim pstrTable As Byte Ptr
                                 Dim strTable As String
                                 Dim bytValue As Byte
                                 pstrSource = StrPtr( StrSource )
                                 strTable = "22233344455566677778889999"
                                 pstrTable = StrPtr( strTable )
                                 For lngIndex = 0 To Len( strSource ) - 1
                                  bytValue = @pstrSource [ lngIndex ]
                                  If bytValue > 64 And bytValue < 91 Then
                                   @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 65 ]
                                  ElseIf bytValue > 96 And bytValue < 123 Then
                                   @pstrSource [ lngIndex ] = @pstrTable [ bytValue - 97 ]
                                  End If
                                 Next lngIndex
                                 End Sub
                                'Mike Doty
                                Sub Test(p As String)
                                  Local ctr As Long, x As Long
                                  For ctr = 1 To Len(p)
                                    x = Asc(p,ctr)
                                    If x > 96 And x< 123 Then x = x - 32 'convert to upper case
                                    If x > 64 And x < 91 Then Asc(p,ctr) = Asc($s,x-64)
                                  Next
                                End Sub
                                'Gösta 
                                Sub Phone_Letters_to_Numbers(P$) 
                                  Local ctr&, x$
                                  p$ = UCase$(p$)'JIC any lower case
                                  For ctr =1 To Len(p$)'check whole length
                                     x$ = Mid$(p$, ctr, 1)'check each character
                                     Select Case x$ 'Is it a letter?
                                       Case "A", "B", "C"
                                         x$ = "2"
                                       Case "D", "E", "F"
                                         x$ = "3"
                                       Case "G", "H", "I"
                                         x$ = "4"
                                       Case "J", "K", "L"
                                         x$ = "5"
                                       Case "M", "N", "O"
                                         x$ = "6"
                                       Case "P", "Q", "R", "S"
                                         x$ = "7"
                                       Case "T", "U", "V"
                                         x$ = "8"
                                       Case "W", "X", "Y", "Z"
                                         x$ = "9"
                                     End Select 
                                     Mid$(p$, ctr, 1) = x$'Now put character back
                                  Next ctr
                                End Sub
                                'Marco Pontello
                                Sub Marco(Phone$)
                                 Local StSrc$, StDst$
                                 StSrc$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvw xyz"
                                 StDst$ = "2223334445556667777888999922233344455566677778889 999"
                                  Replace Any StSrc$ With StDst$ In Phone$  
                                End Sub
                                ' 
                                'John Gleason
                                Sub JohnG(Phone$)
                                   Local phonStr, phoneIn As String, pPtr As Byte Ptr, ii As Long
                                    phoneIn = Phone$ '"1{800}Call the Hotline !"
                                    
                                    pPtr = StrPtr(phoneIn)
                                    phonStr = _     'this is a lookup table which is basically asm fast.
                                "................................ !""#$%&'()*+,-./0123456789:;<+>[email protected][\]^_`22233344455566677778889999{|}~" & _
                                "................................................................................................................................."
                                    Dim phon(255) As Byte At StrPtr(phonStr)
                                    For ii = 1 To Len(phoneIn)
                                       @pPtr = phon(@pPtr)
                                       Incr pPtr
                                    Next
                                    Phone$ = phoneIn 
                                End Sub
                                '
                                Sub JohnG2(Phone$)
                                   Static pPtr As Byte Ptr, ii As Long
                                   Static phonStr As String, oneTime As Long
                                    pPtr = StrPtr(phone$)
                                    If onetime = 0 Then
                                       oneTime = 1
                                       phonStr = _     'this is a lookup table which is basically asm fast.
                                       "................................ !""#$%&'()*+,-./0123456789:;<+>[email protected][\]^_`22233344455566677778889999{|}~" & _
                                       "................................................................................................................................."
                                       Dim phon(255) As Static Byte At StrPtr(phonStr)
                                    End If
                                    For ii = 1 To Len(phone$)
                                       @pPtr = phon(@pPtr)
                                       Incr pPtr
                                    Next
                                End Sub
                                '
                                Sub John_MCM(Phone$)
                                   Static pPtr As Byte Ptr, ii As Long
                                   Static phonStr As String, oneTime As Long
                                   Static pTable As Byte Ptr 
                                    pPtr = StrPtr(phone$)
                                    If onetime = 0 Then
                                       oneTime = 1
                                       phonStr = _     'this is a lookup table which is basically asm fast.
                                       "................................ !""#$%&'()*+,-./0123456789:;<+>[email protected][\]^_`22233344455566677778889999{|}~" & _
                                       "................................................................................................................................."
                                '       Dim phon(255) As Static Byte At StrPtr(phonStr)
                                       Ptable = StrPtr (phonstr)
                                    End If
                                For ii = 1 To Len(phone$)
                                       @pPtr [EMAIL="[email protected]"][email protected][/EMAIL][@pPtr]
                                       Incr pPtr
                                Next
                                '    For ii = 1 To Len(phone$)
                                '       @pPtr = phon(@pPtr)
                                '       Incr pPtr
                                '    Next
                                End Sub
                                '
                                Macro Start 
                                  tmr# = GetTickCount         
                                  For x = 1 To 99999
                                    phone$ = p$
                                End Macro
                                ' 
                                Function PBMain
                                 Local u$, p$, p1$, p2$, p3$, p4$, p5$, p6$, Phone$
                                 Local p7$, tmr7# 
                                 Local tmr#, tmr1#, tmr2#, tmr3#, tmr4#, tmr5#, tmr6#
                                 Local x&
                                 
                                 Phone$ = "1-800-Call Me Now"          
                                 p$ = Phone$ 'hold it to check later
                                 Start                   
                                 Call Phone_Letters_to_Numbers(Phone$)
                                 Next x
                                  tmr1 = GetTickCount - tmr# 'Timer - tmr#  'time to do               
                                  p1$ = Phone$  'hold for later
                                 
                                 Start                   
                                 Call Test(phone$)
                                 Next x
                                  tmr2 = GetTickCount - tmr#  'Timer - tmr# 'time to do test
                                  p2$ = Phone$
                                 
                                 
                                 Start                   
                                 Call George_Bleck(phone$)
                                 Next x
                                  tmr3 = GetTickCount - tmr#  'Timer - tmr# 'time to do test
                                  p3$ = Phone$
                                 
                                 
                                 Start                   
                                 Call Marco(phone$)
                                 Next x
                                  tmr4 = GetTickCount - tmr#  'Timer - tmr# 'time to do test
                                  p4$ = Phone$
                                 Start                   
                                 Call JohnG(phone$)
                                 Next x
                                  tmr5 = GetTickCount - tmr# 'time to do test
                                  p5$ = Phone$
                                 Start                   
                                 Call JohnG2(phone$)
                                 Next x
                                  tmr6 = GetTickCount - tmr# 'time to do test
                                  p6$ = Phone$
                                 start
                                  Call John_MCM(Phone$)
                                  Next x
                                  tmr7 = GetTickCount - tmr# 'time to do test
                                  p7$ = Phone$
                                  
                                  Local u1$, t$
                                  u1$ = " took #,### ticks"
                                  u$ = p1$ & Using$(u1$ & " GHL Using Strings", tmr1) & $CrLf & _
                                       p2$ & Using$(u1$ & " MD Not using Strings", tmr2) & $CrLf & _
                                       p3$ & Using$(u1$ & " GB Using Pointers", tmr3) & $CrLf & _
                                       p4$ & Using$(u1$ & " Marco just being cool", tmr4) & $CrLf & _
                                       p5$ & Using$(u1$ & " John G's shot", tmr5) & $CrLf & _
                                       p6$ & Using$(u1$ & " John G's second shot", tmr6) & $CrLf & _
                                       p7$ & Using$(u1$ & " John G with MCM shot", tmr7) & $CrLf 
                                        
                                   t$ =   "  [qote]" & $CrLf & _
                                          "'1-800-Call Me Now' conversion to numbers"  & $CrLf  & $CrLf & _
                                          u$  & $CrLf & "[/qote]"
                                   Set_Clipboard
                                  ?u$,, "'1-800-Call Me Now' conversion to numbers"          
                                End Function
                                '
                                ============================
                                "I've had a wonderful time,
                                and this wasn't it."
                                Groucho Marx (1895-1977)
                                ============================
                                Last edited by Gösta H. Lovgren-2; 10 Aug 2008, 09:30 PM. Reason: Includes MCM changes to John G
                                It's a pretty day. I hope you enjoy it.

                                Gösta

                                JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                Comment


                                • #17
                                  Gösta, try the below code. I made a few mods mainly to make the translation table "SUB friendly". That is to say, the table gets created and erased just once per program run.
                                  Code:
                                  SUB JohnG(Phone$)
                                     STATIC pPtr AS BYTE PTR, ii AS LONG
                                     STATIC phonStr AS STRING, oneTime AS LONG
                                  
                                      pPtr = STRPTR(phone$)
                                      IF onetime = 0 THEN
                                         oneTime = 1
                                         phonStr = _     'this is a lookup table which is basically asm fast.
                                         "................................ !""#$%&'()*+,-./0123456789:;<+>[email protected][\]^_`22233344455566677778889999{|}~" & _
                                         "................................................................................................................................."
                                         DIM phon(255) AS STATIC BYTE AT STRPTR(phonStr)
                                      END IF
                                  
                                      FOR ii = 1 TO LEN(phone$)
                                         @pPtr = phon(@pPtr)
                                         INCR pPtr
                                      NEXT
                                  END SUB

                                  Comment


                                  • #18
                                    Now where were we when they were decoding the Human genome
                                    <b>George W. Bleck</b>
                                    <img src='http://www.blecktech.com/myemail.gif'>

                                    Comment


                                    • #19
                                      And the New Winner is:

                                      Rather than reposting the code each time I'll just replace it above (see post #16) .

                                      Here are the results:

                                      '1-800-Call Me Now' conversion to numbers
                                      1-800-2255 63 669 took 3,031 ticks GHL Using Strings
                                      1-800-2255 63 669 took 63 ticks MD Not using Strings
                                      1-800-2255 63 669 took 47 ticks GB Using Pointers
                                      1-800-2255 63 669 took 312 ticks Marco just being cool
                                      1-800-2255 63 669 took 78 ticks John G's shot
                                      1-800-2255 63 669 took 16 ticks John G's second shot



                                      =========================================
                                      The company of just and righteous men
                                      is better than wealth and a rich estate.
                                      Euripides, Aegeus
                                      =========================================
                                      Last edited by Gösta H. Lovgren-2; 10 Aug 2008, 09:00 PM. Reason: post hunting
                                      It's a pretty day. I hope you enjoy it.

                                      Gösta

                                      JWAM: (Quit Smoking): http://www.SwedesDock.com/smoking
                                      LDN - A Miracle Drug: http://www.SwedesDock.com/LDN/

                                      Comment


                                      • #20
                                        Code:
                                        FOR ii = 1 TO LEN(phone$)
                                               @pPtr = phon(@pPtr)
                                               INCR pPtr
                                            NEXT
                                        ===>
                                        Look Ma, no arrays required ...
                                        Code:
                                        LOCAL pTable AS BYTE PTR 
                                        Ptable = STRPTR (phonstr)
                                        
                                        FOR ii = 1 TO LEN(phone$)
                                               @pPtr [email protected][@pPtr]
                                               INCR pPtr
                                        NEXT
                                        (another demo of same thing at EBCDIC - ASCII April 17, 2001
                                        Michael Mattias
                                        Tal Systems (retired)
                                        Port Washington WI USA
                                        [email protected]
                                        http://www.talsystems.com

                                        Comment

                                        Working...
                                        X