Файл: Методическое пособие 2013 Корректор Осипова Е. А.pdf

51
function neg(var s : series) : real; var sum,x : real; begin reset(s); sum:=0; while not eof(s) do begin read(s,x); if x<0 then sum:=sum+x end; neg:=sum ; close(s) end; begin assign (f,'proba.txt'); rewrite(f); repeat write('Введите число (0 – конец ввода)– '); readln(y); write(f,y); until (y=0); close (f); n:=neg(f); writeln('Сумма отрицательных элементов файла n= ',n:10:3); close(f); end.
Задача 3.2. type row=file of 0..999;
Описать логическую функцию sort(r), проверяющую, упорядочены ли
по возрастанию элементы непустого файла r типа row.
type row1 = 0..999;
row = file of row1;
var r : row; x,y : row1; i,k : integer; function sort(var r : row) : boolean; var x,y : row1; ok : boolean; begin reset(r); read(r,y); ok:=true; while not eof(r) and ok do begin x:=y; read(r,y); ok:=x

52
begin write('Введите количество элементов файла'); readln(k); assign(r,'12.dat'); rewrite(r); for i:= 1 to k do begin writeln('Введите ',i,'-ый элемент файла'); read(x); write(r,x); end; close(r); if sort(r) then writeln('Упорядочены по возрастанию') else writeln('Не упорядочены по возрастанию'); end.
Задача 3.3. type reals=file of real;
Описать функцию less(f) от непустого файла f типа reals, которая
подсчитывает количество элементов файла f, меньших среднего арифме-
тического всех элементов этого файла.
type reals = file of real; var f1 : reals; a : real;l,i : integer; function less(var f : reals) : integer; var k : integer; x,s : real; begin {подсчет среднего арифметического:} reset(f); k:=0; s:=0; repeat read(f,x); k:=k+1; s:=s+x until eof(f); s:=s/k;
{новый просмотр f и подсчет элементов

53
rewrite(f1); for i:=1 to 10 do begin readln(a); write(f1,a); end; l:=less(f1); close(f1); writeln('l=', l); end.
Рекурсия
Задача 3.4. Использовать рекурсию для нахождения цифрового кор-
ня целого числа.
Цифровой корень находится суммой через сумму цифр числа до тех
пор, пока эта сумма сама не станет цифрой. Например, для числа
9999999 цифровой корень находится так:
9+9+9+9+9+9+9 = 63;
6+3 = 9.
Цифровой корень 9999999 равен девяти.
Переменные: а) в функции num: n — целое число (глобальная переменная); s — вспомогательная переменная (локальная переменная); б) в функции root: n — целое число (глобальная переменная); в) в основной программе: n — целое число (глобальная переменная).
Алгоритм решения задачи:
1)
создаем описание функций num и root;
2)
вводим целое число n;
3)
вызываем рекурсивную функцию root и определяем цифровой ко- рень числа n;
4)
завершаем работу программы. var n:longint; function num(i:longint):integer; var s: integer; begin s:=0; repeat s:=s+n mod 10; n:= n div 10; until n=0;

54
num:=s; end; function root(l:longint):integer; begin if n<10 then root:=n else begin n:=num(n); root:=root(n); end; end; begin write('Введите целое число n='); readln(n); writeln('Его цифровой корень равен : ', root(n)); end.
Задача 3.5. Напишите рекурсивную программу вычисления суммы
n
2
i 2
i i 5
=
+ +
∑
var n : integer; function sum(i : integer) : real; begin if i=1 then sum:=0 else sum:=sum(i–1)+i*i+i+5; end; begin writeln('Введите n'); readln(n); writeln('Значение суммы равно – ', sum(n)); end.

55
Варианты
заданий
лабраторной
работы
№
3
Вариант 1
Задача 1 type ряд = file of integer;
Описать процедуру p(f,g) от двух файлов типа ряд, которая в пустой файл f переписывает положительные элементы файла g.
Указание: введите файл g (последний элемент равен 0). Вы- полните процедуру p(f,g). Распечатайте файл f.
Задача 2
Напишите рекурсивную подпрограмму, которая печатает в обратном порядке заданную строку.
Вариант 2
Задача 1 type fr = file of real;
Описать процедуру predlast(f), значением которой является предпоследний элемент файла f, имеющего тип fr и содер- жащего не менее двух элементов.
Указание: введите файл f (последний элемент = 0) и вычис- лите функцию predlast(f).
Задача 2 type reals = file of real; var f : reals;
Опишите рекурсивную функцию sum без параметров для нахождения суммы элементов файла f.
Вариант 3
Задача 1 type rad = file of integer;
Описать процедуру p(f,g) от двух файлов типа rаd, которая из файла f переписывает в пустой файл g сначала все положи- тельные числа, а потом все отрицательные.
Указание: введите файл f (последний элемент равен 0). Вы- полните процедуру p(f,g). Распечатайте файл g.
Задача 2
Описать рекурсивную функцию letter (s), которая подсчиты- вает количество букв в строке s.
Вариант 4
Задача 1 type seria = file of integer;
Описать функцию prod(s) с вещественным значением, под- считывающую произведение ненулевых элементов файла s.
Указание: введите файл s (последний элемент равен 0) и на- печатайте значение функции prod(s).

56
Задача 2
Напишите рекурсивную программу, которая n раз выводит на экран текст истории о попе и его собаке (рассказ в расска- зе).
Вариант 5
Задача 1 type seria = file of integer; var s:seria;
Описать функцию max(s), вычисляющую значение макси- мального элемента файла s.
Указание: введите файл s (последний элемент равен 0) и на- печатайте значение функции max(s).
Задача 2
Во входном файле задана непустая последовательность по- ложительных вещественных чисел, за которой следует отри- цательное число. Описать рекурсивную функцию sum без параметров для нахождения суммы этих положительных чи- сел.
Вариант 6
Задача 1
Описать логическую функцию check(s) для текстового файла s, проверяющую, содержит ли файл s латинские буквы.
Указание: введите файл s (последний элемент в файле '.') и вычислите значение функции check(s).
Задача 2 type reals = file of real; var f : reals;
Напишите рекурсивную программу, которая печатает снача- ла все отрицательные элементы этого файла, а затем положи- тельные (в любом порядке).
Вариант 7
Задача 1
Для файла s, состоящего из целых чисел, определите проце- дуру, которая находит значения максимального и минималь- ного элементов файла s.
Указание: введите файл s (последний элемент равен 0) и на- печатайте значения максимального и минимального элемен- тов файла s.
Задача 2 const n=...; type vector = array [1..n] of real;
Описать функцию min (x) для определения минимального

57
элемента вектора x, введя вспомогательную рекурсивную функцию min1 (k), находящую минимум среди последних элементов вектора x, начиная с k-го.
Указание: пусть min(x) — функция, которая вычисляет ми- нимум среди элементов массива x, а min1(k) — функция, ко- торая вычисляет минимум среди элементов x k
, x k+1
, …, x n
массива x (для этой функции массив x есть глобальная пере- менная, определенная в главной программе).
Имеем равенство min(x) = min1(1).
Определим функцию min1(k) рекурсивно:
1)
если k=n, то функция возвращает результат x n
;
2)
если k и min1(k+1) (второе число получается при рекурсив- ном вызове).
Вариант 8
Задача 1 type rad = file of 1..maxint;
Описать процедуру prim(f,n), записывающую в файл f все простые числа 2,3,5,7,11,13,17..., не превосходящие целого положительного числа n.
Указание: введите n. Выполните процедуру prim(f,n). Распе- чатайте файл f.
Задача 2
Описать рекурсивную функцию sign (s), которая подсчиты- вает количество знаков препинания в строке s (знаки: '.' , ',' ,
';' , ':').
Вариант 9
Задача 1 type ряд = file of integer;
Описать процедуру append(f,g,h) от трех файлов типа ряд, которая записывает в файл f сначала все элементы файла g, а затем все элементы файла h.
Указание: введите два файла g и h. Выполните процедуру append(f,g,h). Напечатайте файл f.
Задача 2
Дан массив a : array [1..n] of integer;
Напишите рекурсивную программу для вычисления суммы n
i 1 1/ a[ i ]
=
∑
Указание:
Пусть функция f(k) вычисляет сумму 1/a[1]+1/a[2]+…+1/a[k].

58
Нам надо вычислить f(n).
Определим f(k) рекурсивно:
1)
если k=1, то f(k)=1/a[1];
2)
если k>1, то значение функции равно сумме 1/a[k] и f(k–1).
Вариант 10 Задача 1
Type fr = file of real;
Описать функцию s3(f), значением которой является сумма последних трех элементов файла f, имеющего тип fr и со- держащего не менее 3 элементов.
Указание: введите файл f (последний элемент = 0) и вычис- лите функцию s3(f).
Задача 2 type reals = file of real; var f : reals;
Опишите рекурсивную функцию sum (n) для нахождения суммы n
i 1
(a[ i ])
=
∑
, где a[ i ] — элемент файла f.
Указание.
Пусть функция f(k) вычисляет сумму a[1]
n
+a[2]
n
+…+a[k]
n
Нам надо вычислить f(n).
Определим f(k) рекурсивно:
1)
если k=1, то f(k)=a[1]
n
;
2)
если k>1, то значение функции равно сумме a[k]
n и f(k–1).
Вариант 11 Задача 1 type seria = file of integer; var s:seria;
Описать функцию poz(s), подсчитывающую количество по- ложительных чисел в файле s.
Указание: введите файл s (последний элемент равен 0) и на- печатайте значение функции poz(s).
Задача 2
Напишите рекурсивную программу для вычисления суммы n
2
i 1 1/( i)
=
∑
Указания.
Пусть функция f(k) вычисляет сумму a[1]+a[2]+…a[k].
Нам надо вычислить f(n).
Определим f(k) рекурсивно:

59 1)
если k=1, то f(k)=a[1];
2)
если k>1, то значение функции равно сумме a[k] и f(k–1).
Вариант 12 Задача 1
Описать процедуру letter(s,t), которая записывает в тексто- вый файл t все латинские буквы из строки s.
Указание: введите строку s. Выполните процедуру letter(s,t) и распечатайте элементы файла t.
Задача 2
Функция f (n) определена для целых положительных чисел следующим образом: n
i 2 1,
если n 1;
f (n)
f (n div i),
если n
2.
=
=
⎧
⎪
= ⎨
≥
⎪⎩
∑
Вычислить f (k) для k=15, 16,..., 30.
Вариант 13 Задача 1 type reals = file of real;
Описать процедуру p(f,g,h) от трех файлов типа reals, которая переписывает из файла f в непустой файл g все элементы, меньшие среднего арифметического всех элементов файла f, и в непустой файл h записывает все остальные числа.
Указание: введите файл f (последний элемент = 0). Выполни- те процедуру p(f,g,h). Распечатайте файлы g и h.
Задача 2
Напишите рекурсивную программу для вычисления суммы n
i 2 1
( i 1) * i * ( i 1)
=
+
−
∑
Указание:
Пусть функция f(k) вычисляет сумму a[1]+a[2]+…a[k].
Нам надо вычислить f(n).
Определим f(k) рекурсивно:
1)
если k=1, то f(k)=a[1];
2)
если k>1, то значение функции равно сумме a[k] и f(k–1).
Вариант 14 Задача 1
Дан текстовый файл, в котором строки содержат как латин- ские буквы, так и цифры. Необходимо создать другой тек- стовый файл, содержащий строки из первого, преобразован- ные по следующему принципу: в начале строки расположены все буквы исходной строки, а затем все цифры (в том же по- рядке).
Описать процедуру letter(s,t), которая записывает в тексто-

60
вый файл t сначала все латинские буквы из строки s, а затем все цифры.
Указание: введите исходный файл. Выполните процедуру letter(s,t) и распечатайте элементы файла t.
Задача 2
Дан массив a : array [1..n] of integer;
Напишите рекурсивную программу для вычисления произ- ведения n
i 1
a[i ]
=
∏
Указание.
Пусть функция f(k) вычисляет произведение a[1]*a[2]*…a[k].
Нам надо вычислить f(n).
Определим f(k) рекурсивно:
3)
если k=1, то f(k)=a[1];
4)
если k>1, то значение функции равно произведению a[k] и f(k–1).
Вариант 15 Задача 1 type seria = file of integer; var s:seria;
Описать функцию poz(s, n), подсчитывающую количество положительных и отрицательных чисел в файле s.
Указание: введите файл s (последний элемент равен 0) и на- печатайте значение функции poz(s, n).
Задача 2
Описать рекурсивную функцию digits (s), которая подсчиты- вает сумму цифр в строке s.

61
ЛАБОРАТОРНАЯ
РАБОТА
№
4
Лабораторная работа № 4 состоит из двух задач. Первая задача по- священа созданию программ, отражающих приемы работы со списками.
Второе задание посвящено созданию программ в графическом режиме.
В ходе выполнения лабораторной работы № 4 требуется составить программы на языке Паскаль.
Примеры
решения
задач
Списки
Задача 4.1. type telem='a'..'z'.
list=^node;
node= record
info:telem;
next:list
end;
Пусть E1 и E2 — данные типа telem.
Описать функцию или процедуру, которая :
а) заменяет в списке L все вхождения Е1 и Е2;
б) проверяет, упорядочены ли элементы списка L по алфавиту
а) type telem='a'..'z'; list=^node; node= record info : telem; next : list end; var s,l : list; x,e,e1 : telem; n,i : integer; procedure change (l : list; e,e1: telem); var p:list; {ссылка на очерeдное звено} begin p:=L; while p<>nil do begin if p^.info=e then p^.info:=e1; p:=p^.next {переход к следующему звену} end; end;

62
procedure out_spisok(l : list); {выводит список на экран} begin while l<> nil do begin s:=l^.next; write(l^.info,' '); l:=s; end; writeln; end; begin
{формируем список} s:=nil; writeln('Введите количесто элементов списка'); readln(n); for i:=1 to n do begin new(l); l^.next:=s; readln(x); l^.info:=x; s:=l; end;
{выводим список на экран} writeln('Введенный список'); out_spisok(l);
{заменяем элемент Е на Е1} writeln('Введите элемент, который Вы хотите заменить'); readln(e); writeln('Введите элемент, на который Вы хотите заменить'); readln(e1); change (l,e,e1); writeln('Полученный список'); out_spisok(l);
{освобождаем динамическую память} while l<> nil do begin s:=l^.next; dispose(l); l:=s; end; end.

63
б) type telem='a'..'z'; list=^node; node= record info : telem; next : list end; var s,l : list; x : telem; n,i : integer; function sort(l : list) : boolean; var p,q : list; {ссылка на пару соседних звеньев} ok : boolean; begin ok:=true; p:=L; {nil или ссылка на 1-звено} if p<>nil then begin q:=p^.next; {nil или ссылка на 2-е звено} while (q<>nil) and ok do begin ok:=p^.info<=q^.info; p:=q; q:=q^.next {переход к след. паре} end end; sort:=ok end; procedure out_spisok(l:list); begin while l<> nil do begin s:=l^.next; write(l^.info,' '); l:=s; end; writeln; end; begin
{формируем список} s:=nil; writeln('Введите количесто элементов списка');

64
readln(n); for i:=1 to n do begin new(l); l^.next:=s; readln(x); l^.info:=x; s:=l; end;
{выводим список на экран} writeln('Введенный список'); out_spisok(l); if sort(l) then writeln('Список отсортирован по алфавиту') else writeln('Список не отсортирован по алфавиту');
{освобождаем динамическую память} while l<> nil do begin s:=l^.next; dispose(l); l:=s; end; end.
Задача 4.2. type telem=...;
list=^node;
node=record
info : telem;
next : list
end;
Описать процедуру, которая вставляет в список L новый элемент Е1
перед первым вхождением элемента Е, если Е входит в L;
type telem=0..999; list=^node; node= record info : telem; next : list end; var s,l : list; x,e,e1 : telem; n,i : integer; procedure insert( l : list; e,e1 : telem);

65
var p,q : list; eq : boolean; begin { поиск звена с Е:} p:=L; eq:=false; while (p<>nil) and not eq do if p^.info=e then eq:=true else p:=p^.next; if eq then { вставка Е1 перед Е} begin {внимание-трюк: запись Е1 в звено p вместо Е и вставка Е за звеном p:} p^.info:=e1; new(q); q^.info:=e; q^.next:=p^.next; p^.next:=q end; end; procedure out_spisok(l : list); begin while l<> nil do begin s:=l^.next; write(l^.info,' '); l:=s; end; writeln; end; begin
{формируем список} s:=nil; writeln('Введите количесто элементов списка'); readln(n); for i:=1 to n do begin new(l); l^.next:=s; readln(x); l^.info:=x; s:=l; end;
{выводим список на экран} writeln('Введенный список'); out_spisok(l); writeln('Введите элемент, перед которым Вы хотите вставить число'); readln(e);