<< NCGB.m;

<< NCMakeRelations.m;

SetNonCommutative[A, B, G, H, Q, iA, iB];

(* This represents the `If' part of the claim;  namely,  
      we show that if A and B commute and A and B are both EP, 
  then the pseudo - 
        inverses of A and B also commute. *)

(* 
      The following is a list of relations which we shall use,  
      along with an order which we shall define later in a Groebner basis algorithm .   A and B are two commuting
matrices .   We denote their pseudo - 
        inverses by iA and iB respectively .   Tp is an involution,  which in this case we think of as being the Hermitian adjoint .   We assume that A and B are EP
and hence there exist matrices invertible G and H such that A ** 
            G  =  Tp[A] and B ** H  =  Tp[
              B]. *) 

TpCompinv2 = {A ** B - 
            B ** A, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + iB ** iA - 
            iA ** iB, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[A] ** Tp[B] + 
            Tp[B] ** Tp[A], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[iB] ** Tp[iA] + 
            Tp[iA] ** Tp[iB] + Tp[Q], 
          Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - 
            iB ** B
};

NewRelations  = 
        NCAddTranspose[TpCompinv2 //. Tp -> tp] //. 
          tp -> Tp;

ClearMonomialOrderAll[];

SetMonomialOrder[{{iA, 
          Tp[iA], A, Tp[A], iB, Tp[iB], 
B, Tp[B], G, 
          Inv[G], Tp[G], Tp[Inv[G]], 
H, Inv[H], Tp[H], 
          Tp[Inv[H]]}, {Q, Tp[Q]}}]

PrintMonomialOrder[];

\(\(\( (*\ 
      We\ now\ run\ the\ Grobner\ Basis\ algorithm . \ \ It\ is\ called\ by\ using\ the\ NCProcess\ command . \ \ We\ are
using\ 2\ iterations\ and\ are\ using\ two\ options\ to\ save\ \(\(time\)\(.\)\)\ *) \)\(
\)\(
\)\(
\)\(Nextans1 = 
        NCProcess[NewRelations, 2, 0, 0, 0, "ABbothEPproblem1a", 
          SBByCat -> False, 
NCCV -> 
            False];\)\)\)

(* 
      The Groebner basis outputs three lists .   The third list is another list consisting of new relations
 
        obtained by the Groebner basis algorithm .   Note that the first element of the third list is Q .   Hence
 
        we conclude that our relations,  when set equal to zero,  
      imply that Q is zero .   But Q - iA ** iB + 
        iB ** iA is
also zero .   We conclude that iA and iB commute .   Recall that iA and iB represent the pseudo - inverses
of A and B respectively. *) 

 (* 
      The output consists of a list of three lists .   The third list consists of new relations obtained by running
the Groebner basis algorithm .   In this case the first relation in the third list is Q .   Hence the pseudo - inverses of A and B commute,  
      establishing the `if' part of part b. *) 

Nextans1[[2]][[52]]

TpCompinv3 = {iA ** iB - 
            iB ** iA, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + B ** A - 
            A ** B, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[iA] ** Tp[iB] + 
            Tp[iB] ** Tp[iA], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[B] ** Tp[A] + Tp[A] ** Tp[B] + 
            Tp[Q], Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - iB ** B
};

\(\(\(NewRelations2\  = \ 
        NCAddTranspose[TpCompinv3 //. Tp -> tp] //. 
          tp -> Tp;\)\(
\)\)\)

Nextans2 = 
        NCProcess[NewRelations2, 3, 0, 0, 0, "ABbothEPproblem2a", 
          SBByCat -> False, 
NCCV -> 
            False];

Nextans2[[3]][[1]]

ClearMonomialOrderAll[];

<< NCGB.m;

<< NCMakeRelations.m;

SetNonCommutative[A, B, G, H, Q, iA, iB];

(* 
      The following is a list of relations which we shall use,  
      along with an order which we shall define later in a Groebner basis algorithm .   A and B are two commuting
matrices .   We denote their pseudo - 
        inverses by iA and iB respectively .   Tp is an involution,  which in this case we think of as being the Hermitian adjoint .   We assume that A and B are EP
and hence there exist matrices invertible G and H such that A ** 
            G  =  Tp[A] and B ** H  =  Tp[
              B]. *) 

TpCompinv2 = {A ** B - 
            B ** A, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + iB ** iA - 
            iA ** iB, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[A] ** Tp[B] + 
            Tp[B] ** Tp[A], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[iB] ** Tp[iA] + 
            Tp[iA] ** Tp[iB] + Tp[Q], 
          Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - 
            iB ** B
};

NewRelations  = 
        NCAddTranspose[TpCompinv2 //. Tp -> tp] //. 
          tp -> Tp;

ClearMonomialOrderAll[];

SetMonomialOrder[{{iB, 
          Tp[iB], B, Tp[B], iA, Tp[iA], 
A, Tp[A], H, 
          Inv[H], Tp[H], Tp[Inv[H]], 
G, Inv[G], Tp[G], 
          Tp[Inv[G]]}, {Q, Tp[Q]}}]

PrintMonomialOrder[];

\(\(\( (*\ 
      We\ now\ run\ the\ Grobner\ Basis\ algorithm . \ \ It\ is\ called\ by\ using\ the\ NCProcess\ command . \ \ We\ are
using\ 2\ iterations\ and\ are\ using\ two\ options\ to\ save\ \(\(time\)\(.\)\)\ *) \)\(
\)\(
\)\(
\)\(Nextans1 = 
        NCProcess[NewRelations, 2, 0, 0, 0, "ABbothEPproblem1b", 
          SBByCat -> False, 
NCCV -> 
            False];\)\)\)

(* 
      The Groebner basis outputs three lists .   The third list is another list consisting of new relations
 
        obtained by the Groebner basis algorithm .   Note that the first element of the third list is Q .   Hence
 
        we conclude that our relations,  when set equal to zero,  
      imply that Q is zero .   But Q - iA ** iB + 
        iB ** iA is
also zero .   We conclude that iA and iB commute .   Recall that iA and iB represent the pseudo - inverses
of A and B respectively. *) 

 (* 
      The output consists of a list of three lists .   The third list consists of new relations obtained by running
the Groebner basis algorithm .   In this case the first relation in the third list is Q .   Hence the pseudo - inverses of A and B commute,  
      establishing the `if' part of part b. *) 

Nextans1[[3]][[1]]

TpCompinv3 = {iA ** iB - 
            iB ** iA, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + B ** A - 
            A ** B, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[iA] ** Tp[iB] + 
            Tp[iB] ** Tp[iA], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[B] ** Tp[A] + Tp[A] ** Tp[B] + 
            Tp[Q], Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - iB ** B
};

\(\(\(NewRelations2\  = \ 
        NCAddTranspose[TpCompinv3 //. Tp -> tp] //. 
          tp -> Tp;\)\(
\)\)\)

Nextans2 = 
        NCProcess[NewRelations2, 3, 0, 0, 0, "ABbothEPproblem2b", 
          SBByCat -> False, 
NCCV -> 
            False];

Nextans2[[3]][[1]]

ClearMonomialOrderAll[];

<< NCGB.m;

<< NCMakeRelations.m;

SetNonCommutative[A, B, G, H, Q, iA, iB];

(* 
      The following is a list of relations which we shall use,  
      along with an order which we shall define later in a Groebner basis algorithm .   A and B are two commuting
matrices .   We denote their pseudo - 
        inverses by iA and iB respectively .   Tp is an involution,  which in this case we think of as being the Hermitian adjoint .   We assume that A and B are EP
and hence there exist matrices invertible G and H such that A ** 
            G  =  Tp[A] and B ** H  =  Tp[
              B]. *) 

TpCompinv2 = {A ** B - 
            B ** A, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + iB ** iA - 
            iA ** iB, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[A] ** Tp[B] + 
            Tp[B] ** Tp[A], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[iB] ** Tp[iA] + 
            Tp[iA] ** Tp[iB] + Tp[Q], 
          Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - 
            iB ** B
};

NewRelations  = 
        NCAddTranspose[TpCompinv2 //. Tp -> tp] //. 
          tp -> Tp;

ClearMonomialOrderAll[];

SetMonomialOrder[{{H, 
          Inv[H], Tp[H], Tp[Inv[H]], 
G, Inv[G], Tp[G], 
          Tp[Inv[G]], iB, Tp[iB], B, Tp[B], iA, Tp[iA], 
A, 
          Tp[A]}, {Q, Tp[Q]}}]

PrintMonomialOrder[];

\(\(\( (*\ 
      We\ now\ run\ the\ Grobner\ Basis\ algorithm . \ \ It\ is\ called\ by\ using\ the\ NCProcess\ command . \ \ We\ are
using\ 2\ iterations\ and\ are\ using\ two\ options\ to\ save\ \(\(time\)\(.\)\)\ *) \)\(
\)\(
\)\(
\)\(Nextans1 = 
        NCProcess[NewRelations, 2, 0, 0, 0, "ABbothEPproblem1c", 
          SBByCat -> False, 
NCCV -> 
            False];\)\)\)

(* 
      The Groebner basis outputs three lists .   The third list is another list consisting of new relations
 
        obtained by the Groebner basis algorithm .   Note that the first element of the third list is Q .   Hence
 
        we conclude that our relations,  when set equal to zero,  
      imply that Q is zero .   But Q - iA ** iB + 
        iB ** iA is
also zero .   We conclude that iA and iB commute .   Recall that iA and iB represent the pseudo - inverses
of A and B respectively. *) 

 (* 
      The output consists of a list of three lists .   The third list consists of new relations obtained by running
the Groebner basis algorithm .   In this case the first relation in the third list is Q .   Hence the pseudo - inverses of A and B commute,  
      establishing the `if' part of part b. *) 

Nextans1[[3]][[1]]

TpCompinv3 = {iA ** iB - 
            iB ** iA, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + B ** A - 
            A ** B, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[iA] ** Tp[iB] + 
            Tp[iB] ** Tp[iA], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[B] ** Tp[A] + Tp[A] ** Tp[B] + 
            Tp[Q], Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - iB ** B
};

\(\(\(NewRelations2\  = \ 
        NCAddTranspose[TpCompinv3 //. Tp -> tp] //. 
          tp -> Tp;\)\(
\)\)\)

Nextans2 = 
        NCProcess[NewRelations2, 3, 0, 0, 0, "ABbothEPproblem2c", 
          SBByCat -> False, 
NCCV -> 
            False];

Nextans2[[3]][[1]]

ClearMonomialOrderAll[];

<< NCGB.m;

<< NCMakeRelations.m;

SetNonCommutative[A, B, G, H, Q, iA, iB];

(* 
      The following is a list of relations which we shall use,  
      along with an order which we shall define later in a Groebner basis algorithm .   A and B are two commuting
matrices .   We denote their pseudo - 
        inverses by iA and iB respectively .   Tp is an involution,  which in this case we think of as being the Hermitian adjoint .   We assume that A and B are EP
and hence there exist matrices invertible G and H such that A ** 
            G  =  Tp[A] and B ** H  =  Tp[
              B]. *) 

TpCompinv2 = {A ** B - 
            B ** A, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + iB ** iA - 
            iA ** iB, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[A] ** Tp[B] + 
            Tp[B] ** Tp[A], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[iB] ** Tp[iA] + 
            Tp[iA] ** Tp[iB] + Tp[Q], 
          Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - 
            iB ** B
};

NewRelations  = 
        NCAddTranspose[TpCompinv2 //. Tp -> tp] //. 
          tp -> Tp;

ClearMonomialOrderAll[];

SetMonomialOrder[{{iA, 
          Tp[iA], 
A, Tp[A], H, Inv[H], Tp[H], Tp[Inv[H]], 
          iB, Tp[iB], B, Tp[B], 
G, Inv[G], Tp[G], 
          Tp[Inv[G]]}, {Q, Tp[Q]}}]

PrintMonomialOrder[];

\(\(\( (*\ 
      We\ now\ run\ the\ Grobner\ Basis\ algorithm . \ \ It\ is\ called\ by\ using\ the\ NCProcess\ command . \ \ We\ are
using\ 2\ iterations\ and\ are\ using\ two\ options\ to\ save\ \(\(time\)\(.\)\)\ *) \)\(
\)\(
\)\(
\)\(Nextans1 = 
        NCProcess[NewRelations, 2, 0, 0, 0, "ABbothEPproblem1d", 
          SBByCat -> False, 
NCCV -> 
            False];\)\)\)

(* 
      The Groebner basis outputs three lists .   The third list is another list consisting of new relations
 
        obtained by the Groebner basis algorithm .   Note that the first element of the third list is Q .   Hence
 
        we conclude that our relations,  when set equal to zero,  
      imply that Q is zero .   But Q - iA ** iB + 
        iB ** iA is
also zero .   We conclude that iA and iB commute .   Recall that iA and iB represent the pseudo - inverses
of A and B respectively. *) 

 (* 
      The output consists of a list of three lists .   The third list consists of new relations obtained by running
the Groebner basis algorithm .   In this case the first relation in the third list is Q .   Hence the pseudo - inverses of A and B commute,  
      establishing the `if' part of part b. *) 

Nextans1[[3]][[1]]

TpCompinv3 = {iA ** iB - 
            iB ** iA, -1 + G ** Inv[G], -1 + 
            Inv[G] ** G, 
-1 + H ** Inv[H], -1 + 
            Inv[H] ** H, 
Q + B ** A - 
            A ** B, 
iA ** A - 
            Tp[A] ** Tp[iA], -iA ** A + 
            Tp[A] ** Tp[iA], -Tp[iA] ** Tp[iB] + 
            Tp[iB] ** Tp[iA], 
iB ** B - 
            Tp[B] ** Tp[iB],  -iB ** B + 
            Tp[B] ** Tp[iB], 
A - Tp[G] ** Tp[A], -A + 
            Tp[G] ** Tp[A], 
B - Tp[H] ** Tp[B], -B + 
            Tp[H] ** Tp[B], 
-1 + 
            Tp[G] ** Tp[Inv[G]], -1 + Tp[Inv[G]] ** Tp[G], 
          A ** iA - Tp[iA] ** Tp[A], -A ** iA + 
            Tp[iA] ** Tp[A], 
B ** iB - 
            Tp[iB] ** Tp[B], -B ** iB + 
            Tp[iB] ** Tp[B], 
-A + 
            A ** iA ** A, -iA + iA ** A ** iA, 
          A ** G - Tp[A], 
-B + 
            B ** iB ** B,  -iB + iB ** B ** iB, 
          B ** H - Tp[B], 
Tp[A] ** Tp[iA] ** Tp[A] - 
            Tp[A], -A ** G + 
            Tp[A], 
Tp[B] ** Tp[iB] ** Tp[B] - 
            Tp[B],  -B ** H + 
            Tp[B], 
-Tp[B] ** Tp[A] + Tp[A] ** Tp[B] + 
            Tp[Q], Tp[iA] ** Tp[A] ** Tp[iA] - 
            Tp[iA], 
Tp[iB] ** Tp[B] ** Tp[iB] - 
            Tp[iB], 
A ** iB - iB ** A, B ** iA - iA ** B, 
          A ** iA - iA ** A, 
          B ** iB - iB ** B
};

\(\(\(NewRelations2\  = \ 
        NCAddTranspose[TpCompinv3 //. Tp -> tp] //. 
          tp -> Tp;\)\(
\)\)\)

Nextans2 = 
        NCProcess[NewRelations2, 3, 0, 0, 0, "ABbothEPproblem2d", 
          SBByCat -> False, 
NCCV -> 
            False];

Nextans2[[3]][[1]]