Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

КР ТЕХНОЛОГИИ ПРОГРАММИРОВАНИЯ

.docx
Скачиваний:
11
Добавлен:
12.04.2015
Размер:
29.01 Кб
Скачать

МИНИСТЕРСТВО ОБРАЗОВАНИЯ И НАУКИ РФ

Государственное образовательное учреждение высшего профессионального образования

«Юго-Западный государственный университет»

(ЮЗГУ)

Кафедра «Вычислительная техника»

Контрольная работа

По дисциплине «Технологии программирования»

Выполнил: студент группы ВМ-02ф

Нарыков А.С.

Проверил:

Курск-2011

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.