Автоматизация решения систем линейных алгебраических уравнений

ЛИСТИНГ ПРОГРАММЫ

uses Crt, graph;

Var ch: char;

const Nmax=100;

Procedure LoadFile (Name: string);

Var f: text; S: string; code: integer;

Begin

assign (f,Name);

{$I-}

reset (f);

code: =Ioresult;

if code<>0 then

writeln ('Ошибка. Файл не найден! ')

else begin {clrscr}

gotoxy (1,3);

textcolor (10);

TextBackground (0);

while not eof (f) do

begin

readln (f,S);

writeln (S);

end;

close (f);

end;

End;

Procedure menu;

Begin

TextBackground (0);

clrscr;

LoadFile ('A: MENU. txt');

textcolor (9);

TextBackground (0);

gotoxy (1,23);

writeln ('-----------------------------------------------------------------');

gotoxy (1,24);

writeln ('Нажмите номер пункта меню');

end;

procedure menuTeorii;

begin

clrscr;

textcolor (9);

TextBackground (0);

gotoxy (1,23);

writeln ('------------------------------------------------------------------------');

gotoxy (1,24);

writeln ('Для перехода укажите номер страницы (от 1 до 6). ');

writeln ('Для возврата в меню нажмите Esc. Для вывода справки нажмите цифру 0. ');

end;

procedure menuSpravki;

begin

clrscr;

textcolor (9);

TextBackground (0);

gotoxy (1,23);

writeln ('------------------------------------------------------------------------');

gotoxy (1,24);

writeln ('Для возврата назад нажмите "1". ');

writeln ('Для возврата в меню нажмите (Esc). ');

end;

procedure menuPrimera;

begin

clrscr;

textcolor (9);

TextBackground (0);

gotoxy (1,23);

writeln ('------------------------------------------------------------------------');

gotoxy (1,24);

writeln ('Для перехода укажите номер страницы (от 1 до 4). ');

writeln ('Для вывода справки нажмите "0". Для входа в меню нажмите (Esc). ');

end;

procedure Spravka;

var n: char; {номер страницы}

begin

menuSpravki;

gotoxy (1,1);

LoadFile ('A: Spravka1. txt');

repeat

n: =readkey; until n in ['1',#27] ;

case n of

'1': begin

end;

end;

end;

procedure Teoria;

var n: char; {номер страницы}

begin

menuTeorii;

gotoxy (1,1);

writeln ('страница 1');

LoadFile ('A: Text1. txt');

repeat

repeat n: =readkey; until n in ['0'. '6',#27] ;

case n of

'1': begin

menuTeorii;

gotoxy (1,1);

writeln ('страница 1');

LoadFile ('A: Text1. txt');

end;

'2': begin

menuTeorii;

gotoxy (1,1);

writeln ('страница 2');

LoadFile ('A: Text2. txt');

end;

'3': begin

menuTeorii;

gotoxy (1,1);

writeln ('страница 3');

LoadFile ('A: Text3. txt');

end;

'4': begin

menuTeorii;

gotoxy (1,1);

writeln ('страница 4');

LoadFile ('A: Text4. txt');

end;

'5': begin

menuTeorii;

gotoxy (1,1);

writeln ('страница 5');

LoadFile ('A: Text5. txt');

end;

'6': begin

menuTeorii;

gotoxy (1,1);

writeln ('страница 6');

LoadFile ('A: Text6. txt');

end;

'0': begin

Spravka;

gotoxy (1,1);

LoadFile ('A: Spravka1. txt');

end;

end;

until n=#27;

end;

procedure grafic (a1,b1,c1,a2,b2,c2,xc,yc: real);

var

minx,maxx,miny,maxy: real;

mx,my: real;

x1,y1,x2,y2: integer;

x0,y0: integer;

grDriver: Integer;

grMode: Integer;

ErrCode: Integer;

begin

grDriver: = Detect;

InitGraph (grDriver, grMode,'c: \bps\bin\egavga. bgi');

ErrCode: = GraphResult;

if ErrCode = grOk then

begin

minx: =xc-2*xc;

maxx: =xc+2*xc;

miny: =yc-2*yc;

maxy: =yc+2*yc;

mx: =getmaxx;

mx: =mx/ (maxx-minx);

my: =getmaxy/ (maxy-miny);

y0: =round (abs (xc) *mx);

x0: =round (abs (yc) *my);

setcolor (white);

line (x0,0,x0,getmaxy);

line (0,y0,getmaxx,y0);

setcolor (red);

x1: =x0+round (minx*mx);

y1: =y0-round ( (c1-a1*minx) /b1*my);

x2: =x0+round (maxx*mx);

y2: =y0-round ( (c1-a1*maxx) /b1*my);

line (x1,y1,x2,y2);

setcolor (yellow);

x1: =x0+round (minx*mx);

y1: =y0-round ( (c2-a2*minx) /b2*my);

x2: =x0+round (maxx*mx);

y2: =y0-round ( (c2-a2*maxx) /b2*my);

line (x1,y1,x2,y2);

Readkey;

CloseGraph;

end

else

Writeln ('Ошибка работы с графикой: ', GraphErrorMsg (ErrCode));

end;

{$S-}

procedure vvod (var x: real; var code: integer);

var s: string;

begin

readln (s);

val (s,x,code);

if code<>0 then

writeln ('Ошибка, повторите ввод');

end;

procedure vvod1 (var n: integer);

var s: string;

code: integer;

begin

repeat

write ('Введите количество элементов матрицы');

readln (s);

val (s,n,code);

if (code<>0) or (N<0) or (N>Nmax) then

writeln ('Ввод не верный. Повторите ввод... ');

until (N>0) and (N<=Nmax) and (code=0);

end;

procedure Rewenie;

var

x: array [1. Nmax] of real;

A: array [1. Nmax,

1. Nmax] of real;

B: array [1. Nmax] of real;

N, i, ii,j,l,Rez,kol: integer;

k,S: real;

f,f1: text;

code: integer;

c: char;

Name: string;

Begin

assign (f,'otvet. txt');

rewrite (f);

clrscr;

gotoxy (30,12);

writeln ('1-Ввод с клавиатуры');

gotoxy (32,13);

writeln ('2-Ввод с файла');

gotoxy (28,14);

writeln ('3-Выход в основное меню');

repeat c: =readkey; until c in ['1','2','3'] ;

if c='3' then

begin

readkey;

exit;

end;

if c='1' then

begin

vvod1 (n);

writeln ('введите матрицу коэфициентов');

for i: =1 to n do

begin

for j: =1 to N do

repeat

write ('A [', i,',',j,'] =');

vvod (A [i,j],code);

until code=0;

repeat

write ('B [', i,'] =');

vvod (B [i],code);

until code=0;

end;

end

else

begin

writeln ('Задайте имя файла');

readln (Name);

assign (f1,Name);

{$I-}

reset (f);

code: =Ioresult;

if code<>0 then

begin

writeln ('Ошибка. Файл не найден! ');

writeln ('Для выхода в основное меню нажмите любую клавишу. ');

readkey;

exit;

end

else

begin

readln (f1,n);

if Ioresult<>0 then

begin

writeln ('Ошибка чтения из файла! Для выхода в основное меню нажмите любую клавишу. ');

readkey;

exit;

end;

for i: =1 to n do

begin

for j: =1 to N do

begin

read (f1,a [i,j]);

if Ioresult<>0 then

begin

writeln ('Ошибка чтения из файла! Для выхода в основное меню нажмите любую клавишу. ');

readkey;

exit;

end;

end;

read (f1,b [i]);

if Ioresult<>0 then

begin

writeln ('Ошибка чтения из файла! Для выхода в основное меню нажмите любую клавишу. ');

readkey;

exit;

end;

end;

end;

close (f1);

end;

clrscr;

writeln (f,'Исходная матрица: ');

writeln ('Исходная матрица: ');

for i: =1 to N do

begin

for j: =1 to N do

begin

write (A [i,j]: 10: 4);

write (f,A [i,j]: 10: 4);

end;

writeln (' I',B [i]: 10: 4);

writeln (f,' I',B [i]: 10: 4);

end;

for i: =1 to N-1 do begin

for l: =i+1 to N do begin

if a [l, i] =0 then

begin

writeln ('Преобразования матрицы на ', i,'-м шаге выполнить нельзя! ');

writeln ('Диагональный элемент равен 0! ');

writeln (f,'Преобразования матрицы на ', i,'-м шаге выполнить нельзя! ');

writeln (f,'Диагональный элемент равен 0! ');

readkey;

exit;

end;

k: =-A [i, i] /a [l, i] ;

for j: =1 to n do

A [l,j]: =A [l,j] *k+A [i,j] ;

B [l]: =B [l] *k+B [i] ;

end;

writeln;

writeln ('Преобразования матрицы на ', i,'-м шаге');

writeln (f);

writeln (f,'Преобразования матрицы на ', i,'-м шаге');

for ii: =1 to N do

begin

for j: =1 to N do

begin

write (A [ii,j]: 10: 4);

write (f,A [ii,j]: 10: 4);

end;

writeln (' I',B [i]: 10: 4);

writeln (f,' I',B [i]: 10: 4);

end;

readkey;

writeln;

writeln;

writeln (f);

writeln (f);

end;

rez: =1;

for i: =1 to n do

begin

kol: =0;

for j: =1 to N do

if A [i,j] =0 then

kol: =kol+1;

if kol=N then

if B [i] =0 then

begin

Rez: =2;

break;

end

else

begin

Rez: =0;

break;

end;

end;

if rez=1 then

begin

x [N]: =b [n] /a [n,n] ;

for i: =N-1 downto 1 do

begin

S: =0;

for j: =i+1 to N do

S: =S+x [j] *A [i,j] ;

x [i]: = (B [i] -S) /A [i,j] ;

end;

writeln ('Преобразованная матрица');

writeln (f,'Преобразованная матрица');

for i: =1 to N do

begin

for j: =1 to N do

begin

write (A [i,j]: 10: 4);

write (f,A [i,j]: 10: 4);

end;

writeln (' I',B [i]: 10: 4);

writeln (f,' I',B [i]: 10: 4);

end;

writeln ('Вектор ответов');

writeln (f,'Вектор ответов');

for i: =1 to N do

begin

writeln ('x [', i,'] =',x [i]: 10: 4);

writeln (f,'x [', i,'] =',x [i]: 10: 4);

end;

if N=2 then

begin

writeln ('Нажмите любую клавишу для просмотра графика');

readkey;

grafic (a [1,1],a [1,2],b [1],a [2,1],a [2,2],b [2],x [1],x [2]);

end;

end

else

if rez=0 then

begin

writeln ('Решений бесконечное множество');

writeln (f,'Решений бесконечное множество');

end

else

begin

writeln ('Решений НЕТ');

writeln (f,'Решений НЕТ');

end;

readkey;

close (f);

end;

procedure Primer;

var n: char; {номер страницы}

begin

menuPrimera;

gotoxy (1,1);

writeln ('страница 1');

LoadFile ('A: Primer1. txt');

repeat

repeat n: =readkey; until n in ['0'. '4',#27] ;

case n of

'1': begin

menuPrimera;

gotoxy (1,1);

writeln ('страница 1');

LoadFile ('A: Primer1. txt');

end;

'2': begin

menuPrimera;

gotoxy (1,1);

writeln ('страница 2');

LoadFile ('A: Primer2. txt');

end;

'3': begin

menuPrimera;

gotoxy (1,1);

writeln ('страница 3');

LoadFile ('A: Primer3. txt');

end;

'0': begin

Spravka;

gotoxy (1,1);

LoadFile ('A: Spravka1. txt');

end;

'4': begin

menuPrimera;

gotoxy (1,1);

writeln ('страница 4');

LoadFile ('A: Primer4. txt');

end;

end;

until n=#27;

end;

procedure Vuxod;

begin

exit;

end;

Begin

repeat

menu;

repeat ch: =readkey;

until ch in ['1'. '5'] ;

case ch of

'1': Teoria;

'2': Primer;

'3': Rewenie;

'4': Spravka;

'5': Vuxod;

end;

until ch='5';

end.