sw/src/pascal/PERMUT.V1

   1 PROGRAM PERMUTATIONEN(INPUT,OUTPUT);
   2
   3     VAR I,N: INTEGER;
   4         C: ARRAY[1..10] OF INTEGER;
   5
   6
   7     FUNCTION FAK(N: INTEGER): INTEGER;
   8         BEGIN
   9             IF N=1 THEN FAK := 1
  10                    ELSE FAK := N*FAK(N-1)
  11         END (* FAK *);
  12
  13
  14
  15     PROCEDURE WRITEPERMUTATION;
  16       VAR I: INTEGER;
  17         BEGIN
  18             WRITE(" ":10);
  19             FOR I := 1 TO N  DO WRITE( C[I] :3);
  20             WRITELN
  21         END (* WRITEPERMUTATION *);
  22
  23
  24
  25     PROCEDURE NEXTPERMUTATION;
  26       VAR I,J,H: INTEGER;
  27         BEGIN
  28             I := N-1;
  29             WHILE C[I]>C[I+1]  DO I := I-1;
  30             J := N;
  31             WHILE C[J]<C[I]  DO J := J-1;
  32             H := C[I];  C[I] := C[J];  C[J] := H;
  33             I := I+1;  J := N;
  34             WHILE I<J DO
  35                 BEGIN   H := C[I];  C[I] := C[J];  C[J] := H;
  36                         I := I+1;  J := J-1
  37                 END
  38         END (* NEXTPERMUTATION *);
  39
  40
  41
  42 BEGIN
  43     WRITE("P E R M U T A T I O N E N   DER ORDNUNG");
  44     READ(N);
  45     WRITELN;
  46     FOR I := 1 TO N  DO C[I] := I;
  47     WRITEPERMUTATION;
  48     FOR I := 2 TO FAK(N)  DO
  49         BEGIN
  50             NEXTPERMUTATION;
  51             WRITEPERMUTATION
  52         END
  53 END.