Задача 3.

Решение

uses crt;

Const

    N=3;

Type

    Vedomost=Record{Запись ведомость}

      fio:string;{фамилия}

      pr1:integer;{1 оценка}

      pr2:integer;{2}

     pr3:integer;{3}

    end;

Var

    mas:array [1..N] of Vedomost;{массив списков}

    o:array [1..N] of string;{массив индексов повышенной и обычной стипендии}

    i,j:integer;{параметры цикла}

    sr:real;{средний балл}

begin

clrscr;

    for i:=1 to N do{ввод данных}

      with (mas[i]) do

      begin

           writeln('Vvedite FIO studenta');

           readln(fio);

           writeln('Ocenka po pervomu predmetu');

           readln(pr1);

           writeln('Ocenka po vtoromu predmetu');

           readln(pr2);

           writeln('Ocenka po tret''emu predmetu');

           readln(pr3);

           writeln;

      end;

    clrscr;

    for i:=1 to N do

    begin

    with mas[i] do

         begin

         if (pr1=5) and (pr2=5) and (pr3=5) then o[i]:='p' {поиск отличников}

            else

                if (pr1>3) and (pr1>3) and (pr3>3) then o[i]:='o'{поиск хорошистов}

                   else

                       o[i]:='n';

         sr:=(pr1+pr2+pr3)/3;{подсчет среднего балла}

         write(fio,' ','Ocenki:',pr1:4,pr2:4,pr3:4,' sredniy ball:',sr:6:2);{вывод на экран}

         writeln;

         end;

    end;

    Writeln('Povishennaya stipendia:');{Вывод студентов с повышенной стипендией}

    For i:=1 to n do

        if o[i]='p' then writeln(mas[i].fio);

    Writeln('Obichnaya stipendia:');{Вывод студентов с обычной стипендией}

    writeln;

    For i:=1 to n do

        if o[i]='o' then writeln(mas[i].fio);

   readln;

end.

Пример выполнения программы

Vvedite FIO studenta

Petrov

Ocenka po pervomu predmetu

5

Ocenka po vtoromu predmetu

4

Ocenka po tret'emu predmetu

5

Vvedite FIO studenta

Sidorov

Ocenka po pervomu predmetu

5

Ocenka po vtoromu predmetu

5

Ocenka po tret'emu predmetu

5

Vvedite FIO studenta

Ivanov

Ocenka po pervomu predmetu

3

Ocenka po vtoromu predmetu

3

Ocenka po tret'emu predmetu

3

Petrov Ocenki:   5   4   5 sredniy ball: 4.67

Sidorov Ocenki:   5   5   5 sredniy ball: 5.00

Ivanov Ocenki:   3   3   3 sredniy ball: 3.00

Povishennaya stipendia:

Sidorov

Obichnaya stipendia:

Petrov

Задача 4.

uses crt;

const n=3;

Type

    Raspisanie=Record{список расписание}

      day:string;

      k:integer;

      tn:real;

      tk:real;

      f:string;

      p:string;

    end;

Var

    mas:array [1..N] of Raspisanie;

    i:integer;

procedure vivod(a:Raspisanie);{процедура вывода записи на экран}

begin

with a do

     begin

          writeln('Nazvanie predmeta ',p);

          writeln('Den'' nedeli: ',day);

          writeln('Kolichestvo par: ',k);

          writeln('Vremya nachala ',tn:5:2);

          writeln('Vremya konca ',tk:5:2);

          writeln('Familia prepodavatelya: ',f);

          writeln;

     end;

end;

begin

clrscr;

    for i:=1 to N do{ввод данных}

      with (mas[i]) do

      begin

           writeln('Den'' nedeli:');

           readln(day);

           writeln('Kolichestvo par:');

           readln(k);

           writeln('Vremya nachala');

           readln(tn);

           writeln('Vremya konca');

           readln(tk);

           writeln('Familia prepodavatelya');

           readln(f);

           writeln('Nazvanie predmeta');

           readln(p);

      end;

   writeln('Informacia otnasyashayasya k Informatike');

   for i:=1 to N do

     if (mas[i].p='Informatika') then{вывод данных с предметом Информатика}

        vivod(mas[i]);

   readln;

end.

Задача 5.

Решение.

uses crt;

const n=200;

var s:string;{s-строка}

    m:array [1..n] of char;{массив символов}

    i,j,x:integer;{параметры циклов}

    k:array [1..n] of integer;{массив индексов символов}

    sk:string;{строковое представление числа k}

BEGIN

writeln('Vvedite stroku');{ввод строки}

readln(s);

x:=length(s);{определение длины введенной строки}

for i:=1 to x do m[i]:=s[i];

for i:=1 to x do

    for j:=1 to x do

        if (i<>j) and (m[i]=m[j]) then m[j]:=' ';{обнуление повторяющихся символов}

for i:=1 to x do k[i]:=0;{обнуление индексов}

for i:=1 to x do

    for j:=1 to x do

        if (m[i]=s[j]) and (s[j]<>' ') then inc(k[i]);{подсчет индексов}

for i:=1 to x do

    if k[i]<>0 then begin

                    str(k[i],sk);

                      case sk[length(sk)] of{вывод в грамматической форме}

                      '1','5','6','7','8','9','0': begin

                                                   writeln(m[i],'-',k[i],' raz');

                                                   end;

                      '2','3','4': begin

                                   writeln(m[i],'-',k[i],' raza');

                                   end;

                      end;

                    end;

readln;

END.

Пример:

Vvedite stroku

aaabbbabbbcccdedd

a-4 raza

b-6 raz

c-3 raza

d-3 raza

e-1 raz Задача 6.

Решение

uses crt;

const n=200;

var s:string;{строка}

    m:array [1..n] of char;{массив символов}

    i,j,k:integer;

BEGIN

writeln('Vvedite stroku');

readln(s);

for i:=1 to n do m[i]:=s[i];

for i:=1 to n do

    for j:=1 to n do

        if (i<>j) and (m[i]=m[j]) then m[j]:=' ';{обнуление повторяющихся символов}

k:=0;

for i:=1 to n do

    if m[i]<>' ' then begin{подсчет количества каждого символа}

                     writeln(m[i]);

                     k:=k+1;

                     end;

writeln('Vsego ',k-1,' simvolov');{вывод количества}

readln;

END.

Пример выполнения.

Vvedite stroku

aaabbcccddeddd

a

b

c

d

e

Vsego 5 simvolov