Const chb:set of char=['а'..'я','a'..'z']; //множество букв
Var ar,s,st:string; i,j,n:integer; c:char; begin readln(s); //читаем текст n:=0; //обнуляем счётчик for i:=1 to length(s) do {всё в нижнем регистре, чтобы не считать заглавную и строчную буквы разными} s[i]:=lowcase(s[i]); for i:=1 to length(s) do //снова пройдёмся по каждой букве begin st:=s; {передаём переменной текст, тем самым не трогая "оригинал"} while pos(s[i],st)<>0 do //пока в копии есть символ с заданным циклом for индексом begin delete(st,pos(s[i],st),1); {...удаляем этот символ(по одному за шаг вложенного цикла)} inc(n); //увеличиваем число удалённых end; {таким образом, данный цикл позволяет проверить количество вхождений символа в строку} if (n<=2) and (pos(s[i],ar)=0) and (s[i] in chb) then ar:=ar+s[i]; {если вхождений не больше 2 и символа нет в конечной строке(чтобы не было повторов) и символ есть в множестве букв(чтобы не было знаков препинания), то добаляем в конечную строку} n:=0; //обнуляем счётчик end; for i:=1 to length(ar)-1 do {Здесь могла быть "быстрая сортировка", но люди не знающие ничего, кроме "пузырька" будут против} for j:=i+1 to length(ar) do if ar[i]>ar[j] then {сравниваем символы. Тип char является целочислительным, следовательно, нам можно} begin c:=ar[i]; ar[i]:=ar[j]; ar[j]:=c; end; writeln('Result:'); //вывод конечной строки for i:=1 to length(ar) do write(ar[i],' '); end.
{Предвещая недовольство: мне самому не нравится эта подпрограмма, но динамические массивы обычно не изучают в школьной программе}
//Pascal ABC.NET v3.1 сборка 1219
Const n1=5; m1=8; n2=6; m2=4;
Type matrixa=array[1..n1,1..m1] of integer; matrixb=array[1..n2,1..m2] of integer;
procedure FindInd(f:integer;maa:matrixa;mab:matrixb); Var i,j:integer; s:string; begin for i:=1 to n1 do for j:=1 to m1 do if maa[i,j]=f then s:=s+'['+inttostr(i)+']['+inttostr(j)+']'+chr(10)+chr(13); writeln('For A:'); writeln(s); s:=''; for i:=1 to n2 do for j:=1 to m2 do if mab[i,j]=f then s:=s+'['+inttostr(i)+']['+inttostr(j)+']'+chr(10)+chr(13); writeln('For B:'); writeln(s); end;
Var maa:matrixa; mab:matrixb; i,j,f:integer; begin randomize; writeln('Matrix A:'); for i:=1 to n1 do begin for j:=1 to m1 do begin maa[i,j]:=random(20); write(maa[i,j]:4); end; writeln; end; writeln('Matrix B:'); for i:=1 to n2 do begin for j:=1 to m2 do begin mab[i,j]:=random(20); write(mab[i,j]:4); end; writeln; end; readln(f); FindInd(f,maa,mab); end.