Контрольная работа № 21 СИМВОЛЫ И СТРОКИ

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

program junk;

uses crt;

var i:char;

Begin

clrscr;

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

case i of

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

elsewriteln('Согласная')

end;

readln

end.

Пример.

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

а

Гласная

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

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

programpx;

procedurechisla;

vara: integer;

Begin

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

readln(a);

ifa <>0 then

Begin

chisla;

writeln(a);

end;

end;

Begin

chisla;

readln

end.

Пример.

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

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

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

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

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

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

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

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

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

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

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

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

usescrt;

varf: text;

s,sp: string;

j,dmin,ks,ko: byte;

Begin

assign(f,'a.txt');

reset (f); dmin:=255;

while noteof(f) do

Begin

inc(ks);

readln(f,s);

ifs[1]=s[length(s)] theninc(ko);

iflength(s)<dmin thendmin:=length(s);

end;

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

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

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

reset(f);

while noteof(f) do

Begin

readln(f,s);

iflength(s)=dmin thenwriteln(s);

end;

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

reset(f);

ks:=0;

while noteof(f) do

Begin

sp:='';

readln(f,s);

forj:=1 tolength(s) do

Begin

sp:=s[j]+sp;

ifsp=s thenwriteln(s);

end;

end;

ifks=0 thenwriteln('отсутствуют');

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. Найти число, цифры, которых расположены в обратном порядке цифрам данного числа.

Programpp;

varn:longint;

p,s:real;

m,x:integer;

Begin

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

readln(n);

s:=0;

p:=0.1;

forx:=(n mod10) downto1 do

n:=n div10;

p:=p*10;

s:=s+x*p;

writeln(s:0:0);

readln;

end.

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

Programpp;

vara,b,c:integer;abc:real;

functionfaktorial(k:integer):integer;varp,j:integer;

Begin

p:=1;

forj:= 1 tok 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.Дан массив, элементы, которых являются случайными натуральными числами. Преобразовать данный массив, расположив их элементы в порядке убывания

constn=20;

typemass=array[1..n] ofinteger;

varx:mass; i,k,m,j:integer;

Begin

fori:=1 ton do

Begin

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

write (x[i],' ');

end;

writeln;

fori:= n downto2 do

Begin

k:=i;

m:=x[i];

forj:= 1 toi-1 do

ifx[j]<m then

Begin

k:=j;

m:=x[k];

end;

ifk<>i then

Begin

x[k]:=x[i];

x[i]:=m;

end;

end;

fori:=1 ton dowrite (x[i],' ');

end.

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

programpp;

varn,i:longint;

b:boolean;

Begin

Repeat

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

readln(n);

untiln >0;

b:=false;

fori:=2 ton div2 do

ifn modi = 0 then

Begin

b:=true;

break;

end;

if(notb) and(n <>1) thenwriteln ('Простое') elsewriteln ('Составное');

readln;

end.

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

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

programptt;

Type

ppt = array[ 1 .. 22 ] ofinteger;

procedureMyInsert(vara:ppt; varn:byte; x:integer);

vari, j:byte;

Begin

i := 1;

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

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

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

forj := n downtoi + 1 do

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

a[ i ] := x

end;

procedurePrintArray(consta:ppt; constn:byte);

vari:byte;

Begin

fori := 1 ton do

write(a[ i ]:5);

writeln

end;

Var

a:ppt;

n, i:byte;

Begin

randomize;

n := 20;

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

fori := 2 ton 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

constnmax=20;

vara:array[1..nmax,1..nmax] ofinteger;

m,n,i,j:byte;

mn:integer;

Begin

randomize;

Repeat

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

readln(m);

untilm in[1..nmax];

Repeat

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

readln(n);

untiln in[1..nmax];

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

fori:=1 tom do

Begin

forj:=1 ton do

Begin

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

end;

writeln;

end;

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

fori:=1 tom do

Begin

mn:=a[i,1];

forj:=1 ton do

ifa[i,j]<mn thenmn:=a[i,j];

forj:=1 ton do

Begin

a[i,j]:=mn;

write(a[i,j]:3)

end;

writeln

end;

readln

end.

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

constny: array[boolean] ofstring[3] = ('No','Yes');

vari, n: integer; b: boolean;

Begin

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

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

readln(n);

n := abs(n);

b := false;

ifn >0 then

fori := 1 totrunc(ln(n) / ln(10)) do

Begin

b := n mod10 = n mod100 div10;

ifb then break;

n := n div10

end;

writeln(ny[b]);

readln

end.

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

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

vars:string;

s1:string;

k,l,i,j:integer;

m:array[1..100] ofinteger;

Begin

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

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

readln(s);

fori:=1 to30 do

forj:=1 to20 do

fork:=1 to10 do

Begin

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

end;

fori:=1 tolength(s) do

forj:=1 tolength(s1) do

ifs1[j]=s[i] thenwrite(m[j]);

writeln;

readln;

end.

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

vara:array[1..100] ofinteger;

i,k,m,n:integer;

Begin

Randomize;

Write('n=');

Readln(n);

fori:=1 ton do

Begin

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

Write(a[i],' ');

end;

Writeln;

Repeat

Write('k=');

Readln(k);

untilk in[1..n];

fori:=1 ton do

ifi=k then

m:=1

Else

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

n:=n-m;

fori:=1 ton do

Write(a[i],' ');

Readln;

end.

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

Var

a:longint;

d,f:integer;

Begin

Repeat

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

readln(a);

untila>9;

d:= (a div10)mod10-a mod10;

Repeat

if(a div10)mod10-a mod10<>d thenf:=1;

a:=a div10;

untila<10;

iff=0 thenwriteln('yes')elsewriteln('no');

end.

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

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

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

programppt;

vara,b:real;

Begin

writeln('clovo informatika');

readln(a);

Begin

while noteof(f2)do

Begin

read(f2,b);

ori:=1 ton do

ifi=1 then

Begin

TextColor(12);

write(b[i],' ');

End

else ifi=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

fori := 0 to15 do begin

forj := 0 to15 do

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

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

writeln

end;

readln

end.

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

varn:integer;

vara, b:real;

Begin

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

Read(n, a, b);

casen of

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

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

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

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

elsewriteln('Ошибка');

end;

readln;

end.

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

Programprr;

varfl:text;

str:string;

Begin

assign (fl, 'rp.txt');

rewrite (fl);

read (str);

write (fl,str);

close(fl);

end.

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

TypeAnketa=Record

FIO:string[30];

God:byte;

Dolj:string[15];

Staj:integer;

Obraz:string[2];

End;

Varf:file ofAnketa;

f1:Anketa;

j,s,n,x:integer;

ProcedureZapol(n:integer);

Vari:integer;

Begin

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

Fori:=1 ton do Begin

WitHf1 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);

Casex of

1:Begin

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

2:Begin

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

s:=0;j:=0;

While notEof(f) do Begin

Read(f,f1);

Withf1 do

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

End;

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

End;

End;

Untilx=3;

End.

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

Programex_1;

varl,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 м. Сила сопротивления вычисляется по формуле

( скорость).

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

Programex_1;

Varf,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, ...

programpp;

varx,y,a,b:integer;s:real;

Begin

writeln(a,b);

readln(a,b);

x:=1;

y:=2;

s:=0;

whilex<=a do begin

s:=s+x/y;

x:=x+3;

y:=y+2;

end;

writeln(s);

end.

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

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

functionnod(x,y:integer; Varz:integer):integer;

Begin

whilex<>y do

Begin

ifx>y thenx:=x-y

elsey:=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.

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