sw/src/pascal/WORTE.PS

   1  PROGRAM WORTE(INPUT, OUTPUT);
   2  CONST N = 101;    M = 11;
   3  TYPE ALFA = ARRAY[1..10] OF CHAR;
   4  VAR I,J,K: INTEGER;
   5      Z: CHAR;
   6      WORT: ALFA;
   7      A: ARRAY[1..N] OF ALFA;
   8      H: ARRAY[1..N] OF INTEGER;
   9
  10   FUNCTION EQUAL(VAR X,Y: ALFA): BOOLEAN;
  11       VAR K: INTEGER;
  12       BEGIN K:=0;
  13       REPEAT K:=K+1 UNTIL (X[K]<>Y[K]) OR (K=10);
  14       EQUAL := (X[K]=Y[K]) AND (K=10)
  15       END;
  16
  17  FUNCTION INDEX(X:ALFA): INTEGER;
  18      VAR I,Q,Z: INTEGER;
  19      BEGIN Z:= 0;
  20      FOR I := 1 TO 10 DO Z := Z + ORD(X[I]);
  21      I := Z MOD N + 1;   Q := Z MOD M + 1;
  22      WHILE NOT EQUAL(A[I],X) AND (H[I] <> 0) DO I := (I+Q) MOD N + 1;
  23      INDEX := I
  24      END;
  25
  26  BEGIN
  27  FOR I := 1 TO N DO H[I] := 0;
  28  REPEAT FOR J:=1 TO 10 DO WORT[J]:=" ";  J := 0;
  29         REPEAT READ(Z);
  30         UNTIL (Z>="A") AND (Z<="Z") OR EOLN;
  31         IF NOT EOLN
  32            THEN BEGIN
  33                 REPEAT J := J+1; IF J<=10 THEN WORT[J] := Z;
  34                        READ(Z)
  35                 UNTIL NOT ((Z>="A") AND (Z<="Z"));
  36                 I := INDEX(WORT);
  37                 A[I] := WORT;   H[I] := H[I] + 1
  38                 END
  39  UNTIL EOF;
  40  J := 0;
  41  FOR I := 1 TO N DO
  42      IF H[I] <> 0
  43         THEN BEGIN FOR K:=1 TO 10 DO WRITE(A[I,K]);
  44                WRITE(H[I]:3," ":5);
  45              J := J+1;
  46              IF J >=4 THEN BEGIN J := 0;  WRITELN END
  47              END
  48  END.