All the permutations of "ABC.."

[danbaron]

Hi Gang!

I made an Emergence Basic program which demonstrates how to do permutations.

The code is shown below.

The comments in the code, explain what the program does, and how to run it.

Here is a link where it, "PERMUTATIONS.EBA", can be downloaded.

http://www.box.net/shared/tpqv54qodj

Dan.

Code Select Expand


'------------------------------------------------------------
' FILE = PERMUTATIONS.EBA
' EMERGENCE BASIC PROGRAM
' USE "BUILD SINGLE".
' BUILD IT AS TYPE, "CONSOLE EXE".
'------------------------------------------------------------
' "PERMUTATION", MEANS, "ORDERING".
'------------------------------------------------------------

' AS THE PROGRAM IS CONSTRUCTED, IT WILL WRITE THE OUTPUT
' TO A FILE CALLED "PERMUTATIONS.TXT".

' IT WRITES ALL THE PERMUTATIONS OF A STRING CONSISTING
' OF THE FIRST N CHARACTERS OF THE ALPHABET.
' FOR INSTANCE, IF N=6, THEN ALL OF THE PERMUTATIONS
' OF THE CHARACTERS OF THE STRING "ABCDEF" WILL
' BE LISTED IN THE FILE.

' THE ALPHABET STRING IS USED TO DEMONSTRATE THE PERMUTATION
' FUNCTION, WHICH CAN BE USED TO PERMUTE MANY THINGS.

'------------------------------------------------------------

' IF, FOR INSTANCE, PERMLENGTH (N) IS SET EQUAL TO 3,
' THEN THE FILE OUTPUT WILL BE

'0000001 ABC
'0000002 ACB
'0000003 BAC
'0000004 BCA
'0000005 CAB
'0000006 CBA

' (6 PERMUTATIONS, BECAUSE 3! (3 "FACTORIAL"), EQUALS 3*2*1.)

'------------------------------------------------------------

' IF PERMLENGTH IS SET EQUAL TO 4,
' THEN THE FILE OUTPUT WILL BE

'0000001 ABCD
'0000002 ABDC
'0000003 ACBD
'0000004 ACDB
'0000005 ADBC
'0000006 ADCB
'0000007 BACD
'0000008 BADC
'0000009 BCAD
'0000010 BCDA
'0000011 BDAC
'0000012 BDCA
'0000013 CABD
'0000014 CADB
'0000015 CBAD
'0000016 CBDA
'0000017 CDAB
'0000018 CDBA
'0000019 DABC
'0000020 DACB
'0000021 DBAC
'0000022 DBCA
'0000023 DCAB
'0000024 DCBA

' (24 PERMUTATIONS, BECAUSE 4!, EQUALS 4*3*2*1.)

'------------------------------------------------------------

' SET THE VALUE OF PERMLENGTH ON THE NEXT CODE LINE.
' THEN, JUST RUN THE PROGRAM.
' THEN, OPEN THE FILE "PERMUTATIONS.TXT",
' IN THE CURRENT FOLDER, AND VIEW THE OUTPUT.

CONST PERMLENGTH=6

' MAKE PERMLENGTH AS BIG AS YOU WANT.
' BUT BE CAREFUL.
' THE NUMBER OF PERMUTATIONS INCREASES FAST.
' IF PERMLENGTH EQUALS N, THEN THE NUMBER OF PERMUTATIONS EQUALS N!.

'------------------------------------------------------------

IF PERMLENGTH<=0 THEN END
INT PERMCOUNT=0
INT PERMARRAY[PERMLENGTH+1]
INT TOTPERMUTATIONS=FACT(PERMLENGTH)
STRING ASCIISTRING
FILE OUTFILE
STRING FILESTRING="PERMUTATIONS.TXT"

'------------------------------------------------------------

OPENFILE(OUTFILE,FILESTRING,"W")

WHILE TRUE
IF !GETNEXTPERMUTATION(PERMARRAY,PERMLENGTH) THEN GOTO L1
SETASCIISTRING()
WRITEOUTFILE()
WEND

LABEL L1
CLOSEFILE(OUTFILE)
END

'------------------------------------------------------------

SUB GETNEXTPERMUTATION(P[] AS INT, INT N),INT

' P[] IS AN INTEGER PERMUTATION ARRAY, OF LENGTH N.
' (ACTUALLY, P[] HAS LENGTH N+1, BUT P[0] IS NOT USED.)

' IF, FOR INSTANCE N EQUALS 4, THEN THE FIRST CALL
' TO THE FUNCTION WILL SET P WITH THE 4 VALUES
' P[1]=1, P[2]=2, P[3]=3, P[4]=4.

' THE SECOND CALL TO THE FUNCTION WILL SET P
' WITH THE 4 VALUES
' P[1]=1, P[2]=2, P[3]=4, P[4]=3.

' SUBSEQUENT CALLS TO THE FUNCTION WILL SET P AS
' CALL 03: P[1]=1, P[2]=3, P[3]=2, P[4]=4.
' CALL 04: P[1]=1, P[2]=3, P[3]=4, P[4]=2.
' CALL 05: P[1]=1, P[2]=4, P[3]=2, P[4]=3.
' CALL 06: P[1]=1, P[2]=4, P[3]=3, P[4]=2.
' CALL 07: P[1]=2, P[2]=1, P[3]=3, P[4]=4.
' CALL 08: P[1]=2, P[2]=1, P[3]=4, P[4]=3.
' CALL 09: P[1]=2, P[2]=3, P[3]=1, P[4]=4.
' CALL 10: P[1]=2, P[2]=3, P[3]=4, P[4]=1.
' CALL 11: P[1]=2, P[2]=4, P[3]=1, P[4]=3.
' CALL 12: P[1]=2, P[2]=4, P[3]=3, P[4]=1.
' CALL 13: P[1]=3, P[2]=1, P[3]=2, P[4]=4.
' CALL 14: P[1]=3, P[2]=1, P[3]=4, P[4]=2.
' CALL 15: P[1]=3, P[2]=2, P[3]=1, P[4]=4.
' CALL 16: P[1]=3, P[2]=2, P[3]=4, P[4]=1.
' CALL 17: P[1]=3, P[2]=4, P[3]=1, P[4]=2.
' CALL 18: P[1]=3, P[2]=4, P[3]=2, P[4]=1.
' CALL 19: P[1]=4, P[2]=1, P[3]=2, P[4]=3.
' CALL 20: P[1]=4, P[2]=1, P[3]=3, P[4]=2.
' CALL 21: P[1]=4, P[2]=2, P[3]=1, P[4]=3.
' CALL 22: P[1]=4, P[2]=2, P[3]=3, P[4]=1.
' CALL 23: P[1]=4, P[2]=3, P[3]=1, P[4]=2.
' CALL 24: P[1]=4, P[2]=3, P[3]=2, P[4]=1.

' ON THE 25TH CALL, THE FUNCTION WILL RETURN FALSE.
' BECAUSE 4!=24, i.e., THERE IS NO 25TH PERMUTATION OF 1,2,3,4.

' FOR N=4, WE CAN SHOW THE STATE OF P[] FOR EACH
' OF THE 24 CALLS TO THE FUNCTION, AS 24 NUMBERS.

' CALL 01: 1234
' CALL 02: 1243
' CALL 03: 1324
' CALL 04: 1342
' CALL 05: 1423
' CALL 06: 1432
' CALL 07: 2134
' CALL 08: 2143
' CALL 09: 2314
' CALL 10: 2341
' CALL 11: 2413
' CALL 12: 2431
' CALL 13: 3124
' CALL 14: 3142
' CALL 15: 3214
' CALL 16: 3241
' CALL 17: 3412
' CALL 18: 3421
' CALL 19: 4123
' CALL 20: 4132
' CALL 21: 4213
' CALL 22: 4231
' CALL 23: 4312
' CALL 24: 4321

' NOTICE HOW THE NUMBERS APPEAR IN ASCENDING ORDER.
' THAT IS THE TRICK TO HOW THE FUNCTION WORKS.

INT I,LEFT,RIGHT
PERMCOUNT+=1

IF PERMCOUNT=1
FOR I=1 TO N
P[I]=I
NEXT I
RETURN TRUE
ENDIF

RIGHT=N
LEFT=RIGHT

WHILE TRUE
LEFT-=1

IF LEFT=0
PERMCOUNT-=1
RETURN FALSE
ENDIF

FOR I=N TO LEFT +1 STEP -1
IF P[I]>P[LEFT]
RIGHT=I
GOTO L2
ENDIF
NEXT I
WEND

LABEL L2
SWAP(P[LEFT],P[RIGHT])
SORT(P,LEFT+1,N)
RETURN TRUE
ENDSUB

'------------------------------------------------------------

SUB SORT(A[] AS INT, INT INDEX, INT N)

' SORTS VALUES OF A[], FROM A[INDEX]
' TO A[N], IN ASCENDING ORDER.

INT I,J,IMIN,MIN
FOR I=INDEX TO N-1
MIN=A[I]
IMIN=I
FOR J=I+1 TO N
IF A[J]<MIN
MIN=A[J]
IMIN=J
ENDIF
NEXT J
SWAP(A[I],A[IMIN])
NEXT I
ENDSUB

'------------------------------------------------------------

SUB SWAP(I AS INT BYREF, J AS INT BYREF)
INT TEMP
TEMP=I
I=J
J=TEMP
ENDSUB

'------------------------------------------------------------

SUB FACT(INT N),INT
INT I,PROD
PROD=1
FOR I=1 TO N
PROD*=I
NEXT I
RETURN PROD
ENDSUB

'------------------------------------------------------------

SUB SETASCIISTRING()
INT I
ASCIISTRING=""
FOR I=1 TO PERMLENGTH
ASCIISTRING=APPEND$(ASCIISTRING,CHR$(PERMARRAY[I]+64))
NEXT I
ENDSUB

'------------------------------------------------------------

SUB WRITEOUTFILE()
INT FLAG=TOTPERMUTATIONS/2+1
STRING PC=USING("0#######",PERMCOUNT)
STRING FILESTRING=""
IF PERMCOUNT=FLAG THEN WRITEADVERTISEMENT()
FILESTRING=APPEND$(FILESTRING,"'",PC," ",ASCIISTRING)
WRITE OUTFILE,FILESTRING
ENDSUB

'------------------------------------------------------------

SUB WRITEADVERTISEMENT()
STRING NULLSTRING=""
WRITE OUTFILE,NULLSTRING
WRITE OUTFILE,NULLSTRING
WRITE OUTFILE,"'************************************************************************"
WRITE OUTFILE,"'*                                                                      *"
WRITE OUTFILE,"'*        WOULDN'T AN ICE COLD SWAMP'S HIT THE SPOT RIGHT NOW?!         *"
WRITE OUTFILE,"'*  ENJOY THE CLEAN REFRESHING TASTE OF SWAMP'S MOUNTAIN SPRING WATER.  *"
WRITE OUTFILE,"'*          'IF IT'S GREEN - YOU KNOW IT'S GOOD, SWAMP'S!!'             *"
WRITE OUTFILE,"'*                                                                      *"
WRITE OUTFILE,"'************************************************************************"
WRITE OUTFILE,NULLSTRING
WRITE OUTFILE,NULLSTRING
ENDSUB

'------------------------------------------------------------
'------------------------------------------------------------



[pistol350]

Perfect!
I was searching for a way to write a program dealing with combining algorithm.
That seems to be what i need.
Thanks.

[Allan]

I could use that code to create my multiple Doubles betting selections.

[celphick]

Here's a version that I posted a long time ago on the old Ibasic forums. I just checked and it compiles under emergence as a console program under XP.

Code Select Expand


/*
Posted: 18 Jun 2003 12:48    Post subject: Permutations     

--------------------------------------------------------------------------------

I was trying to solve Enigma 1243 in this week's New Scientist [14 June 2003, p55] and had recourse to an old QuickBasic program to find lists of permutations. I found it easier to keep these lists as files and have the program refer to them, and printed lists were often useful for students in class.

Anyway to cut a long story short, I decided, as an exercise to translate it to IBasic and add a few comments.

It may be useful to someone other than myself.

Quote:
' permutations.iba
' Program to make lists of permutations
' The listing of the names of objects can create large files so the
' letter (or digit) is a reference to the object itself.
' The program was originally inspired by an article in PCPlus by
' Wilf Hey some years ago.
' Translated from QB4.5 , 2003-06-17, hence choice of some names.
*/

def infile,outfile :FILE
def inn,owt,x,y,t,start : STRING
def n : INT

openconsole

' Change to your desired directory & name
f$ = "c:\permutations\perms_"

' program uses files previously generated
' so to run in a loop will need a seed file which contains only
' the first character of t$ below and named as f$+"01.txt".
owt = f$ + "01.txt"
if (openfile (outfile, owt, "W") = 0)
write(outfile,"A") : ' change to "A", "a" or "1" as appropriate
closefile outfile
else
print "Unable to open file " + chr$(34) + owt + chr$(34) +" for output."
goto TheEnd
endif

for n = 1 to 7
' Files may become too big after perms_10.txt as size is of the order of n^2.
' Setting as n = 1 to 7 produces 8 files totalling 440kb.

t = mid$("ABCDEFGHIJKLMNOPQRSTUVWXYZ", n + 1, 1): ' Undelete for U.C. letters.
't = mid$("abcdefghijklmnopqrstuvwxyz", n + 1, 1): ' Undelete for L.C. letters.
't = mid$("0123456789abcdef", n + 1, 1): ' Undelete for hex or decimal digits.

start = time$: ' This is used for an idea how long the next loop will take.

inn = f$ + right$("0" + ltrim$(str$(n)), 2) + ".txt"
owt = f$ + right$("0" + ltrim$(str$(n + 1)), 2) + ".txt"
print inn
print owt
if (openfile (infile, inn, "R")<>0)
print "Unable to open file "+chr$(34)+inn+chr$(34)+" for input."
goto TheEnd
endif

if (openfile (outfile, owt, "W")<>0)
print "Unable to open file "+chr$(34)+owt+chr$(34)+" for output."
goto TheEnd
endif

while(read(infile,x) = 0)
y = x + t : ' Put the new character at the end of the old permutation.
print y
write (outfile, y)
if n>1
for i = n - 1 to 1 step -1 : ' Put the new character at each position inside x.
y = left$(x, i) + t + right$(x, n - i)
write (outfile, y)
print y
next i
endif
y = t + x : ' Put the new character at the front of the old permutation.
write (outfile, y)
print y
endwhile

closefile infile
closefile outfile

print "Start : ", start
print "Finish: ", time$
next n
label TheEnd

print "Press any key to terminate."

do : until inkey$ <> ""
closeconsole
end



[danbaron]

In the function, "GETNEXTPERMUTATION", the variable, "DONE", should be removed.

It is there for nothing.

Sorry.

Dan.

[pistol350]

Here's a version that I posted a long time ago on the old Ibasic forums...
...

Quite old but very helpful program.
Thank you for posting it again.

[danbaron]

I hate to say it, but I found something else that didn't belong in the "PERMUTATIONS" code.

There was a "PRINT" statement at the bottom of the "SORT" subroutine.

I fixed that mistake, along with the previous "DONE" mistake, in both the code box above, and in the download file.

-----------------------------------------------

How I found the (malicious) "PRINT" statement: -->

I was using the "SORT" routine in another program.

The program prints a table of numbers in the console.

I made that part, and it worked.

Then I added the main, calculation part, to the program.

Each time the calculation part executed, the table disappeared.

Hours of frustration passed.

I was certain that the "LOCATE" statement, and/or the compiler were/was buggy, because I was certain that the calculation part had nothing to do with the console.

But, I was wrong.

Finally, I decided to search for the word "PRINT", and to my astonishment, there it was, in the "SORT" subroutine.

The same type of thing has happened to me many times before.

Each time I am convinced the error is not mine.

And each time I am relieved, when I find it is.

Woe is me!
Woe is sorry, pitiful me!!

Dan.