Написать 2 программы, 1.описать функцию, которая возвращает количество слов, в которых содержится хотя бы одна заданная буква. 2.описать процедуру, которая печатает все буквы, входящие в строку менее к раз, с указанием количества вхождений.

1)function counter(s: string; c: char): integer; var sub: string; i,k: integer; begin; k: =0; while pos(' ',s)< > 0 do   begin;   for i: =1 to pos(' ',s)-1 do     sub: =sub+s[i];       if pos(c,sub)< > 0 then inc(k);       delete(s,1,pos(' ',s));       delete(sub,1,length(sub)); end; if pos(c,s)< > 0 then inc(k); counter: =k; end; 2)procedure strangeseq(s: string; k: integer); var i,cou: integer; sub: string; ar: array of integer; arc: array of char; begin; setlength(ar,length(s)+1); setlength(arc,length(s)+1); cou: =length(s); while cou< > 0 do begin;   inc(i);   arc[i]: =s[1];   sub: =s[1];   while pos(sub,s)< > 0  do     begin;     inc(ar[i]);     delete(s,pos(sub,s),1);     end;   cou: =length(s);   if (ar[i]> k) and (arc[i]< > ' ') then   writeln('sign: ',arc[i],' count: ',ar[i]); end; end;

Вот ещё варианты решения (покороче, без вложенных циклов): 1. function kw(s: string; c: char): integer; var sl: string; n,k,i: integer; begin n: =0; k: =0; s: =s+'.'; for i: =1 to length(s) do   if s[i] in [' ',',','; ','.']       then begin if k> 0 then inc(n); k: =0; end     else if s[i]=c then inc(k); kw: =n; end; var st: string; c: char; begin st: ='program,   begin,   procedure, var, div, array.'; c: ='r'; writeln('m=',kw(st,c)); end. 2. здесь анализируются только строчные буквы. при желании можно добавить заглавные . и . всё будет аналогично.procedure pk(s: string; k: integer); var a: array['a'..'z'] of integer; i: integer; c: char; beginfor c: ='a' to 'z' do a[c]: =0; for i: =1 to length(s) do    if s[i] in ['a'..'z'] then inc(a[s[i]]); for c: ='a' to 'z' do  if a[c]< k then writeln(c,' - ',a[c])end; var st: string; k: integer; beginst: ='program,   begin,   procedure, var, div, array.'; k: =2; pk(st,k); end.

1)а,ж,и.к.2)б 3)а,б 4)б 5)а 6)с 7)а 8)б 9)а.с,д,л,м