J-Walk posted about the word ‘ravine’. If you spell it backwards, each letter is offset 13 characters from its forward-spelled cousin. He says:
Who can come up with another? You may use Excel.
I came up with these using the list of words at orchy.com:
although I’m not sure how some of those are words. I pasted the dictionary in a text file. Then I tried to replace all of the spaces with commas. I killed notepad.exe after about 20 minutes, deciding to parse the strings in VBA instead.
Sub Enivar()
Dim sFname As String
Dim lFnum As Long
Dim sInput As String
Dim vaWords As Variant
Dim i As Long
Dim sWord As String
‘identify the file
sFname = Environ$(“USERPROFILE”) & “My Documentsorchydict.txt”
lFnum = FreeFile
‘open the file
Open sFname For Input As lFnum
Do While Not EOF(lFnum) ‘loop until the end
Input #lFnum, sInput ‘read in a chunk of data
vaWords = Split(sInput, ” “) ‘split the word on space
For i = LBound(vaWords) To UBound(vaWords)
sWord = UCase(vaWords(i)) ‘make everything upper case
If ReverseString(sWord) = OffsetString(sWord) Then
Debug.Print sWord
End If
Next i
Loop
Close lFnum ‘close the file
End Sub
Function ReverseString(sWord As String) As String
Dim i As Long
Dim sReturn As String
For i = Len(sWord) To 1 Step -1 ‘loop backward
sReturn = sReturn & Mid(sWord, i, 1)
Next i
ReverseString = sReturn
End Function
Function OffsetString(sWord As String) As String
Dim i As Long
Dim sReturn As String
Dim sLetter As String
Dim lAscZ As Long, lAscAm As Long
Const lOFF As Long = 13
lAscZ = Asc(“Z”)
lAscAm = Asc(“A”) – 1
For i = 1 To Len(sWord)
sLetter = Mid$(sWord, i, 1)
‘move 13 letters forward, wrap around to A if necessary
If Asc(sLetter) + lOFF > lAscZ Then
sReturn = sReturn & Chr$(((Asc(sLetter) + lOFF) Mod lAscZ) + lAscAm)
Else
sReturn = sReturn & Chr$(Asc(sLetter) + lOFF)
End If
Next i
OffsetString = sReturn
End Function
Dim sFname As String
Dim lFnum As Long
Dim sInput As String
Dim vaWords As Variant
Dim i As Long
Dim sWord As String
‘identify the file
sFname = Environ$(“USERPROFILE”) & “My Documentsorchydict.txt”
lFnum = FreeFile
‘open the file
Open sFname For Input As lFnum
Do While Not EOF(lFnum) ‘loop until the end
Input #lFnum, sInput ‘read in a chunk of data
vaWords = Split(sInput, ” “) ‘split the word on space
For i = LBound(vaWords) To UBound(vaWords)
sWord = UCase(vaWords(i)) ‘make everything upper case
If ReverseString(sWord) = OffsetString(sWord) Then
Debug.Print sWord
End If
Next i
Loop
Close lFnum ‘close the file
End Sub
Function ReverseString(sWord As String) As String
Dim i As Long
Dim sReturn As String
For i = Len(sWord) To 1 Step -1 ‘loop backward
sReturn = sReturn & Mid(sWord, i, 1)
Next i
ReverseString = sReturn
End Function
Function OffsetString(sWord As String) As String
Dim i As Long
Dim sReturn As String
Dim sLetter As String
Dim lAscZ As Long, lAscAm As Long
Const lOFF As Long = 13
lAscZ = Asc(“Z”)
lAscAm = Asc(“A”) – 1
For i = 1 To Len(sWord)
sLetter = Mid$(sWord, i, 1)
‘move 13 letters forward, wrap around to A if necessary
If Asc(sLetter) + lOFF > lAscZ Then
sReturn = sReturn & Chr$(((Asc(sLetter) + lOFF) Mod lAscZ) + lAscAm)
Else
sReturn = sReturn & Chr$(Asc(sLetter) + lOFF)
End If
Next i
OffsetString = sReturn
End Function
Looks like GNAT and TANG are the longest ones that spell an English word in both directions.
I had a feeling you might post something like this.
How long did it take run?
Don’t know how much these improvements help but here they are.
First, recognize that words that meet the requirement must have an even number of characters.
Second, compare the 1st half of each word with the last half working from the outside in.
Third, the character-by-character test can stop at the first failure.
Combining the above:
Sub Enivar()
Dim sFname As String, lFnum As Long, sInput As String
sFname = “c: emporchydict.txt”
lFnum = FreeFile
Open sFname For Input As lFnum
Do While Not EOF(lFnum)
Input #lFnum, sInput
Dim vaWords As Variant, I As Long
vaWords = Split(sInput, ” “)
For I = LBound(vaWords) To UBound(vaWords)
If Offset13(vaWords(I)) Then Debug.Print vaWords(I)
Next I
Loop
Close lFnum
End Sub
Function Offset13(ByVal aWord As String) As Boolean
Dim I As Integer, WordLen As Integer
WordLen = Len(aWord)
If WordLen Mod 2 <> 0 Then Exit Function
aWord = UCase(aWord)
For I = 1 To Len(aWord) / 2
If Abs(Asc(Mid(aWord, I, 1)) – Asc(Mid(aWord, WordLen + 1 – I, 1))) <> 13 Then _
Exit Function
Next I
Offset13 = True
End Function
The resulting list:
an
bo
CP
Er
fans
fobs
freres
gant
gnat
grivet
GT
Hu
iv
Livy
Lyly
na
nana
Ob
pc
ravine
re
rebore
rive
robe
serf
SF
tang
TG
thug
uh
vi
It’s good to see the VBA community is really getting to grips with the major technological challenges of the 21st century :-) Ah well, back to that perpetual motion machine …
Hi Dick –
No need to roll your own ReverseString(). There’s StrReverse() in VBA6.
…mrt
Mine takes 4.9 seconds. Tushar’s takes 4.5 seconds. Using the built in StrReverse in Tushar’s took 3.6 seconds.
Now how did I not now about StrReverse?
Roy: We once spelled words using Excel’s column headings, so there’s nowhere to go but up. :)
Notepad is only good for a screenful or two of ‘search n replace’. I joined some colelagues on a job once which involved them starting off a very large S’n’R in Notepad and then saying “Right, that’s lunch, it’ll take an hour to run”, my helpful suggestion to use Word and do it in 2 seconds was welcomed with open arms.
Gareth
Hawaiian Tropic Talent Scouting Agency (Elephant Island Office – Antarctica)
[…] string functions Posted on May 15, 2009 by dougaj4 It was pointed out in a comment to this post at Daily Dose of ExcelA that VBA has a StrReverse function that will (logically enough) reverse a string.A That’s […]
Hi Dick –
After reaching a certain maturity, whenever something comes into memory, something goes out. :-) And we’re not given to know what goes out. At least that’s how it is for me. Memory is third thing to go, and I forgot what the other two are.
Potential MIDW posted over at Doug’s site.
…mrt