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.
*****



Logged




yetifoot


« Reply #1 on: June 18, 2006, 05:02:18 AM » 

I've posted one here before, i'll try and dig it up.



Logged

EVEN MEN OF STEEL RUST.



yetifoot


« Reply #2 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. 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. #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



Logged

EVEN MEN OF STEEL RUST.



Moneo


« Reply #3 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.
*****



Logged




Agamemnus


« Reply #4 on: June 19, 2006, 02:55:15 PM » 

Lazy way out: DEFINT AZ
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 stringlength1) AS INTEGER
FOR i = 1 TO stringlength intperm(i1) = ASC(MID$(teststring$, i, 1)) NEXT i
'>Obviously, there must be no duplicate permutations. 'I would like to ignore the implicit 0255 restrictions and use a quicksort on the list and then finally a follow through to get rid of duplicates.
qsort.integer.lowstart intperm(), stringlength1
permlength = 1 FOR i = 1 TO stringlength1 IF intperm(i) <> intperm(permlength1) THEN intperm(permlength) = intperm(i) permlength = permlength + 1 END IF
NEXT i DIM tempstring AS STRING: tempstring$ = space$(permlength) DIM counter(0 TO permlength2)
DO counter(0) = counter(0) + 1 i=0
2 IF counter(i) > i+1 THEN counter(i) = 0 i=i+1 IF i = permlength1 THEN EXIT DO counter(i) = counter(i) + 1 GOTO 2 END IF
FOR i = 0 TO permlength2 SWAP intperm(i), intperm(counter(permlength2i)+i) NEXT i
FOR t = 0 TO permlength1 MID$(tempstring$, t+1,1) = CHR$(intperm(t)) NEXT t: PRINT tempstring$; " ";
FOR i = permlength2 TO 0 STEP 1 SWAP intperm(i), intperm(counter(permlength2i)+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



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



yetifoot


« Reply #5 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.



Logged

EVEN MEN OF STEEL RUST.



Moneo


« Reply #6 on: June 19, 2006, 08:16:59 PM » 

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. *****



Logged




Agamemnus


« Reply #7 on: June 19, 2006, 08:51:54 PM » 

Yeh, the reverseswap 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.



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



Moneo


« Reply #8 on: June 21, 2006, 02:40:31 PM » 

Yeh, the reverseswap 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. *****



Logged




Moneo


« Reply #9 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: defint az 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. defint az 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. *****



Logged




Agamemnus


« Reply #10 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(n1) check time) You could always make the check time smaller like so:
12, 34, 23 [2+1 = 3, n = 4] => log(n) + log(n)\2 + log(n)\4... until log(n)\x = 1.
instead of: 12, 13, 14, 23, 24, 3, 4 [3+2+1=6, n = 4]



Logged

Peace cannot be obtained without war. Why? If there is already peace, it is unnecessary for war. If there is no peace, there is already war." Visit www.neobasic.net to see rubbish in all its finest.



Moneo


« Reply #11 on: June 22, 2006, 07:23:05 PM » 

Yeah, it's an easy way to do it but inefficient as well... at least for really big sequences. (factorial(n1) check time) You could always make the check time smaller like so:
12, 34, 23 [2+1 = 3, n = 4] => log(n) + log(n)\2 + log(n)\4... until log(n)\x = 1.
instead of: 12, 13, 14, 23, 24, 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. *****



Logged




Anonymous
Guest


« Reply #12 on: June 22, 2006, 09:11:18 PM » 

More code, less mumbojumbo!



Logged




yetifoot


« Reply #13 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) 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 Print 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[n1] = 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



Logged

EVEN MEN OF STEEL RUST.



Anonymous
Guest


« Reply #14 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



Logged




