(* ::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.                                                         *)
(************************************************************************)



(* ::Input::Initialization:: *)
Date[]
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\FullDoPeGDO"];
Once[<<KnotTheory`];
Once[Get@"../Profile/Profile.m"];
$k=1;
HL[\[ScriptCapitalE]_] := Style[\[ScriptCapitalE], Background -> If[TrueQ@\[ScriptCapitalE],RGBColor[Rational[1, 3], 1, Rational[1, 3]],RGBColor[1, 0.5, 0.5]]];
<<Engine.m
<<Objects.m


(* ::Input::Initialization:: *)
SetAttributes[Define, HoldAll];
Define[def_,defs__] := (Define[def]; Define[defs];);
Define[Subscript[op_, is__]=\[ScriptCapitalE]_] := Module[{SD,ii,jj,kk,isp,nis,nisp,sis},Block[{i,j,k},
ReleaseHold[Hold[
SD[Subscript[op, nisp,$k_Integer],Subscript[PP, Boot]@Block[{i,j,k},Subscript[op, isp,$k]=\[ScriptCapitalE];Subscript[op, nis,$k]]];
SD[Subscript[op, isp],\!\(\*SubscriptBox[\(op\), \({is}, $k\)]\)]; SD[Subscript[op, sis__],\!\(\*SubscriptBox[\(op\), \({sis}\)]\)];
]/. {SD->SetDelayed,
isp->{is}/.{i->i_,j->j_,k->k_},
nis->{is}/.{i->ii,j->jj,k->kk},
nisp->{is}/.{i->ii_,j->jj_,k->kk_}
}]  ]]


(* ::Input::Initialization:: *)
Subscript[H, i_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {i}\)]\)[\[HBar] Subscript[\[Beta], i] Subscript[b, i]+\[HBar] Subscript[\[Tau], i] Subscript[t, i]+\[HBar] Subscript[\[Alpha], i] Subscript[a, i]+\[HBar] Subscript[\[Eta], i] Subscript[y, i]+\[HBar] Subscript[\[Xi], i] Subscript[x, i]];


(* ::Input::Initialization:: *)
Subscript[sm, i_,j_->k_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i, j} \[Rule] {k}\)]\)[Subscript[b, k](Subscript[\[Beta], i]+Subscript[\[Beta], j])+Subscript[t, k](Subscript[\[Tau], i]+Subscript[\[Tau], j])+Subscript[a, k](Subscript[\[Alpha], i]+Subscript[\[Alpha], j])+Subscript[y, k](Subscript[\[Eta], i]+Subscript[\[Eta], j])+Subscript[x, k](Subscript[\[Xi], i]+Subscript[\[Xi], j])];
Subscript[s\[CapitalDelta], i_->j_,k_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {j, k}\)]\)[Subscript[\[Beta], i](Subscript[b, j]+Subscript[b, k])+Subscript[\[Tau], i](Subscript[t, j]+Subscript[t, k])+Subscript[\[Alpha], i](Subscript[a, j]+Subscript[a, k])+Subscript[\[Eta], i](Subscript[y, j]+Subscript[y, k])+Subscript[\[Xi], i](Subscript[x, j]+Subscript[x, k])];
Subscript[sS, i_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {i}\)]\)[-Subscript[\[Beta], i] Subscript[b, i]-Subscript[\[Tau], i] Subscript[t, i]-Subscript[\[Alpha], i] Subscript[a, i]-Subscript[\[Eta], i] Subscript[y, i]-Subscript[\[Xi], i] Subscript[x, i]];
Subscript[s\[Eta], i_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({} \[Rule] {i}\)]\)[0];Subscript[s\[Epsilon], i_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {}\)]\)[0];


(* ::Input::Initialization:: *)
Subscript[s\[Sigma], i_->j_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {j}\)]\)[Subscript[\[Beta], i] Subscript[b, j]+Subscript[\[Tau], i] Subscript[t, j]+Subscript[\[Alpha], i] Subscript[a, j]+Subscript[\[Eta], i] Subscript[y, j]+Subscript[\[Xi], i] Subscript[x, j]];
Subscript[s\[CapitalUpsilon], i_->j_,k_,l_,m_]:=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {j, k, l, m}\)]\)[Subscript[\[Beta], i] Subscript[b, k]+Subscript[\[Tau], i] Subscript[t, k]+Subscript[\[Alpha], i] Subscript[a, l]+Subscript[\[Eta], i] Subscript[y, j]+Subscript[\[Xi], i] Subscript[x, m]];


(* ::Input::Initialization:: *)
c\[CapitalLambda]=(Subscript[\[Eta], i]+(E^(-\[HBar] Subscript[\[Alpha], i]-\[HBar] \[Epsilon] Subscript[\[Beta], i]) Subscript[\[Eta], j])/(1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i]))Subscript[y, k]+(Subscript[\[Beta], i]+Subscript[\[Beta], j]+Log[1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i]]/(\[HBar] \[Epsilon]))Subscript[b, k]+(Subscript[\[Alpha], i]+Subscript[\[Alpha], j]+Log[1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i]]/\[HBar])Subscript[a, k]+((E^(-\[HBar] Subscript[\[Alpha], j]-\[HBar] \[Epsilon] Subscript[\[Beta], j]) Subscript[\[Xi], i])/(1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i])+Subscript[\[Xi], j])Subscript[x, k];
Define[Subscript[cm, i,j->k]=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i, j} \[Rule] {k}\)]\)[(Subscript[\[Eta], i]+(E^(-\[HBar] Subscript[\[Alpha], i]-\[HBar] \[Epsilon] Subscript[\[Beta], i]) Subscript[\[Eta], j])/(1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i]))Subscript[y, k]+(Subscript[\[Beta], i]+Subscript[\[Beta], j]+Log[1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i]]/(\[HBar] \[Epsilon]))Subscript[b, k]+(Subscript[\[Alpha], i]+Subscript[\[Alpha], j]+Log[1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i]]/\[HBar])Subscript[a, k]+((E^(-\[HBar] Subscript[\[Alpha], j]-\[HBar] \[Epsilon] Subscript[\[Beta], j]) Subscript[\[Xi], i])/(1+\[HBar]^2 \[Epsilon] Subscript[\[Eta], j] Subscript[\[Xi], i])+Subscript[\[Xi], j])Subscript[x, k]]]


(* ::Input::Initialization:: *)
Define[Subscript[c\[Sigma], i->j]=Subscript[s\[Sigma], i,j]/.Subscript[\[Tau], i]->0,Subscript[c\[Epsilon], i]=Subscript[s\[Epsilon], i], Subscript[c\[Eta], i]=Subscript[s\[Eta], i],Subscript[c\[CapitalDelta], i->j,k]=Subscript[s\[CapitalDelta], i->j,k],
Subscript[cS, i]=Subscript[sS, i]//Subscript[s\[CapitalUpsilon], i->1,2,3,4]//Subscript[cm, 4,3->i]//Subscript[cm, i,2->i]//Subscript[cm, i,1->i]];


(* ::Input::Initialization:: *)
U2l[\[ScriptCapitalE]_]:=\[ScriptCapitalE]/.{\!\(
\*SubsuperscriptBox[\(B\), \(i_\), \(p_.\)] :> 
\*SuperscriptBox[\(E\), \(\(-p\)\ \[HBar]\ 
\*SubscriptBox[\(b\), \(i\)]\)]\),B^p_.:>E^(-p \[HBar] b), \!\(
\*SubsuperscriptBox[\(T\), \(i_\), \(p_.\)] :> 
\*SuperscriptBox[\(E\), \(p\ \[HBar]\ 
\*SubscriptBox[\(t\), \(i\)]\)]\),T^p_.:>E^(p \[HBar] t),\!\(
\*SubsuperscriptBox[\(\[ScriptCapitalA]\), \(i_\), \(p_.\)] :> 
\*SuperscriptBox[\(E\), \(p\ \[HBar]\ 
\*SubscriptBox[\(\[Alpha]\), \(i\)]\)]\),\[ScriptCapitalA]^p_.:>E^(p \[HBar] \[Alpha])}; 
l2U[\[ScriptCapitalE]_]:=\[ScriptCapitalE]//.{E^(c_. Subscript[b, i_]+d_.):>\!\(
\*SubsuperscriptBox[\(B\), \(i\), \(\(-c\)/\[HBar]\)] 
\*SuperscriptBox[\(E\), \(d\)]\),E^(c_. b+d_.):>B^(-c/\[HBar]) E^d,E^(c_. Subscript[t, i_]+d_.):>\!\(
\*SubsuperscriptBox[\(T\), \(i\), \(c/\[HBar]\)] 
\*SuperscriptBox[\(E\), \(d\)]\),E^(c_. t+d_.):>T^(c/\[HBar]) E^d,
E^(c_. Subscript[\[Alpha], i_]+d_.):>\!\(
\*SubsuperscriptBox[\(\[ScriptCapitalA]\), \(i\), \(c/\[HBar]\)] 
\*SuperscriptBox[\(E\), \(d\)]\),E^(c_. \[Alpha]+d_.):>\[ScriptCapitalA]^(c/\[HBar]) E^d,E^\[ScriptCapitalX]_:>E^Expand@\[ScriptCapitalX]};
l2U[r_Rule]:=Module[{U=r[[1]]/.{b->B,t->T,\[Alpha]->\[ScriptCapitalA]}},U->l2U[U2l[U]/.r]];
AlsoUpper[rs_List] := rs\[Union](l2U/@rs);


(* ::Input::Initialization:: *)
Subscript[D, b][f_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), \(b\)]f\)-\[HBar] B \!\(
\*SubscriptBox[\(\[PartialD]\), \(B\)]f\); Subscript[D, Subscript[b, i_]][f_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(i\)]]f\)-\[HBar] Subscript[B, i]\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(B\), \(i\)]]f\);
Subscript[D, t][f_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), \(t\)]f\)+\[HBar] T \!\(
\*SubscriptBox[\(\[PartialD]\), \(T\)]f\); Subscript[D, Subscript[t, i_]][f_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(t\), \(i\)]]f\)+\[HBar] Subscript[T, i]\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(T\), \(i\)]]f\); 
Subscript[D, \[Alpha]][f_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Alpha]\)]f\)+\[HBar] \[ScriptCapitalA] \!\(
\*SubscriptBox[\(\[PartialD]\), \(\[ScriptCapitalA]\)]f\); Subscript[D, Subscript[\[Alpha], i_]][f_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(\[Alpha]\), \(i\)]]f\)+\[HBar] Subscript[\[ScriptCapitalA], i] \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(\[ScriptCapitalA]\), \(i\)]]f\);
Subscript[D, v_][f_]:=\!\(
\*SubscriptBox[\(\[PartialD]\), \(v\)]f\);


(* ::Input::Initialization:: *)
Define[Subscript[a\[Sigma], i->j]=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {j}\)]\)[Subscript[a, j] Subscript[\[Alpha], i]+Subscript[x, j] Subscript[\[Xi], i]],Subscript[b\[Sigma], i->j]=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i} \[Rule] {j}\)]\)[Subscript[b, j] Subscript[\[Beta], i]+Subscript[y, j] Subscript[\[Eta], i]]]


(* ::Input::Initialization:: *)
Define[Subscript[am, i,j->k]=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i, j} \[Rule] {k}\)]\)[(Subscript[\[Alpha], i]+Subscript[\[Alpha], j])Subscript[a, k]+(\!\(
\*SubsuperscriptBox[\(\[ScriptCapitalA]\), \(j\), \(-1\)] 
\*SubscriptBox[\(\[Xi]\), \(i\)]\)+Subscript[\[Xi], j])Subscript[x, k]],
Subscript[bm, i,j->k]=\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({i, j} \[Rule] {k}\)]\)[(Subscript[\[Beta], i]+Subscript[\[Beta], j])Subscript[b, k]+(Subscript[\[Eta], i]+E^(- \[HBar] \[Epsilon] Subscript[\[Beta], i]) Subscript[\[Eta], j])Subscript[y, k]]]


(* ::Input::Initialization:: *)
Define[Subscript[R, i,j]=Module[{k},\!\(\*SubscriptBox[\(\[CapitalLambda]2\[DoubleStruckCapitalE]\), \({} \[Rule] {i, j}\)]\)[\[HBar] Subscript[a, j] Subscript[b, i]+\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(k = 1\), \($k + 1\)]\ 
\*FractionBox[\(
\*SuperscriptBox[\((1 - 
\*SuperscriptBox[\(E\), \(\[Epsilon]\ 
\*SuperscriptBox[\(\[HBar]\), \(3\)]\)])\), \(k\)] 
\*SuperscriptBox[\((\[HBar]\ 
\*SubscriptBox[\(y\), \(i\)] 
\*SubscriptBox[\(x\), \(j\)])\), \(k\)]\), \(k \((1 - 
\*SuperscriptBox[\(E\), \(k\ \[Epsilon]\ 
\*SuperscriptBox[\(\[HBar]\), \(3\)]\)])\)\)]\)]]]


(* ::Input::Initialization:: *)
Define[Subscript[\!\(\*OverscriptBox[\(R\), \(_\)]\), i,j]=If[$k==0,\!\(\*SubscriptBox[\(\[DoubleStruckCapitalE]\), \({} \[Rule] {i, j}\)]\)[-\[HBar] Subscript[a, j] Subscript[b, i]-\[HBar] Subscript[x, j] Subscript[y, i]/Subscript[B, i]],Append[\!\(\*SubscriptBox[
OverscriptBox[\(R\), \(_\)], \({i, j}, $k - 1\)]\),-Last[PadRight[\!\(\*SubscriptBox[
OverscriptBox[\(R\), \(_\)], \({i, j}, 0\)]\),$k+1]Subscript[R, 1,2]PadRight[\!\(\*SubscriptBox[
OverscriptBox[\(R\), \(_\)], \({3, 4}, $k - 1\)]\),$k+1]//(Subscript[bm, i,1->i] Subscript[am, j,2->j])//(Subscript[bm, i,3->i] Subscript[am, j,4->j])]]]
]



