UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Reverse A String, Access 2003 & Lower    
 
   
CyberCow
post Apr 17 2013, 07:12 PM
Post#1


UdderAccess Admin + UA Ruler
Posts: 19,555
Joined: 27-April 02
From: Upper MI


Before the release of Access 2007 and its new 'strReverse()' function, there was no built-in method to reverse the contents of a string.
o that end, the following discussion initiates a study of VBA functions to emulate Access 2007 (and higher's) 'strReverse()' function for Access versions 2003 and lower.
Basically, it just takes a string and turns it backwards, (reverses it), spelling-wise.
CODE
Public Function myRevSpell(str As String) As String
' usage: ?myRevSpell("AfrgT764oopppedy")
' returns: ydepppoo467TgrfA
Dim strTemp As String, strBld As String, strDim As String, I As Long, J As Long
    I = Len(str) - 1
    strBld = Right(str, 1)
    strDim = Left(str, (Len(str) - 1))
    For J = 1 To I
        strTemp = Right(strDim, 1)
        strBld = strBld & strTemp
        strDim = Left(str, (Len(str) - (J + 1)))
    Next
    
    myRevSpell = strBld
End Function

Enjoy! hat_tip.gif
Go to the top of the page
 
Doug Steele
post Apr 17 2013, 08:58 PM
Post#2


UtterAccess VIP
Posts: 21,497
Joined: 8-January 07
From: St. Catharines, ON (Canada)


<picky> Since variable J goes from 1 to I, and I is a Long Integer, J should be one as well. </picky>
You could also just use
CODE
Public Function myRevSpell(str As String) As String
' usage: ?myRevSpell("AfrgT764oopppedy")
' returns: ydepppoo467TgrfA
Dim J As Long
Dim strTemp As String
  
    For J = Len(str) To 1 Step -1
        strTemp = strTemp & Mid(str, J, 1)
    Next
    
    myRevSpell = strTemp
End Function
Go to the top of the page
 
CyberCow
post Apr 18 2013, 03:16 AM
Post#3


UdderAccess Admin + UA Ruler
Posts: 19,555
Joined: 27-April 02
From: Upper MI


Doug - Point taken (and edited) on the J as Long preference. (Even if picky)
And yours is more proof of the many ways a thing can be done in Access. Even after I posted it, I saw that it could be leaner. Thanks for showing us how.
Now, perhaps theDBguy will demonstrate how to do it recursively. big_grin.gif
But after Larry Larsen kindly pointed out that strReverse() (a built-in Access function) does exactly the same thing, these are now just exercises in loop/search string manipulat
Go to the top of the page
 
gemmathehusky
post Apr 18 2013, 04:28 AM
Post#4


UtterAccess VIP
Posts: 4,432
Joined: 5-June 07
From: UK


not the DbGuy but here you go
!--c1-->
CODE
Function revstrg(s As String) As String
If Len(s) <= 1 Then
    revstrg = s
Else
    revstrg = Right(s, 1) & revstrg(Left(s, Len(s) - 1))
End If
End Function
Sub tryit()
MsgBox (revstrg("abcde"))
End Sub

recursion - the framework is similar whatever you do in recursion
you need a condition that stops the recursion continuing to another level
and then you need to decide how to modify what you have to manage the next level of the recursion
here's a similar thing to reverse the WORDS in a string, whiuch would be more fiddly than the previous example, without using recursion.
CODE
Function revwords(s As String) As String
If InStr(s, " ") = 0 Then
    revwords = s
Else
    revwords = Mid(s, InStrRev(s, " ") + 1) & " " & revwords(Left(s, InStrRev(s, " ") - 1))
End If
End Function
Sub trywords()
MsgBox (revwords("the cat sat on the hat"))
End Sub

note that in the recursive section, the first time I tried this, I inadvertently put + instead of minus (copy and paste) - which instantly crashed the stack - which we have discussed before.
revwords = Mid(s, InStrRev(s, " ") + 1) & " " & revwords(Left(s, InStrRev(s, " ") + 1))
Go to the top of the page
 
datAdrenaline
post Apr 19 2013, 07:19 PM
Post#5


UtterAccess Editor
Posts: 17,941
Joined: 4-December 03
From: Northern Virginia, USA


Since this is just for an exercise in looping ... lets look efficiency too. You don't have to loop the entire length of the string to accomplish the task at hand ...
!--c1-->
CODE
Public Function xStrReverse(strText) As String
    Dim bHolder As Byte
    Dim bLetters() As Byte
    bLetters = strText
    
    
    Dim x As Long: x = UBound(bLetters)
    Dim i As Long
    
    For i = 0 To Int(x / 2) Step 2
        
        bHolder = bLetters(i)
        bLetters(i) = bLetters(x - i - 1)
        bLetters(x - i - 1) = bHolder
        
    Next i
    
    xStrReverse = bLetters
    
End Function

The same concept can be applied to reversing words ...
CODE
Public Function xStrReverseWords(strText) As String
    Dim strHolder As String
    Dim strWords() As String
    strWords = Split(strText, " ")
    
    Dim x As Long: x = UBound(strWords)
    Dim i As Long
    
    For i = 0 To Int(x / 2)
        
        strHolder = strWords(i)
        strWords(i) = strWords(x - i)
        strWords(x - i) = strHolder
        
    Next i
    
    xStrReverseWords = Join(strWords, " ")
    
End Function
Go to the top of the page
 
cycnus
post Sep 23 2013, 09:50 AM
Post#6



Posts: 36
Joined: 22-May 08



Out of curiosity I checked the performance of each function using various string lengths.
The test code is something simple like this:
CODE
    Private Const MAXITERATIONS = 100000
    Private Const MAXSTRLEN = 400
    
    Dim str As String
    str = String$(MAXSTRLEN, "a")
    StartCounter
        For I = 0 To MAXITERATIONS
            str = funcToTest(str)
        Next I
    Debug.Print "Time to reverse using funcToTest: " & StopCounter

StartCounter/StopCounter are helper functions that leverage API calls to QueryPerformanceCounter to get precise counters.
The results are in milliseconds for 100,000 iterations of each function at various string lengths:
Attached File  sshot_29.png ( 21.04K )Number of downloads: 10

It's clear that datAdrenaline's optimised function (yet still short and easy to understand) is the best performer here, with almost linear performance as string length increases.
Not surprisingly, the most mathematically beautiful implementation, using recursion, is also extremely poor with its exponential performance cost: recursion calls are very costly, and they do cost a lot more in terms of memory as well as each call adds data to the stack.
Go to the top of the page
 
dmhzx
post Sep 23 2013, 10:10 AM
Post#7



Posts: 7,033
Joined: 22-December 10
From: England


cycnus:
Don't know about anyone else , but if you get a few minutes, I for one would be very interested to see how the built in strReverse compares with the offerings of our wizards.
Go to the top of the page
 
cycnus
post Sep 23 2013, 10:28 AM
Post#8



Posts: 36
Joined: 22-May 08



I had to change the scale of the chart to log(10) so we could see the results:
Attached File  sshot_30.png ( 22.52K )Number of downloads: 12

guess there is no beating an optimised native implementation, we're talking orders of magnitudes in performance between various version.
Go to the top of the page
 
dmhzx
post Sep 23 2013, 10:37 AM
Post#9



Posts: 7,033
Joined: 22-December 10
From: England


Many thanks for that.
Go to the top of the page
 
MaxWanadoo
post Sep 23 2013, 05:28 PM
Post#10



Posts: 151
Joined: 2-October 09



Just out of interest (!)
How quickly would it be (against the other benchmarks), if the letters to be sorted were A-Z and were just dumped into an Array (dimensioned to the length of string=26) in their alphabetical position, viz:
A = Arrary(1)
HE = Array(5)
Z= Array(26)
and then print the Array in reverse order.
So, no sorting required, just the requirement to identify the alphabetical position of the letter (ie, ASC()-64)
and then do it AGAIN with the array dimensioned to 64+26, thus avoiding the need to check the ASC() value.
Max
Go to the top of the page
 
cycnus
post Sep 24 2013, 06:59 AM
Post#11



Posts: 36
Joined: 22-May 08



On thing to be careful with the fast code from datAdrenaline is that it doesn't work if you are using any Unicode characters above the extended ASCII character set since it only swaps the lower byte of each character (each character in VBA is 2 bytes).
So it's fast, but there is a bit of cheating as well since it only swaps half of the bytes :-)
Here is a version that is safe (at least it handles Unicode characters as well/bad as the built-in StrReverse):
EDIT: Buggy code block ... see post #18. datAdrenaline
CODE
Public Function xStrReverse(strText) As String
    If Len(strText) < 2 Then
        xStrReverse = strText
        Exit Function
    End If
    Dim bHolderL As Byte, bHolderH As Byte
    Dim bLetters() As Byte
    bLetters = strText
    
    Dim x As Long: x = UBound(bLetters)
    Dim h As Long: h = x \ 2
    Dim i As Long, ii As Long
    Dim k As Long, kk As Long
    x = x - 1
    
    For i = 0 To h Step 2
        k = x - i
        bHolderL = bLetters(i)
        bLetters(i) = bLetters(k)
        bLetters(k) = bHolderL
        ' Deal with Unicode points above U+FF
        ii = i + 1
        bHolderH = bLetters(ii)
        If bHolderH > 0 Then
            kk = k + 1
            bLetters(ii) = bLetters(kk)
            bLetters(kk) = bHolderH
        End If
    Next i
    
    xStrReverse = bLetters
End Function

For the sake of completeness and simplicity, here is another version that's a bit slower, but still OK, and it handles Unicode in the same way as the built-in StrReverse:
CODE
Public Function xStrReverse(strText) As String
    xStrReverse = strText
    Dim x As Long: x = Len(strText)
    If x < 2 Then Exit Function
    Dim h As Long: h = x \ 2
    Dim i As Long
    Dim j As Long
    Dim c As String
    x = x + 1
    For i = 1 To h
        j = x - i
        c = Mid$(xStrReverse, i, 1)
        Mid$(xStrReverse, i) = Mid$(xStrReverse, j, 1)
        Mid$(xStrReverse, j) = c
    Next i
End Function

And here are the stats for all versions:
Attached File  sshot_33.png ( 32.71K )Number of downloads: 2
Go to the top of the page
 
genoma111
post Sep 24 2013, 07:39 AM
Post#12



Posts: 2,018
Joined: 2-June 09
From: Bogotá - Colombia


I've heard that in general is a bad idea to use RegExp for this task.
However I'm wondering how it will rank.
May I ask you cycnus to perform the test?
I'm using the wild character /./ that is not the most efficient but that will capture everything...
Thanks
CODE
Public Function StringRev(strInput As String) As String
    Dim RegExp      As RegExp
    Dim Matches     As MatchCollection
    Dim Match       As Match
    Dim strP        As String
    
    Set RegExp = New RegExp
    
    With RegExp
        .IgnoreCase = False
        .Global = True
        .Pattern = "."
        
        Set Matches = RegExp.Execute(strInput)
        
        For Each Match In Matches
            strP = Match.Value & strP
        Next Match
        
        Set Matches = Nothing
    End With
    
    StringRev = strP
    
    Set RegExp = Nothing
End Function

CODE
Private Sub cmdReverse_Click()
    Me.strRev = StringRev(Me.strFw)
End Sub

Edit: Totally forgot... Requires the Microsoft VBScript Regular Expressions 5.5 library to be added to the References...
Go to the top of the page
 
datAdrenaline
post Sep 24 2013, 09:08 AM
Post#13


UtterAccess Editor
Posts: 17,941
Joined: 4-December 03
From: Northern Virginia, USA


FYI ...
VBA6, implemented with Access 2000 (presumably Office 2000 as well), exposed StrReverse() along with InStrRev(), Replace(), Join(), Split(), and MonthName() --- if I recall correctly <.
Go to the top of the page
 
cycnus
post Sep 24 2013, 10:16 AM
Post#14



Posts: 36
Joined: 22-May 08



@genoma111, it's so slow it's not even funny... I've done one test and we're talking more than 10,000x slower than the built-in StrReverse function...
've got another last implementation that's actually the fastest so far (apart from the built-in StrReverse which probably can't be beat).
This version is also handling Unicode as expected.
CODE
Private Declare Sub GetWord Lib "MSVBVM60.dll" Alias "GetMem2" (ByVal inSrc As LongPtr, ByRef inDst As Integer)
Private Declare Sub PutWord Lib "MSVBVM60.dll" Alias "PutMem2" (ByVal inDst As LongPtr, ByVal inSrc As Integer)
Public Function xStrReverse(str As String) As String
    xStrReverse = str
    
    Dim ptrStart As LongPtr, ptrEnd As LongPtr, ptrMid As LongPtr
    Dim l As Long
    l = LenB(xStrReverse) - 2
    ptrStart = StrPtr(xStrReverse)
    ptrMid = ptrStart + l \ 2
    ptrEnd = ptrStart + l
        
    Dim c1 As Integer, c2 As Integer
    Dim ptr As LongPtr
    For ptr = ptrStart To ptrMid Step 2
        GetWord ptr, c1
        GetWord ptrEnd, c2
        PutWord ptrEnd, c1
        PutWord ptr, c2
        ptrEnd = ptrEnd - 2
    Next ptr
End Function

This version uses the closest thing to pointers in VBA to directly manipulate memory.
The fact that we have to use external functions has certainly a major cost when compared with direct memory manipulation, but it's still faster than manipulating arrays.
Note that I've used LongPtr, you will have to replace LongPtr by Long in pre-Access2010 versions.
Last version of the graph:
Attached File  sshot_34.png ( 37.11K )Number of downloads: 6
Go to the top of the page
 
genoma111
post Sep 24 2013, 10:25 AM
Post#15



Posts: 2,018
Joined: 2-June 09
From: Bogotá - Colombia


Thank you for the test cycnus.
HAs I said , I've heard this is not recommended, but I couldn't find any tests nor comparisons.
Thanks again.
Regards,
Diego
Go to the top of the page
 
datAdrenaline
post Sep 24 2013, 10:58 AM
Post#16


UtterAccess Editor
Posts: 17,941
Joined: 4-December 03
From: Northern Virginia, USA


Note ... Cycnus and I BOTH have a bug in our "Unicode safe" code ... we check for the upper byte of greater than 0 FROM ONE SIDE of the potential swap ... we need to check BOTH SIDES of the potentential swap.
!--coloro:#008000-->Fixed code for practical use in VBA5 as a substitute for VBA6's StrReverse() ...
CODE
Public Function xStrReverse(strText) As String
    Dim bHolder As Long
    Dim bLetters() As Byte
    
    bLetters = strText
    
    Dim x As Long: x = UBound(bLetters)
    
    Dim i As Long
    Dim ii As Long: ii = Int(x / 2)
    
    'Lower Bytes
    For i = 0 To ii Step 2
        bHolder = bLetters(i)
        bLetters(i) = bLetters(x - i - 1)
        bLetters(x - i - 1) = bHolder
    Next i
    
    'Higher Bytes
    For i = 1 To ii Step 2
        If (bLetters(i) Or bLetters(x - i - 1)) > 0 Then
            bHolder = bLetters(i)
            bLetters(i) = bLetters(x - i - 1)
            bLetters(x - i - 1) = bHolder
        End If
    Next i
    
    'Return the result
    xStrReverse = bLetters
    
End Function
Go to the top of the page
 
cycnus
post Sep 24 2013, 08:31 PM
Post#17



Posts: 36
Joined: 22-May 08



Well, good catch, I thought I tested but apparently I've missed that.
peaking of Unicode, I have posted a new topic in this "Access Code Archive" a few days ago but it hasn't been moderated yet.
If there is anything wrong about the post, please let me know.
I'm asking because that post contained code to include arbitrary Unicode code points within VBA strings. Pretty relevant to this discussion too I think.
I have re-created the performance chart, keeping only the version of the code that were Unicode-compliant.
HAs before, the numbers show time in ms to perform 100,000 iterations at different string lengths.
Lower numbers are better.
Attached File  sshot_35.png ( 41.5K )Number of downloads: 13

I'm sure we could get more performance out of this by hard-coding swaps for small strings and then moving to fetching 32bits or 64bits of data at a time, then twiddling the bits.
Reducing the total number of iterations would be good, as well as avoiding assignments.
We could probably even include direct compiled assembly using some hacks.
but I suppose it's enough for now :-)
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    16th December 2017 - 09:59 AM