Cas10/PERMP.MOD

   1 MODULE PermP;
   2
   3 FROM IO IMPORT
   4   WrStr, WrLn, WrCard, RdCard, WrChar, RdKey, OK;
   5
   6 CONST
   7   MaxDim = 50;
   8
   9 TYPE
  10   Niz = ARRAY [1 .. MaxDim] OF CHAR;
  11
  12 VAR
  13   A: Niz;
  14   n: CARDINAL;
  15
  16 PROCEDURE Unos(VAR n: CARDINAL; VAR A: Niz);
  17 VAR
  18   i: CARDINAL;
  19 BEGIN
  20   REPEAT
  21     WrStr('Unesite n (1 <= n <= ');
  22     WrCard(MaxDim, 1);
  23     WrStr(') --- ');
  24     n:= RdCard();
  25     WrLn;
  26   UNTIL OK AND (1 <= n) AND (n <= MaxDim);
  27   REPEAT
  28     WrLn;
  29     WrStr('Unesite ');
  30     WrCard(n, 1);
  31     WrStr(' slova koja treba permutovati (mogu se i ponavljati):');
  32     WrLn;
  33     WrLn;
  34     i:= 0;
  35     REPEAT
  36       INC(i);
  37       A[i]:= RdKey();
  38       WrChar(A[i])
  39     UNTIL (i = n) OR ((CAP(A[i]) < 'A') AND (CAP(A[i]) > 'Z')
  40                        AND (A[i] < '0') AND (A[i] > '9'));
  41   UNTIL NOT ((CAP(A[i]) < 'A') AND (CAP(A[i]) > 'Z') AND
  42              (A[i] < '0') AND (A[i] > '9'));
  43 END Unos;
  44
  45 PROCEDURE Permutacije(n: CARDINAL; VAR A: Niz);
  46
  47   PROCEDURE Nadji(k: CARDINAL);
  48   VAR
  49     i, j: CARDINAL;
  50     Temp: CHAR;
  51   BEGIN
  52     IF k = 1 THEN
  53       FOR i:= 1 TO n DO
  54         WrChar(A[i]);
  55       END;
  56       WrLn;
  57     ELSE
  58       Nadji(k - 1);
  59       FOR i:= 1 TO k - 1 DO
  60         IF A[k] # A[i] THEN
  61           (* Zamenimo elemente samo ako su razliciti *)
  62           j:= 1;
  63           WHILE (j < i) AND (A[j] # A[i]) DO
  64             INC(j);
  65           END;
  66           IF j = i THEN
  67             (* A[i] nema duplikata u skupu {a[1], ... , a[i-1] *)
  68             Temp:= A[i];
  69             A[i]:= A[k];
  70             A[k]:= Temp;
  71             Nadji(k - 1);
  72             Temp:= A[i];
  73             A[i]:= A[k];
  74             A[k]:= Temp;
  75           END;
  76         END;
  77       END;
  78     END;
  79   END Nadji;
  80
  81 BEGIN
  82   Nadji(n);
  83 END Permutacije;
  84
  85 BEGIN
  86   Unos(n, A);
  87   WrLn;
  88   WrLn;
  89   WrStr('Permutacije: ');
  90   WrLn;
  91   Permutacije(n, A);
  92 END PermP.