unit slova;

interface

uses
  crt, graph;

type
  massive = array [1..2000] of string;

procedure PoiskSlov(t: string; var out_veck: massive; var k: integer );
procedure PoiskSimvolov(input_str: massive; count: integer; var out_str: massive; var nomer: integer);
implementation


{
------------------------------------------
--  процедура поиска симметричных слов  --
------------------------------------------
}
procedure PoiskSlov(t: string; var out_veck: massive; var k: integer );{t - строка в которой ищем,
                                                                    out_veck - массив в котором будет результат,
                                                                    k - колличество найденных слов}
var
  w, s, sl, sk, sp: string;
  q, p, l, i, a, e, j: integer;
  Add:boolean;{флаг добавления слова в массив}
begin

  insert(' ', t, length(t) + 1);

  while Pos(' ', t) <> 0 do
  begin
    q := Pos(' ', t);
    sl := Copy(t, 1, q - 1);{копируем слово до пробела}
    delete(t, 1, q); {удаляем из строки слово вместе с пробелом}
      {----------------------------}
    insert(' ', sl, length(sl) + 1);
    l := 1;
    while l < length(sl) do
    begin
      if ord(sl[l]) in [33..47, 58..64, 91..96, 123..126] then
      begin
        delete(sl, l, 1);
        dec(l)
      end;
      inc(l);

    end;
    l := 0;
    delete(sl, length(sl), 1);
      {---------------------------------------------------------------}
    if length(sl) > 1 then  {проверяем слово}
    begin
      sk := ''; sp := '';
      for e := 1 to length(sl) do
        sk := sk + upcase(sl[e]);
      for e := 1 to length(sk) do
        sp := sk[e] + sp;

      if sp = sk then
       {---------------------*************---------------------------}
                             begin
                             Add:=True;{Добавляем в массив слов}
                                if k>0 then{если в массиве уже есть слова, то проверим повторения}
                                for i:=1 to k do{Ищем повоторения}
                                if sp=out_veck[i] then{Нашли повторения}
                                  begin
                                   Add:=False;{Не добавляем повторяющееся слово}
                                   Break;{Прерываем цикл проверки}
                                  end;
                               if Add then
                                begin
                                 inc(k);{Увеличиваем кол-во слов в массиве}
                                 out_veck[k]:=sp;{Записываем это слово}
                                end;
                             end;
                  {------------------*********************--------------------}
                    sl:='';

                 end;



              end;
      {-------------------------}
     { for i:=1 to k do
      writeln(aOut[i],' ');}

end;

 function InitGr():boolean;
    var err,Gd,Gm:integer;
  begin
    Gd:=detect;
    initgraph(Gd,Gm,'');
    err:=graphresult;
    if err = GrOk then
      InitGr := true
    else
      InitGr := false;
  end;
{
--------------------------------------------
--  процедура подсчета символов в строке  --
--------------------------------------------
}

procedure PoiskSimvolov(input_str: massive; count: integer; var out_str: massive; var nomer: integer);
var
  gd, gm, x0, y0: integer;
  t: text;
  s: string;
  mx, mVertical: real;

  w, h, i, j, q, k: integer;
  a: array [0..255] of byte;
  b: array [1..2000] of real; {сколько вхождений каждой буквы}
  c: array [1..2000] of char;{сама букву}
  st: string;
begin
  j := 1;
  k := 1; h:=0;
  for w := 1 to count do
  begin
    st := input_str[w];
    for i := 1 to length(st) do
    begin
      st[i] := upcase(st[i]); {преобразуем букву в заглавную}
      inc(a[ord(st[i])]);
      if st[i] in ['A'..'Z'] then
        inc(h);{подсчет колличества всех вхождений всех встреч. букв}
    end;
  end;
  st := '';
  for i := 65 to 90 do
    if  (a[i] <> 0)   then
    begin
      inc(q); {сколько букв использованно}
      b[j] := (a[i] / h); {записываем в массив относительную частоту буквы}
      c[k] := chr(i);{записываем саму букву}
      inc(k);
      inc(j);
      inc(nomer);
      out_str[nomer] := chr(i) + ' - ' + 'частота-';
      str((a[i] / h):3:3, st);

      {writeln();}
    end;

    {----------diagramma------------------------}
  {gd := 0;
  }
  if InitGr then
  begin
  w := 13; {ширина столбцов}
  x0 := 15; {левый край диаграммы}
  y0 := 420; {нижний край}
  mx := b[1];
  for j := 1 to q do
    if b[j] > mx then mx := b[j];{находим максимум}
  mVertical := (y0 - 40) / mx;{масштаб по вертикале}
  for j := 1 to q do
  begin
    setcolor(13);{цвет}
    Setfillstyle(5, 12);{стиль заполнения }
    {рисуем параллелепипеды с заданной шириной и шагом
     и высотой соответственно значению частоты}
    Bar3d(x0 + 4 * w * (j - 1), y0 - round(b[j] * mVertical), x0 + w * (4 * j - 2), y0, 15, topon);
    outtextXY(x0 + 4 * w * (j - 1), y0 + 20, c[j]);{выводим по низу буквы}
    str(b[j]:3:3, s);{преобразуем частоту в строку}
    outtextXY(x0 + 4 * w * (j - 1) + w - 5, y0 - round(b[j] * mVertical) - 25, s);{выводим частоту выше столбика}
  end;
  end
  else writeln('idi ti');
end;
end.