Pascal. Контрольная работа Технологии программирования
Задачи Pascal
1. type myfile = file of char;
Опишите процедуру delete (f), удаляющую из файла f все
литеры '+' и '-'.
program zadanie1; uses crt; type myfile = file of char; var s:string; f,f2:text; n,i:integer; Procedure delete; begin assign(f2,'file2.txt'); rewrite(f2); reset(f); while not eof(f) do begin readln(f,s); for i:=1 to length(s) do if (s[i]='+') or (s[i]='-')then delete(s,i,1); writeln(f2,s); end; close(f2); readkey; end; begin clrscr; writeln('vvedite kol-vo strok'); readln(n); assign(f,'file.txt'); rewrite(f); for i:=1 to n do begin writeln('vvedite ',i,' stroku'); readln(s); writeln(f,s); end; delete; close(f); end.
2. Файл f
содержит записи следующей структуры:
- имя студента;
- пол;
- рост;
- оценки по трем экзаменам.
Написать функцию TASK_3_1 (f), проверяющую, есть ли среди девушек круглые отличницы
program zadanie2; uses crt; const n=3; {количество студентов 3-это для проверки программы, возьмешь больше} type f=record {тип запись с полями} fam:string[15]; {фамилия} pol:string; oc:array[1..5]of byte;{массив оценок} sr:real;{средний балл} end; var sp:array[1..n] of f;{массив записей-список студентов} i,j,k:integer; Function TASK:integer; var k : integer; begin readln; writeln('Krugliy oylichnik:'); k :=0; for i:=1 to n do if ((sp[i].sr=5) and ((sp[i].pol='ж') or (sp[i].pol='Ж') or (sp[i].pol='д') or (sp[i].pol='Д'))) then begin k:=K+1; writeln(sp[i].fam); end;{если ср. балл=5, круглый отличник} Task :=K; end; begin clrscr; for i:=1 to n do begin writeln('Student ',i); {вводим данные} write('Familia: ');readln(sp[i].fam); write('Pol(М/Ж): '); {РУССКИЕ БУКВЫ вводить надо либо в условии что выше заменить их на латинские} readln(sp[i].pol); sp[i].sr:=0; for j:=1 to 5 do begin repeat write('Ocenka ',j,'='); readln(sp[i].oc[j]); until sp[i].oc[j] in [2..5]; sp[i].sr:=sp[i].sr+sp[i].oc[j]; end; sp[i].sr:=sp[i].sr/5;{считаем и запоминаем средний балл} end; clrscr; writeln('Spisok studentov:');{посмотрим весь список} for i:=1 to n do begin write(sp[i].fam,' '); write(sp[i].pol,' '); for j:=1 to 5 do write(sp[i].oc[j],' '); write('sr ball=',sp[i].sr:0:2); writeln; end; begin If TASK=0 then WriteLn('Среди девушек нет отличниц'); readln; end; end.
3. Задан текстовый файл 'a.txt'. Написать программу, которая меняет местами в словах, являющимися вещественными числами, целую и дробную часть.
Program zadanie3; uses crt; var f: text; s,ch : string; p:integer; begin assign(f,'Z6.txt'); rewrite(f); clrscr; readln(s); p:=pos('.', s); ch:=copy(s, p+1, length(s)); ch:=ch+'.'+copy(s, 0, p-1); writeln(ch); close(f); readkey; end.
4. Описать процедуру, которая меняет местами первый и последний элементы списка L.
type te = integer; sp = ^el; el = record d :te; n :sp; end; var L : sp; E : te;
program zadanie4; uses crt; type te = integer; sp=^el; el=record te:integer; d:te; n:sp end; var l:sp; procedure createList(var d:sp;c:integer); var b:sp; begin while c>0 do begin new(b); b^.te:=random(20); b^.n:=d; d:=b; dec(c); end; end; procedure outputList(b:sp); begin while b<>nil do begin write(b^.te:4); b:=b^.n; end; end; procedure modifyList(var b:sp); var c:sp; e:te; begin c:=b; {ищем конец списка} while c^.n^.n<>nil do c:=c^.n; {закольцовываем его исключая первый элемент} c^.n^.n:=b^.n; {устанавливаем первый элемент перед последним} b^.n:=c^.n; {переключаем связи} c^.n:=b; {сохраняем голову списка и разрываем кольцо} b:=b^.n; c^.n^.n:=nil; end; procedure deleteList(var b:sp); var c:sp; begin repeat c:=b; b:=b^.n; dispose(c); until b=nil; end; begin {создаем список} l:=nil; createList(l,10); {выводим исходный список} outputList(l); writeln; {изменяем список} modifyList(l); {выводим результат и освобождаем память} outputList(l); deleteList(l); readln; end.
5. Описать процедуру, которая создает новый список, в котором все элементы списка L расположены в обратном порядке.
type te = integer; sp = ^el; el = record d :te; n :sp; end; var L : sp; E : te;
program zadanie4var7; uses Crt; const n = 10; {количество элементов в списке,можно поменять на большее} type //te = integer; sp = ^el; el = record te :integer; n :sp; end; var L : sp; E,t : sp; procedure InputData; {процедура ввода массива случайными числами} var i: integer; begin New(t); t^.n:=nil; t^.te:=random(100); l:=t; e:=t; for i:=1 to n do begin New(t^.n); t:=t^.n; t^.n:=nil; t^.te:=random(100); e:=t; end; end; procedure OutputData; {процедура вывода массива} begin t:=l; while t <> nil do begin write(t^.te,' '); t:=t^.n; end; end; Procedure povorot(var p:sp); {процедура обратного порядка} begin if p^.n<>nil then begin povorot(p^.n); p^.n^.n:=p; end; end; begin ClrScr; Randomize; {заполняем случайным порядком} InputData; {вызаваем процедуру ввода массива} OutputData; {вызываем процедуру вывода массива} povorot(l); {вызываем процедуру обратного порядка} l^.n:=nil; t:=l; l:=e; e:=t; writeln; OutputData; readkey; end.