close

Вход

Забыли?

вход по аккаунту

?

Unit2 (2)

код для вставкиСкачать
unit Unit2; //Математическое ядро, процедуры обработки данных и вывода в файл
interface
uses SysUtils;
type
matrix=array of array of real; //Динамический двумерный массив (матрица СЛАУ)
str=string[10]; //Строка длиной в 10 символов
answer=array of real; //Динамический массив вещественных чисел (ответ)
function ord(fl:real):string; //Преобразует число в обыкновенную дробь
procedure gauss(m:matrix; qty:integer; n:string; var ans:answer; var det:boolean);
procedure addtofile(m:matrix; name:string); //Вывод матрицы в текстовый файл
implementation
//Преобразование числа в обыкновенную дробь
function ord(fl:real):string;
var i,j:integer; //Локальные переменные - числитель и знаменатель дроби
begin
i:=1;
if ((abs(trunc(fl))=abs(fl)) or (fl=0)) then ord:=floattostr(fl)
//Если число целое - то преобразуется в текстовую строку без изменений
else begin
//Увеличиваем знаменатель, пока числитель не приблизится к целому числу
while abs(round(fl*i)-fl*i)>0.0001 do i:=i+1;
j:=round(fl*i); //Определяем числитель
if abs(i)<>1 then ord:=inttostr(j)+'/'+inttostr(i)
else ord:=floattostr(round(fl)); //Представляем результат (дробь) как строку
end;
end;
//Процедура решения СЛАУ
procedure gauss(m:matrix; qty:integer; n:string; var ans:answer; var det:boolean);
var i,j,k,l:integer; buf,check:real; cur:answer;
begin
setlength(cur,qty+1); setlength(ans,qty); //Задание размеров буфера и ответа
//Прямой ход метода Гаусса
for i := 0 to qty-1 do begin
if n<>'' then addtofile(m,n); //Вывод матрицы в файл (при необходимости)
for l := qty-1 downto i+1 do begin //Выбор главного элемента
if abs(m[i,l])>abs(m[i,l-1]) then
for j := 0 to qty do begin
buf:=m[j,l];
m[j,l]:=m[j,l-1]; m[j,l-1]:=buf; end;
end;
//В результате строка с наибольшим по модулю элементом cтановится базовой
if n<>'' then addtofile(m,n); //Вывод матрицы в файл
buf:=m[i,i]; //Копирование первого элемента базовой (текущей) строки
for j := 0 to qty do if abs(buf)>2E-10 then
m[j,i]:=m[j,i]/buf; //Деление строки на этот элемент (если он отличен от 0)
if n<>'' then addtofile(m,n); //Вывод матрицы в файл
for l := 0 to qty do cur[l]:=m[l,i]; //Копирование базовой строки
check:=cur[i]; //Копирование главного элемента
for k := i+1 to qty do begin //Вычитание базовой строки из последующих
buf:=m[i,k]; //Копирование множителя - первого элемента обрабатываемой строки
for j := 0 to qty do m[j,k]:=m[j,k]-cur[j]*buf; //Собственно вычитание
end;
end;
//Если последний элемент главной диагонали отличен от 0, запускается обратный ход
if abs(check)>2E-10 then begin for i := qty-1 downto 1 do begin
for l := 0 to qty do cur[l]:=m[l,i]; //Копирование базовой строки
for k := i-1 downto 0 do begin //Вычитание ее из предшествующих строк
buf:=m[i,k]; //Копирование множителя
for j := 0 to qty do m[j,k]:=m[j,k]-cur[j]*buf; //Собственно вычитание
end;
if n<>'' then addtofile(m,n); //Вывод матрицы в файл
end;
for k := 0 to qty-1 do ans[k]:=m[qty,k]; //Формирование ответа из последнего столбца
det:=true; //Отчет о том, что матрица невырождена
end
else det:=false; //В противном случае матрица является вырожденной
end;
//Вывод матрицы m в текстовый файл с именем name
procedure addtofile(m:matrix; name:string);
var f:textfile; i,j,h,l:integer;
begin
l:=length(m); h:=length(m[0]); //Определение размерности матрицы
assignfile(f,name);
append(f); //Открытие файла для дозаписи
for i := 0 to h-2 do begin
for j := 0 to l-1 do write(f,ord(m[j,i]):10);
writeln(f); //Построчный вывод элементов матрицы в файл
end; //(после преобразования в обыкновенные дроби)
writeln(f); writeln(f);
closefile(f);
end;
end.
Документ
Категория
Рефераты
Просмотров
8
Размер файла
68 Кб
Теги
unit
1/--страниц
Пожаловаться на содержимое документа