Block Matrix Algebra with Mathematica

Question

I have come up with some BlockMatrix Algebra for Mathematica to make notations easier.

I have the following:

Needs["Notation`"];
Notation[ParsedBoxWrapper[
RowBox[{"A_", "\[CenterDot]", "B_"}]] \[DoubleLongLeftRightArrow] 
   ParsedBoxWrapper[
RowBox[{"BlockMultiply", "[", 
RowBox[{"A_", ",", "B_"}], "]"}]]];
Notation[ParsedBoxWrapper[
SuperscriptBox["A_", "Inv"]] \[DoubleLongLeftRightArrow] 
   ParsedBoxWrapper[
RowBox[{"BlockInv", "[", "A_", "]"}]]];
Notation[ParsedBoxWrapper[
SuperscriptBox[
RowBox[{"(", "A_", ")"}], "T"]] \[DoubleLongLeftRightArrow] 
   ParsedBoxWrapper[
RowBox[{"BlockTransp", "[", "A_", "]"}]]];

And the actual matrix algebra functions:

ClearAll[BlockTransp]
(*SetAttributes[BlockTransp,OneIdentity]*)

BlockTransp[M_List] := Map[BlockTransp[#] &, Transpose[M], {2}] 
BlockTransp[M__ + B__ ] := BlockTransp[M] + BlockTransp[B]
BlockTransp[a_ /; NumberQ[a]] := a;
BlockTransp[a_Scalar ] := a;
BlockTransp[a_   M__ /; NumberQ[a]] := a BlockTransp[M];
BlockTransp[a_Scalar   M__] := a BlockTransp[M];

BlockTransp[BlockMultiply[x_, y_] ] := 
 BlockMultiply[BlockTransp[y], BlockTransp[x]]
BlockTransp[BlockTransp[x_]] := x

ClearAll[BlockMultiply]
BlockMultiply[mats1 : {{_ ..} ..}, mats2 : {{_ ..} ..}] := 
 Inner[BlockMultiply, mats1, mats2]
(*For numbers*)

BlockMultiply[a_ A_ /; NumberQ[a], B_] := a BlockMultiply[A, B]
BlockMultiply[A_ , a_ B_ /; NumberQ[a]] := a BlockMultiply[A, B]
BlockMultiply[A__, a_ /; NumberQ[a]] := a A
BlockMultiply[a_ /; NumberQ[a], A__ ] := a A
(*For scalar symbols*)

BlockMultiply[a_Scalar A_, B_] := a BlockMultiply[A, B]
BlockMultiply[A_ , a_Scalar B_ ] := a BlockMultiply[A, B]
BlockMultiply[A__, a_Scalar ] := a A
BlockMultiply[a_Scalar, A__ ] := a A



ClearAll[BlockInv]
BlockInv[mats1 : {{_ ..} ..}] := Map[BlockInv[#] &, mats1, {2}];
BlockInv[ a_ /; NumberQ[a]] := a

(*Make some formatting expression*)
Scalar /: MakeBoxes[Scalar[a_], StandardForm] := 
  MakeBoxes[a, StandardForm];

I can do now some funny cool thing like:
1. Example:

2. Example:

3. Example:

4. Example:

Remark: Of course the BlockInverse Function is sensless in the sense that it does not really invert correctly. The input to BlockInverse should only be a diagonal block matrix! There is a general formula for block matrices Block Inversion, but it is not implemented here for the sake of simplicity.

I have two questions which I could not come up so far:

1. How can I make the 3. example such that the scalar variable is treated like a scalar? Can I overload NumberQ[scalar]:= ... ? Or is there a better way? [SOLVED] See the above definitions with added _Scalar that matches any pattern with head Scalar. See example 4!

2. How can I pretty print these things such that superfluous brackets are neglected? Is there some elegant way for the function definitions such that, associativity and non-commutativity is handled well?

Answer 1

The idea about associativity is to use InfixNotation:

InfixNotation[ParsedBoxWrapper["\[CenterDot]"], Mult]

Then the associativity can be defined as

Mult[A___, mats1 : {{_ ..} ..}, mats2 : {{_ ..} ..}, D___] := Mult[A, Inner[Mult, mats1, mats2], D]
Mult[A___, Mult[B__], D___] := Mult[A, B, D];
Mult[A_] := A;

This allow you to get rid of some of the unnecessary brackets

Getting rid of the the brackets under the inverse operator is a bit more tricky. I don't know good answer, so I reformulated this question here. However I used the following workaround:

All the matrices are assumed to be enclosed in Matrix[] function. This allows me to make them bold in the output using the following code:

Notation[ParsedBoxWrapper[TagBox[StyleBox["A_", Rule[FontWeight, Bold]], ""]] \[DoubleLongLeftArrow] ParsedBoxWrapper[RowBox[{"Matrix", "[", "A_", "]"}]]]

Then the inverse of single matrix variable can be defined as InvSimple:

Inv[Matrix[A_]] := InvSimple[Matrix[A]];

and two different Notations for Inv and InvSimple are used

Notation[ParsedBoxWrapper[SuperscriptBox[RowBox[{"(", "A_", ")"}], RowBox[{"-", "1"}]]]\[DoubleLongLeftArrow] ParsedBoxWrapper[RowBox[{"Inv", "[", "A_", "]"}]]]
Notation[ParsedBoxWrapper[SuperscriptBox["A_", RowBox[{"-", "1"}]]]\[DoubleLongLeftArrow] ParsedBoxWrapper[RowBox[{"InvSimple", "[", "A_", "]"}]]]

The full code I am using is here (This code does not fully cover all the options that are implemented in your code, still it might interest you)

Notation[ParsedBoxWrapper[StyleBox["I", Rule[FontWeight, Bold]]] \[DoubleLongLeftArrow] ParsedBoxWrapper["IMatrix"]]
Notation[ParsedBoxWrapper[TagBox[StyleBox["A_", Rule[FontWeight, Bold]], ""]]\[DoubleLongLeftArrow] ParsedBoxWrapper[RowBox[{"Matrix", "[", "A_", "]"}]]]
InfixNotation[ParsedBoxWrapper["\[CenterDot]"], Mult]
Notation[ParsedBoxWrapper[SuperscriptBox[RowBox[{"(", "A_", ")"}], RowBox[{"-", "1"}]]]\[DoubleLongLeftArrow] ParsedBoxWrapper[RowBox[{"Inv", "[", "A_", "]"}]]]
Notation[ParsedBoxWrapper[SuperscriptBox["A_", RowBox[{"-", "1"}]]]\[DoubleLongLeftArrow] ParsedBoxWrapper[RowBox[{"InvSimple", "[", "A_", "]"}]]]

ClearAll[Matrix, Mult, Inv]
(*Matrix*)
Matrix[0] := 0;
Matrix[a_ /; NumberQ2[a]] := a IMatrix;
(*Multiplication*)
Mult[A___, mats1 : {{_ ..} ..}, mats2 : {{_ ..} ..}, D___] :=  Mult[A, Inner[Mult, mats1, mats2], D]
Mult[A___, Mult[B__], D___] := Mult[A, B, D];
Mult[A_] := A;

Mult[A___, a_ B_ /; NumberQ[a], D___] := a Mult[A, B, D];
Mult[A___, a_ /; NumberQ[a], D___] := a Mult[A, D];
Mult[A___, X_, X_, D___] := Mult[A, X^2, D];
(*Inverse*)
Inv[Inv[A_]] := A;
Inv[Mult[A_, B__]] := Mult[Inv[B], Inv[A]];
Inv[Matrix[A_]] := InvSimple[Matrix[A]];
Inv[InvSimple[A_]] := A;
Inv[IMatrix] := IMatrix;
Inv[a_ B__ /; NumberQ[a]] := Inv[B]/a;