(* ::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:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Beijing-2407"];


(* ::Input::Initialization:: *)
Once[<<KnotTheory`; <<Rot.m];


(* ::Input::Initialization:: *)
CCF[\[ScriptCapitalE]_] := ExpandDenominator@ExpandNumerator@Together[\[ScriptCapitalE]];
CF[\[ScriptCapitalE]_List]:=CF/@\[ScriptCapitalE];
CF[\[ScriptCapitalE]_] := Module[{vs=Cases[\[ScriptCapitalE],Subscript[(x|p), _],\[Infinity]]\[Union]{x,p},ps,c},
Total[CoefficientRules[Expand[\[ScriptCapitalE]], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))] ];
CF[eqp_EQP]:=CF/@eqp


(* ::Input::Initialization:: *)
EQP/:c_*EQP[Q_,P_]:=EQP[Q,CF[c P]];


(* ::Input::Initialization:: *)
{SuperStar[p],SuperStar[x]}={\[Pi],\[Xi]};  SuperStar[(Subscript[z_, i__])]:=Subscript[(SuperStar[z]), i]; SuperStar[vs_List]:=(v|->SuperStar[v])/@vs;
\!\(\*SubscriptBox[\(Zip\), \({}\)]\)[\[ScriptCapitalE]_]:=\[ScriptCapitalE];
\!\(\*SubscriptBox[\(Zip\), \({z_, zs___}\)]\)[\[ScriptCapitalE]_] := (Collect[\[ScriptCapitalE]//\!\(\*SubscriptBox[\(Zip\), \({zs}\)]\),z] /. f_. z^d_.:>(D[f,{SuperStar[z],d}]))/.SuperStar[z]->0


(* ::Input::Initialization:: *)
FI[EQP[Q_,P_]]:=FI[EQP[Q,P],Union@Cases[Q,Subscript[p, _],\[Infinity]],Union@Cases[Q,Subscript[x, _],\[Infinity]]];
FI[EQP[Q_,P_],ps_List,xs_List]:=Module[{u,v},
A=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(u, v\)]Q\),{u,ps},{v,xs}];
Factor[Det[A]^-1 Subscript[Zip, ps\[Union]xs][P E^-SuperStar[xs] . Inverse[A] . SuperStar[ps]]]]



