Я тут недавно наткнулся на свой курсач двухлетней давности, там писал функцию для нахождения определителя методом Гаусса, немного переделал, и получилась нормальная прога с интерфейсом. На самом деле я и сам давно хотел написать эту прогу, а недавно она мне, скорее всего, самому понадобится, только мне нужно, чтобы дроби нормальные были, а не десятичные, потому, что мне программу-обучалку написать надо. В коде есть комментарии, думаю, что всё будет ясно. На форме: StringGrid, Memo и BitBtn.
Вот код для кнопки "Решить":
Код:
Uses Math; // не забываем про этот модуль!
Const
N0 = 20;
Type
Matrix=Array[0..N0-1, 0..N0-1] Of Double;
Massiv=Array[0..N0-1] Of Double;
procedure TGaussMethodForm.BitBtnDecideClick(Sender: TObject);
Var
F, B: Matrix;
w: Double;
d, t, y, g, s: Double;
k, c, i, j, v, kn, l, mi, mj, N: Byte;
Str: String;
begin
kn:=0;
// читаю матрицу из сетки
N:=StringGrid.ColCount;
For i:=0 To N-1 Do
For j:=0 To N-1 Do
F[i, j]:=StrToFloat(StringGrid.Cells[j, i]);
If (N<2) Then Exit;
// приписываю к исходной матрице единичную
For i:=0 To N-1 Do
For j:=N To 2*N-1 Do
If (j-i=N) Then F[i, j]:=1
Else F[i, j]:=0;
(* Прямой ход сверху вниз *)
Memo.Lines.Add('---Прямой ход сверху вниз---');
Memo.Lines.Add(#13);
For k:=0 To N-2 Do (* основной цикл прямого хода *)
Begin
D:=F[k, k]; (* ведущий элемент t=d*y => y=t/d *)
If (d=0) Then
Begin (* является ли ведущий элемент нулевым *)
l:=0;
Repeat
l:=l+1; (* нахождение первого ненулевого элемента в столбце *)
Until ((F[k+l, k]<>0) Or (l>=N));
If (l<N) Then
Begin
For v:=k To 2*N-1 Do (* цикл, меняющий строки местами *)
Begin
B[k, j]:=F[k, v];(* ведущая строка с нулевым элементом *)
F[k, v]:=F[k+l, v];(* эта строка теперь с ненулеывм элементом *)
F[k+l, v]:=B[k, j];(* та строка, которая была с нулём *)
End;
d:=F[k, k];(* новый ведущий элемент *)
kn:=kn+1;(* сколько раз менялись строки *)
End
Else
Exit;
End;
For j:=k To 2*N-1 Do B[k, j]:=F[k, j];(* сохранение исходной опорной строки в массив *)
For c:=k+1 To N-1 Do (* цикл прокрутки столбца ведомых элементов *)
Begin
T:=F[c, k]; (* ведомый элемент *)
If (t<>0) Then (* если ведомый элемент нулю ещё не равен, то: *)
Begin
If (d<>0) Then (* проверяю равен ли нулю ведущий элемент *)
y:=t/d;(* разделил ведомый элемент на ведущий, и получил: *)
(* число, на которое нужно умножить ведущую строку *)
For j:=k To 2*N-1 Do
Begin
F[k, j]:=B[k, j];(* сохранение исходной ведущей строки *)
F[k, j]:=F[k, j]*y; (* умножение ведущей строки на число *)
F[c, j]:=F[c, j]-F[k, j];(* вычитание ведущей строки из ведомой *)
End;
End;
End; (* сохранился ли ведущий элемент, если нет - возврат исходной строки *)
If (g<>F[k, k]) Then
For j:=k To 2*N-1 Do F[k, j]:=B[k, j];
For mi:=0 To N-1 Do
Begin
Str:='';
For mj:=0 To 2*N-1 Do
Begin
w:=RoundTo(F[mi, mj], -4);
If (mj=N) Then
Str:=Str+' | '+FloatToStr(w)
Else
Str:=Str+' '+FloatToStr(w);
End;
Memo.Lines.Add(Str);
End;
Memo.Lines.Add(#13);
End;
(* матрица приведена к верхне-треугольному виду *)
Memo.Lines.Add('---Прямой ход снизу вверх---');
Memo.Lines.Add(#13);
For k:=N-1 DownTo 1 Do (* основной цикл прямого хода *)
Begin
D:=F[k, k]; (* ведущий элемент t=d*y => y=t/d *)
If (d=0) Then
Begin (* является ли ведущий элемент нулевым *)
l:=0;
Repeat
l:=l+1; (* нахождение первого ненулевого элемента в столбце *)
Until ((F[k-l, k]<>0) Or (l>=N));
If (l<N) Then
Begin
For v:=k To N-1 Do (* цикл, меняющий строки местами *)
Begin
B[k, j]:=F[k, v];(* ведущая строка с нулевым элементом *)
F[k, v]:=F[k-l, v];(* эта строка теперь с ненулеывм элементом *)
F[k-l, v]:=B[k, v];(* та строка, которая была с нулём *)
End;
d:=F[k, k];(* новый ведущий элемент *)
End
Else
Exit;
End;
For j:=2*N-1 DownTo 0 Do B[k, j]:=F[k, j];(* сохранение исходной опорной строки в массив *)
For c:=k+1 DownTo 0 Do (* цикл прокрутки столбца ведомых элементов *)
Begin
T:=F[c, k]; (* ведомый элемент *)
If (t<>0) Then (* если ведомый элемент нулю ещё не равен, то: *)
Begin
If (d<>0) Then (* проверяю равен ли нулю ведущий элемент *)
y:=t/d;(* разделил ведомый элемент на ведущий, и получил: *)
(* число, на которое нужно умножить ведущую строку *)
For j:=2*N-1 DownTo 0 Do
Begin
F[k, j]:=B[k, j];(* сохранение исходной ведущей строки *)
F[k, j]:=F[k, j]*y; (* умножение ведущей строки на число *)
F[c, j]:=F[c, j]-F[k, j];(* вычитание ведущей строки из ведомой *)
End;
End;
End; (* сохранился ли ведущий элемент, если нет - возврат исходной строки *)
If (g<>F[k, k]) Then
For j:=2*N-1 DownTo 0 Do F[k, j]:=B[k, j];
For mi:=0 To N-1 Do
Begin
Str:='';
For mj:=0 To 2*N-1 Do
Begin
w:=RoundTo(F[mi, mj], -4);
If (mj=N) Then
Str:=Str+' | '+FloatToStr(w)
Else
Str:=Str+' '+FloatToStr(w);
End;
Memo.Lines.Add(Str);
End;
Memo.Lines.Add(#13);
End;
For i:=0 To N-1 Do
Begin
d:=F[i, i];
F[i, i]:=F[i, i]/d;
For j:=N To 2*N Do
F[i, j]:=F[i, j]/d;
End;
For mi:=0 To N-1 Do
Begin
Str:='';
For mj:=0 To 2*N-1 Do
Begin
w:=RoundTo(F[mi, mj], -4);
If (mj=N) Then
Str:=Str+' | '+FloatToStr(w)
Else
Str:=Str+' '+FloatToStr(w);
End;
Memo.Lines.Add(Str);
End;
Memo.Lines.Add(#13);
Memo.Lines.Add('----Обратная матрица----');
Memo.Lines.Add(#13);
For i:=0 To N-1 Do
Begin
Str:='';
For j:=N To 2*N-1 Do
Begin
w:=RoundTo(F[i, j], -4);
Str:=Str+' '+FloatToStr(w);
End;
Memo.Lines.Add(Str);
End;
end;
Матрицу находит правильно: я в Excel-е несколько раз проверял. Только, вот выводить её в Memo не очень удобно, лучше, конечно же, в StringGrid.
|