unit MaticeUnit;

interface
//const Max = 2000;
type
  TMatice = Class
  public
    m, n: Integer;
    elem:array of array of double;
    constructor Create(a, b: Integer);
    procedure Recreate(a, b: Integer);
    procedure s_cti(filename: string);
    procedure s_uloz(filename: string);
    function transp:TMatice;
    function Inv(mat: TMatice): TMatice;
    function Nasob(mat: TMatice):TMatice;
    function NasobSkal(c: Double): TMatice;
    function GEM(mat: TMatice):TMatice;
    function Prumer: Double;
    function Maximum: Double;
    function Minimum: Double;
    function MinimumBezNul: Double;
end;

function MNC(t,y:TMatice):TMatice;
var Error:boolean;

implementation

uses SysUtils,Math;
constructor TMatice.Create(a,b:integer);
var i,j: integer;
begin
  if (a<>0)and(b<>0) then begin
    Error:=false;
    SetLength(elem, a, b);
    m:=a;
    n:=b;
    for i:=0 to a - 1 do begin
      for j:=0 to b - 1 do begin
        elem[i,j]:=0;
      end;
    end;
  end
  else Error:=true;
end;

procedure TMatice.s_cti(filename:string);
var soubor:TextFile;
    i,j:integer;
begin
  {$I-}
  AssignFile(soubor,filename);
  if FileExists(filename) then begin
    Reset(soubor);
      i:=0;
      if (IOResult=0) then begin
        while not SeekEof(soubor) do begin
          j:=0;
          while not SeekEoln(soubor) do begin
            read(soubor,elem[i,j]);
            Inc(j);
          end;
          Inc(i);
        end;
      end
      else writeln('Chybicka se vloudila :)');
    Close(soubor);
    {$I+}
    m:=i;
    n:=j;
  end;
end;

procedure TMatice.s_uloz(filename:string);
var soubor:TextFile;
    i,j:integer;
begin
  AssignFile(soubor,filename);
  Rewrite(soubor);
  for i:=0 to m - 1 do begin
    for j:=0 to n - 1 do begin
      write(soubor,elem[i,j]:5:4,' ');
    end;
    writeln(soubor);
  end;
  Close(soubor);
end;

function TMatice.transp:TMatice;
var i,j:integer;
begin
  transp:=TMatice.Create(n,m);
  for i:= 0 to n - 1 do begin
    for j:= 0 to m - 1 do begin
      transp.elem[i,j]:=elem[j,i];
    end;
  end;
end;

function TMatice.Nasob(mat:TMatice):TMatice;
var i,j,k:integer;
    Pomocna:TMatice;
begin
  if (n<>mat.m) then Error:=true
  else begin
    Pomocna := TMatice.Create(m,mat.n);
    for i:=0 to m - 1 do begin
      for k:=0 to mat.n - 1 do begin
        for j:=0 to n - 1 do begin
          Pomocna.elem[i,k]:=Pomocna.elem[i,k]+elem[i,j]*mat.elem[j,k];
        end;
      end;
    end;
    Nasob:=Pomocna;
  end;
end;

//GEM s částečným výběrem hlavního prvku, řeší rovnici TMatice*GEM=mat
function TMatice.GEM(mat:TMatice):TMatice;
var U,x:TMatice;
    pomoc:double;
    max,i,j,k:integer;
begin
  if (mat.m<>m) or (mat.n<>1) then Error:=true
  else begin
    //přímý chod
    U:=TMatice.Create(m,n+1);
    x:=TMatice.Create(mat.m,mat.n);
    for i:=0 to m - 1 do begin
      for j:=0 to n - 1 do begin
        U.elem[i,j]:=elem[i,j];
      end;
      U.elem[i,n]:=mat.elem[i,0];
    end;
    for i:= 0 to n - 1 do begin
      max:=i;
      for j:=i+1 to n - 1 do begin
        if (Abs(U.elem[j,i])>Abs(U.elem[i,i])) then max:=j;
      end;
      if (max<>i) then begin
        for k:=i to n do begin
          pomoc:=U.elem[i,k];
          U.elem[i,k]:=U.elem[max,k];
          U.elem[max,k]:=pomoc;
        end;
      end;
      if (U.elem[i,i]<>0) then begin
        for j:=i+1 to n - 1 do begin
          for k:=n downto i do begin
            U.elem[j,k]:=U.elem[j,k]-U.elem[i,k]*(U.elem[j,i]/U.elem[i,i]);
          end;
        end;
      end;
    end;
    //zpětný chod
//    for i:=0 to n - 1 do begin
//      x.elem[i,0]:=U.elem[i,n];
//    end;

    for i:=n-1 downto 0 do begin
      pomoc:=0;
      for j:= i to n-1 do begin
        pomoc:=pomoc+(U.elem[i,j]*x.elem[j,0]);
      end;
      x.elem[i,0]:=(U.elem[i,n]-pomoc)/U.elem[i,i];
    end;
    GEM:=x;
  end;
  end;

function TMatice.Inv(mat: TMatice): TMatice;
begin

end;

function MNC(t,y:TMatice):TMatice;
var A:TMatice;
    i,j:integer;
begin
  if (t.m<>y.m) then Error:=true
  else begin
    A:=TMatice.Create(t.m,4);
    for i:=1 to A.m do begin
      for j:=1 to A.n do begin
        A.elem[i,j]:=Power(t.elem[i,1],j-1);
      end;
    end;
    MNC:=A.transp.Nasob(A).GEM(A.transp.Nasob(y));
  end;
end;

function TMatice.Prumer:Double;
var i,j:integer;
    a:Double;
begin
  a:=0;
  for i:=0 to m - 1 do begin
    for j:=0 to n - 1 do begin
      a:=a+elem[i,j];
    end;
  end;
  Prumer:=a/(m*n);
end;

procedure TMatice.Recreate(a, b: Integer);
var i,j: integer;
begin
  if (a<>0)and(b<>0) then begin
    Error:=false;
    SetLength(elem, a, b);
    m:=a;
    n:=b;
    for i:=0 to a - 1 do begin
      for j:=0 to b - 1 do begin
        elem[i,j]:=0;
      end;
    end;
  end
  else begin
    m := a;
    n := b;
    Error:=true;
  end;
end;

function TMatice.Maximum:Double;
var i,j:integer;
    maxik:double;
begin
  maxik:=0;
  for i:=0 to m - 1 do begin
    for j:=0 to n - 1 do begin
      if maxik<elem[i,j] then maxik:=elem[i,j];
    end;
  end;
  Result:=maxik;
end;

function TMatice.Minimum: Double;
var i,j:integer;
    minik:double;
begin
  minik:=600;
  for i:=0 to m - 1 do begin
    for j:=0 to n - 1 do begin
      if minik>elem[i,j] then minik:=elem[i,j];
    end;
  end;
  Result:=minik;
end;

function TMatice.MinimumBezNul: Double;
var i,j:integer;
    minik:double;
begin
  minik:=600;
  for i:=0 to m - 1 do begin
    for j:=0 to n - 1 do begin
      if (elem[i,j]<>0) and (minik>elem[i,j]) then minik:=elem[i,j];
    end;
  end;
  Result:=minik;
end;

function TMatice.NasobSkal(c: Double): TMatice;
begin

end;

end.
