Qbasicnews.com
October 01, 2020, 07:19:12 PM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1] 2
  Print  
Author Topic: Permutations  (Read 8913 times)
Moneo
Na_th_an
*****
Posts: 1971


« 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
Ancient Guru
****
Posts: 575



« 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
Ancient Guru
****
Posts: 575



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

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
Logged

EVEN MEN OF STEEL RUST.
Moneo
Na_th_an
*****
Posts: 1971


« 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
x/ \z
*****
Posts: 3491



« Reply #4 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
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
Ancient Guru
****
Posts: 575



« 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
Na_th_an
*****
Posts: 1971


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

*****
Logged
Agamemnus
x/ \z
*****
Posts: 3491



« Reply #7 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.
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
Na_th_an
*****
Posts: 1971


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

*****
Logged
Moneo
Na_th_an
*****
Posts: 1971


« 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:
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.
*****
Logged
Agamemnus
x/ \z
*****
Posts: 3491



« 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(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]
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
Na_th_an
*****
Posts: 1971


« Reply #11 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.
*****
Logged
Anonymous
Guest
« Reply #12 on: June 22, 2006, 09:11:18 PM »

More code, less mumbo-jumbo!
Logged
yetifoot
Ancient Guru
****
Posts: 575



« 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)

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
      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[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
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
Pages: [1] 2
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!