In[]:=
deploy
Sun 25 Sep 2022 23:07:30
In[]:=
Clear[pic];col0=ColorData["Pastel"][0.2];(*moment*)col1=ColorData["Pastel"][0.8];(*cumulant*)pic[obj_]:=(content=obj[[1]];(*Cumulant[{0,0,1,0}]=>{0,0,1,0}*)pts=CirclePoints[Length@content];pts=RotateRight[pts];(*i,j,k,lincounter-clockwiseorder*)labels={"i","j","k","l"};labels0=labels[[;;Length@content]];activeIndices=Thread[content1];col=Switch[obj[[0]],Moment,col0,Cumulant,col1];pts0=Pick[pts,activeIndices];labels0=Pick[labels0,activeIndices];Graphics[{{FaceForm[col],EdgeForm@Directive[col,Thickness[0.15],JoinForm["Round"]],Polygon[pts0]},{Black,PointSize[0.07],Point[pts]}},FrameTrue,PlotRangePaddingScaled[.1],FrameTicksNone,PlotLabelStyle[StringJoin[labels0],16],ImageSizeTiny,BaselinePositionAxisCenter]);visualize[expr_]:=(poses0=Most/@Position[expr,Moment];poses1=Most/@Position[expr,Cumulant];Style[MapAt[pic,expr,poses0~Join~poses1],30]);(*dropCumulant/Momenttermsmatchinggivencriterion*)rank[expr_]:=Total[expr[[1]]];(*GetpositionofeveryMoment/Cumulanttermintheexpression*)termPositions[expr_]:=(poses0=Most/@Position[expr,Moment];poses1=Most/@Position[expr,Cumulant];poses0~Join~poses1);dropTerms[expr_,crit_]:=Module[{},helper[part_]:=If[part[[0]]===Cumulant||part[[0]]===Moment,If[crit[part],0,part],part];MapAt[helper,expr,termPositions[expr]]];convert[a_Moment]:=MomentConvert[a,"Cumulant"];convert[a_Cumulant]:=MomentConvert[a,"Moment"];(*Convertallmoment(orcumulant)termsintheexpression*)convertAll[expr_]:=(MapAt[convert,expr,termPositions[expr]]);moment4=Moment[{1,1,1,1}];cumulants=convert@moment4;cumulants=dropTerms[cumulants,rank[#]>2&];result=convertAll@cumulants//Simplifyvisualize[result]
Out[]=
-2Moment[{0,0,0,1}]Moment[{0,0,1,0}]Moment[{0,1,0,0}]Moment[{1,0,0,0}]+Moment[{0,1,1,0}]Moment[{1,0,0,1}]+Moment[{0,1,0,1}]Moment[{1,0,1,0}]+Moment[{0,0,1,1}]Moment[{1,1,0,0}]
Out[]=
-2
+
+
+
In[]:=