ITSKURS

Program matrixs;

{$APPTYPE CONSOLE}

{$R *.res}

Uses
  System.SysUtils, Windows;

Const
  cExpression = ['0'..'9','*','-','+','A','B'];
  cSigns = ['*','-','+'];
  cWSigns = ['0'..'9','A','B'];
  cExpresTr = ['*','0'..'9','(','t','A'];

Type
  tMatr = array of array of real;

Var
  A:tMatr;
  B:tMatr;
  expr:string;
  i,i1,j1,i2,j2,count:integer;
  basis,check,checkz:boolean;
  input:char;
  uuzka:extended;
  inm:char;

procedure fillManual(var Matr:tMatr; line,col:integer);
var
  i,j:integer;
begin
  for i := 0 to line-1 do
    for j := 0 to col-1 do
    begin
      write('[',i,',',j,']:');
      readln(Matr[i,j]);
      writeln;
    end;
end;

procedure fillRandom(var Matr:tMatr; line,col:integer);
var
  i,j:integer;
begin
  randomize;
  for i := 0 to line-1 do
    for j := 0 to col-1 do
      Matr[i,j]:=Random(10);
end;

procedure hyphen;
begin
  writeln('--------------------------');
end;

procedure swapStr(var Matr:tMatr; col, line1,line2:integer);
var
  j:integer;
  tmp:real;
begin
  for j := 0 to col do
  begin
    tmp:=Matr[line1,j];
    Matr[line1,j]:=Matr[line2,j];
    Matr[line2,j]:=tmp;
  end;
end;

procedure OutPutMatrix(Matr:tMatr; line,col:integer);
var
  i,j:integer;
begin
  for i := 0 to line-1 do
  begin
    for j := 0 to col-1 do
      write(Matr[i,j]:10:2,' ':4);
    writeln;
  end;
end;

function SumMatrix(M1,M2:tMatr; line,col:integer):tMatr;
var
  i,j:integer;
  XM:tMatr;
begin
  SetLength(XM,line,col);
  for i := 0 to line-1 do
    for j := 0 to col-1 do
      XM[i,j]:=M1[i,j]+M2[i,j];
  SumMatrix:=XM;
end;

function SubMatrix(M1,M2:tMatr; line,col:integer):tMatr;
var
  i,j:integer;
  XM:tMatr;
begin
  SetLength(XM,line,col);
  for i := 0 to line-1 do
    for j := 0 to col-1 do
      XM[i,j]:=M1[i,j]-M2[i,j];
  SubMatrix:=XM;
end;

function COM(a:integer; Matr:tMatr; line,col:integer):tMatr;
//COM - const*Matrix
var
  i,j:integer;
  XM:tMatr;
begin
  SetLength(XM,line,col);
  for i := 0 to line-1 do
    for j := 0 to col-1 do
      XM[i,j]:=a*Matr[i,j];
  COM:=XM;
end;

function MultiMatrix(M1,M2:tMatr; line1,col1,line2,col2:integer):tMatr;
var
  i,k,m:integer;
  XM:tMatr;
begin
  SetLength(XM,line1,col2);
  for k := 0 to line1-1 do
    for i := 0 to col2-1 do
      for m := 0 to col1-1 do
        XM[k,i]:=XM[k,i]+M1[k,m]*M2[m,i];

  MultiMatrix:=XM;
end;

function TranMatrix(M1:tMatr; line,col:integer):tMatr;
var
  i,j:integer;
  XM:tMatr;
begin
  SetLength(XM,col,line);
  for i := 0 to line-1 do
    for j := 0 to col-1 do
      XM[j,i]:=M1[i,j];
  TranMatrix:=XM;
end;

procedure SortStr(var Matr, EMatr:tMatr; line,col:integer);
var
  i,j,k,indMin,x:integer;
  tmp:real;
  flag,check:boolean;
begin
  for i := 1 to line-1 do
    repeat
    flag:=true;
      for k := line-1 downto i do
      begin
        if Matr[k-1,0]>Matr[k,0] then
        begin
          flag:=false;
          for j := 0 to col-1 do
          begin
            tmp:=Matr[k-1,j];
            Matr[k-1,j]:=Matr[k,j];
            Matr[k,j]:=tmp;

            tmp:=EMatr[k-1,j];
            EMatr[k-1,j]:=EMatr[k,j];
            EMatr[k,j]:=tmp;
          end;

        end;
      end;
    until flag;
end;

procedure Gauss(var Matr:tMatr; line,col:integer; var checkSw:Boolean);
var
  AX:tMatr;
  n,j,i,v,zn:integer;
  k:real;
  flag:boolean;
begin
  n:=line-1;
  for v := 0 to n do
  begin

    for j := v+1 to n do
    begin
      if Matr[v,v] = 0 then
      begin
        for zn := v+1 to line-1 do
          if Matr[zn,v] <> 0 then
          begin
            swapStr(Matr, n, v, zn);
            flag:=true;
            checkSw:=not checkSw;
            break;
          end
          else
            flag:=false;

        if flag=false then
          break;
      end;

      k:=Matr[j,v]/Matr[v,v];
      for i := 0 to n do
        Matr[j,i]:=Matr[j,i]-k*Matr[v,i];
    end;
  end;
end;

function Dim(Matr:tMatr; line,col:integer):extended;
var
  i,j:integer;
  X:extended;
  Swaps:boolean;

begin
  Swaps:=false;
  Gauss(Matr,line,col,Swaps);
  X:=1;
  for i := 0 to line-1 do
    X:=X*Matr[i,i];

  if Swaps then
    X:=-X;

  Dim:=X;
end;

function Degenerate(Matr:tMatr; line,col:integer):Boolean;
begin
  if Dim(Matr,line,col) <> 0 then
    Degenerate:=False
  else
    Degenerate:=True;
end;

procedure GaussE(var Matr, EMatr:tMatr; line,col:integer);
var
  i,j,m,v,zn,n:integer;
  k:real;
  flag:boolean;
begin
  n:=line-1;
  for v := 0 to n do
  begin
    for j := v+1 to n do
    begin
      if Matr[v,v] = 0 then
      begin
        for zn := v+1 to n do
          if Matr[zn,v] <> 0 then
          begin
            swapStr(Matr, n, v, zn);
            swapStr(EMatr, n, v, zn);
            flag:=true;
            break;
          end
          else
            flag:=false;

        if flag=false then
          break;
      end;
      k:=Matr[j,v]/Matr[v,v];
      for i := 0 to n do
      begin
        Matr[j,i]:=Matr[j,i]-(k*Matr[v,i]);
        EMatr[j,i]:=EMatr[j,i]-(k*EMatr[v,i]);
      end;
    end;
  end;
end;

procedure GaussAb(var Matr, EMatr:tMatr; line,col:integer);
var
  i,j,m,v,n,zn:integer;
  k:real;
  flag:boolean;
begin
  n:=line-1;
  for v := n downto 0 do
  begin
    for j := v-1 downto 0 do
    begin
      if Matr[v,v] = 0 then
      begin
        for zn := v-1 to 0 do
          if Matr[zn,v] <> 0 then
          begin
            swapStr(Matr, n, v, zn);
            swapStr(EMatr, n, v, zn);
            flag:=true;
            break;
          end
          else
            flag:=false;

        if flag=false then
          break;
      end;
      k:=Matr[j,v]/Matr[v,v];
      for i := n downto 0 do
      begin
        Matr[j,i]:=Matr[j,i]-k*Matr[v,i];
        EMatr[j,i]:=EMatr[j,i]-k*EMatr[v,i];
      end;
    end;
  end;
end;

function InvMatr(Matr:tMatr; line,col:integer):tMatr;
var
  i,j,m:integer;
  E:tMatr;
  tmp:real;
begin
  SetLength(E, line, col);
  for i := 0 to line-1 do
    E[i,i]:=1;

  GaussE(Matr,E, line, col);
  GaussAb(Matr,E,line,col);
  for i := 0 to line-1 do
    for j := 0 to col-1 do
      E[i,j]:=E[i,j]/Matr[i,i];

  for i := 0 to line-1 do
    for j := 0 to col-1 do
      Matr[i,j]:=Matr[i,j]/Matr[i,i];

  InvMatr:=E;
end;

Begin
  writeln('dim:');
  readln(i1);
  setlength(A,i1,i1);
  writeln('1 - manual'#10,'2 - random'#10,'else - exit');
  readln(inm);
  case inm of
    '1':  fillManual(A,i1,i1);
    '2':  fillRandom(A,i1,i1)
    else
      exit;
  end;
  OutPutMatrix(A,i1,i1);
  hyphen;
//  writeln('det: ',Dim(A,i1,i1):0:2);
  try
    writeln('Inverse:');
    OutPutMatrix(InvMatr(A,i1,i1),i1,i1);
    hyphen;
    writeln('A:');
    OutPutMatrix(A,i1,i1);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;

{
  basis:=false;
  Writeln('Hello!');
  repeat
    writeln('What do you want to do?');
    writeln('1 - matrix calculator(add,sub,mult)');
    writeln('2 - matrix transformation');
    writeln('0 - close program');
    repeat
      try
        readln(input);
        case input of
          '1':
          begin
            checkz:=true;
            writeln('Set i by j matrix A:');
            repeat
              try
                readln(i1,j1);
                if (i1>0) and (j1>0) then
                begin
                  SetLength(A,i1,j1);
                  check:=true;
                end
                else
                  strtoint('V');
              except
                check:=false;
                writeln('опять елена павловна виновата?');
              end;
            until check;

            writeln('How do you want to fill matrix A?');
            writeln('1 - random',#10,'2 - manually');
            writeln('0 - close program');
            repeat
              try
                readln(input);
                case input of
                  '1': fillRandom(A,i1,j1);
                  '2': fillManual(A,i1,j1);
                  '0': exit;
                  else
                    strtoint('V');
                end;
                check:=true;
              except
                check:=false;
                writeln('опять елена павловна виновата?');
              end;
            until check;

            writeln('Set i by j matrix B:');
            repeat
              try
                readln(i2,j2);
                if (i2>0) and (j2>0) then
                begin
                  SetLength(B,i2,j2);
                  check:=true;
                end
                else
                  strtoint('V');
              except
                check:=false;
                writeln('опять елена павловна виновата?');
              end;
            until check;

            writeln('How do you want to fill matrix B?');
            writeln('1 - random',#10,'2 - manually');
            writeln('0 - close program');
            repeat
              try
                readln(input);
                case input of
                  '1': fillRandom(B,i2,j2);
                  '2': fillManual(B,i2,j2);
                  '0': exit;
                  else
                    strtoint('V');
                end;
                check:=true;
              except
                check:=false;
                writeln('опять елена павловна виновата?');
              end;
            until check;

            writeln('A[',i1,',',j1,']:');
            OutPutMatrix(A,i1,j1);

            hyphen;
            writeln('B[',i2,',',j2,']:');
            OutPutMatrix(B,i2,j2);

            writeln('Enter the expression of 2 matrices');
            writeln('Example: A+B or A*B');
            writeln('0 - close program');
            repeat
              try
                readln(expr);
                if expr = '0' then
                  exit;
                if (not (expr[1] in cWSigns)) or (expr[length(expr)] in cSigns) then
                  StrToInt('V');

                for i := 1 to length(expr) do
                  if expr[i] in cExpression then
                    check:=True
                  else
                    StrToInt('V');

                if (expr[2] = '+') or (expr[2] = '-') then
                  if not ((i1 = i2) and (j1=j2)) then
                  begin
                    writeln('For addition / subtraction, dimension must be the same');
                    StrToInt('V');
                  end;

                if (expr[2] = '*') and (not (expr[1] in ['0'..'9'])) then
                  if j1 <> i2 then
                  begin
                    writeln('For multiplication the number of columns of matrix A');
                    writeln('and the number of rows of matrix B MUST BE the same!');
                    StrToInt('V');
                  end;

                count:=0;
                for i := 1 to length(expr) do
                  if (expr[i] = 'A') or (expr[i] = 'B') then
                    count:=count+1;
                if count>2 then
                  StrToInt('V');

                if expr[2]=expr[3] then
                  StrToInt('V');


              except
                writeln('опять елена павловна виновата?');
                writeln('0 - close program');
                readln(expr);
                if expr = '0' then
                  exit;
                check:=False;
              end;
            until check;

            hyphen;
            writeln(expr,':');

            if not (expr[1] in ['0'..'9']) then
              case expr[2] of
                '+': OutPutMatrix(SumMatrix(A,B,i1,j1),i1,j1);
                '-': OutPutMatrix(SubMatrix(A,B,i1,j1),i1,j1);
                '*': OutPutMatrix(MultiMatrix(A,B,i1,j1,i2,j2),i1,j2);
              end;
          end;
          '2':
          begin
            checkz:=true;
            writeln('Set i by j matrix A:');
            repeat
              try
                readln(i1,j1);
                if (i1>0) and (j1>0) then
                begin
                  SetLength(A,i1,j1);
                  check:=true;
                end
                else
                  strtoint('V');
              except
                check:=false;
                writeln('опять елена павловна виновата?');
              end;
            until check;

            writeln('How do you want to fill matrix A?');
            writeln('1 - random',#10,'2 - manually');
            writeln('0 - close program');
            repeat
              try
                readln(input);
                case input of
                  '1': fillRandom(A,i1,j1);
                  '2': fillManual(A,i1,j1);
                  '0': exit;
                  else
                    strtoint('V');
                end;
                check:=true;
              except
                check:=false;
                writeln('опять елена павловна виновата?');
              end;
            until check;

            writeln('A[',i1,',',j1,']:');
            OutPutMatrix(A,i1,j1);

            writeln('Enter the expression of 2 matrices');
            writeln('Example: 3*A or A( or At');
            writeln('A( - inverse matrix(soon)',#10,'At - transposed matrix');
            writeln('0 - close program');
            repeat
              try
                readln(expr);
                if expr = '0' then
                  exit;
                hyphen;
                case expr[2] of
                  '*':
                  begin
                    check:=true;
                    OutPutMatrix(COM(StrToInt(expr[1]),A,i1,j1),i1,j1);
                  end;
                  't':
                  begin
                    check:=true;
                    OutPutMatrix(TranMatrix(A,i1,j1),j1,i1);
                  end;
                  '(':
                  begin
                    check:=true;
                    writeln('Oops, not available now =(',#10,'Try again later =)');
                  end
                  else
                    StrToInt('V');
                end;
              except
                check:=false;
                writeln('опять елена павловна виновата?');
                writeln('0 - close program');
                readln(expr);
                if expr = '0' then
                  exit;
              end;
            until check;
          end;
          '0': exit;
          else StrToInt('V');
        end;
      except
        checkz:=false;
        writeln('опять елена павловна виновата?');
      end;
    until checkz;
  until basis;
  }
  hyphen;
  writeln('Press "Enter" to exit...');
  readln;
End.