(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



DQ[is___] := (Sort[{is}]===Union[{is}]);


Simp[expr_] := Simplify[expr];
LSimp[\[Gamma][f_,j_,k_,k_]] = 0;
LSimp[\[Gamma][f_,j_,k_,l_]] /; OrderedQ[{l,k}]\[And]DQ[k,l] := \[Gamma][-f, j, l, k] // LSimp;
LSimp[\[Gamma]a[f_, i_,j_,i_,k_]] /; OrderedQ[{k,j}]\[And]DQ[k,j] := \[Gamma][Subscript[b, i]f, i,j,k] + \[Gamma]a[f, i,k,i,j] // LSimp;
LSimp[\[Beta][f_]] := \[Beta][Simp[f]];
LSimp[a[i_,j_]] := a[i,j];
LSimp[a[f_, i_,j_]] := a[Simp[f], i,j];
LSimp[\[Gamma][f_, is__]] := \[Gamma][Simp[f], is];
LSimp[\[Gamma]a[f_, is__]] := \[Gamma]a[Simp[f], is];
LSimp[expr_] := expr /. (\[Lambda]_\[Beta]|\[Lambda]_a|\[Lambda]_\[Gamma]|\[Lambda]_\[Gamma]a) :> LSimp[\[Lambda]];


\[Beta][0] :=0;
\[Beta] /: \[Beta][f_] + \[Beta][g_] := \[Beta][f+g];
\[Beta] /: -\[Beta][f_] := \[Beta][-f] // LSimp;
a[0,__] := 0;
a /: a[f_,i_,j_] + a[g_, i_,j_] := a[f+g, i,j];
a /: -a[f_, is__] := a[-f, is] // LSimp;
\[Gamma][0,__] :=0;
\[Gamma] /: \[Gamma][f_,is__] + \[Gamma][g_, is__] := \[Gamma][f+g, is];
\[Gamma] /: -\[Gamma][f_, is__] := \[Gamma][-f, is] // LSimp;
\[Gamma]a[0,__] :=0;
\[Gamma]a /: \[Gamma]a[f_,is__] + \[Gamma]a[g_, is__] := \[Gamma]a[f+g, is];
\[Gamma]a /: -\[Gamma]a[f_, is__] := \[Gamma]a[-f, is] // LSimp;


B[0,_] =0; B[_, 0] = 0;
B[x_,x_] = 0;
B[x_Plus, y_] := B[#,y]& /@ x;
B[x_, y_Plus] := B[x,#]& /@ y;


B[a[f_, j_,k_], \[Beta][g_]] := \[Gamma][f(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(j\)]]g\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(k\)]]g\)), j,k] // LSimp;


B[a[f_, j_,k_], a[g_, l_,m_]] := Plus[
B[a[j,k], a[l,m]] /. {a[h_,is__] :> a[f g h, is], \[Gamma][h_,is__] :> \[Gamma][f g h, is]},
\[Gamma]a[f(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(j\)]]g\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(k\)]]g\)), j,k,l,m] + \[Gamma]a[g(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(m\)]]f\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(l\)]]f\)), l,m,j,k]
] // LSimp;


B[a[j_,k_], a[j_,l_]] /; DQ[j,k,l] := \[Gamma][1,j,k,l] // LSimp;
B[a[j_,k_], a[i_,k_]] /; DQ[i,j,k] := a[Subscript[b, i], j,k] - a[Subscript[b, j], i,k] // LSimp;
B[a[j_,k_], a[i_,j_]] /; DQ[i,j,k] := a[Subscript[b, j], i,k] - a[Subscript[b, i], j,k] + \[Gamma][1, i,j,k] // LSimp;
B[a[j_,k_], a[k_,l_]] /; DQ[j,k,l] := -B[a[k,l], a[j,k]];
B[a[j_,k_], a[l_,m_]] /; DQ[j,k,l,m] := 0;


B[a[f_, j_,k_], \[Gamma][g_, j_,l_]] /; DQ[j,k,l] := 0;
B[a[f_, j_,k_], \[Gamma][g_, i_,k_]] /; DQ[i,j,k] := - \[Gamma][Subscript[b, j]f g, i,k] // LSimp;
B[a[f_, j_,k_], \[Gamma][g_, i_,j_]] /; DQ[i,j,k] := \[Gamma][Subscript[b, j]f g, i,k] // LSimp;
B[a[f_, j_,k_], \[Gamma][g_, k_,l_]] /; DQ[j,k,l] := \[Gamma][Subscript[b, j]f g, k,l] - \[Gamma][Subscript[b, k]f g, j,l] // LSimp;
B[a[f_, j_,k_], \[Gamma][g_, l_,m_]] /; DQ[j,k,l,m] := 0;
B[a[f_, j_,k_], \[Gamma][g_, j_,k_]] :=  \[Gamma][-Subscript[b, j]f g, j,k] // LSimp;


B[a[f_, j_,k_], \[Gamma][g_, j_,l_,m_]] /; DQ[j,k,l,m] := 0;
B[a[f_, j_,k_], \[Gamma][g_, i_,j_,l_]] /; DQ[i,j,k,l] := \[Gamma][Subscript[b, j]f g,i,k,l] + \[Gamma]a[f g,i,l,j,k] // LSimp;
B[a[f_, l_,k_], \[Gamma][g_, i_,j_,l_]] /; DQ[i,j,k,l] := \[Gamma][-Subscript[b, l]f g,i,k,j] + \[Gamma]a[-f g,i,j,l,k] // LSimp;
B[a[f_, j_,k_], \[Gamma][g_, k_,l_,m_]] /; DQ[j,k,l,m] := \[Gamma][-Subscript[b, k]f g,j,l,m] + \[Gamma][Subscript[b, j]f g,k,l,m] // LSimp;
B[a[f_, j_,k_], \[Gamma][g_, n_,i_,k_]] /; DQ[n,i,j,k] := \[Gamma][-Subscript[b, j]f g, n,i,k] + \[Gamma]a[f g, n,i,j,k] // LSimp;
B[a[f_, j_,i_], \[Gamma][g_, n_,i_,k_]] /; DQ[n,i,j,k] := \[Gamma][Subscript[b, j]f g, n,k,i] + \[Gamma]a[-f g, n,k,j,i] // LSimp;
B[a[f_, j_,k_], \[Gamma][g_, j_,k_,l_]] /; DQ[j,k,l] := \[Gamma]a[-f g,j,k,j,l] // LSimp;
B[a[f_, j_,l_], \[Gamma][g_, j_,k_,l_]] /; DQ[j,k,l] := \[Gamma]a[f g,j,l,j,k] // LSimp;
B[a[f_, j_,k_], \[Gamma][g_, i_,j_,k_]] /; DQ[i,j,k] := \[Gamma][-Subscript[b, j]f g, i,j,k] + \[Gamma]a[f g, i,j,j,k] + \[Gamma]a[f g, i,k,j,k] // LSimp;
B[a[f_, k_,j_], \[Gamma][g_, i_,j_,k_]] /; DQ[i,j,k] := \[Gamma][Subscript[b, k]f g, i,k,j] + \[Gamma]a[-f g, i,k,k,j] + \[Gamma]a[-f g, i,j,k,j] // LSimp;
B[a[f_, i_,j_], \[Gamma][g_, k_,l_,m_]] /; DQ[i,j,k,l,m] := 0;


B[x_a, \[Gamma]a[f_, i_,j_,m_,n_]] := Plus[
B[x, \[Gamma][f, i,j]] /. \[Gamma][g_, k_,l_] :> \[Gamma]a[g, k,l,m,n],
B[x, a[1, m,n]] /. {a[g_, k_,l_] :> \[Gamma]a[f g, i,j,k,l], _\[Gamma]|_\[Gamma]a:>0}
] // LSimp


B[x_\[Beta]|x_\[Gamma]|x_\[Gamma]a, y_a] := -B[y,x];
B[_\[Beta]|_\[Gamma]|_\[Gamma]a, _\[Beta]|_\[Gamma]|_\[Gamma]a] := 0;


FormalPlusBasis[n_, f_] := Module[{ff},
ff=f@@Table[Subscript[b, i], {i,n}];
Flatten@{
Table[a[ff, i,j], {i,n-1}, {j,i+1,n}],
Table[\[Gamma][ff, i,j], {i,n-1}, {j,i+1,n}],
Table[\[Gamma][ff, i,j,k], {i,n-2}, {j,i+1,n-1}, {k,j+1,n}],
Table[\[Gamma]a[ff, i,j,k,l], {i,n-1},{j,i+1,n},{k,n-1},{l,k+1,n}]
} /. 1[___] -> 1
];


AutoAd[x_][y_] := Module[{pows, states, s, seq,sh=5, sf, t1, n},
pows = NestList[B[x,#]&, y, 15];
states = Union[Cases[pows, s_a|s_\[Beta]|s_\[Gamma]|s_\[Gamma]a :> ReplacePart[s, 1->_], \[Infinity]]];
Sum[
seq=Cases[{#},s, \[Infinity]]& /@ pows;
seq=Replace[seq,{{_[f_,___]}:>f, {}->0}, {1}];
sf=FindSequenceFunction[Drop[seq, sh]];
ReplacePart[s, 1 ->FullSimplify[ \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = 0\), \(sh - 1\)]
\*FractionBox[\(seq[[n + 1]]\), \(n!\)]\)+ \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = sh\), \(\[Infinity]\)]
\*FractionBox[\(sf[n + 1 - sh]\), \(n!\)]\)]],
{s,states}]
];
AutoAd1[x_][y_] := Module[{pows, states, s, seq,sh, sf, t1, n},
pows = NestList[B[x,#]&, y, 15];
states = Union[Cases[pows, s_a|s_\[Beta]|s_\[Gamma]|s_\[Gamma]a :> ReplacePart[s, 1->_], \[Infinity]]];
Sum[
seq=Cases[{#},s, \[Infinity]]& /@ pows;
sh=0; While[seq[[1]]==={}, ++sh; seq=Rest[seq]];
seq=Replace[seq,{{_[f_,___]}:>f, {}->0}, {1}];
sf=Replace[seq,{
{t1_,0...}:>(t1*KroneckerDelta[1,#]&),
seq_ :> FindSequenceFunction[seq]
}];
ReplacePart[s, 1 ->FullSimplify[ \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(n = sh\), \(\[Infinity]\)]
\*FractionBox[\(sf[n + 1 - sh]\), \(n!\)]\)]],
{s,states}
]
]
(* Hint: Perhaps improve using Variables, CoefficientList, FromCoefficientList *)


Ad[a[t_,j_,k_]][\[Beta][f_]] /; FreeQ[t,Subscript[b, _]] := \[Beta][f]+\[Gamma][((E^(-t Subscript[b, j])-1) (\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(k\)]]f\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(j\)]]f\)))/Subscript[b, j],j,k];
Ad[a[t_,j_,k_]][\[Gamma][f_, j_,k_]] /; FreeQ[t,Subscript[b, _]] := \[Gamma][E^(-t Subscript[b, j]) f,j,k];
Ad[a[t_,j_,k_]][\[Gamma][f_, j_,l_]] /; DQ[j,k,l]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][f,j,l];
Ad[a[t_,j_,k_]][\[Gamma][f_, i_,k_]] /; DQ[i,j,k]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][E^(-t Subscript[b, j]) f,i,k];
Ad[a[t_,j_,k_]][\[Gamma][f_, i_,j_]] /; DQ[i,j,k]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][f,i,j]+\[Gamma][f-E^(-t Subscript[b, j]) f,i,k];
Ad[a[t_,j_,k_]][\[Gamma][f_, k_,l_]] /; DQ[j,k,l]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][E^(t Subscript[b, j]) f,k,l]+\[Gamma][((1-E^(t Subscript[b, j])) f Subscript[b, k])/Subscript[b, j],j,l];
Ad[a[t_,j_,k_]][\[Gamma][f_, i_,l_]] /; DQ[i,j,k,l]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][f,i,l];
Ad[a[t_,j_,k_]][\[Gamma][f_, j_,l_,m_]] /; DQ[j,l,k,m]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][f, j,l,m];
Ad[a[t_,j_,k_]][\[Gamma][f_, i_,j_,l_]] /; DQ[i,j,k,l]\[And]FreeQ[t,Subscript[b, _]] :=  \[Gamma][f,i,j,l]+\[Gamma][f-E^(-t Subscript[b, j]) f,i,k,l]+\[Gamma]a[(f-E^(-t Subscript[b, j]) f)/Subscript[b, j],i,l,j,k];
Ad[a[t_,j_,k_]][\[Gamma][f_, i_,k_,l_]] /; DQ[i,j,k,l]\[And]FreeQ[t,Subscript[b, _]] :=  \[Gamma][E^(-t Subscript[b, j]) f,i,k,l]+\[Gamma]a[((E^(-t Subscript[b, j])-1) f)/Subscript[b, j],i,l,j,k];
Ad[a[t_,j_,k_]][\[Gamma][f_, k_,l_,m_]] /; DQ[j,k,l,m]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][E^(t Subscript[b, j]) f,k,l,m]+\[Gamma][((1-E^(t Subscript[b, j])) f Subscript[b, k])/Subscript[b, j],j,l,m];
Ad[a[t_,j_,k_]][\[Gamma][f_, j_,k_,l_]] /; DQ[j,k,l]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][f,j,k,l]+\[Gamma]a[((-1+E^(-t Subscript[b, j])) f)/Subscript[b, j],j,k,j,l];
Ad[a[t_,j_,k_]][\[Gamma][f_, i_,j_,k_]] /; DQ[i,j,k]\[And]FreeQ[t,Subscript[b, _]] := \[Gamma][E^(-t Subscript[b, j]) f,i,j,k]+\[Gamma]a[(1-E^(-t Subscript[b, j]))/Subscript[b, j] f,i,j,j,k]+\[Gamma]a[(1-E^(-t Subscript[b, j]))/Subscript[b, j] f,i,k,j,k];
Ad[a[t_,j_,k_]][a[1,j_,k_]] /; FreeQ[t,Subscript[b, _]] := a[1,j,k];

Ad[a[t_,j_,k_]][a[1,j_,l_]] /; DQ[j,k,l]\[And]FreeQ[t,Subscript[b, _]] := a[1,j,l]+\[Gamma][t,j,k,l]+\[Gamma]a[(1-E^(-t Subscript[b, j])-t Subscript[b, j])/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(2\)]\),j,k,j,l];Ad[a[t_,j_,k_]][a[1,i_,k_]] /; DQ[i,j,k]\[And]FreeQ[t,Subscript[b, _]] := a[E^(-t Subscript[b, j]),i,k]+a[((1-E^(-t Subscript[b, j])) Subscript[b, i])/Subscript[b, j],j,k]+\[Gamma]a[(E^(-2 t Subscript[b, j]) Subscript[b, i] (2 E^(t Subscript[b, j]) t Subscript[b, j]+1-E^(2 t Subscript[b, j])))/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(3\)]\),j,k,j,k]+\[Gamma]a[(E^(-2 t Subscript[b, j]) (E^(t Subscript[b, j]) (1-t Subscript[b, j])-1))/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(2\)]\),j,k,i,k];
Ad[a[t_,j_,k_]][a[1,i_,j_]] /; DQ[i,j,k]\[And]FreeQ[t,Subscript[b, _]] := a[1,i,j]+a[1-E^(-t Subscript[b, j]),i,k]+a[((E^(-t Subscript[b, j])-1) Subscript[b, i])/Subscript[b, j],j,k]+\[Gamma][(1-E^(-t Subscript[b, j]))/Subscript[b, j],i,j,k]+\[Gamma]a[(Subscript[b, i] (1-2 E^(-t Subscript[b, j]) t Subscript[b, j]-E^(-2 t Subscript[b, j])))/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(3\)]\),j,k,j,k]+\[Gamma]a[(E^(-t Subscript[b, j])+t Subscript[b, j]-1)/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(2\)]\),i,j,j,k]+\[Gamma]a[(E^(-t Subscript[b, j])+t Subscript[b, j]-1)/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(2\)]\),i,k,j,k]+\[Gamma]a[(E^(-2 t Subscript[b, j]) (1+E^(t Subscript[b, j]) (-1+t Subscript[b, j])))/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(2\)]\),j,k,i,k];
Ad[a[t_,j_,k_]][a[1,k_,l_]] /; DQ[j,k,l]\[And]FreeQ[t,Subscript[b, _]] := a[E^(t Subscript[b, j]),k,l]+a[((1-E^(t Subscript[b, j])) Subscript[b, k])/Subscript[b, j],j,l]+\[Gamma][(t Subscript[b, j] Subscript[b, k]+(1-E^(t Subscript[b, j]) )(Subscript[b, j]+Subscript[b, k]))/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(2\)]\),j,k,l]+\[Gamma]a[(1+E^(t Subscript[b, j]) (t Subscript[b, j]-1))/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(2\)]\),j,k,k,l]+\[Gamma]a[(E^(-t Subscript[b, j]) Subscript[b, j]+E^(t Subscript[b, j]) (Subscript[b, j]+2 Subscript[b, k]-t Subscript[b, j] Subscript[b, k])-2 Subscript[b, j]-2 Subscript[b, k]-t Subscript[b, j] Subscript[b, k])/
\!\(\*SubsuperscriptBox[\(b\), \(j\), \(3\)]\),j,k,j,l];
Ad[a[t_,j_,k_]][a[1,l_,m_]] /; DQ[j,k,l,m]\[And]FreeQ[t,Subscript[b, _]] := a[1,l,m];
(*Ad[\[Beta][f_]][a[1, i_,j_]] := a[1,i,j]+\[Gamma][\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(j\)]]f\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(i\)]]f\),i,j];*)
Ad[x_\[Beta]|x_\[Gamma]|x_\[Gamma]a][y_] := y+B[x,y];
Ad[\[Beta][f_]][t_\[Beta]|t_\[Gamma]|t_\[Gamma]a] := t;


AdTests[a[t,j,k]] = {\[Beta][f[Subscript[b, j],Subscript[b, k]]], \[Gamma][f,i,j], \[Gamma][f,i,k], \[Gamma][f,j,l], \[Gamma][f,k,l], \[Gamma][f,i,j,l], \[Gamma][f,j,k,l], \[Gamma][f,i,j,k], \[Gamma][f,i,k,l], \[Gamma][f,k,l,m], a[1,j,k], a[1,j,l], a[1,i,k], a[1,i,j], a[1,k,l]};


Ad[x_][y_Plus] := Ad[x] /@ y;
(Ad[x_][a[f_ ,i_,j_]] /; f=!=1 ):= Module[{Adf, g, \[Gamma]s},
Adf = \[Beta][f] // Ad[x];
Adf /. \[Beta][h_] :> (g=h);
\[Gamma]s = Cases[{Adf-\[Beta][g]}, _\[Gamma], \[Infinity]];
LSimp[(a[1, i,j] // Ad[x]) /. {
a[h_, k_,l_] :> Plus[
a[g*h, k, l],
Total[\[Gamma]s /. \[Gamma][hh_, m_,n_] :> \[Gamma]a[h*hh, m,n,k,l]]
],
\[Gamma][h_,is__] :> \[Gamma][g*h, is],
\[Gamma]a[h_,is__] :> \[Gamma]a[g*h, is]
}]
];
Ad[x_][\[Gamma]a[f_, i_,j_,k_,l_]] := LSimp[
Expand[(\[Gamma][f, i,j]//Ad[x])(a[1, k,l]//Ad[x])] /. {
\[Gamma][g_, m_,n_]a[h_,p_,q_] :> \[Gamma]a[g*h, m,n,p,q],
_\[Gamma]*(_\[Gamma]|_\[Gamma]a) -> 0
}
];


Ad[x_][y_] := (Print["Ad not yet defined on ", {x,y}]; y);


tests={\[Beta][f[Subscript[b, j],Subscript[b, k]]], \[Gamma][1,i,j], \[Gamma][1,i,k],  \[Gamma][1,i,l], \[Gamma][1,j,k], \[Gamma][1,j,l],  \[Gamma][1,k,l], \[Gamma][1,j,l,m], \[Gamma][1,i,j,l], \[Gamma][1,i,k,l], \[Gamma][1, k,l,m], \[Gamma][1,j,k,l], \[Gamma][1,i,j,k], a[1,j,k], a[1,j,l], a[1,i,k], a[1,i,j], a[1,k,l], a[1,l,m], \[Gamma]a[1,j,k,j,l]};


Switch[6,
0, R[i_,j_][x_] := Ad[a[1,i,j]][x],
1, R[i_,j_][x_] := Ad[a[1,i,j]][x] + B[a[t Subscript[b, i],i,j], Ad[a[1,i,j]][x]],
2, R[i_,j_][x_] := Ad[a[1,i,j]][x] + B[\[Gamma][t,i,j], Ad[a[1,i,j]][x]],
3, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[\[Beta][r[Subscript[b, i],Subscript[b, j]]]],
4, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[\[Beta][f0[Subscript[b, j]]+Subscript[b, i]f1[Subscript[b, j]]]],
5, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[\[Beta][f0[Subscript[b, j]]+Subscript[b, i]f1[Subscript[b, j]]]] // Ad[\[Gamma][g, i,j]],
6, R[i_,j_][x_] := x // Ad[a[1,i,j]] // Ad[\[Beta][f0[Subscript[b, j]]+Subscript[b, i]f1[Subscript[b, j]]]] // Ad[\[Gamma][g[Subscript[b, i],Subscript[b, j]], i,j]] // Ad[\[Gamma]a[-((E^-Subscript[b, 1] (Subscript[b, 1]-E^Subscript[b, 1] Subscript[b, 1]+Subscript[b, 2]-E^Subscript[b, 1] Subscript[b, 2]+E^Subscript[b, 1] Subscript[b, 1] Subscript[b, 2]))/(\!\(
\*SubsuperscriptBox[\(b\), \(1\), \(3\)]\ 
\*SubscriptBox[\(b\), \(2\)]\))), i,j,i,j]]
];
VerifyR3[expr_] := Module[{lhs,rhs}, {
lhs = expr // R[1,2] // R[1,3] // R[2,3] // LSimp;
rhs = expr // R[2,3] // R[1,3] // R[1,2] // LSimp;
LSimp[lhs-rhs]==0
}]



