Announcement

Collapse
No announcement yet.

Phone Letters to Numbers

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

  • Gösta H. Lovgren-2
    replied
    New 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 79 ticks MD Not using Strings
    1-800-2255 63 669 took 31 ticks GB Using Pointers
    1-800-2255 63 669 took 328 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
    1-800-2255 63 669 took 15 ticks John G with MCM adjustment

    ===========================================
    "God, please save me from your followers!"
    Bumper Sticker
    ===========================================
    Last edited by Gösta H. Lovgren-2; 10 Aug 2008, 08:28 PM. Reason: Put MCM's Local into Static, it doubled speed

    Leave a comment:


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

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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, 08:00 PM. Reason: post hunting

    Leave a comment:


  • George Bleck
    replied
    Now where were we when they were decoding the Human genome

    Leave a comment:


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

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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, 08:30 PM. Reason: Includes MCM changes to John G

    Leave a comment:


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

    Leave a comment:


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

    Leave a comment:


  • George Bleck
    replied
    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, 02:17 PM.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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
    =======================================================================================================================

    Leave a comment:


  • George Bleck
    replied
    Many artists, many brushes...same exact painting

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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
    ============================================

    Leave a comment:


  • Michael Mattias
    replied
    >REPLACE ANY ..

    Outstanding!

    Leave a comment:


  • Marco Pontello
    replied
    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!

    Leave a comment:


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

    Leave a comment:


  • George Bleck
    replied
    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, 02:01 PM. Reason: Corrected error on two lines of code (Line 13=64 to 65, Line=15 95 to 97)

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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
    =====================================

    Leave a comment:


  • Mike Doty
    replied
    '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
    '

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    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)
    ======================================

    Leave a comment:


  • Mike Doty
    replied
    '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
    '

    Leave a comment:

Working...
X