WEBINAR: On-demand webcast
How to Boost Database Development Productivity on Linux, Docker, and Kubernetes with Microsoft SQL Server 2017 REGISTER >
Explanation and Usage
It is very useful to have all possible combinations of a string. For example: In a search engine, if the user types "mp3 rock hard," the engine should be smart enough to search for all combinations of the user input; otherwise, it will not be a powerful searching tool. These combinations would look like the following:
"mp3 rock hard"
"mp3 hard rock"
"rock mp3 hard"
"rock hard mp3"
"hard mp3 rock"
"hard rock mp3"
First of all, I tried searching about it in CodeGuru's forums. But all I found was that there was a function that could do that job, but in VC++. And because I know nothing of C & Cia, I didn't even look at it.
So, what could I do? I could develop my own algorithm in Visual Basic. And that is what I've decided to do. First of all, while developing the algorithm, I asked my whole family and my neighbor (a judge) for help with the algorithm; no one could get even close. As time passed, after rewriting the whole thing from scratch for more than 20 times, I was getting closer and closer. With significant but buggy outputs, I've noticed that I would have to develop (for the 1st time in my little programmer life) a callback function. And that worked! The function generates all the 40,320 combinations of an 8-element string (in other words, "1 2 a 4 b 6 c 8") in 1.34 seconds.
' Generates all combination possibilities out of a string Public Function PermuteString(ByVal Ztring As String, _ Optional Base As String = "") As String Dim TmpStrArray() As String, I As Long ' If there's only 1 element, then If InStr(1, Ztring, " ", vbTextCompare) = 0 Then PermuteString = Base & " " & Ztring & vbCrLf Exit Function End If ' If more than 1 element: split elements in one array of elements TmpStrArray = Split(Ztring, " ", , vbTextCompare) If Base = "" Then ' Loop trough each element and do callbacks to permute again For I = LBound(TmpStrArray) To UBound(TmpStrArray) PermuteString = PermuteString & _ PermuteString(ReturnAllBut(TmpStrArray, I),_ TmpStrArray(I)) Next Else ' Loop trough each element and do callbacks to permute again For I = LBound(TmpStrArray) To UBound(TmpStrArray) PermuteString = PermuteString & " " & _ PermuteString(ReturnAllBut(TmpStrArray, I), _ Base & " " & TmpStrArray(I)) Next End If End Function ' Return all items in a array but 1 Public Function ReturnAllBut(ByRef Arrai() As String, _ But As Long) _ As String Dim I As Long For I = LBound(Arrai) To UBound(Arrai) If I <> But Then ReturnAllBut = ReturnAllBut & Arrai(I) & " " End If Next ReturnAllBut = RTrim(ReturnAllBut) End Function
To Test the Speed, Use This
Public Sub TestPermutationSpeed() Dim I As Long ' Used in loops Dim Nou ' Used to calc delay Dim NumberOfElements As Long ' Used to calc number of elements in PermutyString Const NumberOfPermutations = 1 ' Number of permutations to be done Const PermutyString = "A B C D E F G H" ' String to be permuted NumberOfElements = UBound(Split(PermutyString, " ", , _ vbTextCompare)) + 1 ' Calc number of elements in PermutyString Nou = Timer ' Get start time For I = 1 To NumberOfPermutations ' Loop #NumberOfPermutations times PermuteString (PermutyString) ' Do permutation Next ' End of loop ' Display the results. MsgBox NumberOfPermutations & " permutations of " & _ NumberOfElements & " elements in " & _ Timer - Nou & " seconds" End Sub
That's all for now!