procedure cleanString(var s: string);
  var i: integer;
  begin
    for i := 1 to length(s) do
      if s[i] in ['.', ',', '!', '?']
        then delete(s, i, 1);
  end;
function getToken(delim: char; var s: string): string;
  var p: byte;
  begin
    getToken := '';
    p := pos(delim, s);
    if p <> 0 then
      begin
        getToken := Copy(s, 1, pred(p));
        delete(s, 1, p); exit
      end;
    getToken := s; s := ''
  end;

type
  LexType = (lxPredict, lxName, lxWord);
const
  WhichType: array[LexType] of string =
    (' > Predicate', ' > Name', ' > Word');

function analyzeToken(s: string): LexType;
  const
    Vowels = ['A', 'E', 'I', 'O', 'U', 'Y'];
    Consonants = ['B', 'C', 'D', 'F', 'G', 'H', 'J', 'K', 'L',
                  'M', 'N', 'P', 'Q', 'R', 'S', 'T', 'V', 'Z'];
  var
    hasDouble: boolean;
    i: byte;
  begin
    hasDouble := false;

    analyzeToken := lxName;
    if upcase(s[length(s)]) in Consonants then exit;
    for i := 1 to length(s) - 1 do
      hasDouble := hasDouble or
        ((upcase(s[i]) in Consonants) and (upcase(s[i+1]) in Consonants));

    if hasDouble then analyzeToken := lxPredict
    else analyzeToken := lxWord
  end;

const
  maxString = 30;
  maxWords = 1000;
type
  arrRec =
    record
      s: string[maxString];
      freq: word;
      lex: LexType;
    end;

var
  arr: array[1 .. maxWords] of arrRec;
const
  arrCount: Integer = 0;

function checkInArray(str: string): boolean;
  var i: integer;
  begin
    checkInArray := true;
    for i := 1 to arrCount do
      if arr[i].s = str then
        begin
          inc(arr[i].freq); exit
        end;
    checkInArray := false
  end;

function putToArray(str: string; lx: LexType): boolean;
  begin
    putToArray := false;
    inc(arrCount);
    if arrCount > maxWords then exit;

    arr[arrCount].s := str;
    arr[arrCount].lex := lx;
    arr[arrCount].freq := 1;
    putToArray := true
  end;


const
  f_name = 'TEXT.LGL';
var
  f: text;
  st, sToken: string;
  lex: LexType;
  i: integer;

begin
  assign(f, f_name);
  {$i-} reset(f); {$i+}
  while not seekeof(f) do
    begin
      readln(f, st);
      cleanString(st);
      while st <> '' do
        begin
          sToken := getToken(' ', st);
          if not checkInArray(sToken) then
            begin
              lex := analyzeToken(sToken);
              if not putToArray(sToken, lex) then
                begin
                  writeln( 'word amount exceeded' ); exit;
                end;
            end;
        end;
    end;

  for i := 1 to arrCount do
    writeln(arr[i].freq:4, ': ', arr[i].s, whichType[arr[i].lex] );

  close(f);
end.