Results 1 to 3 of 3

Thread: All the Permutations of ABCD..

  1. #1
    thinBasic MVPs danbaron's Avatar
    Join Date
    Jan 2010
    Location
    California
    Posts
    1,378
    Rep Power
    152

    All the Permutations of ABCD..

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

    [code=thinbasic]'------------------------------------------------------------
    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

    '------------------------------------------------------------
    '------------------------------------------------------------
    [/code]
    Attached Files Attached Files
    "You can't cheat an honest man. Never give a sucker an even break, or smarten up a chump." - W.C.Fields

  2. #2
    thinBasic MVPs kryton9's Avatar
    Join Date
    Nov 2006
    Location
    Naples, Florida & Duluth, Georgia
    Age
    67
    Posts
    3,869
    Rep Power
    404

    Re: All the Permutations of ABCD..

    Thanks for the example. These might be good candidates for the math module.

    Acer Notebook: Win 10 Home 64 Bit, Core i7-4702MQ @ 2.2Ghz, 12 GB RAM, nVidia GTX 760M and Intel HD 4600
    Raspberry Pi 3: Raspbian OS use for Home Samba Server and Test HTTP Server

  3. #3
    thinBasic MVPs danbaron's Avatar
    Join Date
    Jan 2010
    Location
    California
    Posts
    1,378
    Rep Power
    152

    Re: All the Permutations of ABCD..

    No problem, Kent.

    Dan
    "You can't cheat an honest man. Never give a sucker an even break, or smarten up a chump." - W.C.Fields

Members who have read this thread: 3

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •