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







Off[General::"spell",General::"spell1",Remove::"rmnsm",UpSet::"write"];

Unprotect["Global`*"];ClearAll["Global`*"];Remove["Global`*"];ClearAll[Wedge];\
Unprotect[In,Out];Clear[In,Out];Protect[In,Out];$Line=0;$RecursionLimit=256;$\
IterationLimit=4096;

Forms[i_]:={};AllScalForms={};AllDifForms={};AllSymbols={};FormVars={_Wedge,_\
d};HeadList={};ScalHeadList={};nodHeads={Bar,Pattern,Condition,RuleDelayed,
    SeriesData};$EDCversion=367;

zeroQ[0]=True;zeroQ[x_List]:=And@@(zeroQ/@Union[Flatten[x]]);
zeroQ[x_SeriesData]:=If[x[[3]]==={},True,False];zeroQ[x_]:=False;

SetAttributes[Bar,{Listable}];Bar[Bar[x_]]=x;
Bar[Complex[u_,v_]]:=Complex[u,-v];
Bar[x_Plus|x_Times|x_Wedge|x_Power|x_Rule|x_Equal]:=Bar/@x;
Bar[x_?NumericQ]:=x;
Bar[x_RuleDelayed]:=Rule[Bar[x[[1]]],Bar[x[[2]]]]/.Rule\[Rule]RuleDelayed;
Bar[x_SeriesData]:=
  x/.{First[x]->Bar[First[x]],x[[2]]->Bar[x[[2]]],x[[3]]->Bar/@x[[3]]};
Bar[DirectedInfinity[x_]]:=DirectedInfinity[Bar[x]];Bar[d[x_]]:=d[Bar[x]];
Bar[x_Condition]:=Condition[Bar[x[[1]]],x[[2]]];
Bar[Derivative[x__][y_][z__]]:=
  If[Union[Bar[{z}]]===Union[{z}],
    Derivative[Sequence@@Coefficient[{x}.{z},Bar[{z}]]][Bar[y]][z],
    Derivative[x][Bar[y]][Sequence@@Bar[{z}]]];
Bar[h_[y__]/;FreeQ[nodHeads,h]]:=
  If[Union[Bar[{y}]]===Union[{y}],Bar[h][y],Bar[h][Sequence@@Bar[{y}]]]/;
    FreeQ[{Integer,Blank,Pattern,Condition},Head[First[{y}]]];

FormDegree[x_Plus]:=FormDegree[First[x]];
FormDegree[x_Times]:=Plus@@FormDegree/@List@@x;
FormDegree[x_Wedge]:=Plus@@FormDegree/@List@@x;
FormDegree[d[x_]]:=FormDegree[d[x]]=1+FormDegree[x];
FormDegree[x_List]:=FormDegree[Last[Union[Flatten[x]]]];
FormDegree[Bar[x_]]:=FormDegree[Bar[x]]=FormDegree[x];
FormDegree[x_SeriesData]:=If[x[[3]]==={},0,FormDegree[x[[3]]]];
FormDegree[x_]:=0;

DeclareForms[z__]:=
    Block[{h,x={{z}},xi,rxi,k,oldHeads,newHeads},
      While[Head[x[[1,1]]]===List,x=First[x]];
      Do[xi=x[[i]];rxi=Rest[xi];Forms[First[xi]]=Union[Forms[First[xi]],rxi];
        AllScalForms=Union[AllScalForms,rxi];
        Do[h=Head[rxi[[j]]];
          If[h===Symbol,FormDegree[rxi[[j]]]=First[xi];
            BasicScalFormQ[rxi[[j]]]=True;,FormDegree[_h]=First[xi];
            BasicScalFormQ[_h]=True;],{j,Length[rxi]}],{i,Length[x]}];
      AllDifForms=Union[AllScalForms];oldHeads=ScalHeadList;
      ScalHeadList=
        Complement[Union[Head/@AllScalForms,ScalHeadList],{Symbol}];
      newHeads=Complement[ScalHeadList,oldHeads];
      AllSymbols=Union[AllDifForms];
      HeadList=Union[Head/@AllSymbols];
      DifFormSymbols=Drop[AllDifForms,-Length[ScalHeadList]];
      k=Thread[Blank[ScalHeadList]];
      FormVars=Flatten[{_Wedge,_d,Union[k,Bar[k]],
            u_|Bar[u_]/;MemberQ[DifFormSymbols,u],_tr}];];

NoDif[z__]:=(nodHeads=Union[nodHeads,Flatten[{z}]];)

BasicScalFormQ[Bar[x_]]:=BasicScalFormQ[x];BasicScalFormQ[_d]=True;
BasicScalFormQ[x_]:=False;

ScalFormQ[x_Times]:=Or@@ScalFormQ/@List@@x;
ScalFormQ[x_Wedge|x_Plus]:=And@@ScalFormQ/@List@@x;
ScalFormQ[x_]:=BasicScalFormQ[x];

SetAttributes[d,{Listable}];
d[x_Times|x_Wedge]:=
  d[First[x]]\[Wedge]Rest[x]+(-1)^FormDegree[First[x]]*
      First[x]\[Wedge]d[Rest[x]];d[x_?NumericQ|x_d]=0;
d[Power[y_,n_]]:=n y^(n-1) d[y]+y^n Log[y]d[n];d[x_Plus]:=d/@x;
HoldPattern[d[Bar[x_]]]:=With[{evalHx=d[x]},Bar[evalHx]/;Head[evalHx]=!=d];
d[x_Rule|x_Equal]:=reWrite[d/@x];
d[x_SeriesData]:=(x/.x[[3]]->d[x[[3]]])+Wedge[d[First[x]],D[x,First[x]]];
d[h_[y__]/;FreeQ[nodHeads,h]]:=
  Sum[(Derivative[
                Sequence@@RotateRight[Append[Table[0,{Length[{y}]-1}],1],i]][
              h][y])d[{y}[[i]]],{i,Length[{y}]}]/;
    FormDegree[h[y]]===0&&
      FreeQ[{Integer,Blank,Pattern,Condition},Head[First[{y}]]];

newSer$[x_SeriesData,k_]:=
  SeriesData[First[x],x[[2]],
    Flatten[Transpose[
        Prepend[Table[Table[0,{Length[x[[3]]]}],{k-1}],x[[3]]]]],k x[[4]],
    k x[[5]],k Last[x]]

Wedge[x_]:=x/;Length[{x}]<2&&Head[{x}[[1]]]=!=Pattern

Default[Wedge]:=1;SetAttributes[Wedge,{Flat,OneIdentity}];Wedge[0,y__]=0;
Wedge[x__,0]=0;
Wedge[x_SeriesData,y_SeriesData]:=
  Block[{x$,y$,r1,r2,res,x3,y3},
      If[Last[x]===Last[y],x$=x;y$=y,
        x$=newSer$[x,LCM[Last[x],Last[y]]/Last[x]];
        y$=newSer$[y,LCM[Last[x],Last[y]]/Last[y]]];r1=x$[[-3]]+y$[[-3]];
      r2=Min[x$[[-2]]+y$[[-3]],x$[[-3]]+y$[[-2]]];
      If[Length[x$[[3]]]<x$[[-2]]-x$[[-3]],
        x3=Join[x$[[3]],Table[0,{x$[[-2]]-x$[[-3]]-Length[x$[[3]]]}]],
        x3=x$[[3]]];
      If[Length[y$[[3]]]<y$[[-2]]-y$[[-3]],
        y3=Join[y$[[3]],Table[0,{y$[[-2]]-y$[[-3]]-Length[y$[[3]]]}]],
        y3=y$[[3]]];
      Which[r2===r1,res={},r2-r1===x$[[-2]]-x$[[-3]],
        res=Sum[Map[Wedge[x3[[i]],#]&,Join[Table[0,{i-1}],Drop[y3,-i+1]]],{i,
              Length[x3]}],True,
        res=Sum[Map[Wedge[#,y3[[i]]]&,Join[Table[0,{i-1}],Drop[x3,-i+1]]],{i,
              Length[y3]}]];SeriesData[First[x$],x$[[2]],res,r1,r2,Last[x$]]]/;
    First[x]===First[y]&&x[[2]]===y[[2]];
Wedge[y_,x_SeriesData]:=x/.x[[3]]->Map[Wedge[y,#]&,x[[3]]];
Wedge[x_SeriesData,y_]:=x/.x[[3]]->Map[Wedge[#,y]&,x[[3]]];
Wedge[x__,y_Plus]:=Plus@@Map[Wedge[x,#]&,List@@y];
Wedge[x_Plus,y__]:=Plus@@Map[Wedge[#,y]&,List@@x];
Wedge[u__,Times[x_,y_]]:=Times[x,Wedge[u,y]]/;NumericQ[x]||FormDegree[x]===0;
Wedge[Times[x_,y_],z__]:=Times[x,Wedge[y,z]]/;NumericQ[x]||FormDegree[x]===0;
x_^n_.\[Wedge]y_ :=x^n*y/;FormDegree[x]===0;
y_\[Wedge]x_^n_.:=x^n*y/;FormDegree[x]===0;
Wedge[x_,y___,x_]:=0/;OddQ[FormDegree[x]]&&ScalFormQ[x];
Wedge[x__]:=
  Block[{doubL=Transpose[{FormDegree/@{x},{x}}]},
      Signature[Select[doubL,OddQ[First[#]]&]]Wedge@@
          Map[Last[#1]&,Sort[doubL]]]/;
    Union[BasicScalFormQ/@{x}]==={True}&&
      Map[Last[#1]&,Sort[Transpose[{FormDegree/@{x},{x}}]]]=!={x};

simpRules = {Cos[z_]^2*(x_.)+(x_.)*Sin[z_]^2 -> x};varList={};

coll[x_]:=Collect[x,{_Wedge,_tr},Factor]/.simpRules;

SetAttributes[reWrite,{Listable}];reWrite[0]=0;
reWrite[x_Equal]:=Equal[reWrite[First[x]-Last[x]],0];
reWrite[x_Rule]:=Rule[First[x],reWrite[Last[x]]];
reWrite[x_RuleDelayed]:=Rule[First[x],reWrite[x[[2]]]]/.Rule->RuleDelayed;
reWrite[x_SeriesData]:=(x/.x[[3]]->reWrite[x[[3]]]);
reWrite[x_Condition]:=Condition[reWrite[x[[1]]],x[[2]]];
reWrite[x_]:=(Collect[coll[x/.simpRules],FormVars,bestFacRul]/.simpRules)/;
    FormDegree[x]>0;reWrite[x_]:=bestFacRul[x/.simpRules]/.simpRules;

FreeALLQ[x_,y_List]:=And@@Map[FreeQ[x,#]&,y];

bestFacRul[x_]:=
  If[varList==={}||FreeALLQ[x,varList],minFacRul[x],varFacRul[x]];
varFacRul[x_]:=Collect[Expand[x]/.simpRules,varList,Factor]/.simpRules;
minFacRul[x_]:=Factor[Expand[x]/.simpRules]/.simpRules;

Unprotect[SeriesData];If[$VersionNumber<5,Times[x_SeriesData,0]^=0];
SeriesData[x1_,x2_,x3_,x4_,x5_,x6_]:= 
  Plus@@If[x2===Infinity,
        Map[First[#]/x1^((x4+Last[#]-1)/x6)&,
            Transpose[{x3,Range[Length[x3]]}]]+
          SeriesData[x1,x2,{},x4,x5,x6],   
        Map[First[#]*(x1-x2)^((x4+Last[#]-1)/x6)&,
            Transpose[{x3,Range[Length[x3]]}]]+
          SeriesData[x1,x2,{},x4,x5,x6]]/;!FreeQ[x3,x1];Protect[SeriesData];

On[General::"spell",General::"spell1",UpSet::"write"];