Title: PermutationsPost by: Moneo on June 18, 2006, 02:14:12 AM
Over at Qbasic.com, somebody posted the need for code for what he called "randomizing strings". What he actually needs is an algorithm for generating the list of permutations for a given string of unique characters.
Every place that I've looked for info regarding permutations, including Knuth's books, just gives the formula for counting the number of permutations, i.e., N!, plus a lot of talk about them. But none of these references gives you a method or algorithm for generating all the permutations. For example, given the string containing A B C, the N! tells you that there are 6 permutations, which if you work it out by hand, gives you the following 6 permutations: ABC ACB BAC BCA CAB CBA iI'd like to see an algorithm that can generate the permutations for say a string with 2 to 9 characters. Obviously, there must be no duplicate permutations. Do any of you guys have such an algorithm? Thanks. ***** Title: PermutationsPost by: yetifoot on June 18, 2006, 05:02:18 AM
I've posted one here before, i'll try and dig it up.
Title: PermutationsPost by: yetifoot on June 18, 2006, 05:28:26 AM
I can't find the post, but i found some code on disk.
I've modified it so it should be easier to convert for QB. I only ran a quick check, so i can't promise it's bug free. I also include my original FB code for those interested. Code: Option Explicit Declare Sub Generate_Combinations(AllowedChars As String,_ MinChars As Integer,_ MaxChars As Integer) Sub Generate_Combinations(AllowedChars As String, _ MinChars As Integer, _ MaxChars As Integer) Dim NumOutChars As Integer Dim CurrComb As Long Dim strCurrComb As String Dim strCurrCombPos As Integer Dim lenAllowedChars As Integer Dim tmpPower As Integer lenAllowedChars = Len(AllowedChars) For NumOutChars = MinChars To MaxChars For CurrComb = 0 To (lenAllowedChars ^ NumOutChars) - 1 strCurrComb = Space(NumOutChars) For strCurrCombPos = NumOutChars - 1 To 0 Step -1 tmpPower = lenAllowedChars ^ strCurrCombPos Mid(strCurrComb, NumOutChars - strCurrCombPos, 1) = Mid(AllowedChars, ((CurrComb MOD (lenAllowedChars) * tmpPower) \ tmpPower + 1), 1) If strCurrCombPos = 0 Then Exit for Next strCurrCombPos Print strCurrComb Next CurrComb Next NumOutChars End Sub Generate_Combinations("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !£$%&*@'#.-_=+/\", 1, 4) The FB original. Code: #include "crt.bi" '#include "YFLib.bi" Option Explicit Declare Sub Generate_Combinations(AllowedChars As ZString ptr,_ MinChars As uInteger,_ MaxChars As uInteger) Generate_Combinations("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 !£$%&*@'#.-_=+/\", 1, 4) system_("PAUSE") Sub Generate_Combinations(AllowedChars As ZString ptr,_ MinChars As uInteger,_ MaxChars As uInteger) Dim NumOutChars As uLongInt Dim CurrComb As uLongInt Dim strCurrComb As ZString ptr Dim strCurrCombPos As uLongInt Dim lenAllowedChars As uLongInt Dim tmpPower As uLongInt Dim NewLine As ZString * 2 NewLine[0] = 13 NewLine[1] = 10 lenAllowedChars = strlen(AllowedChars) strCurrComb = malloc(MaxChars - MinChars + 2) For NumOutChars = MinChars To MaxChars Print NumOutChars For CurrComb = 0 To (lenAllowedChars ^ NumOutChars) - 1 strCurrComb[0] = 0 For strCurrCombPos = NumOutChars - 1 To 0 Step -1 tmpPower = pow(lenAllowedChars, strCurrCombPos) strCurrComb[(NumOutChars - 1) - strCurrCombPos] = AllowedChars[((CurrComb MOD (lenAllowedChars) * tmpPower) \ tmpPower + 1) - 1] If strCurrCombPos = 0 Then Exit for Next strCurrCombPos strCurrComb[NumOutChars] = 0 Print *strCurrComb Next CurrComb Next NumOutChars free(strCurrComb) End Sub Title: PermutationsPost by: Moneo on June 18, 2006, 04:14:11 PM
Thanks, Yetifoot, I'll give it a test.
EDIT: Yetifoot, I had a tough time getting it to compile with QuickBASIC 4.5., since it still had some FB stuff. I finally got it to run, and tested with "ABC" with minchars=3 and maxchars=3. What it gave me was all the 27 COMBINATIONS of ABC and not the 6 permutations. The combinations include AAA AAB .... CCC. Thanks. I do like it because it is completely algorithmic. I've got to figure out how it works, and then maybe I can modiify it to only generate only the permutations. ***** Title: PermutationsPost by: Agamemnus on June 19, 2006, 02:55:15 PM
Lazy way out:
Code: DEFINT A-Z DECLARE SUB qsort.integer.lowstart (array1() AS INTEGER, amax AS INTEGER) DIM stringlength AS INTEGER, permlength AS INTEGER teststring$ = "blargity" stringlength = LEN(teststring$) 'Let's convert this to numbers. DIM intperm(0 TO stringlength-1) AS INTEGER FOR i = 1 TO stringlength intperm(i-1) = ASC(MID$(teststring$, i, 1)) NEXT i '>Obviously, there must be no duplicate permutations. 'I would like to ignore the implicit 0-255 restrictions and use a quicksort on the list and then finally a follow through to get rid of duplicates. qsort.integer.lowstart intperm(), stringlength-1 permlength = 1 FOR i = 1 TO stringlength-1 IF intperm(i) <> intperm(permlength-1) THEN intperm(permlength) = intperm(i) permlength = permlength + 1 END IF NEXT i DIM tempstring AS STRING: tempstring$ = space$(permlength) DIM counter(0 TO permlength-2) DO counter(0) = counter(0) + 1 i=0 2 IF counter(i) > i+1 THEN counter(i) = 0 i=i+1 IF i = permlength-1 THEN EXIT DO counter(i) = counter(i) + 1 GOTO 2 END IF FOR i = 0 TO permlength-2 SWAP intperm(i), intperm(counter(permlength-2-i)+i) NEXT i FOR t = 0 TO permlength-1 MID$(tempstring$, t+1,1) = CHR$(intperm(t)) NEXT t: PRINT tempstring$; " "; FOR i = permlength-2 TO 0 STEP -1 SWAP intperm(i), intperm(counter(permlength-2-i)+i) NEXT i LOOP SLEEP SYSTEM SUB qsort.integer.lowstart (array1() AS INTEGER, amax AS INTEGER) DIM g2(0 TO amax) AS INTEGER, h2(0 TO amax) AS INTEGER, i AS INTEGER, j AS INTEGER, r AS INTEGER, E AS INTEGER, g AS INTEGER, h AS INTEGER, k AS INTEGER E = 0: g2(0) = 0: h2(0) = amax e1: g = g2(E): h = h2(E) e2: i = g: j = h: r = (g + h) \ 2: k = array1(r) e3: IF array1(i) < k THEN i = i + 1: GOTO e3 e4: IF array1(j) > k THEN j = j - 1: GOTO e4 IF i <= j THEN SWAP array1(i), array1(j): i = i + 1: j = j - 1: IF i <= j THEN GOTO e3 IF j - g + i < h THEN IF i < h THEN g2(E) = i: h2(E) = h: E = E + 1 h = j ELSE IF g < j THEN g2(E) = g: h2(E) = j: E = E + 1 g = i END IF IF g < h THEN GOTO e2 ELSE E = E - 1: IF E >-1 THEN GOTO e1 ERASE g2, h2 END SUB Title: PermutationsPost by: yetifoot on June 19, 2006, 06:17:43 PM
no problem moneo, sorry it wasn't what you wanted, but glad to hear you like it anyway!
Nice work agamemnus. Do you think that is the best way to do it? It seems a bit excessive using a qsort, but i've never tried to do it myself so I don't know any better way. Title: PermutationsPost by: Moneo on June 19, 2006, 08:16:59 PM
Quote from: "Agamemnus" Lazy way out: ...... Thanks for posting a solution, Aga. I modified the test word to ABC. It printed the following 5 permutations to the screen: ACB BAC BCA BAC BCA Asuming that the original permutation of ABC does not print, then you should have 6 permutations in total, the original plus 5. However, BAC and BCA are both duplicated, and CAB and CBA are both missing. The duplicates are a common error for other attempts at this solution. The 2 missing permutations are a new problem. If you know of quick fix, please post it. ***** Title: PermutationsPost by: Agamemnus on June 19, 2006, 08:51:54 PM
Yeh, the reverse-swap isn't a reverse swap. Needs to go backwards... should be fixed now.
Yetifoot: No I do not think it is the best way... there is something simpler.... I'm sure of it. Title: PermutationsPost by: Moneo on June 21, 2006, 02:40:31 PM
Quote from: "Agamemnus" Yeh, the reverse-swap isn't a reverse swap. Needs to go backwards... should be fixed now...... Aga, sorry for the delay. I tested your revised version with ABC, and it works fine generating: ACB BAC BCA CBA CAB. My only minor comments are: 1) It doesn't display the original ABC which is also one of the permutations. 2) The last 2 permutaions (CBA and CAB) are not in sequence. iI tested again using ABCD, also ecountering several permutations out of sequence. Actually, the need for generating the permutations in strict sequence, was not part of the original specifications. Therefore, your solution works fine. Thanks again. ***** Title: PermutationsPost by: Moneo on June 21, 2006, 04:00:30 PM
I continued to search my books at home and the Internet for algorithms for the generating of permutations. It's amazing all the bla, bla, bla that's written regarding permutations, but without any algorithms.
In desperation, I searched the Internet in Spanish. I encountered one document by a university professor, Leopoldo Silva, in Chile. He showed the following very simple algorithm for generating the permutations of 1,2,3: Code: defint a-z for i=1 to 3 for j=1 to 3 for k=1 to 3 if i<>j and i<>k and j<>k then print i;j;k end if next k next j next i system Basically what it does is generate all the numbers between 111 and 333, and then using an IF, filter out alll the numbers not wanted. It works perfectly, generating all 6 permutations. IMHO this is not truly an algorithm, per se, because of the filtering process. Inspired by Professor Silva's approach, I designed what I consider a more efficient program, still using a filter, which will generate the permutations for 123 or 1234 or 12345. Code: defint a-z cls DO print "Enter 3,4 or 5 for size of permutations "; input size$ LOOP WHILE size$<>"3" and size$<>"4" and size$<>"5" max=val(size$) dim x as single dim xfrom as integer dim xto as single xfrom=val(mid$("12345",1,max)) xto=val(right$("54321",max)) for x=xfrom to xto gosub filter if ok=1 then print x next x system filter: ok=0 dup=0 s$=ltrim$(str$(x)) for z=1 to len(s$) c=val(mid$(s$,z,1)) if c<1 or c>max then RETURN if (dup and 2^c) > 0 then RETURN dup = dup or 2^c next z ok=1 RETURN Your comments will be appreciated. Thanks. ***** Title: PermutationsPost by: Agamemnus on June 22, 2006, 05:02:50 PM
Yeah, it's an easy way to do it but inefficient as well... at least for really big sequences. (factorial(n-1) check time) You could always make the check time smaller like so:
1-2, 3-4, 2-3 [2+1 = 3, n = 4] => log(n) + log(n)\2 + log(n)\4... until log(n)\x = 1. instead of: 1-2, 1-3, 1-4, 2-3, 2-4, 3, 4 [3+2+1=6, n = 4] Title: PermutationsPost by: Moneo on June 22, 2006, 07:23:05 PM
Quote from: "Agamemnus" Yeah, it's an easy way to do it but inefficient as well... at least for really big sequences. (factorial(n-1) check time) You could always make the check time smaller like so: 1-2, 3-4, 2-3 [2+1 = 3, n = 4] => log(n) + log(n)\2 + log(n)\4... until log(n)\x = 1. instead of: 1-2, 1-3, 1-4, 2-3, 2-4, 3, 4 [3+2+1=6, n = 4] Sorry, Aga, I don't understand your comments. Please explain. Also, would you kindly explain how your algorithm works --- the theory first, then the details. ***** Title: PermutationsPost by: Anonymous on June 22, 2006, 09:11:18 PM
More code, less mumbo-jumbo!
Title: PermutationsPost by: yetifoot on June 22, 2006, 10:48:21 PM
I've been thinking about this problem, and decided it would probably involve recursion. I tried to implement one though, and failed.
I then had a search on Google, and found that most, but not all of the implementations do use recursion. I searched google for 'permutations source code', this seemed to yield quite a few good results. The best i found was http://www.bearcave.com/random_hacks/permute.html (i actually found this searching 'permutations source code C ABC', I thought that it would be more likely to find some C code than BASIC) I managed to convert the ordered version to FreeBASIC, but due to it's nature (using pointers etc), it will require some heavy changes to work in QB. I post the code now anyway, maybe you, aga or someone else can get it going for QB, I have a few other things to do right now, so I can't put much more time into this just yet (although i find the subject interesting and will return to it when i can) Code: Sub _print(v As Integer ptr, size As Integer) Dim i As Integer If (v <> 0) Then For i = 0 To size - 1 print Trim(Str(v[i])); Next i End If End Sub Sub _swap(v As Integer ptr, i As Integer, j As Integer) Dim t As Integer t = v[i] v[i] = v[j] v[j] = t End Sub Sub rotateLeft(v As Integer ptr, start As Integer, n As Integer) Dim tmp As Integer = v[start] For i = start To n - 2 v[i] = v[i+1] Next i v[n-1] = tmp End Sub Sub permute(v As Integer ptr, start As Integer, n As Integer) _print(v, n) If (start < n) Then Dim As Integer i, j For i = n - 2 To start Step -1 For j = i + 1 To n - 1 _swap(v, i, j) permute(v, i+1, n) Next j rotateLeft(v, i, n) Next i End If End Sub Dim v(0 To 2) As Integer = {1, 2, 3} permute(@v(0), 0, 3) Sleep Title: PermutationsPost by: Anonymous on June 23, 2006, 12:23:32 AM
Nicely done. I was also considering that the problem could be solved with recursion, but I also failed to implement it ;P
Title: PermutationsPost by: Agamemnus on June 23, 2006, 09:52:15 AM
Moneo:
>Sorry, Aga, I don't understand your comments. Please explain. Never mind the other thing... I got ahead of myself... works if you want to find the biggest number, though. >Also, would you kindly explain how your algorithm works --- the theory first, then the details Basically it's exactly like that recursive function above except without the ....useless... pointers.... or useless recursion... :humm: Pre-algorithm: 1) Start with the string. 2) Convert it to integers. 3) Sort the integers low-high. 4) Remove duplicates. Algorithm: What we are doing is a counter with this code: Code: counter(0) = counter(0) + 1 i=0 2 IF counter(i) > i+1 THEN counter(i) = 0 i=i+1 IF i = permlength-1 THEN EXIT DO counter(i) = counter(i) + 1 GOTO 2 END IF The counter converts to a number that is a set of "digits" of decreasing base, for instance the size 2 number (for "abc") is counted like so: 00 = 0 01 = 1 10 = 2 11 = 3 20 = 4 21 = 5 (I'd use loops but there's already a "do...loop" and neither FB or QB support double loops, like Powerbasic, unfortunately...) After the counter is moved up one, this code: Code: FOR i = 0 TO permlength-2 SWAP intperm(i), intperm(counter(permlength-2-i)+i) NEXT i ...translates the counter to a series of swaps. The counter correlates to all succeeding positions on a permutation tree. For "abcde", the tree loops through all the different characters/values in the first spot, then all the characters in the second spot (one less choice), then all the characters in the third spot, and so on until there are only 2 characters to choose from. Code: FOR t = 0 TO permlength-1 MID$(tempstring$, t+1,1) = CHR$(intperm(t)) NEXT t: PRINT tempstring$; " "; FOR i = permlength-2 TO 0 STEP -1 SWAP intperm(i), intperm(counter(permlength-2-i)+i) NEXT i This code prints the number and then switches it back. After this, it's looped back to the counter till the counter gets too big. (i = permlength-1) Title: PermutationsPost by: Moneo on June 24, 2006, 08:13:37 PM
Aga, thanks for your explanation, but I still don't get it. I get lost right at the beginning where you say:
Code: The counter converts to a number that is a set of "digits" of decreasing base, for instance the size 2 number (for "abc") is counted like so: 00 = 0 01 = 1 10 = 2 11 = 3 20 = 4 21 = 5 The 20 = 4 really confuses me, as does the mention of a "decreasing base". I also don't understand why "abc" is a size 2 number. Thanks anyway. ***** Title: PermutationsPost by: Agamemnus on June 24, 2006, 09:07:13 PM
Size 2 = 2 digits.
20 = 2, 0 = 2*2 + 0*1 = 4 If it was 3 digits it'd have the form (I think): a, b, c = a*3*2*1 + b*2*1 + c If 4: a, b, c, d = a*4*3*2*1 + b*3*2*1 + c*2*1 + d Title: PermutationsPost by: Moneo on June 25, 2006, 08:48:25 PM
Aga,
I appreciate your trying to enlighten me, but I think you and I, "went to different schools together." :o ***** Title: PermutationsPost by: Moneo on June 28, 2006, 10:28:22 PM
Aga, Yetifoot, Cha0s,
EUREKA! I found it. An algorithm with no filter, no recursion and no sorting required. This algorithm is based on one by Dijkstra. Here it is: Code: defint a-z cls do print "Enter number of digits (2-9) for which to generate permutations "; input n loop while n<2 or n>9 dim a(1 to n) for x=1 to n a(x)=x next x DO for x=1 to n 'Print a permutation print a(x); next x i = n-1 while a(i) > a(i+1) : i=i-1 : wend if i<1 then EXIT DO j = n while a(i) > a(j) : j=j-1 : wend swap a(i),a(j) r = n s = i+1 do while r > s swap a(r),a(s) r=r-1 s=s+1 loop LOOP system ***** EDIT: Changed 1-9 digits to 2-9. Title: PermutationsPost by: Agamemnus on June 29, 2006, 01:15:38 PM
That's interesting.
Hard to visualize.. Title: PermutationsPost by: Moneo on June 29, 2006, 09:37:33 PM
Quote from: "Agamemnus" That's interesting. Hard to visualize.. If what you mean by "hard to visualize" is that you can't figure out how it works, well, don't feel bad, I haven't had the time to figure it out either, All I know is that it works. Enclosed is the same algorithm with a modified front end to generate permutations of letters or numbers. Code: defint a-z cls do print "Enter 2-9 characters for which to generate permutations "; input ch$ n=len(ch$) loop while n<2 or n>9 dim a(1 to n) for x=1 to n a(x)=x next x DO for x=1 to n 'Print a permutation print mid$(ch$,a(x),1); next x i = n-1 while a(i) > a(i+1) : i=i-1 : wend if i<1 then EXIT DO j = n while a(i) > a(j) : j=j-1 : wend swap a(i),a(j) r = n s = i+1 do while r > s swap a(r),a(s) r=r-1 s=s+1 loop LOOP system ***** |