{"id":362,"date":"2009-04-30T20:10:00","date_gmt":"2009-04-30T12:10:00","guid":{"rendered":""},"modified":"2013-11-17T19:30:54","modified_gmt":"2013-11-17T11:30:54","slug":"matrice-pas","status":"publish","type":"post","link":"https:\/\/kyle.ai\/blog\/362.html","title":{"rendered":"Matrice.pas"},"content":{"rendered":"
\r\n\/\/ Unit MATRICE\r\n\r\n\/\/ OBJECT : matrix and vector aritmetic (inversion, addition, multiplication ...)\r\n\/\/ first written in Turbo-Pascal (02-05-1991)\r\n\/\/ adapted to Delphi 4 (28-05-1999)\r\n\r\n\/\/ NOTES\r\n\r\n\/\/ Note 1 : these routines operate on dynamical square matrix and dynamical vectors\r\n\/\/ (RCOMat and RCOVec),whose dimension should have been be declared with\r\n\/\/ the InitMat(Dim) procedure (error if if not initialize).\r\n\r\n\/\/ Note 2 : the index (i,j..) are "zero based", this is a constraint of\r\n\/\/ Delphi4 dynamical matrix structure.\r\n\r\n\/\/ Note 3 : the "if true ..." instructions are remainings of the TurboPascal 5 version,\r\n\/\/ I should have transform them into "try .. except .." instructions in order to\r\n\/\/ manage memory overflow errors. If somebody do that, I can mail me the upgraded version.\r\n\r\n\/\/ Note 4 : I checked this unit with the small program at the end of that file.\r\n\/\/ The time required to invert a 200 x 200 extented matrix is of about 2 seconds,\r\n\/\/ (AMD K6-2 overclocked at 400 MHz), and the accuracy compatible with extended\r\n\/\/ accuracy (10E-17 .. 10E-18)\r\n\r\n\/\/ if you find that unit usefull, please let me know :\r\n\/\/ remi CORMIER, rco@club-internet.fr\r\n\r\nUNIT Matrice;\r\n\r\n\/\/determinant\u4e3a\u884c\u5217\u5f0f\u7684\u503c\r\n\r\nINTERFACE\r\nuses SysUtils,Dialogs,PerlRegEx,classes;\r\n\/\/ I would'nt worry if you change "RCOMat" to "YourNameMat" ...\r\nTYPE      RCOMat = array of array of extended;\r\n          RCOVec = array of extended;\r\n\r\nVAR       ErreurMat : integer; { code d'erreur, Cf ci apr\u9463 :   }\r\n\r\nCONST     MatCorrect   = 0;\r\n          MatNonInit   = 1;\r\n          MatDebordTas = 2;\r\n          MatDetNul    = 3;\r\n\/\/\u4e24\u4e2a\u884c\u5217\u76f8\u540c\u7684\u77e9\u9635\u76f8\u52a0\r\nfunction MatAddMat(A,B:RCOMat;i,j:integer):RCOMat;\r\n\r\n\/\/\u5c06\u77e9\u9635\u8f6c\u6210\u76f8\u53cd\u6570\uff0c\u6c42A\u7684\u8d1f\r\nfunction FuMat(A:RCOMat;i,j:integer):RCOMat;\r\n\r\n\/\/\u5c0f\u6570\u8f6c\u5206\u6570\r\nfunction Fraction(decimal: double): string;\r\n\r\n\/\/\u4ece\u6587\u672c\u6587\u4ef6\u4e2d\u8bfb\u53d6\u77e9\u9635\u5230A \uff0ci,j\u4e3a\u8fd4\u56de\u7684\u77e9\u9635\u957f\u5ea6\r\nprocedure MatFromText(var A:RCOMat;path:string;var i,j:integer);\r\n\r\n\/\/\u7528MessageBox\u663e\u793a\u51fa\u77e9\u9635\uff0cisT\u8868\u793a\u662f\u5426\u7528\u5206\u6570\u663e\u793a\uff0c\u9ed8\u8ba4\u4e3a\u7528\u5c0f\u6570\u663e\u793a\r\nprocedure MatToMessageBox(A:RCOMat;i,j:integer;isT:boolean=false;isToText:boolean=true);\r\n\r\n\/\/ Returns (W) = (U)-(V) ; U,V,W : Vectors\r\nPROCEDURE DifVec(U,V:RCOVec;var W:RCOVec);\r\n\r\n\/\/ Returns the current dimension of matrix and vectors\r\nFUNCTION DimMatrices:integer;\r\n\r\n\/\/ Initialize the matrix and vectors dimension with Dim\r\nPROCEDURE InitMat(Dim:integer);\r\n\r\n\/\/ Returns [B], the invert matrix of [A] ([A]x[B]=[I]), Det is the determinant of [A] (and [B])\r\n\/\/\u6c42A\u7684\u9006\u9635B   \u53ea\u6709\u65b9\u9635\u624d\u6709\u9006 \u8fd4\u56dedet\u4e3aA\u7684\u884c\u5217\u5f0f\u7684\u503c\r\nPROCEDURE InvMat(A:RCOMat;var B:RCOMat;var Det:extended{MatElem});\r\n\r\n\/\/ Returns [C] = [A]x[B]\r\nPROCEDURE MatMat(A,B:RCOMat;var C:RCOMat);\r\n\r\n\/\/ Returns [C] = [A]x[B] ; same as MatMat, except that [A] and [B] can be\r\n\/\/ rectangular. [A] have Dim rows and M columns, [B] have M rows and P colums :\r\n\/\/ [A]N,M x [B]M,P -> [C]N,P (with N = DimMat)\r\nPROCEDURE MatMatR(A,B:RCOMat;M,P:integer;var C:RCOMat);\r\n\r\n\/\/ Returns the unit matrix (one on diagonal, zero everywhere else)\u8fd4\u56de\u5355\u5143\u77e9\u9635\r\nPROCEDURE MatUnt(var MU:RCOMat);\r\n\r\n\/\/ Returns the (W)=[M]x(V) ; [M] RCOMat, (V) and (W) RCOVec\r\nPROCEDURE MatVec(M:RCOMat;V:RCOVec;var W:RCOVec);\r\n\r\n\/\/ Returns the norm of vector (U)\r\nFUNCTION Norme(U:RCOVec)    : extended;\r\n\r\n\/\/ Returns the norm of [A], [A] can be rectangular, with n row and m columns\r\nFUNCTION NorMat(A:RCOMat;n,m:integer):extended;\r\n\r\n\/\/ Returns the scalar product of the vector (U) and (V)\r\nFUNCTION PrdScal(U,V:RCOVec) : extended;\r\n\r\n\/\/ Multiply the matrix [A] with x, the result in matrix [B]\r\nPROCEDURE ScalMat(x:extended;A:RCOMat;var B:RCOMat);\r\n\r\n\/\/ Multiply the vector (U) with x, the result in vector (V)\r\nPROCEDURE ScalVec(x:extended;U:RCOVec;var V:RCOVec);\r\n\r\n\/\/ Addition of two square matrix [A] and [B], result in [C]\r\nPROCEDURE SomMat(A,B:RCOMat;var C:RCOMat);\r\n\r\n\/\/ Addition of two vectors, (U) and (V), result in (W)\r\nPROCEDURE SomVec(U,V:RCOVec;var W:RCOVec);\r\n\r\n\/\/ Solution of the linear system [A]x(X)=(B)\r\n\/\/ vector (X) is the solution\r\n\/\/ check Det for valid solution (should be <> 0)\r\nPROCEDURE SysLin(A:RCOMat;var X:RCOVec;B:RCOVec;var Det:extended{MatElem});\r\n\r\n\/\/ Returns the transposed matrix of [A] into [B] (Bij = Aji)   \u8f6c\u7f6e\u884c\u5217\u5f0f\r\nPROCEDURE TransMat(A:RCOMat;var B:RCOMat;n,m:integer); \/\/n,m\u4e3aA\u7684\u884c\u3001\u5217\u6570\r\n\r\n\/\/ Returns the text (in french) associated with the error # no\r\nFUNCTION MsgErreurMat(no:integer):string;\r\n\r\nIMPLEMENTATION\r\n\r\nVAR   Ini       : boolean;\r\n      DimMat    : integer;\r\n\r\nTYPE RCoVecE   = array of integer;\r\n\r\nfunction MatAddMat(A,B:RCOMat;i,j:integer):RCOMat;\r\nvar C:RCOMat;\r\n    m,n:integer;\r\nbegin\r\n    InitMat(i);\r\n    SetLength(C,i,j);\r\n    for m := 0 to i - 1 do\r\n      for n := 0 to j - 1 do\r\n        C[m,n] := A[m,n]+B[m,n];\r\n    result := C;\r\nend;\r\n\r\nfunction FuMat(A:RCOMat;i,j:integer):RCOMat;\r\nvar B:RCOMat;\r\n    temp,temp1:integer;\r\nbegin\r\n   setlength(B,i,j);\r\n   for temp := 0 to i - 1 do\r\n     for temp1 := 0 to j - 1 do\r\n       B[temp,temp1] := -A[temp,temp1];\r\n   result := B;\r\nend;\r\n\r\nfunction Fraction(decimal: double): string;\r\nvar\r\nintNumerator, intDenominator, intNegative: integer; \/\/ \u58f0\u660e\u6574\u6570\u53d8\u91cf\u4e3a\u957f\u6574\u6570\r\ndblFraction, dblDecimal, dblAccuracy, dblinteger: Double; \/\/ \u58f0\u660e\u6d6e\u70b9\u6570\u4e3a\u53cc\u7cbe\u5ea6\r\ntemp:string;\r\nbegin\r\ndblDecimal := decimal; \/\/\u53d6\u5f97\u76ee\u6807\u5c0f\u6570\r\nif trunc(decimal) = decimal then \/\/ \u5982\u679c\u662f\u6574\u6570\uff0c\u5219\u76f4\u8f6c\r\n    result := floattostr(decimal)\r\nelse\r\nbegin\r\n    if abs(decimal) > 1 then \/\/\u5982\u679c\u5c0f\u6570\u5927\u4e8e1 \u5982 10.24 \uff0c\u8fdb\u884c\u62c6\u89e3\r\n    begin\r\n      dblinteger := trunc(decimal); \/\/\u53d6\u51fa\u6574\u6570\u90e8\u5206\r\n      dblDecimal := abs(frac(decimal)); \/\/\u53d6\u51fa\u5c0f\u6570\u90e8\u5206\r\n    end\r\n    else dblDecimal := decimal;\r\n\r\n    dblAccuracy := 0.01; \/\/\u8bbe\u7f6e\u7cbe\u5ea6\r\n    intNumerator := 0; \/\/\u521d\u59cb\u5206\u5b50\u4e3a0\r\n    intDenominator := 1; \/\/\u521d\u59cb\u5206\u6bcd\u4e3a1\r\n    intNegative := 1; \/\/\u7b26\u53f7\u6807\u8bb0\u4e3a\u6b63\r\n    if dblDecimal < 0 then intNegative := -1; \/\/\u5982\u679c\u76ee\u6807\u4e3a\u8d1f\uff0c\u8bbe\u7f6e\u8d1f\u6807\u5fd7\u4f4d\r\n    dblFraction := 0; \/\/\u8bbe\u7f6e\u5206\u6570\u503c\u4e3a 0\/1\r\n    while Abs(dblFraction - dblDecimal) > dblAccuracy do \/\/\u5982\u679c\u5f53\u524d\u6ca1\u6709\u8fbe\u5230\u7cbe\u5ea6\u8981\u6c42\u5c31\u7ee7\u7eed\u5faa\u73af\r\n    begin\r\n      if Abs(dblFraction) > Abs(dblDecimal) then \/\/\u5982\u679c\u6211\u4eec\u7684\u5206\u6570\u5927\u4e8e\u76ee\u6807\r\n        intDenominator := intDenominator + 1 \/\/\u589e\u52a0\u5206\u6bcd\r\n      else \/\/\u5426\u5219\r\n        intNumerator := intNumerator + intNegative; \/\/\u589e\u52a0\u5206\u5b50\r\n      dblFraction := intNumerator \/ intDenominator; \/\/\u8ba1\u7b97\u65b0\u7684\u5206\u6570\r\n    end;\r\n   \/\/ edit2.Text := inttostr(intNumerator) + '\/' + inttostr(intDenominator);\r\n    if abs(decimal) > 1 then \/\/\u5982\u679c\u5c0f\u6570\u5927\u4e8e1 \u5982 10.24 \uff0c\u8fdb\u884c\u62c6\u89e3\r\n     \/\/\u7ed3\u679c\uff1adblinteger\u4e3a\u6574\u6570\u90e8\u5206\uff0c intNumerator\u4e3a\u5206\u5b50\uff0cintDenominator\u4e3a\u5206\u6bcd\r\n     begin\r\n     if dblinteger<0 then\r\n       begin dblinteger := -dblinteger;\r\n       temp := floattostr(dblinteger*intDenominator+intNumerator) + '\/' + inttostr(intDenominator);\r\n       \/\/result := floattostr(dblinteger) + '\u53c8' + inttostr(intNumerator) + '\/' + inttostr(intDenominator)\r\n       result := '-'+temp;\r\n       end else\r\n       begin\r\n       temp := floattostr(dblinteger*intDenominator+intNumerator) + '\/' + inttostr(intDenominator);\r\n       result :=temp;\r\n       end;\r\n     end\r\n    else\r\n      result := inttostr(intNumerator) + '\/' + inttostr(intDenominator);\r\nend;\r\nend;\r\n\r\nprocedure MatFromText(var A:RCOMat;path:string;var i,j:integer);\r\nvar f:TextFile;\r\n    n,m:integer;\r\n    Reg:TPerlRegEx;\r\n    List:TStrings;\r\n    s:string;\r\nbegin\r\ni:=0; j:=0;\r\nReg:=TPerlRegEx.Create(nil);\r\nList:=TStringList.Create;\r\nn:=0;\r\nassignFile(f,path);\r\nreset(f);\r\nwhile not eof(f) do\r\nbegin\r\n    readln(f,s);\r\n    if not (trim(s)='') then      \/\/\u7a7a\u884c\u60c5\u51b5\u7684\u5904\u7406\r\n    i:=i+1;\r\nend;\r\nclosefile(f);\r\nreset(f);\r\ns:='';\r\nwhile not eof(f) do\r\nbegin\r\n    Readln(f,s); s:=trim(s);\r\n    if not (s='') then          \/\/\u7a7a\u884c\u60c5\u51b5\u7684\u5904\u7406\r\n    begin\r\n      reg.Subject := s;\r\n      reg.RegEx := ' *';                  \/\/\u4ee5\u7a7a\u683c\u4e3a\u5206\u9694\u7b26\uff08\u7a7a\u683c\u4e2a\u6570\u4e0d\u9650\uff09\r\n      reg.Split(list,MaxInt);\r\n      j:=list.Count;\r\n      SetLength(A,i,j);\r\n      for m := 0 to j - 1 do\r\n      begin\r\n         A[n,m]:=strtofloat(list[m]);\r\n      end;\r\n       n:=n+1;\r\n    end;\r\n   list.Clear;\r\nend;\r\nlist.Free;\r\nclosefile(f);\r\nend;\r\n\r\nprocedure MatToMessageBox(A:RCOMat;i,j:integer;isT:boolean=false;isToText:boolean=true);\r\nvar m,n:integer;\r\n    str:string;\r\n    f:textfile;\r\nbegin\r\n   str:='';\r\n   for m := 0 to i - 1 do\r\n   begin\r\n     str:=str+#13;\r\n     for n := 0 to j - 1 do\r\n       begin\r\n          if isT then\r\n             str := str+Fraction(A[m,n])+'     '\r\n          else\r\n            str:=str+format('%.4f',[A[m,n]])+'     ';\r\n       end;\r\n   end;\r\n   showmessage(str);\r\n    str :='';\r\n\r\n   if isToText then                              \/\/\u5c06\u7ed3\u679c\u4fdd\u5b58\u5230\u6587\u672c\u6587\u4ef6\r\n   begin\r\n   assignfile(f,'.\\data\\result.txt');\r\n   rewrite(f);                         \/\/\u6e05\u7a7a\u6587\u672c\r\n   closefile(f);\r\n   assignfile(f,'.\\data\\result.txt');\r\n   Append(f);\r\n   for m := 0 to i - 1 do\r\n     for n := 0 to j - 1 do\r\n     begin\r\n      str:=str+format('%.4f',[A[m,n]])+'     ';\r\n      if n=j-1 then\r\n      begin\r\n      writeln(f,str); str := '';\r\n      end;\r\n     end;\r\n   closefile(f);\r\n   end;\r\nend;\r\n\r\nFUNCTION MsgErreurMat(no:integer):string;\r\nBEGIN\r\nMsgErreurMat:='';\r\ncase no of\r\n    MatCorrect   : Result:='succ\u9463';\r\n    MatNonInit   : Result:='unit?non initialis\u9591';\r\n    MatDebordTas : Result:='pas assez de m\u9599oire';\r\n    MatDetNul    : Result:='d\u95a0erminant nul';\r\n    end;\r\nEND;\r\n\r\nFUNCTION NorMat(A:RCOMat;n,m:integer):extended;\r\nVAR Nor : extended;\r\n    i,j : integer;\r\nBEGIN\r\nNor:=1;\r\nfor i:=0 to pred(n) do\r\n    for j:=0 to pred(m) do\r\n      Nor:=Nor*sqr(A[i,j]);\r\nNor:=sqrt(Nor\/n\/m);\r\nResult:=Nor;\r\nEND;\r\n\r\nFUNCTION DimMatrices:integer;\r\nBEGIN\r\nDimMatrices:=DimMat;\r\nEND;\r\n\r\nPROCEDURE Init;\r\nbegin\r\nif not Ini then\r\n    begin\r\n      ErreurMat:=MatDebordTas;\r\n      write('Unit?MATRICES non initialis\u9591');\/\/ I think that write generate the write\r\n      halt(1);                                \/\/ instruction would generate an exception\r\n    end;\r\nErreurMat:=0;\r\nend;\r\n\r\nPROCEDURE InitMat(Dim:integer);\r\nbegin\r\nDimMat:=Dim;\r\nIni:=true;\r\nInit;\r\nend;\r\n\r\nPROCEDURE MatMat(A,B:RCOMat;var C:RCOMat);\r\nvar i, j , k : integer;\r\n    Cij      : extended;\r\n\r\nbegin\r\nInit;\r\nif true\r\n    then\r\n      begin\r\n        for i:=0 to pred(DimMat) do\r\n          for j:=0 to pred(DimMat) do\r\n            begin\r\n              Cij:=0;\r\n              for k:=0 to pred(DimMat) do\r\n                Cij:=Cij+A[i,k]*B[k,j];\r\n              C[i,j]:=Cij;\r\n            end;\r\n        ErreurMat:=0;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nend;\r\n\r\nPROCEDURE SomMat(A,B:RCOMat;var C:RCOMat);\r\nvar i,j : integer;\r\n\r\nBEGIN\r\nif true\r\n    then\r\n      begin\r\n        for i:=0 to pred(DimMat) do\r\n          for j:=0 to pred(DimMat) do\r\n            C[i,j]:=A[i,j]+B[i,j];\r\n        ErreurMat:=0;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nEND;\r\n\r\nPROCEDURE MatMatR(A,B:RCOMat;M,P:integer;var C:RCOMat);\r\nvar i,j,k       : integer;\r\n    Cij         : extended;\r\nBEGIN\r\nif true\r\n    then\r\n      begin\r\n        for i:=0 to pred(DimMat) do\r\n          for j:=0 to pred(P) do\r\n            begin\r\n              Cij:=0;\r\n              for k:=0 to pred(M) do\r\n                Cij:=Cij+A[i,k]*B[k,j];\r\n              C[i,j]:=Cij;\r\n            end;\r\n        ErreurMat:=0;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nEND;\r\n\r\nPROCEDURE TransMat(A:RCOMat;var B:RCOMat;n,m:integer); \/\/n,m\u4e3aA\u7684\u884c\u3001\u5217\u6570\r\nvar i, j     : integer;\r\nbegin\r\nInit;\r\nif true\r\n    then\r\n      begin\r\n        for i:=0 to pred(m) do\r\n          for j:=0 to pred(n) do\r\n            B[i,j]:=A[j,i];\r\n        ErreurMat:=0;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nend;\r\n\r\nPROCEDURE MatUnt(var MU:RCOMat);\r\nvar i,j     : integer;\r\nbegin\r\nInit;\r\nfor i:=0 to pred(DimMat) do\r\n    for j:=0 to pred(DimMat) do\r\n      if i=j then MU[i,j]:=1\r\n             else MU[i,j]:=0;\r\nend;\r\n\r\nPROCEDURE MatVec(M:RCOMat;V:RCOVec;var W:RCOVec);\r\nvar i, j     : integer;\r\n    Wi       : extended;\r\nbegin\r\nInit;\r\nif true\r\n    then\r\n      begin\r\n        for i:=0 to pred(DimMat) do\r\n          begin\r\n            Wi:=0;\r\n            for j:=0 to pred(DimMat) do\r\n              Wi:=Wi+M[i,j]*V[j];\r\n            W[i]:=Wi;\r\n          end;\r\n        ErreurMat:=0;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nend;\r\n\r\nFUNCTION PrdScal(U,V:RCOVec) : extended;\r\nvar i : integer;\r\n    s : extended;\r\nbegin\r\nInit;\r\ns:=0;\r\nfor i:=0 to pred(DimMat) do\r\n    s:=s+U[i]*V[i];\r\nResult:=s;\r\nend;\r\n\r\nPROCEDURE ScalVec(x:extended;U:RCOVec;var V:RCOVec);\r\nvar i        : integer;\r\nbegin\r\nInit;\r\nfor i:=0 to pred(DimMat) do\r\n    V[i]:=x*U[i];\r\nend;\r\n\r\nPROCEDURE ScalMat(x:extended;A:RCOMat;var B:RCOMat);\r\nvar i,j : integer;\r\nBEGIN\r\nfor i:=0 to pred(DimMat) do\r\n    for j:=0 to pred(DimMat) do\r\n      B[i,j]:=x*A[i,j];\r\nEND;\r\n\r\nPROCEDURE AddVec (Signe:integer;U,V:RCOVec;var W:RCOVec);\r\nvar i        : integer;\r\nbegin\r\nInit;\r\nfor i:=0 to pred(DimMat) do\r\n    W[i]:=U[i]+Signe*V[i];\r\nend;\r\n\r\nPROCEDURE SomVec(U,V:RCOVec;var W:RCOVec);\r\nbegin\r\nAddVec(1,U,V,W);\r\nend;\r\n\r\nPROCEDURE DifVec(U,V:RCOVec;var W:RCOVec);\r\nbegin\r\nAddVec(-1,U,V,W);\r\nend;\r\n\r\nFUNCTION Norme(U:RCOVec)    : extended;\r\nvar i : integer;\r\n    n : extended;\r\nbegin\r\nInit;\r\nn:=0;\r\nfor i:=0 to pred(DimMat) do\r\n    n:=n+sqr(U[i]);\r\nResult:=sqrt(n);\r\nend;\r\n\r\nPROCEDURE TrianguleO(A:RCOMat;var AT:RCOMat;var Jx,Iy:RCOVecE;var Det:extended);\r\nvar i, k     : integer;\r\n    im , jm : integer;\r\n    ATkk     : extended;\r\n    C        : extended;\r\n    Max      : extended;\r\n    SignDet : integer;\r\n\r\nPROCEDURE InitJxIy;\r\nvar i:integer;\r\nbegin\r\n    for i:=0 to pred(DimMat) do\r\n    begin\r\n      Jx[i]:=i;\r\n      Iy[i]:=i;\r\n    end;\r\nend;\r\n\r\nPROCEDURE CopiAAT;\r\nvar i,j:integer;\r\nbegin\r\n    for i:=0 to pred(DimMat) do\r\n    for j:=0 to pred(DimMat) do\r\n      AT[i,j]:=A[i,j];\r\nend;\r\n\r\nPROCEDURE Reduit;\r\nvar i,j:integer;\r\nbegin\r\n    ATkk:=AT[k,k];\r\n      for i:=k+1 to pred(DimMat) do\r\n        begin\r\n          C   :=AT[i,k]\/ATkk;\r\n          for j:=k+1 to pred(DimMat) do\r\n            AT[i,j]:=AT[i,j]-C*AT[k,j];\r\n          for j:=0 to k do\r\n            if j<>k\r\n              then AT[i,j]:=AT[i,j]-C*AT[k,j]\r\n              else AT[i,j]:=-C;\r\n        end;\r\nend;\r\n\r\nPROCEDURE ChercheMax(var Max:extended;var im,jm:integer);\r\nvar i,j : integer;\r\n      M   : extended;\r\nbegin\r\n    Max:=abs(AT[k,k]);\r\n    im:=k;jm:=k;\r\n    for i:=k to pred(DimMat) do\r\n      for j:=k to pred(DimMat) do\r\n        begin\r\n          M:=abs(AT[i,j]);\r\n          if M>Max then\r\n            begin\r\n              Max:=M;\r\n              im:=i;jm:=j;\r\n            end;\r\n        end;\r\nend;\r\n\r\nPROCEDURE PermuteCol;\r\nvar Ind : integer;\r\n      i   : integer;\r\n      x   : extended;\r\nbegin\r\n    for i:=0 to pred(DimMat) do\r\n      begin\r\n        x:=AT[i,k];\r\n        AT[i,k]:=AT[i,jm];\r\n        AT[i,jm]:=x;\r\n      end;\r\n    Ind   :=Jx[k];\r\n    Jx[k] :=Jx[jm];\r\n    Jx[jm]:=Ind;\r\n    SignDet:=-SignDet;\r\nend;\r\n\r\nPROCEDURE PermuteLig;\r\nvar Ind : integer;\r\n      j   : integer;\r\n      x   : extended;\r\nbegin\r\n    for j:=0 to pred(DimMat) do\r\n      begin\r\n        x:=AT[k,j];\r\n        AT[k,j]:=AT[im,j];\r\n        AT[im,j]:=x;\r\n      end;\r\n    Ind:=Iy[k];\r\n    Iy[k]:=Iy[im];\r\n    Iy[im]:=ind;\r\n    SignDet:=-SignDet;\r\nend;\r\n\r\nbegin\r\nInitJxIy;\r\nCopiAAT;\r\nk:=0;\r\nSignDet:=1;\r\nwhile (k<=pred(DimMat)-1) and (ErreurMat=0) do\r\n    begin\r\n      ChercheMax(Max,im,jm);\r\n      if Max<>0\r\n        then\r\n          begin\r\n            if k<>jm then PermuteCol;\r\n            if k<>im then PermuteLig;\r\n            Reduit;\r\n          end\r\n        else ErreurMat:=MatDetNul;\r\n      k:=k+1;\r\n    end;\r\nDet:=SignDet;\r\nfor i:=0 to pred(DimMat) do\r\n    Det:=Det*AT[i,i];\r\nif Det=0 then ErreurMat:=MatDetNul;\r\nend;\r\n\r\nPROCEDURE ResouTrO(A:RCOMat;var X,Y:RCOVec;Jx,Iy:RCOVecE);\r\nvar i, j     : integer;\r\n    PVX      : RCOVec;\r\n    Xi       : extended;\r\n\r\nbegin\r\nif true\r\n    then\r\n      begin\r\n        SetLength(PVX,DimMat);\r\n        for i:=pred(DimMat) downto 0 do\r\n          begin\r\n            Xi:=Y[Iy[i]];\r\n            for j:=0 to i-1 do\r\n              Xi:=Xi+A[i,j]*Y[Iy[j]];\r\n            for j:=i+1 to pred(DimMat) do\r\n              Xi:=Xi-A[i,j]*PVX[j];\r\n            PVX[i]:=Xi\/A[i,i];\r\n          end;\r\n        for i:=0 to pred(DimMat) do\r\n          X[Jx[i]]:=PVX[i];\r\n        Setlength(PVX,0);\r\n        ErreurMat:=0;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nend;\r\n\r\nPROCEDURE SysLin(A:RCOMat;var X:RCOVec;B:RCOVec;var Det:extended);\r\nvar AT       : RCOMat;\r\n    Jx,Iy    : RCOVecE;\r\n\r\nPROCEDURE Alloc;\r\nbegin\r\n    SetLength(AT,DimMat,DimMat);\r\n    SetLength(Jx,DimMat);\r\n    SetLength(Iy,DimMat);\r\nend;\r\n\r\nPROCEDURE DesAlloc;\r\nbegin\r\n    SetLength(Iy,0);\r\n    SetLength(Jx,0);\r\n    SetLength(At,0,0);\r\nend;\r\n\r\nbegin\r\nInit;\r\nif true\r\n    then\r\n      begin\r\n        Alloc;\r\n        TrianguleO(A,AT,Jx,Iy,Det);\r\n        if Det<>0\r\n          then ResouTrO(AT,X,B,Jx,Iy);\r\n        DesAlloc;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nend;\r\n\r\nPROCEDURE InvMat(A:RCOMat;var B:RCOMat;var Det:extended);\r\nvar j        : integer;\r\n    AT       : RCOMAt;\r\n    PVX      : RCOVec;\r\n    Jx,Iy    : RCOVecE;\r\n\r\nPROCEDURE Alloc;\r\nbegin\r\n    Setlength(AT,DimMat,DimMat);\r\n    SetLength(PVX,DimMat);\r\n    SetLength(Jx,DimMat);\r\n    SetLength(Iy,DimMat);\r\nend;\r\n\r\nPROCEDURE DesAlloc;\r\nbegin\r\n    SetLength(Iy,0);\r\n    SetLength(Jx,0);\r\n    SetLength(PVX,0);\r\n    SetLength(AT,0,0);\r\nend;\r\n\r\nPROCEDURE initVX;\r\nvar i : integer;\r\nbegin\r\n    for i:=0 to pred(DimMat) do\r\n      PVX[i]:=0;\r\n    PVX[j]:=1;\r\nend;\r\n\r\nPROCEDURE TransfertCol;\r\nvar i : integer;\r\nbegin\r\n    for i:=0 to pred(DimMat) do\r\n      B[i,j]:=PVX[i];\r\nend;\r\n\r\nbegin\r\nInit;\r\nif true\r\n    then\r\n      begin\r\n        Alloc;\r\n        TrianguleO(A,AT,Jx,Iy,Det);\r\n        if ErreurMat=0\r\n          then\r\n            begin\r\n              for j:=0 to pred(DimMat) do\r\n              begin\r\n                InitVX;\r\n                ResouTrO(AT,PVX,PVX,Jx,Iy);\r\n                TransfertCol;\r\n              end;\r\n            end;\r\n        DesAlloc;\r\n      end\r\n    else ErreurMat:=MatDebordTas;\r\nend;\r\n\r\ninitialization\r\nIni:=false;\r\nDimMat:=0;\r\nEND.\r\n\r\n\/\/ Test program :\r\n{\r\nprocedure TForm1.FormCreate(Sender: TObject);\r\nConst Dim = 200;\r\nvar   A,B,C : RCOMat;\r\n      V,W,U : RCOVec;\r\n      i,j   : integer;\r\n      Det   : extended;\r\nbegin\r\nInitMat(Dim);\r\nSetLength(A,Dim,Dim);\r\nSetLength(B,Dim,Dim);\r\nSetLength(C,Dim,Dim);\r\nRandomize;\r\nfor i:=0 to pred(Dim) do\r\n    begin\r\n      V[i]:=random*10;\r\n      for j:=0 to pred(Dim) do\r\n      A[i,j]:=random*10;\r\n    end;\r\nInvMat(A,B,Det);\r\nMatMat(A,B,C);\r\n\/\/ [C] should be the unit matrix\r\nend;\r\n}\r\n<\/pre>\n","protected":false},"excerpt":{"rendered":"
\/\/ Unit MATRICE \/\/ OBJECT : matrix and vector aritmetic […]<\/p>\n","protected":false},"author":1,"featured_media":0,"comment_status":"open","ping_status":"open","sticky":false,"template":"","format":"standard","meta":{"footnotes":""},"categories":[6],"tags":[],"class_list":["post-362","post","type-post","status-publish","format-standard","hentry","category-code_related"],"_links":{"self":[{"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/posts\/362","targetHints":{"allow":["GET"]}}],"collection":[{"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/posts"}],"about":[{"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/types\/post"}],"author":[{"embeddable":true,"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/users\/1"}],"replies":[{"embeddable":true,"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/comments?post=362"}],"version-history":[{"count":1,"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/posts\/362\/revisions"}],"predecessor-version":[{"id":4768,"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/posts\/362\/revisions\/4768"}],"wp:attachment":[{"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/media?parent=362"}],"wp:term":[{"taxonomy":"category","embeddable":true,"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/categories?post=362"},{"taxonomy":"post_tag","embeddable":true,"href":"https:\/\/kyle.ai\/blog\/wp-json\/wp\/v2\/tags?post=362"}],"curies":[{"name":"wp","href":"https:\/\/api.w.org\/{rel}","templated":true}]}}