PROG4.LST 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136
  1. Listing:
  2. 1 MODULE prog4;
  3. 2 (* This program displays the permutations of a string
  4. 3 in alphabetic order *)
  5. 4 IMPORT IO,Str;
  6. 5
  7. 6 TYPE StringType = ARRAY [0..9] OF CHAR;
  8. ***** ^ not supported yet
  9. ***** ^ not supported yet
  10. 7
  11. 8 PROCEDURE NextPerm(n:CARDINAL;
  12. 9 VAR s:StringType;
  13. 10 VAR wrap:BOOLEAN);
  14. 11 (* This procedure updates s to the next permutation of the
  15. 12 first n characters of s. The sequence of permutations
  16. 13 generated by successive calls is in 'dictionary' order.
  17. 14 If s is the last string in the sequence, the first is
  18. 15 returned. The boolean result wrap is used to indicate
  19. 16 this event *)
  20. 17 VAR
  21. 18 i:CARDINAL; (* s[i-1] is the most significant char changed *)
  22. 19 j:CARDINAL; (* s[j] is the char to be swapped with s[i-1] *)
  23. 20 tmp:CHAR;
  24. 21
  25. 22 BEGIN
  26. 23 IF n = 0 THEN
  27. 24 wrap := TRUE;
  28. 25 RETURN;
  29. 26 END;
  30. 27 i := n - 1;
  31. 28 LOOP
  32. 29 IF i = 0 THEN
  33. 30 wrap := TRUE;
  34. 31 EXIT;
  35. 32 END;
  36. 33 IF s[i-1] < s[i] THEN
  37. ***** ^ not supported yet
  38. ***** ^ not supported yet
  39. ***** ^ not supported yet
  40. ***** ^ not supported yet
  41. 34 j := n - 1;
  42. 35 WHILE s[j] <= s[i-1] DO
  43. ***** ^ not supported yet
  44. ***** ^ not supported yet
  45. ***** ^ not supported yet
  46. ***** ^ not supported yet
  47. 36 j := j - 1;
  48. 37 END;
  49. 38 tmp := s[j]; s[j] := s[i-1]; s[i-1] := tmp; (* swap *)
  50. ***** ^ not supported yet
  51. ***** ^ not supported yet
  52. ***** ^ not supported yet
  53. ***** ^ not supported yet
  54. ***** ^ not supported yet
  55. ***** ^ not supported yet
  56. ***** ^ not supported yet
  57. ***** ^ not supported yet
  58. 39 wrap := FALSE;
  59. 40 EXIT;
  60. 41 END;
  61. 42 i := i - 1;
  62. 43 END;
  63. 44 (* s[i]..s[n-1] are in reverse order, reversing them
  64. 45 yields the minimum permutation we require *)
  65. 46 j := n - 1;
  66. 47 WHILE i < j DO
  67. 48 tmp := s[j]; s[j] := s[i]; s[i] := tmp;
  68. ***** ^ not supported yet
  69. ***** ^ not supported yet
  70. ***** ^ not supported yet
  71. ***** ^ not supported yet
  72. ***** ^ not supported yet
  73. ***** ^ not supported yet
  74. ***** ^ not supported yet
  75. ***** ^ not supported yet
  76. 49 i := i + 1;
  77. 50 j := j - 1;
  78. 51 END;
  79. 52 END NextPerm;
  80. ***** ^ not supported yet
  81. 53
  82. 54 VAR InputString:StringType;
  83. ***** ^ not supported yet
  84. 55 wrap:BOOLEAN;
  85. 56 online:CARDINAL; (* number of strings in output line *)
  86. 57 len:CARDINAL;
  87. 58 BEGIN
  88. 59 IO.WrStr('Enter string : ');
  89. ***** ^ not supported yet
  90. ***** ^ not supported yet
  91. ***** ^ not supported yet
  92. 60 IO.RdStr(InputString);
  93. ***** ^ not supported yet
  94. ***** ^ not supported yet
  95. ***** ^ not supported yet
  96. 61
  97. 62 len := Str.Length(InputString);
  98. ***** ^ not supported yet
  99. ***** ^ not supported yet
  100. ***** ^ not supported yet
  101. 63 REPEAT
  102. 64 NextPerm(len,InputString,wrap);
  103. ***** ^ not supported yet
  104. ***** ^ not supported yet
  105. ***** ^ not supported yet
  106. 65 UNTIL wrap;
  107. 66
  108. 67 online := 0;
  109. 68 REPEAT
  110. 69 IO.WrStr(InputString);
  111. ***** ^ not supported yet
  112. ***** ^ not supported yet
  113. ***** ^ not supported yet
  114. 70 IO.WrStr(' ');
  115. ***** ^ not supported yet
  116. ***** ^ not supported yet
  117. ***** ^ not supported yet
  118. 71 online := online + 1;
  119. 72 IF online = 6 THEN
  120. 73 IO.WrLn;
  121. ***** ^ not supported yet
  122. ***** ^ not supported yet
  123. 74 online := 0;
  124. 75 END;
  125. 76 NextPerm(len,InputString,wrap);
  126. ***** ^ not supported yet
  127. ***** ^ not supported yet
  128. ***** ^ not supported yet
  129. 77 UNTIL wrap;
  130. 78 END prog4.
  131. 79
  132. 51 errors