<<NCGB.m;
<<ans3.result;

SetNonCommutative[a,b,c,d,Tp[a], Tp[b],Tp[c],Tp[d],x,y,Tp[x],Tp[y],
                  Inv[x],Inv[y],Tp[Inv[x]],Tp[Inv[y]], Inv[b],Inv[c],
                  Tp[Inv[b]],Tp[Inv[c]],Tp[Inv[d]],Inv[d],Inv[a],
                  Tp[Inv[a]],Inv[c x + d],Tp[Inv[c x + d]]];

SetNonCommutative[f,Tp[f],F,Tp[F]];    (* Set f and F noncommutative *)

SetMonomialOrder[{x,Tp[x],Inv[x],Tp[Inv[x]],
                 y,Tp[y],Inv[y],Tp[Inv[y]]},
                 {f,Tp[f],F,Tp[F],Inv[F],Tp[Inv[F]]}, (* Put f and F *)
                 {d,Inv[d],Tp[d],Tp[Inv[d]]},         (*  into order *)
                 {b,Tp[b],Tp[Inv[b]],Inv[b]},
                 {a,Tp[a],Inv[a],Tp[Inv[a]]},
                 {c,Tp[c],Tp[Inv[c]],Inv[c]},
                 {Inv[c x + d],Tp[Inv[c x + d]]}];

selects={Tp[f] ** y ** Tp[y] ** f -> -1 + x ** Tp[x] + Tp[f] ** f,
         Tp[F] ** Tp[x] ** x ** F -> -1 + Tp[F] ** F + Tp[y] ** y,
         Tp[f]-Tp[a]-x**Tp[b],f-a-b**Tp[x],
         Tp[F]-d+Tp[y]**b,F-Tp[d]+Tp[b]**y,
         F ** Inv[F] -> 1,
         Inv[F] ** F -> 1,
         Tp[Inv[F]] ** Tp[F] -> 1,
         Tp[F] ** Tp[Inv[F]] -> 1,
         a ** Inv[a] -> 1,
         Inv[a] ** a -> 1,
         Tp[Inv[a]] ** Tp[a] -> 1,
         Tp[a] ** Tp[Inv[a]] -> 1,
         b ** Inv[b] -> 1,
         Inv[b] ** b -> 1,
         Tp[Inv[b]] ** Tp[b] -> 1,
         Tp[b] ** Tp[Inv[b]] -> 1,
         c ** Inv[c] -> 1,
         Inv[c] ** c -> 1,
         Tp[Inv[c]] ** Tp[c] -> 1,
         Tp[c] ** Tp[Inv[c]] -> 1,
         d ** Inv[d] -> 1,
         Inv[d] ** d -> 1,
         Tp[Inv[d]] ** Tp[d] -> 1,
         Tp[d] ** Tp[Inv[d]] -> 1};

StartingRelations = Union[ans3[[2]],ans3[[3]],selects];

OrderedRelations = NCMakeGB[StartingRelations,0,
            CleanUp->0,UserSelect->selects,ReorderInput->True];

ans3=SmallBasis[OrderedRelations,{},5];
RegularOutput[ans3,"ans3"];
Put[Definition[ans3],"ans3.result"];
