uses wincrt;
var CH:String[50];


Function Check(CH:String[50]):Boolean;
Var i:Byte;
Begin
  i:=1;
  While (CH[i] in ['A'..'Z','a'..'z']) do
  Begin
    i:=i+1;
  End;
  Check:=(length(CH)<50) and (length(CH)=i);
End;


Procedure Saisie(Var CH:String[50]);
Begin
  Repeat
    writeln('CH :');
    readln(CH);
  Until Check(CH);
End;


Procedure Affiche(CH:String[50]);
Var Tier1,Tier2,Tier3,Tier4,i:Byte;
    RES:String[50];
Begin
  Tier1:=1; {Uppercase Consonants}
  Tier2:=2; {Uppercase Vowels}
  Tier3:=3; {Lowercase Consonants}
  Tier4:=4; {Lowercase Vowels}
  RES:='    ';
  For i:=1 to length(CH) do
  Begin
    if not(CH[i] in ['A','E','I','I','U','Y']) and (CH[i] in ['A'..'Z']) then
    Begin
      Insert(Res,CH[i],Tier1+1);
      Tier1:=Tier1+1;
      Tier2:=Tier2+1;
      Tier3:=Tier3+1;
      Tier4:=Tier4+1;
    End
    Else if (CH[i] in ['A'..'Z']) then
    Begin
      Insert(Res,CH[i],Tier2+1);
      Tier1:=Tier1+1;
      Tier2:=Tier2+1;
      Tier3:=Tier3+1;
      Tier4:=Tier4+1;
    End;

    if not(CH[i] in ['a','e','i','o','u','y']) and (CH[i] in ['a'..'z']) then
    Begin
      Insert(Res,CH[i],Tier3+1);
      Tier1:=Tier1+1;
      Tier2:=Tier2+1;
      Tier3:=Tier3+1;
      Tier4:=Tier4+1;
    End
    Else if (CH[i] in ['a'..'z']) then
    Begin
      Insert(Res,CH[i],Tier4+1);
      Tier1:=Tier1+1;
      Tier2:=Tier2+1;
      Tier3:=Tier3+1;
      Tier4:=Tier4+1;
    End;
  End;
  writeln('Res: ',CH);
End;


Begin
  Saisie(CH);
  Affiche(CH);
End.