Глава 3 Более сложные элементы языка
____________________________________________________________________
3-го параметра процедуры записи/чтения} BlockWrite(matrix, temp, SizeOf(real));
end;
writeln(UTF8ToConsole('Информация на диск записана')); CloseFile(matrix);
writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;
end.
Программа решения системы линейных алгебраических уравнений мето-
дом Гаусса, коэффициенты расширенной матрицы вводятся из нетипизирован-
ного файла:
program Gauss_File; {$mode objfpc}{$H+} uses
CRT, FileUtil; var
matrix: File;
a:array of array of real; {матрица коэффициентов системы, двумерный динамический массив}
vector: array of real; {преобразованный одномерный динамический массив}
b:array of real;
x: array of real; temp: real;
i, j, k, n: integer; {Процедура остается без изменений}
procedure gauss(var vector: array of real; var b: array of real;
var x: array of real; var n: integer);
var
a: array of array of real; {матрица коэффициентов системы, двумерный динамический массив}
i, j, k, p, r: integer; m, s, t: real;
begin
SetLength(a, n, n); // установка фактического размера массива
251
3.6 Файлы
____________________________________________________________________
{Преобразование одномерного массива в двумерный} k:=1;
for i:=0 to n-1 do for j:=0 to n-1 do begin
a[i,j]:= vector[k]; k:=k+1;
end;
for k:=0 to n-2 do begin
for i:=k+1 to n-1 do begin
if (a[k,k]=0) then begin
{перестановка уравнений}
p:=k; // в алгоритме используется буква l, но она похожа на 1 // Поэтому используем идентификатор p
for r:=i to n-1 do begin
if abs(a[r,k]) > abs(a[p,k]) then p:=r; end;
if p<>k then begin
for j:= k to n-1 do begin
t:=a[k,j];
a[k,j]:=a[p,j];
a[p,j]:=t;
end;
t:=b[k];
b[k]:=b[p];
b[p]:=t;
end;
end; // конец блока перестановки уравнений m:=a[i,k]/a[k,k];
a[i,k]:=0;
for j:=k+1 to n-1 do begin
a[i,j]:=a[i,j]-m*a[k,j]; end;
b[i]:= b[i]-m*b[k]; end;
end;
252
Глава 3 Более сложные элементы языка
____________________________________________________________________
{Проверка существования решения} if a[n-1,n-1] <> 0 then begin
x[n-1]:=b[n-1]/a[n-1,n-1]; for i:=n-2 downto 0 do begin
s:=0;
for j:=i+1 to n-1 do begin
s:=s-a[i,j]*x[j]; end;
x[i]:=(b[i] + s)/a[i,i]; end;
writeln(''); writeln(UTF8ToConsole('Решение:')); writeln('');
for i:=0 to n-1 do
writeln('x', i+1, '= ', x[i]:0:4);
end else
if b[n-1] = 0 then writeln(UTF8ToConsole('Система не имеет решения.'))
else
writeln(UTF8ToConsole('Система уравнений'+ ' имеет бесконечное множество решений.'));
writeln(''); {освобождение памяти,
распределенной для динамического массива} a:=nil;
end;
{Начало основной программы} begin
AssignFile(matrix, 'Coeff.dat'); Reset(matrix, 1);
{Чтение количества уравнений системы из файла} BlockRead(matrix, n, SizeOf(integer)); {Установка реальных размеров динамических массивов} SetLength(a, n, n);
SetLength(vector, n*n); SetLength(b, n); SetLength(x, n);
{Ввод коэффициентов расширенной матрицы} for i:=1 to n do
253
3.6 Файлы
____________________________________________________________________
begin
for j:=1 to n do begin
BlockRead(matrix, temp, SizeOf(real)); a[i-1, j-1]:= temp;
end;
BlockRead(matrix, temp, SizeOf(real)); b[i-1]:= temp;
end;
{Преобразование двумерного массива в одномерный} k:=1;
for i:=0 to n-1 do for j:=0 to n-1 do begin
vector[k]:=a[i,j];
k:=k+1;
end;
CloseFile(matrix);
{Вызов процедуры решения системы линейных алгебраических уравнений методом Гаусса} gauss(vector, b, x, n); {освобождение памяти, распределенной для динамических массивов}
a:=nil;
vector:=nil;
x:=nil;
b:=nil;
writeln(UTF8ToConsole('Нажмите любую клавишу')); readkey;
end.
3.6.3.5. Организация контроля ввода/вывода при работе файлами
При работе с файлами часто возникают непредвиденные ситуации, кото-
рые приводят к ошибкам ввода/вывода. Такие ситуации возникают, например,
если указанный файл не существует на диске или диск не готов к работе или файл по каким-либо причинам был запорчен и прочитать данные невозможно и т.п. В таких случаях, если не предусмотреть соответствующих действий, про-
грамма аварийно завершается. Паскаль предоставляет возможность ввести в
программу контроль операций ввода/вывода. Это дает возможность даже если
254
Глава 3 Более сложные элементы языка
____________________________________________________________________
не исправить сразу возникшую ошибку, то хотя бы локализовать ее, вывести какое-то сообщение или предупреждение и продолжить работу с программой.
Для организации контроля за операциями ввода/вывода применяется функция IOResult. Перед вызовом этой функции необходимо отключить ав-
томатический контроль операций ввода/вывода директивой компилятора
{$I-}. Этой директивой программа как бы сообщает компилятору и операци-
онной системе, что контроль последующих операций ввода/вывода она берет на себя. Только после этого функция IOResult становится доступной. После за-
вершения очередной операции ввода/вывода функция возвращает 0, если опе-
рация прошла успешно. В противном случае функция возвращает код ошибки.
Необходимо анализировать значение функции IOResult сразу после вво-
да/вывода. В противном случае функция сбрасывает свое значение в 0. После завершения опасного участка программы, автоматический контроль вво-
да/вывода нужно восстановить директивой компилятора {$I+}.
Рассмотрим пример. Пусть имеется текстовый файл Data.txt. В про-
грамме моделируется ситуация, когда пользователь записывает в файл последо-
вательности целых чисел в их символьном представлении. Затем программа чи-
тает эти числа в переменную целого типа. В первый раз пользователь вводит строку '1234', во второй раз пользователь случайно ввел вместо цифры недо-
пустимый для числа символ, например вводит строку '12#4', т.е. нажал на клавишу с цифрой 3 в верхнем регистре.
program project1; {$mode objfpc}{$H+} uses
CRT, FileUtil, SysUtils; var
F: TextFile; code: word; number:integer;
255