Главная » Контрольные

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.

 

также в рубрике Контрольные, тесты: