Дан символьный файл f, содержащий произвольный текст. Получить 10 наиболее часто встречающихся букв и число их появления - PascalABC.NET - Ответ 3934916

program _strings;
 
const
 
 N = 10;
 filename = 'input.txt' ;
 
 
type
 
 TInfo  = record
  chr   : char;
  count : integer;
 end;
 
 TLetters = array [0..59] of Tinfo;
 
var
 
 fi           : text;
 inString     : string;
 letters      : TLetters;
 i            : byte;
 
procedure CheckChr(const inCHR:char;var aLetters:TLetters );
 const
  cLet= ['A'..'Z','А'..'Я'];
 var
  not_found    : boolean;
  j,h          : byte;
begin
 if inCHR in cLet then
 begin
  h:=aLetters[0].count;
  not_found:=TRUE;
  for j:=1 to h do
    if letters[j].chr = inCHR then
     begin
      inc(aLetters[j].count);
      not_found:=FALSE;
      break;
     end;
    if not_found then 
     begin
      inc(h);
      aLetters[h].chr:=inCHR;
      aLetters[h].count:=1;
     end;
  aletters[0].count:=h;     
 end;
end;
 
procedure UpString(var instr:string);
{переписывает instr в верхнем регистре}
 const
  eng_alph = ['a'..'z','A'..'Z'];
  rus_alph = ['а'..'я','А'..'Я'];
 var
  i,lnth      : integer;
begin
 lnth:=length(instr);
 for i:=1 to lnth do 
  begin
   if instr[i] in eng_alph then 
    if instr[i] in ['a'..'z'] then instr[i]:=CHR(ord(instr[i])-32);
   if instr[i] in rus_alph then 
    if instr[i] in ['а'..'я'] then instr[i]:=CHR(ord(instr[i])-32);
  end;
end;
 
procedure Sort(var Let:Tletters;left,right:byte);
 var
  l,r,m       : integer;
  temp        : TInfo;
begin
 l:=left;
 r:=right;
 m:=let[(l+r) div 2].count;
 repeat
  while let[l].count > m do inc(l);
  while let[r].count < m do dec(r);
  if l<=r then 
   begin
    temp:=let[l];
    let[l]:=let[r];
    let[r]:=temp;
    inc(l);dec(r);
   end;
 until l>r;
 if left< r then sort(Let,left,r);
 if l<right then sort(let,l,right);
end;
 
BEGIN
 
{ Assign & read text }
 assign(fi,filename);reset(fi);
 letters[0].count:=0;
 while not eof(fi) do
     begin
      Readln(fi,instring);
      UpString(instring);
      for i:=1 to length(instring) do CheckCHR(instring[i],letters);
     end;
 close(fi);
{ sort & output }
sort(letters,1,letters[0].count);
for i:=1 to N do writeln(letters[i].chr,' ',letters[i].count);
 
END.