danbaron
03-02-2010, 08:44
[font=Courier New]Hi volunteers.
Here is a program that can be modified to list all of the permutations
(orderings) for a set of objects.
For instance, consider the set,
(dog, cat, horse).
It has three members, so it has 3! (3 "factorial"), or, 3*2*1 = 6, permutations.
The permutations for this set are,
1. dog cat horse
2. dog horse cat
3. cat dog horse
4. cat horse dog
5. horse dog cat
6. horse cat dog.
To demonstrate the procedure, the program permutes the first N letters of the
alphabet, and writes the permutations to a file.
All you need to do, is to set the constant %PERMLENGTH (meaning N), and then run the
program. By default, the output is written to the file, "PERMUTATIONS.TXT".
If, say, you set %PERMLENGTH = 6, then the program will write the 720
permutations of ABCDEF, to PERMUTATIONS.TXT.
The function which does the work is called, GETNEXTPERMUTATION. It modifies a
permutation array of length, %PERMLENGTH, to give the next permutation in the
sequence of permutations.
(I previously wrote the program for another implementation of Basic, and just
translated it into thinBasic.)
DTB.
'------------------------------------------------------------
Uses "FILE"
Uses "MATH"
'------------------------------------------------------------
' FILE = PERMUTATIONS.tbasic
'------------------------------------------------------------
' "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.
%PERMLENGTH = 5
' 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!.
'------------------------------------------------------------
Global PERMARRAY(%PERMLENGTH) As Byte
Global TOTPERMUTATIONS As DWord
Global GLOBALPERMCOUNT As DWord
Global ASCIISTRING As String
Global FILESTRING As String
Global OUTFILE As DWord
'------------------------------------------------------------
Function TBMAIN()
FILESTRING = "PERMUTATIONS.TXT"
If %PERMLENGTH <= 0 Then Exit Function
TOTPERMUTATIONS = Factorial(%PERMLENGTH)
OUTFILE = FILE_Open(FILESTRING, "OUTPUT")
While TRUE
If Not GETNEXTPERMUTATION(PERMARRAY, %PERMLENGTH) Then Exit While
SETASCIISTRING()
WRITEOUTFILE()
Wend
FILE_Close(OUTFILE)
End Function
'------------------------------------------------------------
Function GETNEXTPERMUTATION(ByRef P() As Byte, N As Byte) As Byte
' P() IS A BYTE PERMUTATION ARRAY, OF LENGTH N.
' N IS THE NUMBER OF OBJECTS IN THE SET TO BE PERMUTED.
' 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.
Static STATICPERMCOUNT As DWord
Static I, LEFT0, RIGHT0 As Byte
STATICPERMCOUNT += 1
'GLOBALPERMCOUNT IS ONLY USED IN THE FUNCTION "WRITEOUTFILE".
GLOBALPERMCOUNT = STATICPERMCOUNT
If STATICPERMCOUNT = 1 Then
For I = 1 To N
P(I) = I
Next
Return TRUE
End If
RIGHT0 = N
LEFT0 = RIGHT0
While TRUE
LEFT0 -= 1
If LEFT0 = 0 Then
STATICPERMCOUNT -= 1
Return FALSE
End If
For I = N To LEFT0 + 1 Step -1
If P(I) > P(LEFT0) Then
RIGHT0 = I
Exit While
End If
Next
Wend
Swap P(LEFT0), P(RIGHT0)
Sort0(P, LEFT0 + 1, N)
Return TRUE
End Function
'------------------------------------------------------------
Function Sort0(ByRef A() As Byte, INDEX As Byte, N As Byte)
' SORTS VALUES OF A(), FROM A(INDEX)
' TO A(N), IN ASCENDING ORDER.
Static I, J, IMIN, MIN0 As Byte
For I = INDEX To N - 1
MIN0 = A(I)
IMIN = I
For J = I + 1 To N
If A(J) < MIN0 Then
MIN0 = A(J)
IMIN = J
End If
Next
Swap A(I), A(IMIN)
Next
END FUNCTION
'------------------------------------------------------------
FUNCTION SETASCIISTRING()
Static I As Byte
ASCIISTRING = ""
For I = 1 To %PERMLENGTH
ASCIISTRING = ASCIISTRING & Chr$(PERMARRAY(I)+64)
Next
END FUNCTION
'------------------------------------------------------------
FUNCTION WRITEOUTFILE()
Static FLAG As DWord
Static PC, FS As String
FLAG = TOTPERMUTATIONS / 2 + 1
PC = Format$(GLOBALPERMCOUNT, "0000000")
FS = ""
If GLOBALPERMCOUNT = FLAG Then WRITEADVERTISEMENT()
FS = FS & "'" & PC & " " & ASCIISTRING
FILE_LinePrint(OUTFILE, FS)
END FUNCTION
'------------------------------------------------------------
Function WRITEADVERTISEMENT()
Local NULLSTRING As String
NULLSTRING = ""
FILE_LinePrint(OUTFILE, NULLSTRING)
FILE_LinePrint(OUTFILE, NULLSTRING)
FILE_LinePrint(OUTFILE, "'************************************************************************")
FILE_LinePrint(OUTFILE, "'* *")
FILE_LinePrint(OUTFILE, "'* WOULDN'T AN ICE COLD SWAMP'S HIT THE SPOT RIGHT NOW?! *")
FILE_LinePrint(OUTFILE, "'* ENJOY THE CLEAN REFRESHING TASTE OF SWAMP'S MOUNTAIN SPRING WATER. *")
FILE_LinePrint(OUTFILE, "'* ""IF IT'S GREEN - YOU KNOW IT'S GOOD, SWAMP'S!!"" *")
FILE_LinePrint(OUTFILE, "'* *")
FILE_LinePrint(OUTFILE, "'************************************************************************")
FILE_LinePrint(OUTFILE, NULLSTRING)
FILE_LinePrint(OUTFILE, NULLSTRING)
End Function
'------------------------------------------------------------
'------------------------------------------------------------
Here is a program that can be modified to list all of the permutations
(orderings) for a set of objects.
For instance, consider the set,
(dog, cat, horse).
It has three members, so it has 3! (3 "factorial"), or, 3*2*1 = 6, permutations.
The permutations for this set are,
1. dog cat horse
2. dog horse cat
3. cat dog horse
4. cat horse dog
5. horse dog cat
6. horse cat dog.
To demonstrate the procedure, the program permutes the first N letters of the
alphabet, and writes the permutations to a file.
All you need to do, is to set the constant %PERMLENGTH (meaning N), and then run the
program. By default, the output is written to the file, "PERMUTATIONS.TXT".
If, say, you set %PERMLENGTH = 6, then the program will write the 720
permutations of ABCDEF, to PERMUTATIONS.TXT.
The function which does the work is called, GETNEXTPERMUTATION. It modifies a
permutation array of length, %PERMLENGTH, to give the next permutation in the
sequence of permutations.
(I previously wrote the program for another implementation of Basic, and just
translated it into thinBasic.)
DTB.
'------------------------------------------------------------
Uses "FILE"
Uses "MATH"
'------------------------------------------------------------
' FILE = PERMUTATIONS.tbasic
'------------------------------------------------------------
' "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.
%PERMLENGTH = 5
' 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!.
'------------------------------------------------------------
Global PERMARRAY(%PERMLENGTH) As Byte
Global TOTPERMUTATIONS As DWord
Global GLOBALPERMCOUNT As DWord
Global ASCIISTRING As String
Global FILESTRING As String
Global OUTFILE As DWord
'------------------------------------------------------------
Function TBMAIN()
FILESTRING = "PERMUTATIONS.TXT"
If %PERMLENGTH <= 0 Then Exit Function
TOTPERMUTATIONS = Factorial(%PERMLENGTH)
OUTFILE = FILE_Open(FILESTRING, "OUTPUT")
While TRUE
If Not GETNEXTPERMUTATION(PERMARRAY, %PERMLENGTH) Then Exit While
SETASCIISTRING()
WRITEOUTFILE()
Wend
FILE_Close(OUTFILE)
End Function
'------------------------------------------------------------
Function GETNEXTPERMUTATION(ByRef P() As Byte, N As Byte) As Byte
' P() IS A BYTE PERMUTATION ARRAY, OF LENGTH N.
' N IS THE NUMBER OF OBJECTS IN THE SET TO BE PERMUTED.
' 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.
Static STATICPERMCOUNT As DWord
Static I, LEFT0, RIGHT0 As Byte
STATICPERMCOUNT += 1
'GLOBALPERMCOUNT IS ONLY USED IN THE FUNCTION "WRITEOUTFILE".
GLOBALPERMCOUNT = STATICPERMCOUNT
If STATICPERMCOUNT = 1 Then
For I = 1 To N
P(I) = I
Next
Return TRUE
End If
RIGHT0 = N
LEFT0 = RIGHT0
While TRUE
LEFT0 -= 1
If LEFT0 = 0 Then
STATICPERMCOUNT -= 1
Return FALSE
End If
For I = N To LEFT0 + 1 Step -1
If P(I) > P(LEFT0) Then
RIGHT0 = I
Exit While
End If
Next
Wend
Swap P(LEFT0), P(RIGHT0)
Sort0(P, LEFT0 + 1, N)
Return TRUE
End Function
'------------------------------------------------------------
Function Sort0(ByRef A() As Byte, INDEX As Byte, N As Byte)
' SORTS VALUES OF A(), FROM A(INDEX)
' TO A(N), IN ASCENDING ORDER.
Static I, J, IMIN, MIN0 As Byte
For I = INDEX To N - 1
MIN0 = A(I)
IMIN = I
For J = I + 1 To N
If A(J) < MIN0 Then
MIN0 = A(J)
IMIN = J
End If
Next
Swap A(I), A(IMIN)
Next
END FUNCTION
'------------------------------------------------------------
FUNCTION SETASCIISTRING()
Static I As Byte
ASCIISTRING = ""
For I = 1 To %PERMLENGTH
ASCIISTRING = ASCIISTRING & Chr$(PERMARRAY(I)+64)
Next
END FUNCTION
'------------------------------------------------------------
FUNCTION WRITEOUTFILE()
Static FLAG As DWord
Static PC, FS As String
FLAG = TOTPERMUTATIONS / 2 + 1
PC = Format$(GLOBALPERMCOUNT, "0000000")
FS = ""
If GLOBALPERMCOUNT = FLAG Then WRITEADVERTISEMENT()
FS = FS & "'" & PC & " " & ASCIISTRING
FILE_LinePrint(OUTFILE, FS)
END FUNCTION
'------------------------------------------------------------
Function WRITEADVERTISEMENT()
Local NULLSTRING As String
NULLSTRING = ""
FILE_LinePrint(OUTFILE, NULLSTRING)
FILE_LinePrint(OUTFILE, NULLSTRING)
FILE_LinePrint(OUTFILE, "'************************************************************************")
FILE_LinePrint(OUTFILE, "'* *")
FILE_LinePrint(OUTFILE, "'* WOULDN'T AN ICE COLD SWAMP'S HIT THE SPOT RIGHT NOW?! *")
FILE_LinePrint(OUTFILE, "'* ENJOY THE CLEAN REFRESHING TASTE OF SWAMP'S MOUNTAIN SPRING WATER. *")
FILE_LinePrint(OUTFILE, "'* ""IF IT'S GREEN - YOU KNOW IT'S GOOD, SWAMP'S!!"" *")
FILE_LinePrint(OUTFILE, "'* *")
FILE_LinePrint(OUTFILE, "'************************************************************************")
FILE_LinePrint(OUTFILE, NULLSTRING)
FILE_LinePrint(OUTFILE, NULLSTRING)
End Function
'------------------------------------------------------------
'------------------------------------------------------------