2 Способ

Program Problem1a; { Обработка массивов с помощью файлов }

uses WinCrt; { пузырьковая сортировка }

const

name = 'd:\Bp\prakt\p23\array1.dat';

name1 = 'd:\Bp\Prakt\p23\array1.int';

n = 100;

type

v = file of integer;

t = array[1..n] of integer;

var

f, f1 : v;

a : t;

i : integer;

{---------------------------------------------------------------------------------------}

{Процедура, читающая элементы из файла f, сортирующая

элементы методом "пузыря" и записывающая отсортированный

массив в новый файл array1.int}

Procedure bubble(n : integer; var f1 : v);

var

i, j, p : integer;

begin

assign(f, name); {доступ к файлу f}

assign(f1, name1); {доступ к файлу f1}

create(n, a, f);

{$i-}

reset(f); {открытие файла f для чтения}

{$i+}

if ioresult <> 0 then writeln('Такой файл не существует');

rewrite(f1); {открытие файла f1 для записи}

{$i+}

if ioresult <> 0 then writeln('Такой файл не существует');

for i := 1 to n do read(f, a[i]); {чтение из файла f}

for i := 2 to n do

for j := n downto i do

if a[j] < a[j - 1] then

begin

p := a[j];

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

a[j - 1] := p

end;

for i := 1 to n do write(f1, a[i]); {запись отсортированного

массива в файл f1 }

close(f); close(f1) { закрытие файла f, закрытие файла f1 }

end;

{----------------------------------------------------------------------------------------}

{Основная программа, вызывающая отсортированные элементы

begin

assign(f1, name1); { доступ к файлу f1 }

bubble(n, f1); { вызов процедуры сортировки }

{$i-}

reset(f1); { Открытие файла f1 для чтения }

{$i+}

if ioresult <> 0 then writeln('Такой файл не существует');

writeln('Отсортированный по не убыванию массив');

for i := 1 to n do

begin

read(f1, a[i]); { Чтение элементов массива из файла f1 }

write(a[i], ' ') { Вывод их на экран }

end;

writeln;

close(f1) {Закрытие файла f1}

end.

Задача 2. Создать файл f, содержащий числа 1, 2, 3, 4, 5. Необходимо вместо последних трех элементов файла f записать числа 30, 40, 50.

Решение

Program Problem2;

uses WinCrt;

var

name : string;

f : file of integer;

x, i : integer;

begin

write('Введите имя файла '); readln(name);

assign(f, name);

rewrite(f);

for i := 1 to 5 do write(f, i);

reset(f);

for i := 3 to 5 do

begin

seek(f, i - 1); read(f, x);

x := 10*i;

seek(f, i - 1);

write(f, x)

end;

writeln('Содержимое файла f');

reset(f);

while not eof(f) do

begin

read(f, x);

write(x, ' ')

end;

close(f);

end.

Задача 3. Компонентами файла f являются действительные числа. Найти:

а) сумму компонент;

б) произведение компонент;

в) сумму квадратов компонент;

г) модуль суммы и квадрат произведения компонент;

д) последнюю компоненту файла.

Решение

Program Problem3; { Обработка компонентов файла }

uses WinCrt;

const

name = 'd:\Bp\Prakt\P23\array3.dat';

type

v = file of real;

var

f : v;

a, s, sk, p : real;

i : integer;

{----------------------------------------------------------------------------------------}

{Открытие файла f, соответствующего на диске файлу arra3.dat

и процедура заполнения его действительными числами}

Procedure create(var f : v);

var

i, n : integer;

a : real;

begin

assign(f, name); { доступ к файлу f }

{$i-}

rewrite(f); { открытие его для записи }

{$i+}

if ioresult <> 0 then writeln('Такой файл не существует');

write('Введите число элементов '); readln(n);

for i := 1 to n do

begin

write('Введите ', i, '-й элемент '); readln(a);

write(f, a) { запись элементов массива в файл f }

end;

close(f); { закрытие файла f }

end;

{----------------------------------------------------------------------------------------}

begin

create(f);

assign(f, name); {доступ к файлу f}

{$i-}

reset(f); {Открытие файла f для чтения}

{$i+}

if ioresult <> 0 then writeln('Такой файл не существует');

s := 0; p := 1; sk := 0;

while not eof(f) do

begin

read(f, a); { Чтение элементов массива из файла f }

s := s + a; p := p*a;

sk := sk + a*a;

end;

writeln('Сумма компонент файла равна ', s:6:4);

writeln('Произведение компонент файла ', p:6:4);

writeln('Сумма квадратов компонент ', sk:12:4);

write('Модуль суммы и квадрат произведения компонент ');

writeln(abs(s):6:4, ' ', p*p:10:4);

seek(f, FileSize(f) - 1); read(f, a);

writeln('Последний компонент файла ', a:6:4);

close(f) { Закрытие файла f }

end.

Задача 4. Дан файл f, компонентами которого являются целочисленные массивы Каждый массив преобразовать в квадратную матрицу размера

а) б)

записать в файл g.

Решение

Program Problem4;

uses WinCrt;

const

n = 7;

name = 'd:\Bp\Prakt\P23\arr20a.dat';

name1 = 'd:\Bp\Prakt\P23\matr20wa.dat';

type

t = array[1..n] of integer;

s = array[1..n] of longint;

m = array[1..n] of s;

v = file of t;

vv = file of m;

var

x : t; p : s;

a : m; f : v;

g : vv;

n1, i, j, d, k : integer;

begin

assign(f, name); assign(g, name1);

rewrite(f);

write('Введите число массивов чисел '); readln(n1);

randomize;

for i := 1 to n1 do

begin

for j := 1 to n do x[j] := random(21) - 10;

write(f, x)

end;

reset(f);

writeln('Заданные массивы целых чисел');

while not eof(f) do

begin

read(f, x);

for i := 1 to n do write(x[i]:3, ' ');

writeln

end; writeln;

reset(f);

{$i+}

if IoResult <> 0 then writeln('Такого файла нет');

rewrite(g);

for k := 1 to n1 do

begin

read(f, x);

for d := 1 to n do p[d] := 1;

for j := 1 to n do

for i := 1 to n do

begin

p[i] := x[i]*p[i];

a[j, i] := p[i]

end;

write(g, a)

end;

writeln('Полученные матрицы из заданного массива');

reset(g);

while not eof(g) do

begin

read(g, a);

for i := 1 to n do

begin

for j := 1 to n do write(a[i, j]:10, ' ');

writeln

end; writeln

end;

close(f); close(g)

end.

Задача 5. Дан файл, компонентами которого является массив из действительных чисел Записать в файл следующую матрицу:

Решение

Алгоритм составления программы будет таким:

1. Процедура ввода коэффициентов.

2. Процедура создания элементов массива - таблицы.

3. Процедура записи в файл.

4. Процедура чтения из файла.

Program Problem5;

uses WinCrt;

Const

nn = 20;

name = 'd:\Bp\Prakt\P21\file5.dat';

Type

s = array[0..nn] of real;

t = array[0..nn] of s;

v = file of real;

var

a : s; b : t; f : v;

n : integer;

{----------------------------------------------------------------------------------------}

Procedure Input(n : integer; var a : s);

var

i : integer;

begin

for i := 0 to n do

begin

write('Введите коэффициент при переменной ', n - i);

write('-й степени '); readln(a[i])

end

end;

{----------------------------------------------------------------------------------------}

Procedure Square(n : integer; a : s; var b : t);

var

k, i, j, p, q : integer;

begin

k := 0;

for i := 0 to n do b[i, 0] := a[i]*a[i];

for j := 1 to (n div 2) do

begin

k := k + 1; p := 2*j;

for i := 1 to n - k do

begin

if k mod 2 <> 0 then q := -1 else q := 1;

b[i, j] := q*2*a[i - k]*a[i - k + p]

end

end

end;

{----------------------------------------------------------------------------------------}

Procedure Write_file(n : integer; var f : v);

var

k, i, j : integer;

begin

Assign(f, name); rewrite(f);

k := 0;

for j := 0 to (n div 2) do

begin

for i := 0 to n - k do write(f, b[i, j]);

k := k + 1;

writeln

end;

Close(f)

end;

{----------------------------------------------------------------------------------------}

Procedure Read_file(n : integer; var f : v);

var

k, i, j : integer;

begin

Assign(f, name); reset(f);

while not eof(f) do

begin

k := 0;

for j := 0 to (n div 2) do

begin

for i := 0 to n - k do

begin

read(f, b[i, j]);

write(b[i, j]:3:3, ' ':4)

end;

k := k + 1;

writeln

end

end;

Close(f)

end;

{----------------------------------------------------------------------------------------}

begin

write('Введите наивысшую степень многочлена '); readln(n);

Input(n, a);

Square(n, a, b);

Write_file(n, f);

Read_file(n, f)

end.

Program Problem5a;

uses WinCrt;

Const

nn = 20;

name = 'd:\Bp\Prakt\P21\file5.dat';

Type

s = array[0..nn] of real;

t = array[0..nn] of s;

v = file of real;

var

b : t;

f : v;

n : integer;

{----------------------------------------------------------------------------------------}

Procedure Read_file(n : integer; var f : v);

var

k, i, j : integer;

begin

Assign(f, name);

reset(f);

while not eof(f) do

begin

k := 0;

for j := 0 to (n div 2) do

begin

for i := 0 to n - k do

begin

read(f, b[i, j]);

write(b[i, j]:3:3, ' ':4)

end;

k := k + 1;

writeln

end

end;

Close(f)

end;

{----------------------------------------------------------------------------------------}

begin

write('Введите наивысшую степень многочлена '); readln(n);

Read_file(n, f)

end.