program kursovai;
uses crt;
label PR,OUT;
var
s:integer;

      procedure zada4a1;
      var
      sk:string;
      a,b,c,d: integer;
      label SN;
      begin
      SN: clrscr;
      write('Введите год в промежутке от 1 до 2100: ');
      readln(sk);
      val(sk,a,d);
      if (a<1) or (a>2100) then goto SN;
      b:=12;
      c:=a mod b;
      case c of
      0: writeln(a,' - Обезьяна');
      1: writeln(a,' - Петух');
      2: writeln(a,' - Собака');
      3: writeln(a,' - Кабан');
      4: writeln(a,' - Крыса');
      5: writeln(a,' - Бык');
      6: writeln(a,' - Тигр');
      7: writeln(a,' - Кот');
      8: writeln(a,' - Дракон');
      9: writeln(a,' - Змея');
      10: writeln(a,' - Лошадь');
      11: writeln(a,' - Коза');
      end;
      writeln('Нажмите пожалуйста любую клавишу');
      repeat until Keypressed;
      end;


      procedure zada4a2;
      const
        n=70;
      var
        m:array[1..n] of integer;
        y,i,k:integer;
      begin
      randomize;
      clrscr;
      writeln('Исходная последовательность:');
      for k:=1 to n do
      begin
        m[k]:=random(65534)-32768;
        write(' ',m[k],' ');
      end;

      for i:=1 to n-1 do
        for k:=1 to n-1 do
          if m[k] > m[k+1] then
          begin
            y:=m[k+1];
            m[k+1]:=m[k];
            m[k]:=y;
          end;
      writeln;
      writeln('Упорядоченная последовательность: ');
      for k:=1 to n do
      write(' ',m[k],' ');
      readkey;
      end;

      procedure zada4a3;
      type mn1=set of 'а'..'я';
      const mn_gl: set of 'а'..'я' = ['а','е','ё','и','о','у','ы','э','ю','я'];
      var
      sn,s1,s2:string;
      ii,j,kk,kol,max,pz,nach:integer;
      c:char;
      mn_b,mn:mn1;
      begin
      clrscr;
      writeln('Примечание!Для перехода на русскую раскладку клавиатура');
      writeln('нажмите одновременно правые Shift и Ctrl');
      writeln('Введите строку');
      read(sn);
      kk:=-1;{Первое слово без пробела}
      while (ii<=length(sn)) and (sn[ii]<>' ') do
        begin
          inc(kk);inc(ii);
        end;
      s1:=copy(sn,0,kk);
      max:=0;
      while ii<=length(sn) do
      begin
        kol:=kol+1;
        if sn[ii]=' ' then
        if kol>=max then
        begin
          max:=kol; pz:=ii;kol:=0;
        end;
        ii:=ii+1;
      end;
      nach:=pz;{Номер позици пробела после длинного слова}
      pz:=pz-max+1;{Номер позиции с которой начинается длинное слово}
      s2:=copy(sn,pz,nach-pz);{Самое длинное слово}
      insert (s1,sn,pz+max-1);
      delete(sn,pz,max-1);
      Writeln('Измененная строка:');
      writeln(sn);
      writeln;
      {Формируем множество букв из строки s}
      for ii:=1 to length(sn) do
        include(mn_b,sn[ii]);
      {Выводим все использованные буквы}
      writeln('Все использованные буквы:');
      for c:='а' to 'я' do
        if c IN mn_b then write(c);
      writeln;
      writeln('Неиспользованные гласные:');
      {Формируем множество из гласных букв встречающихся в строке s}
      for ii:=1 to length(sn) do
        if sn[ii] in mn_gl then include(mn,sn[ii]);
      mn_gl:=mn_gl-mn;{Из всех гласных букв убрать те которые уже есть в строке}
      for c:='а' to 'я' do
        if c IN mn_gl then write(c);
      readkey;
      end;

      procedure zada4a4;
      type sp=record
      fam:string;
      imy:string;
      otch:string;
      voz:integer;
      nkv:integer;
      net:integer;
      end;

      var
      ch:array[1..10] of sp;
      il,sum,sr,o,p,r:integer;
      v1,k1,e1: string;
      label GH;

      begin
      GH: clrscr;
      write('Введите данные жильцов дома');
      writeln;
      for il:=1 to 10 do
      begin
        write('Фамилия: ');
        readln(ch[il].fam);
        write('Имя: ');
        readln(ch[il].imy);
        write('Отчество: ');
        readln(ch[il].otch);
        write('Возраст: ');
        readln(v1);
        val(v1,ch[il].voz,o);
        if ch[il].voz<1 then goto GH;
        write('N квартиры: ');
        readln(k1);
        val(k1,ch[il].nkv,p);
        if ch[il].nkv<1 then goto GH;
        write('N этажа: ');
        readln(e1);
        val(e1,ch[il].net,r);
        if ch[il].net<1 then goto GH;
      end;
      clrscr;
      writeln('Фамилия':15,'Имя':15,'Отчество':15,'Возраст':8,'Nквартиры':10,'Nэтажа':10);
      for il:=1 to 10 do
      begin
        write(ch[il].fam:15);
        write(ch[il].imy:15);
        write(ch[il].otch:15);
        write(ch[il].voz:15);
        write(ch[il].nkv:15);
        write(ch[il].net:15);
        writeln;
      end;
      writeln;
      writeln('Список жильцов 3 этажа');
      for il:=1 to 10 do
      begin
        if ch[il].net=3 then
        begin
          write(ch[il].fam:15,ch[il].imy:15,ch[il].otch:15,ch[il].voz:15,ch[il].nkv:15,ch[il].net:15);
          writeln;
        end;
      end;
      writeln;
      writeln('Список жильцов,возраст которых меньше 17 лет');
      for il:=1 to 10 do
      begin
        if ch[il].voz<17 then
        begin
          write(ch[il].fam:15,ch[il].imy:15,ch[il].otch:15,ch[il].voz:15,ch[il].nkv:15,ch[il].net:15);
          writeln;
        end;
      end;
      sum:=0;
      for il:=1 to 10 do
      begin
        sum:=sum+ch[il].voz;
      end;
      sr:=trunc(sum/10);
      writeln;
      writeln('Средний возраст жильцов = ',sr);
      readkey;
      end;

      procedure zada4a5;
      type
        ff=file of real;
      var
      log_f:ff;

      procedure zapolnenie (var f:ff);
      var
      nq:integer;
      ip,q,w:integer;
      kt:real;
      ky,mm:string;
      label MK;
      begin
      MK: clrscr;
      write('Введите количество компонент в файле: ');
      readln(ky);
      val(ky,nq,q);
      if nq<1 then goto MK;
      rewrite(f);
      writeln('Примечание!Если будут введены буквенные элементы,то они будут приравнены к 0!');
      writeln('Введите компоненты файла: ');
      for ip:=1 to nq do
        begin
          readln(mm);
          val(mm,kt,w);
          write(f,kt);
        end;
      close(f);
      end;

      procedure vyvod (var f:ff);
      var
      kt:real;
      begin
      reset(f);
      while not eof(f) do
      begin
        read(f,kt);
        write(kt:5:5,' ');
      end;
      close(f);
      writeln;
      end;

      procedure vyvod1 (var f:ff);
      const
        q=1.1;
      var
      kt:real;
      begin
      reset(f);
      while not eof(f) do
      begin
        read(f,kt);
        if kt<0 then kt:=q;
        write(kt:5:5,' ');
      end;
      close(f);
      writeln;
      end;

      function sr_ar (var f:ff):real;
      var
      kt:real;
      sum:real;
      begin
      reset(f);
      sum:=0;
      while not eof(f) do
      begin
        read(f,kt);
        sum:=sum+kt;
      end;
      sr_ar:=sum/filesize(f);
      close(f);
      end;

      function zam(var f:ff):real;
      var
      kt,z:real;
      begin
      reset(f);z:=0;
      while not eof(f) do
      begin
        read(f,kt);
        if kt<0 then z:=z+1;
      end;
      zam:=z;
      close(f);
      end;


      procedure vyvod2 (var f:ff);
      var
      t,kt,sr:real;

      begin
      sr:=sr_ar(f); t:=zam(f);
      reset(f);
      while not eof(f) do
      begin
        read(f,kt);
      end;
      write(f,sr);
      write(f,t);
      close(f);

      reset(f);
      while not eof(f) do
      begin
        read(f,kt); write(kt:8:2);
      end;
      writeln;
      end;

      begin
      assign(log_f,'bank.dat');
      clrscr;
      zapolnenie(log_f);
      writeln('Содержимое файла: ');
      vyvod(log_f);
      writeln('Содержание измененного файла: ');
      vyvod1(log_f);
      writeln('Среднее арифмитическое компонент файла = ',sr_ar(log_f):5:5);
      writeln('Дописанный файл: ');
      vyvod2(log_f);
      repeat until Keypressed;
      end;

begin
PR:
clrscr;
Writeln('Введите номер программы которую вы желаете просмотреть.Пример:');
writeln('1 (Выбор задачи подтверждается нажатием клавиши Enter)');
writeln;
writeln('1: Определение знака задиака по введенному году');
writeln('2: Формирование нового упорядеченного массива');
writeln('3: Замена самого длинного слова в строке');
writeln('4: Список жильцов дома');
writeln('5: Файл');
writeln('0: Выход');
read(s);
case s of
1: zada4a1;
2: zada4a2;
3: zada4a3;
4: zada4a4;
5: zada4a5;
0: goto OUT;
end;
goto PR;
readkey;
OUT:
end.