program abitura;
uses crt;
type mas=array[1..100] of integer;
var 
  a:mas;i:integer; k:integer;  //оценки первого экзамена
begin
  k:=0;
  clrscr;
  for i:=1 to 100 do 
    a[i]:=random(3)+2; // ЗАПОЛНИЛИ МАССИВ
  for i:=1 to 100 do 
    write(a[i]:2);
  writeln;
  for i:=1 to 100 do 
  begin
     if a[i]=2 then k:=k+1;
  end;
  writeln('количество абитуриентов не допущенных ко второму экзамену=',k);
end.

program q132022;
uses
  CRT;
const
  N_Max = 100;
var
  A : array [0..N_Max] of integer;
  i, j, N : integer;
begin
  ClrScr;
  WriteLn('Введите кол-во элементов последовательности:');
  ReadLn(N);
  WriteLn('Введите ', N, ' элементов последовательности:');
  for i := 1 to N do
    ReadLn(A[i]);

  for i := 1 to N-1 do
    if (A[i] = 1) and (A[i+1] = 0) then
      begin
        A[i] := 0;
        A[i+1] := 1;
        for j := i downto 1 do
          if (A[j] = 0) and (A[j-1] = 1) then
            begin
              A[j] := 1;
              A[j-1] := 0;
            end;
      end;

  WriteLn('Полученная последовательность:');
  for i := 1 to N do
    Write(A[i]:3);

  ReadLn;
end.

program dvumer;
uses crt;
const n=7;
      m=5;
var a:array[1..n,1..m] of integer;
    i,j,k,p:byte;
begin
clrscr;
randomize; {генерация случайных чисел}
k:=0;{счетчик строк без отрицательных элементов}
for i:=1 to n do
   begin
     p:=0;{счетчик отрицательных чисел в строке}
     for j:=1 to m do
       begin
         a[i,j]:=random(10)-2;
         write(a[i,j]:3);
         if a[i,j]<0 then p:=p+1;{если отрицательное, +1}
       end;
     if p=0 then k:=k+1; {если в строке нет отрицательных, +1}
     writeln;
   end;
writeln('Kolichestvo strok bez otricatelnyh elementov=',k);
readln
end.

program dvumer;
uses crt;
const n=7;
      m=4;
var a:array[1..n,1..m]of integer;
    i,j,imax,jmax,max:integer;
begin
clrscr;
randomize;
max:=a[1,1];imax:=1;jmax:=1; {начальные значения макс., строки и столбца}
for i:=1 to n do
   begin
     for j:=1 to m do
       begin
        a[i,j]:=random(20);
        write(a[i,j]:4);
        if a[i,j]>max then {если очередное число больше предыдущего максимума}
          begin
            max:=a[i,j]; {запоминаем число}
            imax:=i; {запоминаем номер строки}
            jmax:=j; {запоминаем номер столбца}
          end;
      end;
    writeln;
   end;
writeln('Nomer stroki=',imax,'  Nomer stolbca=',jmax);
readln
end.

program stroki;
uses crt;
var
  s: String;
  i: Integer;
BEGIN
  WriteLn('Введите строку:');
  ReadLn(s);
  i:=1;
  while i < length(s) do 
  begin
    if s[i] = s[i+1] then delete(s,i,1)
   else inc(i)
  end;
  WriteLn(s);
END.

program stroki;
uses crt;
var s,s1,s2:string;
    i,k:integer;
begin
clrscr;
writeln('Vvedite posledovatelnost slov:');
readln(s); {исходная последовательность}
s:=s+' '; {добавляем в конец пробел}
s1:=copy(s,1,pos(' ',s)-1); {запоминаем первое слово, его не печатаем}
k:=0; {заводим счетчик совпадений}
for i:=length(s) downto 1 do {движемся по строке от конца к началу}
   begin
    s2:=copy(s,1,pos(' ',s)-1);{запоминаем очередное слово}
    if s2>s1 then {если оно по алфавиту дальше, то}
       begin
         writeln(s2);{печатаем его}
         s1:=s2;{запоминаем его как очередное наибольшее}
         k:=k+1;{считаем}
       end;
    delete(s,1,pos(' ',s));{удаляем использованное слово}
  end;
if k=0 then writeln('Takih slov net!');{если совпадений нет, выводим сообщение}
readln
end.

program stroki;
uses crt;
var
s:string;
m:array[1..10]of string;
i,n,k,j:integer;
Function Obrat(str:string):string;{функция для "переворота" слов}
var st:string;
    j:integer;
begin
st:='';
for j:=length(str) downto 1 do
st:=st+str[j];
Obrat:=st;
end;

begin
clrscr;
writeln('Vvedite posledovatelnost slov:');
readln(s);
n:=1;
for i:=1 to length(s) do {преобразуем строку в массаив слов}
if s[i]=' ' then n:=n+1
else m[n]:=m[n]+s[i];
k:=0;
for i:=1 to n-1 do
for j:=i to n do
if m[i]=Obrat(m[j]) then {если есть слова, обратные друг другу, то}
 begin
   writeln('Takaja para est!'); {выводим сообщение}
   readln;
   k:=k+1;{считаем}
   exit;{выходим из программы}
 end;
if k=0 then writeln('Takoj pary net!');{если нет, сообщаем}
readln
end.