unit1.pas

多元线性方程求解程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Label5: TLabel;
    Label7: TLabel;
    Edit10: TEdit;
    Edit11: TEdit;
    Label6: TLabel;
    Label8: TLabel;
    Edit12: TEdit;
    Label9: TLabel;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

function SolutionOf(n: byte; var mat): boolean; {求解线性方程组}

var
  Form1: TForm1;

implementation

{$R *.dfm}

function SolutionOf(n: byte; var mat): boolean; {求解线性方程组}
  { 参数 mat 中存放的是待解方程的系数增广矩阵,采用高斯列主消元法解此方程,
    并将解存放在系数增广矩阵的最后一列中。 }
  type
    Matrix=array[0..1023] of real;
  function Gauss(var A:Matrix):boolean;
    var
      i,j,k,j1,ind,base:integer;
      tmp:real;
    begin
      Gauss:=FALSE;
      for i:=0 to N do {对每一行列主消元}
      begin
        j1 := N+1;  {初始化主列行号为非法值}
        tmp := 0.0; {临时记录最大值}
        base := i*(N+2); {第 i 行起始位置}
        ind := base+i; {i 行 i 列}
        for j:=i to N do {检查第 i 行以下的各行}
        begin
          if abs(A[ind])>tmp then
            begin
              tmp := abs(A[ind]); {记录最大值及其行号}
              j1 := j;
            end;
          inc(ind,N+2); {j 行 i 列}
        end;
        if j1<>i then
        begin
          if (j1>N) then exit; {方程组无解}
          j1 := j1*(N+2); {换为数组下标}
          for j:=i to N+1 do {将当前行与主列行交换}
          begin
            tmp := A[base+j];       {Tmp  := ａij}
            A[base+j] := A[j1+j]; {ａij := ａj1,j }
            A[j1+j] := tmp;       {ａj1,j := Tmp}
          end;
        end;
        if A[base+i] <> 1 then {化 ａii = 1}
          for j:= N+1 downto i do
            A[base+j] := A[base+j]/A[base+i]; {ａij=ａij/ａii, j=n+1,...,i}
        for j := i + 1 to N do {消元}
        begin
          ind := j*(N+2);
          for k := N+1 downto i do
            A[ind+k] := A[ind+k]-A[base+k]*A[ind+i]; {ａjk:=ａjk-ａik*ａji}
        end;
      end;
      for i:=N-1 downto 0 do {回代求解}
      begin
        base := i*(N+2);
        for j:=N downto i+1 do {ａi,n+1:=ａi,n+1 - ａij*ａj,n+1}
          A[base+N+1] := A[base+N+1] - A[base+j] * A[j*(N+2)+N+1];
      end;
      {此时, 系数增广矩阵的最后一列即为方程组的解}
      Gauss:=TRUE;
    end;{Gauss}
  var
    A: Matrix absolute mat;
  begin
    dec(N); {从 0 开始}
    SolutionOf:=Gauss(A);
  end;{SolutionOf}



procedure TForm1.Button1Click(Sender: TObject);
var n:byte;
    i:integer;
    mat:array[0..11] of real;
    s:string;
begin
  n:=3;//未知数个数n，数组长度为n*(n+1)
  try
    mat[0]:=strtofloat(edit1.text);
    mat[1]:=strtofloat(edit2.text);
    mat[2]:=strtofloat(edit3.text);
    mat[3]:=strtofloat(edit4.text);
    mat[4]:=strtofloat(edit5.text);
    mat[5]:=strtofloat(edit6.text);
    mat[6]:=strtofloat(edit7.text);
    mat[7]:=strtofloat(edit8.text);
    mat[8]:=strtofloat(edit9.text);
    mat[9]:=strtofloat(edit10.text);
    mat[10]:=strtofloat(edit11.text);
    mat[11]:=strtofloat(edit12.text);
  except;
    showmessage('请输入实数');
    exit;
  end;

 //解存放在mat[i*(n+1)-1]
  solutionof(n,mat);
  s:='';
  s:=s+'x= '+floattostr(mat[3])+chr(13)+chr(10);
  s:=s+'y= '+floattostr(mat[7])+chr(13)+chr(10);
  s:=s+'z= '+floattostr(mat[11])+chr(13)+chr(10);
  memo1.Text:=s;

end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if key=chr(13) then
  begin
    key:=chr(0);
    postmessage(tedit(sender).Handle,wm_keydown,vk_tab,0);
  end;
end;

end.