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.