Pensieve header: The double and meta-double of the 2D pencil; continues pensieve://2017-04/.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2017-05"];

UEA` and Provisional Extensions

Once[Get["UEA`"]]

𝕆[specs_,sd_SeriesData] := MapAt[𝕆[specs,#]&, sd, {3,All}];
𝕆[specs_, poly_] := Module[{rules,vars,elems},
rules=Union@@Cases[{specs}, (Subscript[U, _])[u___]:>Cases[{u},r_Rule], ∞];
vars=First/@rules; elems=Last/@rules;
USimp@Total[CoefficientRules[poly, vars] /. (ps_ -> c_) :> c(
specs /. MapThread[((#1->_) :> ((#3)^(#2)))&,{vars,ps,elems}] /. (Subscript[U, i_]):>(Subscript[UU, i])
)]
]

The 2D Lie BiAlgebra Pencil

I hope to stick to G=(e^(η g)) and to H=(e^(γ h)), where [g,e]=γ e and [h,f]=-η f.
Also, (Subscript[qΔ, 12])(g,G,e,h,H,f) = ((Subscript[g, 1])+(Subscript[g, 2]), (Subscript[G, 1])(Subscript[G, 2]), (Subscript[e, 1])+(Subscript[G, 1])(Subscript[e, 2]), (Subscript[h, 1])+(Subscript[h, 2]), (Subscript[H, 1])(Subscript[H, 2]), (Subscript[f, 1])(Subscript[H, 2])+(Subscript[f, 2])).
Also, (g,e) and (h,f) are dual bases.

$Basis={g,G,e,h,H,f}; $PBWRule=Thread[$Basis->Range@Length@$Basis];

𝕆[(Subscript[U, 1])[x->g], Normal@Series[(E^(η x)),{η,0,5}]]

B[g,e] = γ e; B[e,G]=((E^(-γ η))-1)U[G,e]; B[g,G]=0;

With[{G=𝕆[(Subscript[U, 1])[x->g], Series[(E^(η x)),{η,0,5}]]}, UB[(Subscript[U, 1])[e],G]-((E^(-γ η))-1)G**(Subscript[U, 1])[e]]

B[e,G]

B[h,f] = -η f; B[f,H]=((E^(γ η))-1)U[H,f]; B[f,H]=0;

With[{H=𝕆[(Subscript[U, 1])[x->h], Series[(E^(γ x)),{γ,0,5}]]}, UB[(Subscript[U, 1])[f],H]-((E^(γ η))-1)H**(Subscript[U, 1])[f]]

The Co-Product and Co-Associativity

(Subscript[qΔ, i_->j_,k_])[ℰ_] := USimp@Module[{tj,tk}, ℰ /. {
(Subscript[U, i])[] -> (Subscript[U, j])[](Subscript[U, k])[],
(Subscript[U, i])[g,xs___] :> (USimp[((Subscript[U, j])[g](Subscript[U, k])[]+(Subscript[U, j])[](Subscript[U, k])[g])(Subscript[qΔ, i->tj,tk])[(Subscript[U, i])[xs]]] // (Subscript[m, j,tj->j]) // (Subscript[m, k,tk->k])),
(Subscript[U, i])[G,xs___] :> (USimp[(Subscript[U, j])[G](Subscript[U, k])[G](Subscript[qΔ, i->tj,tk])[(Subscript[U, i])[xs]]] // (Subscript[m, j,tj->j]) // (Subscript[m, k,tk->k])),
(Subscript[U, i])[e,xs___] :> (USimp[((Subscript[U, j])[e](Subscript[U, k])[G]+(Subscript[U, j])[](Subscript[U, k])[e])(Subscript[qΔ, i->tj,tk])[(Subscript[U, i])[xs]]] // (Subscript[m, j,tj->j]) // (Subscript[m, k,tk->k])),
(Subscript[U, i])[h,xs___] :> (USimp[((Subscript[U, j])[h](Subscript[U, k])[]+(Subscript[U, j])[](Subscript[U, k])[h])(Subscript[qΔ, i->tj,tk])[(Subscript[U, i])[xs]]] // (Subscript[m, j,tj->j]) // (Subscript[m, k,tk->k])),
(Subscript[U, i])[H,xs___] :> (USimp[(Subscript[U, j])[H](Subscript[U, k])[H](Subscript[qΔ, i->tj,tk])[(Subscript[U, i])[xs]]] // (Subscript[m, j,tj->j]) // (Subscript[m, k,tk->k])),
(Subscript[U, i])[f,xs___] :> (USimp[((Subscript[U, j])[f](Subscript[U, k])[]+(Subscript[U, j])[H](Subscript[U, k])[f])(Subscript[qΔ, i->tj,tk])[(Subscript[U, i])[xs]]] // (Subscript[m, j,tj->j]) // (Subscript[m, k,tk->k]))
}]

(Subscript[U, 1])[e] // (Subscript[qΔ, 1->1,2])

{lhs=(Subscript[U, 1])[e] // (Subscript[qΔ, 1->1,2]) // (Subscript[qΔ, 2->2,3]), rhs=(Subscript[U, 1])[e] // (Subscript[qΔ, 1->1,3]) // (Subscript[qΔ, 1->1,2]), lhs==rhs}

(Subscript[U, 1])[f] // (Subscript[qΔ, 1->1,2])

{lhs=(Subscript[U, 1])[f] // (Subscript[qΔ, 1->1,2]) // (Subscript[qΔ, 2->2,3]), rhs=(Subscript[U, 1])[f] // (Subscript[qΔ, 1->1,3]) // (Subscript[qΔ, 1->1,2]), lhs==rhs}

The Pairing at Lie-Level and Compatibilities

(Subscript[P, i_,j_])[ℰ_] := ℰ /. {
(Subscript[U, i])[](Subscript[U, j])[H...] -> 1, (Subscript[U, i])[](Subscript[U, j])[__] -> 0,
(Subscript[U, i])[G...](Subscript[U, j])[] -> 1, (Subscript[U, i])[__](Subscript[U, j])[] -> 0,
(Subscript[U, i])[g](Subscript[U, j])[h]->1, (Subscript[U, i])[g](Subscript[U, j])[H]->γ, (Subscript[U, i])[g](Subscript[U, j])[f]->0,
(Subscript[U, i])[G](Subscript[U, j])[h]->η, (Subscript[U, i])[G](Subscript[U, j])[H]->(E^(η γ)), (Subscript[U, i])[G](Subscript[U, j])[f]->0,
(Subscript[U, i])[e](Subscript[U, j])[h]->0, (Subscript[U, i])[e](Subscript[U, j])[H]->0, (Subscript[U, i])[e](Subscript[U, j])[f]->1
}

t=(Subscript[U, i])[g](Subscript[U, j])[e](Subscript[U, k])[f];
{(Subscript[m, i,j->i])[t]-(Subscript[m, j,i->i])[t], (Subscript[qΔ, k->k,l])[t]-(Subscript[qΔ, k->l,k])[t]}

t=(Subscript[U, i])[g](Subscript[U, j])[e](Subscript[U, k])[f];
{((Subscript[m, i,j->i])[t]-(Subscript[m, j,i->i])[t])//(Subscript[P, i,k]), ((Subscript[qΔ, k->k,l])[t]-(Subscript[qΔ, k->l,k])[t]) // (Subscript[P, i,k])//(Subscript[P, j,l])}

Table[t=(Subscript[U, i])[xi](Subscript[U, j])[xj](Subscript[U, k])[yk];
{((Subscript[m, i,j->i])[t]-(Subscript[m, j,i->i])[t])//(Subscript[P, i,k]), ((Subscript[qΔ, k->k,l])[t]-(Subscript[qΔ, k->l,k])[t]) // (Subscript[P, i,k])//(Subscript[P, j,l])},
{xi,{g,e}}, {xj,{g,e}}, {yk,{h,f}}]

Table[t=(Subscript[U, i])[xi](Subscript[U, k])[yk](Subscript[U, l])[yl];
{((Subscript[qΔ, i->i,j])[t]-(Subscript[qΔ, i->j,i])[t])//(Subscript[P, i,k])//(Subscript[P, j,l]), ((Subscript[m, k,l->k])[t]-(Subscript[m, l,k->k])[t]) // (Subscript[P, i,k])},
{xi,{g,e}}, {yk,{h,f}}, {yl,{h,f}}]