Контрольная работа № 21 символы и строки

Составьте программу, которая определяет, является ли введенный символ гласной или согласной буквой русского алфавита.

program junk;

uses crt;

var i: char;

Begin

clrscr;

writeln('Введитебукву');readln(i);

case i of

'е','э','о','а','ы','я','и','ю','ё':writeln('Гласная')

else writeln('Согласная')

end;

readln

end.

Пример.

Введите букву

а

Гласная

 

Контрольная работа №22 ПОДПРОГРАММЫ. ФУНКЦИИ И ПРОЦЕДУРЫ.

 

Составить рекурсивную программу ввода с клавиатуры последовательности чисел (окончание ввода –0) и вывода ее на экран в обратном порядке.

 

program px;

procedure chisla;

var a: integer;

Begin

writeln('Введите целые числа, окончание ввода 0');

readln(a);

if a <>0 then

Begin

chisla;

writeln(a);

end;

end;

 

Begin

chisla;

readln

end.

Пример.

Введите целые числа, окончание ввода 0

Введите целые числа, окончание ввода 0

Введите целые числа, окончание ввода 0

Введите целые числа, окончание ввода 0

Введите целые числа, окончание ввода 0

Введите целые числа, окончание ввода 0

 

 

Контрольная работа №23.ФАЙЛЫ ПОСЛЕДОВАТЕЛЬНОГО И ПРЯМОГО ДОСТУПА.

1. Дан текстовый файл, содержащий строки. Найти:

а) число строк;

б) число строк, начинающихся одинаковыми символами;

в) самые короткие строки;

г) симметричные строки

uses crt;

var f: text;

s,sp: string;

j,dmin,ks,ko: byte;

Begin

assign(f,'a.txt');

reset (f); dmin:=255;

while not eof(f) do

Begin

inc(ks);

readln(f,s);

if s[1]=s[length(s)] then inc(ko);

if length(s)<dmin then dmin:=length(s);

end;

writeln('число строк ',ks);

writeln('число строк начинающихся и заканчивающихся одинаковыми символами ',ko);

writeln('самые короткие строки: ');

reset(f);

while not eof(f) do

Begin

readln(f,s);

if length(s)=dmin then writeln(s);

end;

writeln('симетричныестроки:');

reset(f);

ks:=0;

while not eof(f) do

Begin

sp:='';

readln(f,s);

for j:=1 to length(s) do

Begin

sp:=s[j]+sp;

if sp=s then writeln(s);

end;

end;

if ks=0 then writeln('отсутствуют');

close(f);

readln;

end.

Пример.

число строк 4

число строк начинающихся и заканчивающихся одинаковыми символами 0

самые короткие строки:

Ванек

симетричные строки:

отсутствуют

 

Контрольная работа №24 ГРАФИКА ПАСКАЛЯ

Написать программу рисующую домик.

Uses graphABC;

Begin

line(100,100,150,50);

line(150,50,200,100);

line(200,100,100,100);

floodfill(120,90,clgreen);

SetBrushcolor(clred);

rectangle(115,100,185,150);

SetBrushcolor(clblue);

circle(150,75,5);

SetBrushcolor(clgray);

rectangle(125,120,140,140);

SetBrushcolor(clred);

textOut(150,110,'Дом');

end.

Пример.

 

 

Общие вопросы обязательные для выполнения студентом не зависимо от вариантов

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

Program pp;

var n:longint;

p,s:real;

m,x:integer;

Begin

write('Введите натуральное число: ');

readln(n);

s:=0;

p:=0.1;

for x:=(n mod 10) downto 1 do

n:=n div 10;

p:=p*10;

s:=s+x*p;

writeln(s:0:0);

readln;

end.

2.Данынатуральныечисла a, b, c. Вычислить .

Program pp;

var a,b,c:integer;abc:real;

function faktorial(k:integer):integer; var p,j:integer;

Begin

p:=1;

for j:= 1 to k do

Begin

p:=p*j;

end;

faktorial:=p;

end;

Begin

writeln('a,b,c');

readln(a,b,c);

abc:=faktorial(a+b+c)/faktorial(a)*faktorial(b)*faktorial(c);

writeln('rez=',abc);

end.

3.Дан массив, элементы, которых являются случайными натуральными числами. Преобразовать данный массив, расположив их элементы в порядке убывания

const n=20;

type mass= array [1..n] of integer;

var x:mass; i,k,m,j:integer;

Begin

for i:=1 to n do

Begin

x[i]:=random (40)-20;

write (x[i],' ');

end;

writeln;

for i:= n downto 2 do

Begin

k:=i;

m:=x[i];

for j:= 1 to i-1 do

if x[j]<m then

Begin

k:=j;

m:=x[k];

end;

if k<>i then

Begin

x[k]:=x[i];

x[i]:=m;

end;

end;

for i:=1 to n do write (x[i],' ');

end.

4.Дано натуральное число n. Какое это число, простое или составное?

program pp;

var n,i:longint;

b:boolean;

Begin

Repeat

write ('Число = ');

readln(n);

until n >0;

b:=false;

for i:=2 to n div 2 do

if n mod i = 0 then

Begin

b:=true;

break;

end;

if (not b) and (n <>1) then writeln ('Простое') else writeln ('Составное');

readln;

end.

boolen –это логический тип, переменные этого типа могут принимать 2 значения true=истина и false=ложь.

5.Дан численный массив M, элементы, которых упорядочены по возрастанию и число a. Не нарушая порядок возрастания элементов включить число a в массив M.

program ptt;

Type

ppt = array [ 1.. 22 ] of integer;

procedure MyInsert(var a:ppt; var n:byte; x:integer);

var i, j:byte;

Begin

i:= 1;

while (i <= n) and (x > a[ i ]) do

inc(i); {или i:= i + 1;}

inc(n); {или n:= n + 1;}

for j:= n downto i + 1 do

a[ j ]:= a[ j - 1 ];

a[ i ]:= x

end;

procedure PrintArray(const a:ppt; const n:byte);

var i:byte;

Begin

for i:= 1 to n do

write(a[ i ]:5);

writeln

end;

Var

a:ppt;

n, i:byte;

Begin

randomize;

n:= 20;

a[ 1 ]:= random(8) - 15;

for i:= 2 to n do

a[ i ]:= a[ i - 1 ] + random(5) + 1;

writeln('Исходныймассив: ');

PrintArray(a, n);

MyInsert(a, n, -5);

writeln('Вставленочисло -5:');

PrintArray(a, n);

MyInsert(a, n, 10);

writeln('Вставленочисло 10:');

PrintArray(a, n);

readln

end.

6.Дана числовая таблица размера n × m. Составить программу, которая обращают в нуль все элементы i -ой строки и j -ого столбца. 0≤i≤n, 0≤j≤m

const nmax=20;

var a: array [1..nmax,1..nmax] of integer;

m,n,i,j:byte;

mn:integer;

Begin

randomize;

Repeat

write('Количествострокдо ',nmax,' m=');

readln(m);

until m in [1..nmax];

Repeat

write('Количество столбцов до ',nmax,' n=');

readln(n);

until n in [1..nmax];

writeln('Исходнаяматрица:');

for i:=1 to m do

Begin

for j:=1 to n do

Begin

write(a[i,j]:3);

end;

writeln;

end;

writeln('Замена элементов строк на минимальный в них');

for i:=1 to m do

Begin

mn:=a[i,1];

for j:=1 to n do

if a[i,j]<mn then mn:=a[i,j];

for j:=1 to n do

Begin

a[i,j]:=mn;

write(a[i,j]:3)

end;

writeln

end;

readln

end.

7.Дана строка, состоящая исключительно из цифр. Найти наибольшее число рядом стоящих одинаковых цифр и определить, какое это число.

const ny: array [boolean] of string[3] = ('No','Yes');

var i, n: integer; b: boolean;

Begin

writeln('Если в числе есть одинаковые цифры то выйдет слово Yes,Если нет то No ');

write('Введите число n = ');

readln(n);

n:= abs(n);

b:= false;

if n >0 then

for i:= 1 to trunc(ln(n) / ln(10)) do

Begin

b:= n mod 10 = n mod 100 div 10;

if b then break;

n:= n div 10

end;

writeln(ny[b]);

readln

end.

8.Дано натуральное число n. Составить программу, которая рисует правильный n -угольник.

 

9.Используя кодирование A ->15, B -> 16, C -> 17, D-> 18, E-> 19, …, Z-> 40 шифруйте любое слово, состоящее из заглавных английских букв.

var s:string;

s1:string;

k,l,i,j:integer;

m: array [1..100] of integer;

Begin

s1:='абвгдеёжзийклмнопрстуфхцчшщъыьэюя';

writeln('Введитебукву');

readln(s);

for i:=1 to 30 do

for j:=1 to 20 do

for k:=1 to 10 do

Begin

m[j]:=k+j*1+i*2;

end;

for i:=1 to length(s) do

for j:=1 to length(s1) do

if s1[j]=s[i] then write(m[j]);

writeln;

readln;

end.

9.Дан численный массив M, количество элементов которого равно n и натуральное число k (k£n). Исключить из массива элемент индекса k.

var a: array [1..100] of integer;

i,k,m,n:integer;

Begin

Randomize;

Write('n=');

Readln(n);

for i:=1 to n do

Begin

a[i]:=random(20)-10;

Write(a[i],' ');

end;

Writeln;

Repeat

Write('k=');

Readln(k);

until k in [1..n];

for i:=1 to n do

if i=k then

m:=1

Else

a[i-m]:=a[i];

n:=n-m;

for i:=1 to n do

Write(a[i],' ');

Readln;

end.

11.Найти все пятизначные числа, цифры которых составляют арифметическую прогрессию. Сколькоих?

Var

a:longint;

d,f:integer;

Begin

Repeat

writeln('Введитечислобольше 9');

readln(a);

until a>9;

d:= (a div 10) mod 10-a mod 10;

Repeat

if (a div 10) mod 10-a mod 10<>d then f:=1;

a:=a div 10;

until a<10;

if f=0 then writeln('yes') else writeln('no');

end.

12.Известно, что одна из корней уравнения лежит в интервале [0,1]. Вычислить этот корень приближенно, с точностью 0,001 методом деления отрезка пополам.

13.Построить график функции в промежутке x [0,10].

 

14.Составить программу, позволяющую выводить каждую букву слова «INFORMATICA» с определенной позиции разным цветом через 1 секунд.

program ppt;

var a,b:real;

Begin

writeln('clovo informatika');

readln(a);

Begin

while not eof(f2) do

Begin

read(f2,b);

or i:=1 to n do

if i=1 then

Begin

TextColor(12);

write(b[i],' ');

End

else if i=1 then

Begin

TextColor(14);

write(b[i],' ');

End

Else

Begin

TextColor(15);

write(b[i],' ');

end;

writeln;

end;

15.Траектория тела, брошенного под углом к горизонту и начальной скоростью (без учета сопротивления воздуха) определяется уравнениями

 

Моделировать траекторию полета и вычислить максимальную дальность и время полета, а также максимальную высоту подъема тела.

16.Вычислить сумму , где n – натуральное, а х – действительное число

17. Составить программу для выведения на экран стандартных символов ASCII-кода в виде таблицы размера 16 х 16

Var

i,j: byte;

Begin

for i:= 0 to 15 do begin

for j:= 0 to 15 do

write (chr(i*16+j):2);

write (chr(i*16+j):2);

writeln

end;

readln

end.

18.Даны действительные числа a, в. Выбирая одну из действии, указанные символами ('+', '-', '*', '/,), показать результат выполнения действия с данными числами.

var n:integer;

var a, b:real;

Begin

Writeln('Введите номер действия и два числа A и B');

Read(n, a, b);

case n of

1:writeln('Ответ: ',a+b);

2:writeln('Ответ: ',a-b);

3:writeln('Ответ: ',a*b);

4:writeln('Ответ: ',a/b);

else writeln('Ошибка');

end;

readln;

end.

19.Составить программу для записи вводимого текста с клавиатуры в текстовый файл «text1.txt», а также и для чтения с этого файла.

Program prr;

var fl:text;

str:string;

Begin

assign (fl, 'rp.txt');

rewrite (fl);

read (str);

write (fl,str);

close(fl);

end.

 

20.Используя тип данных – записи сформировать файл с данными: Ф.И.О., год рождения, специальность, наименование учебной группы студента

Type Anketa= Record

FIO:string[30];

God:byte;

Dolj:string[15];

Staj:integer;

Obraz:string[2];

End;

Var f: file of Anketa;

f1:Anketa;

j,s,n,x:integer;

Procedure Zapol(n:integer);

Var i:integer;

Begin

Assign(f,'anketa.dat');Rewrite(f);

For i:=1 to n do Begin

WitH f1 do Begin

write('ВведитеФ.И.О [',i,']-госотрудника ');readln(FIO);

write('Введите год рождения [',i,']-го сотрудника ');readln(God);

write('Введите должность [',i,']-го сотрудника ');readln(Dolj);

write('Введите Стаж [',i,']-го сотрудника ');readln(Staj);

write('Введите оброзование [',i,']-го сотрудника (sr/vs) ');readln(Obraz);

End;

write(f,f1);

End;

End;

Begin

Repeat

Writeln('1: Заполнениеанкетy');

Writeln('2: Просмотр (Нужно чтобы файл был заполнен) ');

Writeln('3: Выход');

Write('Введите число 1-3: ');readln(x);

Case x of

1: Begin

Write('Введитекол-воучеников ');readln(n);Zapol(n); End;

2: Begin

Assign(f,'Anketa.dat');Reset(f);

s:=0;j:=0;

While not Eof(f) do Begin

Read(f,f1);

With f1 do

if (Obraz='vs') or (Obraz='Vs') tHen Begin s:=s+Staj;inc(j); End;

End;

writeln('Среднее= ',s/j:0:2);

End;

End;

Until x=3;

End.

 

27) Груз на невесомом жестком подвесе длинойL=1 м колебляется с большой амплитудой. Вычислить период колебания, если дано значение начального угла отклонения в градусах. Уравнение колебания:

Program ex_1;

var l,P,t,w,g,f:real;

Begin

t:=0;

w:=0;

g:=10;

f:=0;

p:= (-g/l)*sin(f);

writeln('периодкoлебанияравен',p);

end.

 

28) Шарик массой 5 г и радиусом 4 мм падает в масло с высоты 1,5 м. Сила сопротивления вычисляется по формуле

( скорость).

Найти время падения и конечную скорость шарика, если известно уравнение движения:

Program ex_1;

Var f,n,t,u,nu,m,pi,h,r:real;

Begin

Nu:=0.92;

g:=10; m:=0.005;

pi:=3.14; h:=1.5; r:=0.04;

writeln('введите скорость движения шарика'); readln(u);

f:=6*pi*g*r*nu*u;

t:=(m*u)/(m*g*f);

writeln('t=',t);

end.

 

29.Вывести на экран последовательность чисел и вычислить сумму ряда: 1/2,1/4, 1/6, 1/8, 1/10,...

program pp;

var x,y,a,b:integer;s:real;

Begin

writeln(a,b);

readln(a,b);

x:=1;

y:=2;

s:=0;

while x<=a do begin

s:=s+x/y;

x:=x+3;

y:=y+2;

end;

writeln(s);

end.

30.Составить программу для вычисления наибольшего общего кратного трех данных натуральных чисел a, b и c.

Var a,b,c,d,K,P,T:integer; nok:real;

function nod(x,y:integer; Var z:integer):integer;

Begin

while x<>y do

Begin

if x>y then x:=x-y

else y:=y-x

end;

z:=x

end;

Begin

writeln('enter a,b,c');

readln(a,b,c,d);

nod(a,b,K); nod(c,d,P);

nod(K,P,T);

writeln('nod(a,b,c)=', T);

nok:=(a*b*c)/T;

writeln('NOK=', nok)

end.

 

 

ТЕОРЕТИЧЕСКАЯ ЧАСТЬ ОТЧЕТА