algorithm

이를 생성하기위한 순열 알고리즘의 더 많은 예.

출처 : http://www.ddj.com/architect/201200326

1. 가장 빨리 알려진 Fike의 알고리즘을 사용합니다.
2. 사전 순서에 Algo를 사용합니다.
3. 비 사전을 사용하지만 항목 2보다 빠르게 실행됩니다.

1.

PROGRAM TestFikePerm;
CONST marksize = 5;
VAR
    marks : ARRAY [1..marksize] OF INTEGER;
    ii : INTEGER;
    permcount : INTEGER;

PROCEDURE WriteArray;
VAR i : INTEGER;
BEGIN
FOR i := 1 TO marksize
DO Write ;
WriteLn;
permcount := permcount + 1;
END;

PROCEDURE FikePerm ;
{Outputs permutations in nonlexicographic order.  This is Fike.s algorithm}
{ with tuning by J.S. Rohl.  The array marks[1..marksizn] is global.  The   }
{ procedure WriteArray is global and displays the results.  This must be}
{ evoked with FikePerm(2) in the calling procedure.}
VAR
    dn, dk, temp : INTEGER;
BEGIN
IF
THEN BEGIN { swap the pair }
    WriteArray;
    temp :=marks[marksize];
    FOR dn :=  DOWNTO 1
    DO BEGIN
        marks[marksize] := marks[dn];
        marks [dn] := temp;
        WriteArray;
        marks[dn] := marks[marksize]
        END;
    marks[marksize] := temp;
    END {of bottom level sequence }
ELSE BEGIN
    FikePerm;
    temp := marks[k];
    FOR dk :=  DOWNTO 1
    DO BEGIN
        marks[k] := marks[dk];
        marks[dk][ := temp;
        FikePerm;
        marks[dk] := marks[k];
        END; { of loop on dk }
    marks[k] := temp;l
    END { of sequence for other levels }
END; { of FikePerm procedure }

BEGIN { Main }
FOR ii := 1 TO marksize
DO marks[ii] := ii;
permcount := 0;
WriteLn ;
WrieLn;
FikePerm ; { It always starts with 2 }
WriteLn ;
ReadLn;
END.

2.

PROGRAM TestLexPerms;
CONST marksize = 5;
VAR
    marks : ARRAY [1..marksize] OF INTEGER;
    ii : INTEGER;
    permcount : INTEGER;


PROCEDURE WriteArray;
VAR i : INTEGER;
BEGIN
FOR i := 1 TO marksize
DO Write ;
permcount := permcount + 1;
WriteLn;
END;

PROCEDURE LexPerm ;
{ Outputs permutations in lexicographic order.  The array marks is global   }
{ and has n or fewer marks.  The procedure WriteArray () is global and  }
{ displays the results.                             }
VAR
    work : INTEGER:
    mp, hlen, i : INTEGER;
BEGIN
IF
THEN BEGIN { Swap the pair }
    work := marks[1];
    marks[1] := marks[2];
    marks[2] := work;
    WriteArray ;
    END
ELSE BEGIN
    FOR mp :=  DOWNTO 1
    DO BEGIN
        LexPerm<>;
        hlen :=  DIV 2;
        FOR i := 1 TO hlen
        DO BEGIN { Another swap }
            work := marks[i];
            marks[i] := marks[n - i];
            marks[n - i] := work
            END;
        work := marks[n]; { More swapping }
        marks[n[ := marks[mp];
        marks[mp] := work;
        WriteArray;
        END;
    LexPerm<>
    END;
END;

BEGIN { Main }
FOR ii := 1 TO marksize
DO marks[ii] := ii;
permcount := 1; { The starting position is permutation }
WriteLn <   Starting position:  >;
WriteLn
LexPerm ;
WriteLn <   PermCount is   , permcount>;
ReadLn;
END.

삼.

PROGRAM TestAllPerms;
CONST marksize = 5;
VAR
    marks : ARRAY [1..marksize] of INTEGER;
    ii : INTEGER;
    permcount : INTEGER;


PROCEDURE WriteArray;
VAR i : INTEGER;
BEGIN
FOR i := 1 TO marksize
DO Write ;
WriteLn;
permcount := permcount + 1;
END;

PROCEDURE AllPerm (n : INTEGER);
{ Outputs permutations in nonlexicographic order. The array marks is    }
{ global and has n or few marks.  The procedure WriteArray is global and    }
{ displays the results.                             }
VAR
    work : INTEGER;
    mp, swaptemp : INTEGER;
BEGIN
IF
THEN BEGIN { Swap the pair }
    work := marks[1];
    marks[1] := marks[2];
    marks[2] := work;
    WriteArray;
    END
ELSE BEGIN
    FOR mp :=  DOWNTO 1
    DO BEGIN
        ALLPerm<< n - 1>>;
        IF >
        THEN swaptemp := 1
        ELSE swaptemp := mp;
        work := marks[n];
        marks[n] := marks[swaptemp};
        marks[swaptemp} := work;
        WriteArray;
    AllPerm< n-1 >;
    END;
END;

BEGIN { Main }
FOR ii := 1 TO marksize
DO marks[ii] := ii
permcount :=1;
WriteLn < Starting position;   >;
WriteLn;
Allperm < marksize>;
WriteLn < Perm count is  , permcount>;
ReadLn;
END.