Palindromes

[Luciano Paulino da Silva]

Dear all,
Some time ago (http://groups.google.com.br/group/
microsoft.public.excel.worksheet.functions/browse_thread/thread/
6b068321053a5c90/c6dcff10540e4bc2?q=palindromes+excel+bernie&lnk=ol&)
Bernie Deitrick helped me to solve a problem related to palindromes
and repeats detection on a string of letters. At present, I need
perform some change on that macros in order to detect non-redundant
palindromes and repeats. In this way, for the sequence bellow my
solution it would be:

QGAGAAAAAAAAGGAGQGG

13 Palindromes detected
GAG
AGA
GAAAAAAAAG
AA
AAA
AAAA
AAAAA
AAAAAA
AAAAAAA
AAAAAAAA
AGGA
GG
GQG 1 3

Now the solution it would be:

QGAGAAAAAAAAGGAGQGG

13 Non-redundant Palindromes detected

GAG
GAAAAAAAAG
GG

The big palindromes should be preferred in the occurrences.
Thanks in advance,
Luciano

 

[Bernie Deitrick]

Luciano,

Why not GQG and AGGA also? Can each individual character only be used once?

HTH,
Bernie
MS Excel MVP

 

[Luciano Paulino da Silva]

Luciano,

Why not GQG and AGGA also? Can each individual character only be used once?

HTH,
Bernie
MS Excel MVP

Dear Bernie,
In this case, the palindromes GQG and AGGA should not be detected
because they are part of the other palindromes previously detected or
bigger than them. Yes, each palindrome should be used once.
Thank you for your attention,
Luciano

 

[Bernie Deitrick]

Luciano,

Run the sub

FindPalindromes

and it will list the palindromes from cell A1 in column B, with the restriction that no letter be
used more than once, and that the longest palindromes are used first, and the first palindromes of a
certain length is used if there are two or more of the same length. As written, the string cannot
have the character \ used in it.

HTH,
Bernie
MS Excel MVP


Option Explicit

Sub FindPalindromes()
Palindromes Range("A1").Value
End Sub

Sub Palindromes(strBig As String)
Dim FoundPals() As String
Dim PalCount As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim MaxLen As Integer
Dim MaxID As Integer
Dim strTemp As String

If Len(strBig) < 2 Then Exit Sub

MaxLen = 0
MaxID = 0
PalCount = 1

ReDim FoundPals(1 To 1)

For i = 1 To Len(strBig) - 1
For j = 2 To Len(strBig) - i + 1
strTemp = Mid(strBig, i, j)
If isPal(strTemp) Then
If Len(strTemp) > MaxLen Then
MaxLen = Len(strTemp)
MaxID = PalCount
End If
If PalCount = 1 Then
FoundPals(1) = Mid(strBig, i, j)
PalCount = 2
Else
For k = 1 To UBound(FoundPals)
If FoundPals(k) = strTemp Then GoTo PalExists
Next k
ReDim Preserve FoundPals(1 To PalCount)
FoundPals(PalCount) = strTemp
PalCount = PalCount + 1
PalExists:
End If
End If
Next j
Next i

If MaxID <> 0 Then
Cells(Rows.Count, 2).End(xlUp)(2).Value = FoundPals(MaxID)
Palindromes CStr(Split(Replace(strBig, FoundPals(MaxID), "\"), "\")(0))
Palindromes CStr(Split(Replace(strBig, FoundPals(MaxID), "\"), "\")(1))
End If

End Sub
Function isPal(strPal As String) As Boolean
Dim i As Integer
Dim strTemp As String
isPal = False
For i = Len(strPal) To 1 Step -1
strTemp = strTemp & Mid(strPal, i, 1)
Next i
isPal = (strPal = strTemp)
End Function