File: PERMUT.PS of Tape: Various/Decus/decus-3

(Source file text) 

---

PROGRAM PERMUTATIONEN(INPUT,OUTPUT);

    VAR I,N: INTEGER;
        C: ARRAY[1..10] OF INTEGER;


    FUNCTION FAK(N: INTEGER): INTEGER;
        BEGIN
            IF N=1 THEN FAK := 1
                   ELSE FAK := N*FAK(N-1)
        END (* FAK *);



    PROCEDURE WRITEPERMUTATION;
      VAR I: INTEGER;
        BEGIN
            WRITE(" ":10);
            FOR I := 1 TO N  DO WRITE( C[I] :3);
            WRITELN
        END (* WRITEPERMUTATION *);



    PROCEDURE NEXTPERMUTATION;
      VAR I,J,H: INTEGER;
        BEGIN
            I := N-1;
            WHILE C[I]>C[I+1]  DO I := I-1;
            J := N;
            WHILE C[J]<C[I]  DO J := J-1;
            H := C[I];  C[I] := C[J];  C[J] := H;
            I := I+1;  J := N;
            WHILE I<J DO
                BEGIN   H := C[I];  C[I] := C[J];  C[J] := H;
                        I := I+1;  J := J-1
                END
        END (* NEXTPERMUTATION *);



BEGIN
    WRITE("P E R M U T A T I O N E N   DER ORDNUNG");
    READ(N);
    WRITELN;
    FOR I := 1 TO N  DO C[I] := I;
    WRITEPERMUTATION;
    FOR I := 2 TO FAK(N)  DO
        BEGIN
            NEXTPERMUTATION;
            WRITEPERMUTATION
        END
END.

---