(* ::Package:: *)

If[MemberQ[$Packages,"STR`"],Print["The package STR is already loaded!"];Abort[]]


BeginPackage["STR`"]


Print["-*-*-*-*-STR-1.0-*-*-*-*-\n
Star-Triangle Relations (Uniqueness method) in D dimension.\n
Author: Michelangelo Preti, Ecole Normale Superieure\n
-*-*-*-*-*-*-*-*-*-*-*-*-*-\n
STR loaded! The new provided commands are:\n 
- STR\n 
- STRrelations\n 
- STRprefactor\n
- STRintegral\n
- STRgraph\n
- STRSimplify"]


STR::usage="STR[dimension]: It open the STR input window. Run the command without any argument."
STRrelations::usage="This function has no arguments. It contains the set of relations imposed on the STR input window usign Add star relation and Add triangle relation."
STRprefactor::usage="This function has no arguments. It contains the prefactor of the integral generated by the STR input window after the use of Computation tools."
STRintegral::usage="This function has no arguments. It contains the integral representation of the diagram in the STR input window."
STRgraph::usage="This function has no arguments. It contains the diagram as a graphical object drawn in the STR input window."
STRSimplify::usage="STRSimplify[expr,dimension]: Given the spacetime dimension, will simplify the output of the function STRprefactor."


Begin["`Private`"]


(* ::Subsection:: *)
(*Notation*)


Notation`AutoLoadNotationPalette = False


Needs["Notation`"]


Notation[ParsedBoxWrapper[SubscriptBox["x", "a_"]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{"Global`x", "[", "a_", "]"}]]]
Notation[ParsedBoxWrapper[RowBox[{SubscriptBox["\[CapitalDelta]", "a_"], "[", RowBox[{"\[Alpha]_", ",", "\[Beta]_"}], "]"}]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{RowBox[{"Global`\[CapitalDelta]", "[", "a_", "]"}], "[", RowBox[{"\[Alpha]_", ",", "\[Beta]_"}], "]"}]]]
Notation[ParsedBoxWrapper[RowBox[{SubscriptBox["\[DoubleStruckA]", "a_"], "[", "\[Alpha]___", "]"}]] \[DoubleLongLeftRightArrow] ParsedBoxWrapper[RowBox[{RowBox[{"Global`\[DoubleStruckA]", "[", "a_", "]"}], "[", "\[Alpha]___", "]"}]]]


SetAttributes[Global`B,Orderless];
SetAttributes[Global`TempA,Orderless];
SetAttributes[Global`TempB,Orderless];
SetAttributes[Global`TempC,Orderless];


(* ::Subsection:: *)
(*Functions*)


(*This function takes two coordinates (belonging to nodes) and draws bubbles between them, according to the number of edges going between these nodes.*)
makeBsplineCurves[endpoint1_,endpoint2_,multiplicity_]:=
Block[{transverseendpoint1,transverseendpoint2,listofbsplinecurves},
transverseendpoint1=Normalize[Cross[endpoint2-endpoint1]]/3+(endpoint1+endpoint2)/2;
transverseendpoint2=-Normalize[Cross[endpoint2-endpoint1]]/3+(endpoint1+endpoint2)/2;
listofbsplinecurves=Map[BSplineCurve[Join[{endpoint1},{transverseendpoint1+(transverseendpoint2-transverseendpoint1)#},{endpoint2}]]&,Range[0,1,1/(multiplicity-1)]];
listofbsplinecurves];


(*This function computes the position of the label of the edges. The output is a list of text objects containing the label and the related coordinate.*)
drawEdgeNames[inputpointcoordinatesandcolors_,inputedges_,showedges_,names_,inputmultiedges_]:=
Block[{graphedges,replacetographposition,graphmultiedges,labelpositions,outputgraphics},
If[showedges,
graphedges=Sort[#]&/@inputedges;
graphmultiedges=Cases[Tally[graphedges],Except[{_,1}]];
(*Now we have the edge an multiedges names {i,j}. We will turn each of these into a position, which is on the midway point of the edge. We will use ReplacePart to turn each position in graphedges to its corresponding coordinate*)
(*First we turn the single edges into their graph positions*)
replacetographposition=Map[Position[graphedges,#][[1,1]]->Mean[inputpointcoordinatesandcolors[[#,1]]]&,Cases[Tally[graphedges],{_,1}][[All,1]]];
(*Then the same for the multiedges*)
If[graphmultiedges=!={},
(*Multiedges are computed using makeBSplineCurves then we have to compute for any curve the point in the midway for any arch.*)
replacetographposition=Join[replacetographposition,MapThread[Sequence@@MapThread[Rule,{#1,#2}]&,{Map[Flatten[Position[graphedges,#]]&,graphmultiedges[[All,1]]],Map[(BSplineFunction@@#)[0.5]&,inputmultiedges,{2}]}]]
];
(*This function contains all the coordinates of the labels in the same order of graphedges*)
labelpositions=ReplacePart[graphedges,replacetographposition];
(*Now we have all the positions, and are ready to print out the graphics data for the edge labels*)
outputgraphics=MapThread[Text[Style[#1(*edge name*),FontColor->RGBColor[0.173,0.659,0.761],Medium,Background->RGBColor[1,1,1,0.8]],#2(*position of text*)]&,{names,labelpositions}];
,outputgraphics={};
];
outputgraphics
];


(*This function takes the graphical information and prints out Graph data which, when drawn, shows the node numbers next to each node in the graph*)
makeNodeNumbers[shownumbers_,inputpointcoordinatesandcolors_]:=
Block[{recenterPositions,nodenumbersasstrings,nodenumberpositions,nodenumbersgraphics},
If[shownumbers,
(*This function makes sure that if the position of the node number ends up outside the drawing box, it will be moved to be inside the box*)
recenterPositions=Function[{input},
Block[{output},
If[input<=-1.5,
output=input+0.2;
,If[input>=1.5,
output=input-0.2;
,output=input;
];
];
output]
];
(*these are the positions of the node numbers. If they fall outside the drawing box, we move them back into the box*)
nodenumberpositions=Map[recenterPositions[#]&,inputpointcoordinatesandcolors[[All,1]]+0.1,{2}];
nodenumbersgraphics=MapThread[Text[Style[#1(*number to write*),Medium,FontColor->Blue,Background->RGBColor[1,1,1,0.8]],#2(*position of text*)]&,
{Range[Length[inputpointcoordinatesandcolors]],nodenumberpositions}];
,(*if it is set to False, draw nothing*)
nodenumbersgraphics={};
];
nodenumbersgraphics
];


(*This function takes the graphical information and give a list of graphical object, arrows for fermions and lines for scalars*)
drawLines[inputpointcoordinatesandcolors_,inputedges_,inputmultiedges_,showarrow_,edgenametext_,flavor_]:=
Block[{outputgraphics},
(*check if the arrows and the nemas of the propagators have to be shown*)
If[showarrow,If[edgenametext,outputgraphics={Arrowheads[{{0.04,0.4}}],Line[Map[inputpointcoordinatesandcolors[[#,1]]&,inputedges[[#]]&/@Intersection[Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],{_,1}]]],Flatten[Position[flavor,1]]]]],{Red,Arrow[Map[inputpointcoordinatesandcolors[[#,1]]&,inputedges[[#]]&/@Intersection[Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],{_,1}]]],Flatten[Position[flavor,2]]]]]},Sequence@@MapAt[{Red,Arrow[#]}&,inputmultiedges,Flatten[Position[inputmultiedges,#]&/@(Flatten[inputmultiedges][[#]]&/@Flatten[Position[flavor[[#]]&/@Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],Except[{_,1}]]]],2]]),1]]};,outputgraphics={Arrowheads[{{0.04,0.6}}],Line[Map[inputpointcoordinatesandcolors[[#,1]]&,inputedges[[#]]&/@Intersection[Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],{_,1}]]],Flatten[Position[flavor,1]]]]],{Red,Arrow[Map[inputpointcoordinatesandcolors[[#,1]]&,inputedges[[#]]&/@Intersection[Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],{_,1}]]],Flatten[Position[flavor,2]]]]]},Sequence@@MapAt[{Red,Arrow[#]}&,inputmultiedges,Flatten[Position[inputmultiedges,#]&/@(Flatten[inputmultiedges][[#]]&/@Flatten[Position[flavor[[#]]&/@Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],Except[{_,1}]]]],2]]),1]]};],outputgraphics={Line[Map[inputpointcoordinatesandcolors[[#,1]]&,inputedges[[#]]&/@Intersection[Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],{_,1}]]],Flatten[Position[flavor,1]]]]],{Red,Line[Map[inputpointcoordinatesandcolors[[#,1]]&,inputedges[[#]]&/@Intersection[Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],{_,1}]]],Flatten[Position[flavor,2]]]]]},Sequence@@MapAt[{Red,#}&,inputmultiedges,Flatten[Position[inputmultiedges,#]&/@(Flatten[inputmultiedges][[#]]&/@Flatten[Position[flavor[[#]]&/@Flatten[Position[inputedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@inputedges],Except[{_,1}]]]],2]]),1]]};];
outputgraphics
];


(*This function gives a list of the vertices numbers with their color*)
Nodecolor[inputpointcoordinatesandcolors_]:=
MapThread[List[#1,#2]&,
{Range[Length[inputpointcoordinatesandcolors]],inputpointcoordinatesandcolors[[All,2]]}]


(*This function is a list of replacemente for the arrows shown in the pop-up window for Add triangle relations and Triangle-star*)
changestyle[A_,test2_]:=
A/.DoubleLongRightArrow[a_,b_]/;test2===1:>DoubleLongLeftRightArrow[a,b]/.DoubleLongLeftArrow[a_,b_]/;test2===1:>DoubleLongLeftRightArrow[a,b]/.DoubleLongRightArrow[a_,b_]/;test2===2:>Style[DoubleLongRightArrow[Style[a,Black],Style[b,Black]],Red]/.DoubleLongLeftArrow[a_,b_]/;test2===2:>Style[DoubleLongLeftArrow[Style[a,Black],Style[b,Black]],Red]


(*this function, given the spacetime dimension dim, will open the interactive window with the graphical environment and all the uniqueness method tools*)
STR[dim_]:=
DynamicModule[{pointcoordinatesandcolors={},temppointcoordinatesandcolors={},temporarydottededge={},tempnormaledges={},edges={},clickedposition,unclickedposition,addremove="Add",draggedposition,nodeinfo,nodenumber,multiedges={},tempmultiedges={},newposition,oldposition,nodenumberstext=True,edgenametext=True,names={},nm,mergeclick={},mergenodenumber,tempedgespositions,tempnames,tempedges,indext=1,relations={},tempnames2,starnodes,starnames,newstaredges,newstarnames,prefactor=1,triangleedges,trianglenames,convnodes,convnames,newconvedges,newconvnames,tempprefactor,showarrow=True,graph,choice,URlist={{{},{},{},{},{},1,{}}},URposition=1,URlisttemp,mouse1,flavor={},tempflavor,Bospos,Fermpos,starflavor,triangflavor,convflavor,testcolor=False},
(*The drawn graph is a Dynamic object, it's redrawn any time the graph has changed. There are two main variables that specify what to draw: pointcoordinatesandcolors, which is the list of nodes, and edges, the list of edges. Each element in pointcoordinatesandcolors contains the coordinates of the nodes in the Graphics box (whose positions are always approximated to the nearest 0.1 value, effectively turning the box into a grid), and a string which specifies what type of node you have: "WI" for white external positions that are not integrated, "BI", for black internal integrated positions, "WE" and "BE" that represent internal and external point selected by the tools. By default we begin with an empty graph, i.e. pointcoordinatesandcolors={} and edges={}.*)
(*Now we make the interactive Graphical environment. The entire thing is in a Panel[...,Background->RGBColor[0.07,0.55,0.49,0.43]]. Inside this panel, there's a single element: Grid[{row1,row2,...},Spacings\[Rule]{{...},{...}}]. There are 4 rows in the grid. The first row contains the RadioButtons for drawing the graph nodes and edges, and the Undo/Redo buttons. It contains also Checkboxes to control the graph drawing as arrows, vertices numbers and propagators weights. The second raw contains only some vertical spacing. The third row contains the interactive graph-drawing box and the list of the selectionand computation tools. The last row contains the output buttons.*)
Panel[Grid[{
(*Row1*)
{(*In this row there is a single Grid.*)
Grid[{
(*On this row we control the variable addremove, which takes the values "Add", "Remove", or "Move". We have also the Undo/Redo buttons.*)
{"                 "Row[{RadioButton[Dynamic[addremove],"Add"]," Add vertices/propagators  "}],"  "Row[{RadioButton[Dynamic[addremove],"Remove"]," Remove vertices  "}],"             "Row[{RadioButton[Dynamic[addremove],"Move"]," Move vertices  "}],"                  ",
Button["Undo",If[URposition===Length[URlist],URposition=URposition,URposition=URposition+1];
If[URposition<=Length[URlist],pointcoordinatesandcolors=URlist[[-URposition,1]];
edges=URlist[[-URposition,2]];
multiedges=URlist[[-URposition,3]];
names=URlist[[-URposition,4]];
relations=URlist[[-URposition,5]];
prefactor=URlist[[-URposition,6]];
flavor=URlist[[-URposition,7]];];,Enabled->Dynamic[If[URposition===Length[URlist],False,True]]]
,Button["Redo",If[URposition===1,URposition=1,URposition=URposition-1];If[URposition<=Length[URlist],pointcoordinatesandcolors=URlist[[-URposition,1]];
edges=URlist[[-URposition,2]];
multiedges=URlist[[-URposition,3]];
names=URlist[[-URposition,4]];
relations=URlist[[-URposition,5]];
prefactor=URlist[[-URposition,6]];
flavor=URlist[[-URposition,7]];];,Enabled->Dynamic[If[URposition===1,False,True]]]},
{(*This sub-row contains checkboxes for vertex numbers, propagator weights, arrows and the Clear All button*)Row[{Checkbox[Dynamic[nodenumberstext]],"Vertex numbers"}],"    "Row[{Checkbox[Dynamic[edgenametext]],"Propagator weights"}],Row[{Checkbox[Dynamic[showarrow]],"Arrows"}],"           ",Button["Clear All",
pointcoordinatesandcolors={};
temporarydottededge={};
indext=1;
edges={};
names={};
relations={};
prefactor=1;
multiedges={};
temppointcoordinatesandcolors={};
temporarydottededge={};
tempnormaledges={};
tempmultiedges={};
mergeclick={};
flavor={};
testcolor=False;
addremove="Add";
nodenumberstext=True;
edgenametext=True;
showarrow=True;
STRrelations={};
STRintegral=0;
ClearAll[STRgraph];
STRprefactor=1;
URlist={{{},{},{},{},{},1,{}}};
URposition=1;
ClearAll[clickedposition,unclickedposition,draggedposition,nodeinfo,nodenumber,newposition,oldposition,nm,mergenodenumber,tempedgespositions,tempnames,tempedges,tempnames2,starnodes,starnames,newstaredges,newstarnames,triangleedges,trianglenames,convnodes,convnames,newconvedges,newconvnames,tempprefactor,graph,choice,URlisttemp,mouse1,tempflavor,Bospos,Fermpos,starflavor,triangflavor,convflavor],ImageSize->Large]
}
},Spacings->{0,.05}
]},
(*Row2*)
(*This row is there to add a little vertical space*)
{},
(*Row3*)
{
(*The structure of the graphics is the following: it is a Dynamic[Graphics[{listofthingstobedrawn},PlotRange\[Rule]1.5,...,Background\[Rule]White].*)
(*The Dynamic Graphics is in turn wrapped by an EventHandler, which says that if you click in certain ways on the object wrapped by the EventHandler, it can perform actions you want. The structure is 
EventHandler[Dynamic[Graphics[...]],
{"MouseClicked"\[RuleDelayed](action if you left-clicked and released on the same spot),"MouseDown"\[RuleDelayed](action to do as soon as the mouse left-click is pressed down),,{"MouseDown",2}\[RuleDelayed](action to do as soon as the mouse right-click is pressed down),"MouseDragged"\[RuleDelayed](action to do every time the mouse is moved while the left-click is pressed. This is recomputed a lot as you drag across the screen),{"MouseDragged",2}\[RuleDelayed](action to do every time the mouse is moved while the right-click is pressed. This is recomputed a lot as you drag across the screen),"MouseUp"\[RuleDelayed](action to do as soon as the mouse left-click is released),{"MouseUp",2}\[RuleDelayed](action to do as soon as the mouse right-click is released)} *)
Row[{EventHandler[Dynamic[Graphics[{(*draw edges that are not bubbles*)
Thickness[0.005],
(*draw the normal propagators or multiedges*)
Sequence@@drawLines[pointcoordinatesandcolors,edges,multiedges,showarrow,edgenametext,flavor],
(*draw dotted edge as you drag the mouse*)
Thickness[0.005],temporarydottededge,
(*draw the nodes; internal\[Rule]black, external\[Rule]white, selected\[Rule]red border *)
{Black,EdgeForm[{Thick,Black}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"BI"}][[All,1]]]},{Black,EdgeForm[{Thick,Red}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"BE"}][[All,1]]]},{White,EdgeForm[{Thick,Black}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"WI"}][[All,1]]]},{White,EdgeForm[{Thick,Red}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"WE"}][[All,1]]]},
(*draw small blue node numbers next to each node, if nodenumberstext is set to True*)
makeNodeNumbers[nodenumberstext,pointcoordinatesandcolors],
(*draw the propagator weight on top of the edges*)
drawEdgeNames[pointcoordinatesandcolors,edges,edgenametext,names,multiedges]
},(*finished drawing. Now we list the options of the Graphics[{thingstodraw},options].*)
PlotRange->1.5,Frame->True,FrameTicks->None,ImageSize->{500,500},Background->White]],
(*Now the Dynamic box is finished. Here we list the actions to perform in the EventHandler*)
(*Drawing new nodes and lines is only done with "MouseDown", "MouseDragged", "MouseUp", {"MouseDown",2}, {"MouseDragged",2} and {"MouseUp",2}. "MouseClicked" is used to remove nodes.*)
(*In each case we approximate the mouse position so as to not need to click infinitely precisely.*)
{"MouseClicked":> (
(*if addremove is set to "Remove", find out which node you clicked on (if any) and remove it. Then also remove the edges connected to it*)
If[addremove==="Remove",
clickedposition=Round[MousePosition["Graphics"],0.1];
nodenumber=Flatten[Position[pointcoordinatesandcolors,{clickedposition,_}]];
If[nodenumber=!={},
temppointcoordinatesandcolors=Delete[pointcoordinatesandcolors,nodenumber[[1]]];
tempnormaledges=DeleteCases[edges,{nodenumber[[1]],_}|{_,nodenumber[[1]]}]/.{zz_/;(zz>nodenumber[[1]]):>zz-1};
tempnames2=Delete[names,Position[edges,{nodenumber[[1]],_}|{_,nodenumber[[1]]}]];
tempflavor=Delete[flavor,Position[edges,{nodenumber[[1]],_}|{_,nodenumber[[1]]}]];
tempmultiedges=Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]];
If[tempmultiedges=!={},(*we have multiple edges going between the same two nodes*)tempmultiedges=MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[tempnormaledges[[#]]&,Flatten[#]&/@(Position[tempnormaledges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(temppointcoordinatesandcolors[[#,1]])&,tempmultiedges,{All,1}]]},2];];
pointcoordinatesandcolors=temppointcoordinatesandcolors;
edges=tempnormaledges;
names=tempnames2;
flavor=tempflavor;
multiedges=tempmultiedges;
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;
];,
(*This is the Merging tool of uniqueness relations.*)
If[addremove==="Merge",
If[Length[mergeclick]<2,mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];,mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];
];
mergenodenumber=Flatten[Position[pointcoordinatesandcolors,{#,_}]]&/@mergeclick;
If[Length[mergenodenumber]===2&&FreeQ[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]&&FreeQ[edges,{mergenodenumber[[2,1]],mergenodenumber[[1,1]]}],mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};,Table[pointcoordinatesandcolors[[mergenodenumber[[kk]],2]]=pointcoordinatesandcolors[[mergenodenumber[[kk]],2]]/.{"WI"->"WE","BI"->"BE"},{kk,1,Length[mergenodenumber]}];
If[mergenodenumber=!={}&&Length[mergenodenumber]===2&&mergenodenumber[[1]]=!=mergenodenumber[[2]],
tempedgespositions=Flatten[{Position[edges,Flatten[mergenodenumber]],Position[edges,Reverse[Flatten[mergenodenumber]]]},1];
Bospos=tempedgespositions[[#]]&/@Flatten[Position[flavor[[#]]&/@Flatten[tempedgespositions],1]];
Fermpos=tempedgespositions[[#]]&/@Flatten[Position[flavor[[#]]&/@Flatten[tempedgespositions],2]];
If[Length[Fermpos]>0,If[OddQ[Length[Fermpos]],tempedges=Delete[edges,Flatten[{Drop[Fermpos,1],Bospos},1]];
tempnames=Delete[ReplacePart[names,Fermpos[[1,1]]->Plus@@(names[[#]]&/@Flatten[{Fermpos,Bospos}])],Flatten[{Drop[Fermpos,1],Bospos},1]];
tempflavor=Delete[flavor,Flatten[{Drop[Fermpos,1],Bospos},1]];
tempprefactor=(-1)^(Length[Fermpos]-Count[edges[[#]]&/@Flatten[Fermpos],Flatten[edges[[#]]&/@Fermpos[[1]]]])(*(-1)^(Length[Fermpos]/2)*);,If[(Plus@@(names[[#]]&/@Flatten[{Fermpos,Bospos}]))===0,tempedges=Delete[edges,Flatten[{Fermpos,Bospos},1]];
tempnames=Delete[names,Flatten[{Fermpos,Bospos},1]];
tempflavor=Delete[flavor,Flatten[{Fermpos,Bospos},1]];
tempprefactor=If[FreeQ[flavor[[#]]&/@Complement[Union[First/@Position[edges,mergenodenumber[[1,1]]],First/@Position[edges,mergenodenumber[[2,1]]]],Intersection[First/@Position[edges,mergenodenumber[[1,1]]],First/@Position[edges,mergenodenumber[[2,1]]]]],2],(-1)^(Length[Fermpos]-Count[edges[[#]]&/@Flatten[Fermpos],Flatten[edges[[#]]&/@Fermpos[[1]]]])(*(-1)^(Length[Fermpos]/2)*)Global`tr[\[DoubleStruckOne]],(-1)^(Length[Fermpos]-Count[edges[[#]]&/@Flatten[Fermpos],Flatten[edges[[#]]&/@Fermpos[[1]]]])(*(-1)^(Length[Fermpos]/2)*)];,
tempedges=Delete[edges,Flatten[{Drop[Fermpos,1],Bospos},1]];
tempnames=Delete[ReplacePart[names,Fermpos[[1,1]]->Plus@@(names[[#]]&/@Flatten[{Fermpos,Bospos}])],Flatten[{Drop[Fermpos,1],Bospos},1]];
tempflavor=Delete[ReplacePart[flavor,Fermpos[[1,1]]->1],Flatten[{Drop[Fermpos,1],Bospos},1]];
tempprefactor=If[FreeQ[flavor[[#]]&/@Complement[Union[First/@Position[edges,mergenodenumber[[1,1]]],First/@Position[edges,mergenodenumber[[2,1]]]],Intersection[First/@Position[edges,mergenodenumber[[1,1]]],First/@Position[edges,mergenodenumber[[2,1]]]]],2],(-1)^(Length[Fermpos]-Count[edges[[#]]&/@Flatten[Fermpos],Flatten[edges[[#]]&/@Fermpos[[1]]]])(*(-1)^(Length[Fermpos]/2)*)Global`tr[\[DoubleStruckOne]],(-1)^(Length[Fermpos]-Count[edges[[#]]&/@Flatten[Fermpos],Flatten[edges[[#]]&/@Fermpos[[1]]]])(*(-1)^(Length[Fermpos]/2)*)];];];,If[(Plus@@(names[[#]]&/@Flatten[tempedgespositions]))===0,tempedges=Delete[edges,tempedgespositions];
tempnames=Delete[names,tempedgespositions];
tempflavor=Delete[flavor,tempedgespositions];
tempprefactor=1;,tempedges=Delete[edges,Drop[tempedgespositions,1]];
tempnames=Delete[ReplacePart[names,tempedgespositions[[1,1]]->Plus@@(names[[#]]&/@Flatten[tempedgespositions])],Drop[tempedgespositions,1]];
tempflavor=Delete[flavor,Drop[tempedgespositions,1]];
tempprefactor=1;];];
edges=tempedges;
names=tempnames//Simplify;
flavor=tempflavor;
multiedges=Delete[multiedges,DeleteDuplicates[Flatten[{First/@Position[multiedges,BSplineCurve[{mergeclick[[1]],b_,mergeclick[[2]]}]],First/@Position[multiedges,BSplineCurve[{mergeclick[[2]],b_,mergeclick[[1]]}]]}]]];
prefactor=Times[prefactor,tempprefactor];
mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;
];];,
(*This is the Add triangle relation tool of uniqueness relations.*)
If[addremove==="RelationsT",
If[Length[mergeclick]<3,mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];,mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];
];
mergenodenumber=Flatten[Position[pointcoordinatesandcolors,{#,_}]]&/@mergeclick;
Table[pointcoordinatesandcolors[[mergenodenumber[[k]],2]]=pointcoordinatesandcolors[[mergenodenumber[[k]],2]]/.{"WI"->"WE","BI"->"BE"},{k,1,Length[mergenodenumber]}];
If[Length[mergenodenumber]===2&&(FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]]),CreateDialog[{TextCell["The nodes are not connected"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,If[Length[mergenodenumber]===3&&(FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]]||FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]]||FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]]),CreateDialog[{TextCell["This is not a triangle"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[mergenodenumber=!={}&&Length[mergenodenumber]===3&&(mergenodenumber[[1]]===mergenodenumber[[2]]||mergenodenumber[[1]]===mergenodenumber[[3]]||mergenodenumber[[3]]===mergenodenumber[[2]]),CreateDialog[{TextCell["This is not a triangle"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[Length[mergenodenumber]===3&&(Count[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]]===1&&Count[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]]===1&&Count[Sort[#]&/@edges,Sort[{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]]===1),If[!With[{testflavor=(flavor[[#]]&/@Flatten[{{Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}],Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[1,1]]}]},{Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[3,1]]}],Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]},{Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}],Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]}}])},(Count[testflavor,1]===1&&Count[testflavor,2]===2)||(Count[testflavor,1]===3)],CreateDialog[{TextCell["This is not a bosonic or Yukawa triangle"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,Module[{temprelation=Simplify[Plus@@(names[[#]]&/@Flatten[{{Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}],Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[1,1]]}]},{Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[3,1]]}],Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]},{Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}],Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]}}])]},If[((Simplify[temprelation==dim/2])===False)||Solve[Flatten[{relations,(Simplify[temprelation==dim/2])}]]==={},CreateDialog[{TextCell["This relation is False or incompatible with the others"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[((Simplify[temprelation==dim/2])===True)||((Simplify[temprelation==dim/2])/.Flatten[Solve[relations]])===True,CreateDialog[{TextCell["This relation is already True or included in the others"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
relations=DeleteDuplicates[Append[relations,Simplify[Plus@@(names[[#]]&/@Flatten[{Position[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]],Position[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]],Position[Sort[#]&/@edges,Sort[{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]]}])==dim/2]]];
CreateDialog[{TextCell["Unique triangle added"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;]],InheritScope->True]},Modal->True];];];];];,
If[Length[mergenodenumber]===3,nodeinfo=Module[{triangles=With[{posedges={Flatten[{Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}],Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[1,1]]}]}],Flatten[{Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[3,1]]}],Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]}],Flatten[{Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}],Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]}]}},Flatten[Table[{posedges[[1,iiii]],posedges[[2,jjjj]],posedges[[3,kkkk]]},{iiii,1,Length[posedges[[1]]]},{jjjj,1,Length[posedges[[2]]]},{kkkk,1,Length[posedges[[3]]]}],2]]},With[{flavorinfo=Map[flavor[[#]]&,triangles,1]},triangles[[#]]&/@Flatten[{Position[Sort/@flavorinfo,{1,1,1}],Position[Sort/@flavorinfo,{1,2,2}]}]]];
If[nodeinfo==={},CreateDialog[{TextCell["There are no bosonic or Yukawa triangles for the selected vertices"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,CreateDialog[{TextCell["Select the unique triangle"],Multicolumn[Table[With[{name=iiii},DynamicModule[{},Button[With[{test=MapThread[#1===#2&,{edges[[#]]&/@nodeinfo[[iiii]],{{mergenodenumber[[1,1]],mergenodenumber[[2,1]]},{mergenodenumber[[2,1]],mergenodenumber[[3,1]]},{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}}}],test2=flavor[[#]]&/@nodeinfo[[iiii]]},If[test[[2]],Overscript[DoubleLongRightArrow[If[test[[1]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]]]//changestyle[#,test2[[1]]]&,If[test[[3]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]]]//changestyle[#,test2[[3]]]&],names[[nodeinfo[[iiii,2]]]]],Overscript[DoubleLongLeftArrow[If[test[[1]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]]]//changestyle[#,test2[[1]]]&,If[test[[3]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]]]//changestyle[#,test2[[3]]]&],names[[nodeinfo[[iiii,2]]]]]]//changestyle[#,test2[[2]]]&],
DialogReturn[choice=name;
If[((Simplify[(Plus@@(names[[#]]&/@nodeinfo[[choice]]))]==Simplify[dim/2])===False)||Solve[Flatten[{relations,(Simplify[(Plus@@(names[[#]]&/@nodeinfo[[choice]]))]==Simplify[dim/2])}]]==={},CreateDialog[{TextCell["This relation is False or incompatible with the others"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,If[((Simplify[(Plus@@(names[[#]]&/@nodeinfo[[choice]]))==dim/2])===True)||((Simplify[(Plus@@(names[[#]]&/@nodeinfo[[choice]]))==dim/2])/.Flatten[Solve[relations]])===True,CreateDialog[{TextCell["This relation is already True or included in the others"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,(*choice=name;*)
relations=DeleteDuplicates[Append[relations,Simplify[Plus@@(names[[#]]&/@nodeinfo[[choice]])==dim/2]]];
CreateDialog[{TextCell["Unique triangle added"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;]],InheritScope->True]},Modal->True];];];]],InheritScope->True]],{iiii,1,Length[nodeinfo]}],4]},Modal->False];];];];];
];];,
(*This is the Add star relation tool of uniqueness relations.*)
If[addremove==="RelationsS",
mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],mergeclick=mouse1;
mergenodenumber=Flatten[Position[pointcoordinatesandcolors,{mergeclick,_}]];
If[FreeQ[Nodecolor[pointcoordinatesandcolors],{mergenodenumber[[1]],"BI"}],
pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This is not an integration point"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[Count[FreeQ[#,mergenodenumber[[1]]]&/@edges,False]=!=3,pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This is not a star"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[!With[{testflavor=flavor[[#]]&/@Flatten[{Position[edges,{_,mergenodenumber[[1]]}],Position[edges,{mergenodenumber[[1]],_}]}]},(Count[testflavor,1]===1&&Count[testflavor,2]===2)||Count[testflavor,1]===3],pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This is not a bosonic or Yukawa star"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,If[With[{testtadpole=Flatten[{Position[edges,{_,mergenodenumber[[1]]}],Position[edges,{mergenodenumber[[1]],_}]}]},(edges[[testtadpole[[1]]]]==edges[[testtadpole[[2]]]]||edges[[testtadpole[[1]]]]==Reverse[edges[[testtadpole[[2]]]]])||(edges[[testtadpole[[1]]]]==edges[[testtadpole[[3]]]]||edges[[testtadpole[[1]]]]==Reverse[edges[[testtadpole[[3]]]]])||
(edges[[testtadpole[[3]]]]==edges[[testtadpole[[2]]]]||edges[[testtadpole[[3]]]]==Reverse[edges[[testtadpole[[2]]]]])],pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This star produces a divergent result"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,Module[{temprelation=Simplify[Plus@@(names[[#]]&/@Flatten[Position[edges,{_,mergenodenumber[[1]]}|{mergenodenumber[[1]],_}]])]},If[((temprelation==dim)===False)||Solve[Flatten[{relations,(temprelation==dim)}]]==={},pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This relation is False or incompatible with the others"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[((temprelation==dim)===True)||((temprelation==dim)/.Flatten[Solve[relations]])===True,pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This relation is already True or included in the others"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};
relations=DeleteDuplicates[AppendTo[relations,Plus@@(names[[#]]&/@Flatten[Position[edges,{_,mergenodenumber[[1]]}|{mergenodenumber[[1]],_}]])==dim]]//Simplify;
CreateDialog[{TextCell["Unique star added"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;]],InheritScope->True]},Modal->True];];];];];];];];,CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];
,
(*This is the Star-triangle tool of uniqueness relations.*)
If[addremove==="Star",
mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],mergeclick=mouse1;
mergenodenumber=Flatten[Position[pointcoordinatesandcolors,{mergeclick,_}]];
If[FreeQ[Nodecolor[pointcoordinatesandcolors],{mergenodenumber[[1]],"BI"}],pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This is not an integration point"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,If[Count[FreeQ[#,mergenodenumber[[1]]]&/@edges,False]=!=3,pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This is not a star"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,If[!With[{testflavor=flavor[[#]]&/@Flatten[{Position[edges,{_,mergenodenumber[[1]]}],Position[edges,{mergenodenumber[[1]],_}]}]},(Count[testflavor,1]===1&&Count[testflavor,2]===2)||Count[testflavor,1]===3],pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This is not a bosonic or Yukawa star"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,If[With[{testtadpole=Flatten[{Position[edges,{_,mergenodenumber[[1]]}],Position[edges,{mergenodenumber[[1]],_}]}]},(edges[[testtadpole[[1]]]]==edges[[testtadpole[[2]]]]||edges[[testtadpole[[1]]]]==Reverse[edges[[testtadpole[[2]]]]])||(edges[[testtadpole[[1]]]]==edges[[testtadpole[[3]]]]||edges[[testtadpole[[1]]]]==Reverse[edges[[testtadpole[[3]]]]])||
(edges[[testtadpole[[3]]]]==edges[[testtadpole[[2]]]]||edges[[testtadpole[[3]]]]==Reverse[edges[[testtadpole[[2]]]]])],pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This star produces a divergent result"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[Simplify[((Plus@@(names[[#]]&/@Flatten[Position[edges,{_,mergenodenumber[[1]]}|{mergenodenumber[[1]],_}]])==dim)/.Flatten[Solve[relations]])]===True,
Module[{pos=Position[edges,{_,mergenodenumber[[1]]}|{mergenodenumber[[1]],_}]},starnodes=(edges[[#]]&/@Flatten[pos])/.{a_,mergenodenumber[[1]]}:>a/.{mergenodenumber[[1]],a_}:>a;starnames=names[[#]]&/@Flatten[pos]//Simplify;
starflavor=flavor[[#]]&/@Flatten[pos];newstaredges={If[starflavor[[1]]===1,{starnodes[[2]],starnodes[[3]]},If[!FreeQ[edges,{mergenodenumber[[1]],starnodes[[1]]}],{starnodes[[Flatten[Position[ReplacePart[starflavor,1->0],2]][[1]]]],starnodes[[Flatten[Position[starflavor,1]][[1]]]]},{starnodes[[Flatten[Position[starflavor,1]][[1]]]],starnodes[[Flatten[Position[ReplacePart[starflavor,1->0],2]][[1]]]]}]],If[starflavor[[2]]===1,{starnodes[[1]],starnodes[[3]]},If[!FreeQ[edges,{mergenodenumber[[1]],starnodes[[2]]}],{starnodes[[Flatten[Position[ReplacePart[starflavor,2->0],2]][[1]]]],starnodes[[Flatten[Position[starflavor,1]][[1]]]]},{starnodes[[Flatten[Position[starflavor,1]][[1]]]],starnodes[[Flatten[Position[ReplacePart[starflavor,2->0],2]][[1]]]]}]],If[starflavor[[3]]===1,{starnodes[[1]],starnodes[[2]]},If[!FreeQ[edges,{mergenodenumber[[1]],starnodes[[3]]}],{starnodes[[Flatten[Position[ReplacePart[starflavor,3->0],2]][[1]]]],starnodes[[Flatten[Position[starflavor,1]][[1]]]]},{starnodes[[Flatten[Position[starflavor,1]][[1]]]],starnodes[[Flatten[Position[ReplacePart[starflavor,3->0],2]][[1]]]]}]]};
newstarnames={dim/2-starnames[[1]],dim/2-starnames[[2]],dim/2-starnames[[3]]};
temppointcoordinatesandcolors=Delete[pointcoordinatesandcolors,mergenodenumber[[1]]];
tempedges=Flatten[{Delete[edges,pos],newstaredges},1]/.{zz_/;(zz>mergenodenumber[[1]]):>zz-1};
tempnames=Flatten[{Delete[names,pos],newstarnames},1];
tempflavor=Flatten[{Delete[flavor,pos],starflavor},1];
pointcoordinatesandcolors=temppointcoordinatesandcolors;
edges=tempedges;
flavor=tempflavor;
tempmultiedges=Cases[Tally[Sort[#]&/@edges],Except[{_,1}]];
If[tempmultiedges=!={},(*we have multiple edges going between the same two nodes*)tempmultiedges=MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[edges[[#]]&,Flatten[#]&/@(Position[edges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@edges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(temppointcoordinatesandcolors[[#,1]])&,tempmultiedges,{All,1}]]},2];];multiedges=tempmultiedges;
names=tempnames//Simplify;
prefactor=prefactor \[Pi]^(dim/2) ((Global`TempA@@starnames[[Flatten[Position[starflavor,1]]]])(Global`TempB@@starnames[[Flatten[Position[starflavor,2]]]])/.Global`TempB[]:>1)//.Global`TempA[a_,b_,c_]Global`TempA[d_,e_,f_]/;Simplify[a+d]===Simplify[dim/2]&&Simplify[b+e]===Simplify[dim/2]&&Simplify[c+f]===Simplify[dim/2]:>1//.Global`TempA[a1_]Global`TempA[a2_]Global`TempB[b1_,c1_]Global`TempB[b2_,c2_]/;Simplify[a1+a2]===Simplify[dim/2]&&Simplify[b1+b2]===Simplify[dim/2]&&Simplify[c1+c2]===Simplify[dim/2]:>1;];
mergeclick={};ClearAll[mergenodenumber];
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;,
pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This star is not unique (check relations)"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];
;];];];];];,CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];,
(*This is the triangle-star relation tool of uniqueness relations.*)
If[addremove==="Triangle",
If[Length[mergeclick]<3,mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];,mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];
];
mergenodenumber=Flatten[Position[pointcoordinatesandcolors,{#,_}]]&/@mergeclick;
Table[pointcoordinatesandcolors[[mergenodenumber[[k]],2]]=pointcoordinatesandcolors[[mergenodenumber[[k]],2]]/.{"WI"->"WE","BI"->"BE"},{k,1,Length[mergenodenumber]}];
If[Length[mergenodenumber]===2&&(FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]]),
CreateDialog[{TextCell["The nodes are not connected"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,If[Length[mergenodenumber]===3&&(FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]]||FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]]||FreeQ[Sort[#]&/@edges,Sort[{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]]),
CreateDialog[{TextCell["This is not a triangle"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[mergenodenumber=!={}&&Length[mergenodenumber]===3&&(mergenodenumber[[1]]===mergenodenumber[[2]]||mergenodenumber[[1]]===mergenodenumber[[3]]||mergenodenumber[[3]]===mergenodenumber[[2]]),CreateDialog[{TextCell["This is not a triangle"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[Length[mergenodenumber]===3&&(Count[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]]===1&&Count[Sort[#]&/@edges,Sort[{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]]===1&&Count[Sort[#]&/@edges,Sort[{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]]===1),
Module[{pos=Flatten[{{Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}],Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[1,1]]}]},{Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[3,1]]}],Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]},{Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}],Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]}}]},If[!With[{testflavor=(flavor[[#]]&/@pos)},(Count[testflavor,1]===1&&Count[testflavor,2]===2)||(Count[testflavor,1]===3)],CreateDialog[{TextCell["This is not a bosonic or Yukawa triangle"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[Simplify[((Simplify[Plus@@(names[[#]]&/@pos)]==dim/2)/.Flatten[Solve[relations]])]===True,
temppointcoordinatesandcolors=Flatten[{pointcoordinatesandcolors,{{Round[RegionCentroid[Polygon[pointcoordinatesandcolors[[#]][[1]]&/@Flatten[mergenodenumber]]],0.1],"BI"}}},1];
triangflavor=flavor[[#]]&/@pos;
triangleedges={If[!FreeQ[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}],If[triangflavor[[2]]===1,{mergenodenumber[[3,1]],Length[temppointcoordinatesandcolors]},{Length[temppointcoordinatesandcolors],mergenodenumber[[3,1]]}],If[triangflavor[[2]]===1,{Length[temppointcoordinatesandcolors],mergenodenumber[[3,1]]},{mergenodenumber[[3,1]],Length[temppointcoordinatesandcolors]}]],If[!FreeQ[edges,{mergenodenumber[[2,1]],mergenodenumber[[3,1]]}],If[triangflavor[[3]]===1,{mergenodenumber[[1,1]],Length[temppointcoordinatesandcolors]},{Length[temppointcoordinatesandcolors],mergenodenumber[[1,1]]}],If[triangflavor[[3]]===1,{Length[temppointcoordinatesandcolors],mergenodenumber[[1,1]]},{mergenodenumber[[1,1]],Length[temppointcoordinatesandcolors]}]],If[!FreeQ[edges,{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}],If[triangflavor[[1]]===1,{mergenodenumber[[2,1]],Length[temppointcoordinatesandcolors]},{Length[temppointcoordinatesandcolors],mergenodenumber[[2,1]]}],If[triangflavor[[1]]===1,{Length[temppointcoordinatesandcolors],mergenodenumber[[2,1]]},{mergenodenumber[[2,1]],Length[temppointcoordinatesandcolors]}]]};
trianglenames={dim/2-names[[pos[[1]]]],dim/2-names[[pos[[2]]]],dim/2-names[[pos[[3]]]]};
prefactor=prefactor \[Pi]^(-(dim/2)) ((Global`TempA@@((names[[#]]&/@pos)[[#]]&/@Flatten[Position[triangflavor,1]]))(Global`TempB@@((names[[#]]&/@pos)[[#]]&/@Flatten[Position[triangflavor,2]]))/.Global`TempB[]:>1)//.Global`TempA[a_,b_,c_]Global`TempA[d_,e_,f_]/;Simplify[a+d]===Simplify[dim/2]&&Simplify[b+e]===Simplify[dim/2]&&Simplify[c+f]===Simplify[dim/2]:>1//.Global`TempA[a1_]Global`TempA[a2_]Global`TempB[b1_,c1_]Global`TempB[b2_,c2_]/;Simplify[a1+a2]===Simplify[dim/2]&&Simplify[b1+b2]===Simplify[dim/2]&&Simplify[c1+c2]===Simplify[dim/2]:>1;
pointcoordinatesandcolors=temppointcoordinatesandcolors;
edges=Flatten[{Delete[edges,(List/@pos)],triangleedges},1];
names=Flatten[{Delete[names,(List/@pos)],trianglenames},1];
flavor=Flatten[{Delete[flavor,(List/@pos)],triangflavor},1];mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;,CreateDialog[{TextCell["This triangle is not unique"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];];];];,
If[Length[mergenodenumber]===3,nodeinfo=Module[{triangles=With[{posedges={Flatten[{Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}],Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[1,1]]}]}],Flatten[{Position[edges,{mergenodenumber[[2,1]],mergenodenumber[[3,1]]}],Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[2,1]]}]}],Flatten[{Position[edges,{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}],Position[edges,{mergenodenumber[[1,1]],mergenodenumber[[3,1]]}]}]}},Flatten[Table[{posedges[[1,iiii]],posedges[[2,jjjj]],posedges[[3,kkkk]]},{iiii,1,Length[posedges[[1]]]},{jjjj,1,Length[posedges[[2]]]},{kkkk,1,Length[posedges[[3]]]}],2]]},With[{flavorinfo=Map[flavor[[#]]&,triangles,1]},triangles[[#]]&/@Flatten[{Position[Sort/@flavorinfo,{1,1,1}],Position[Sort/@flavorinfo,{1,2,2}]}]]];
If[nodeinfo==={},CreateDialog[{TextCell["There are no bosonic or Yukawa triangles for the selected vertices"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,CreateDialog[{TextCell["Select a triangle"],Multicolumn[Table[With[{name=iiii},DynamicModule[{},Button[With[{test=MapThread[#1===#2&,{edges[[#]]&/@nodeinfo[[iiii]],{{mergenodenumber[[1,1]],mergenodenumber[[2,1]]},{mergenodenumber[[2,1]],mergenodenumber[[3,1]]},{mergenodenumber[[3,1]],mergenodenumber[[1,1]]}}}],test2=flavor[[#]]&/@nodeinfo[[iiii]]},If[test[[2]],Overscript[DoubleLongRightArrow[If[test[[1]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]]]//changestyle[#,test2[[1]]]&,If[test[[3]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]]]//changestyle[#,test2[[3]]]&],names[[nodeinfo[[iiii,2]]]]],Overscript[DoubleLongLeftArrow[If[test[[1]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[1,1]]],Global`x[mergenodenumber[[2,1]]]],names[[nodeinfo[[iiii,1]]]]]]//changestyle[#,test2[[1]]]&,If[test[[3]],Overscript[DoubleLongRightArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]],Overscript[DoubleLongLeftArrow[Global`x[mergenodenumber[[3,1]]],Global`x[mergenodenumber[[1,1]]]],names[[nodeinfo[[iiii,3]]]]]]//changestyle[#,test2[[3]]]&],names[[nodeinfo[[iiii,2]]]]]]//changestyle[#,test2[[2]]]&],
DialogReturn[choice=name;
If[Simplify[((Plus@@(names[[#]]&/@nodeinfo[[choice]])==Simplify[dim/2])/.Flatten[Solve[relations]])]===True,
temppointcoordinatesandcolors=Flatten[{pointcoordinatesandcolors,{{Round[RegionCentroid[Polygon[pointcoordinatesandcolors[[#]][[1]]&/@Flatten[mergenodenumber]]],0.1],"BI"}}},1];
triangflavor=flavor[[#]]&/@nodeinfo[[choice]];
triangleedges=With[{tr=edges[[#]]&/@nodeinfo[[choice]]},{If[tr[[1]]==={mergenodenumber[[1,1]],mergenodenumber[[2,1]]},If[triangflavor[[2]]===1,{mergenodenumber[[3,1]],Length[temppointcoordinatesandcolors]},{Length[temppointcoordinatesandcolors],mergenodenumber[[3,1]]}],If[triangflavor[[2]]===1,{Length[temppointcoordinatesandcolors],mergenodenumber[[3,1]]},{mergenodenumber[[3,1]],Length[temppointcoordinatesandcolors]}]],If[tr[[2]]==={mergenodenumber[[2,1]],mergenodenumber[[3,1]]},If[triangflavor[[3]]===1,{mergenodenumber[[1,1]],Length[temppointcoordinatesandcolors]},{Length[temppointcoordinatesandcolors],mergenodenumber[[1,1]]}],If[triangflavor[[3]]===1,{Length[temppointcoordinatesandcolors],mergenodenumber[[1,1]]},{mergenodenumber[[1,1]],Length[temppointcoordinatesandcolors]}]],If[tr[[3]]==={mergenodenumber[[3,1]],mergenodenumber[[1,1]]},If[triangflavor[[1]]===1,{mergenodenumber[[2,1]],Length[temppointcoordinatesandcolors]},{Length[temppointcoordinatesandcolors],mergenodenumber[[2,1]]}],If[triangflavor[[1]]===1,{Length[temppointcoordinatesandcolors],mergenodenumber[[2,1]]},{mergenodenumber[[2,1]],Length[temppointcoordinatesandcolors]}]]}];
trianglenames=With[{tr=names[[#]]&/@nodeinfo[[choice]]},{dim/2-tr[[1]],dim/2-tr[[2]],dim/2-tr[[3]]}]//Simplify;
prefactor=prefactor \[Pi]^(-(dim/2)) ((Global`TempA@@(names[[#]]&/@((nodeinfo[[choice]])[[#]]&/@Flatten[Position[triangflavor,1]])))(Global`TempB@@(names[[#]]&/@((nodeinfo[[choice]])[[#]]&/@Flatten[Position[triangflavor,2]])))/.Global`TempB[]:>1)//.Global`TempA[a_,b_,c_]Global`TempA[d_,e_,f_]/;Simplify[a+d]===Simplify[dim/2]&&Simplify[b+e]===Simplify[dim/2]&&Simplify[c+f]===Simplify[dim/2]:>1//.Global`TempA[a1_]Global`TempA[a2_]Global`TempB[b1_,c1_]Global`TempB[b2_,c2_]/;Simplify[a1+a2]===Simplify[dim/2]&&Simplify[b1+b2]===Simplify[dim/2]&&Simplify[c1+c2]===Simplify[dim/2]:>1;
tempedges=Flatten[{Delete[edges,List[#]&/@nodeinfo[[choice]]],triangleedges},1];
tempnames=Flatten[{Delete[names,List[#]&/@nodeinfo[[choice]]],trianglenames},1];
tempflavor=Flatten[{Delete[flavor,List[#]&/@nodeinfo[[choice]]],triangflavor},1];
tempmultiedges=Module[{multitest=Cases[Tally[Sort[#]&/@tempedges],Except[{_,1}]]},If[multitest==={},{},MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[tempedges[[#]]&,Flatten[#]&/@(Position[tempedges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@tempedges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(temppointcoordinatesandcolors[[#,1]])&,multitest,{All,1}]]},2]]];
pointcoordinatesandcolors=temppointcoordinatesandcolors;
edges=tempedges;
names=tempnames;
flavor=tempflavor;
multiedges=tempmultiedges;
mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;
,CreateDialog[{TextCell["This triangle is not unique"],DynamicModule[{},DefaultButton[],InheritScope->True]},Modal->True];mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]]],InheritScope->True]],{iiii,1,Length[nodeinfo]}],4]},Modal->True];];];];];

];];,
(*This is the chain-rule tool of uniqueness relations.*)
If[addremove==="Convolution",
mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],mergeclick=mouse1;
mergenodenumber=Flatten[Position[pointcoordinatesandcolors,{mergeclick,_}]];
If[FreeQ[Nodecolor[pointcoordinatesandcolors],{mergenodenumber[[1]],"BI"}],
pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["This is not an integration point"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[Count[FreeQ[#,mergenodenumber[[1]]]&/@edges,False]=!=2,pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["Convolution integration needs 2 propagators"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
If[With[{testtadpole=Flatten[{Position[edges,{_,mergenodenumber[[1]]}],Position[edges,{mergenodenumber[[1]],_}]}]},(edges[[testtadpole[[1]]]]==edges[[testtadpole[[2]]]]||edges[[testtadpole[[1]]]]==Reverse[edges[[testtadpole[[2]]]]])],pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};CreateDialog[{TextCell["The result of the chain rule is divergent"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};ClearAll[mergenodenumber];pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True];,
pointcoordinatesandcolors[[mergenodenumber[[1]],2]]=pointcoordinatesandcolors[[mergenodenumber[[1]],2]]/.{"WI"->"WE","BI"->"BE"};
Module[{pos=Position[edges,{_,mergenodenumber[[1]]}|{mergenodenumber[[1]],_}]},convnodes=(edges[[#]]&/@Flatten[pos])/.{a_,mergenodenumber[[1]]}:>a/.{mergenodenumber[[1]],a_}:>a;
convnames=names[[#]]&/@Flatten[pos];
convflavor=flavor[[#]]&/@Flatten[pos];
Which[convflavor==={1,1},newconvedges={convnodes};
prefactor=prefactor  \[Pi]^(dim/2) (Global`TempA@@Append[convnames,dim-(Plus@@convnames)]);
tempflavor=Flatten[{Delete[flavor,pos],1}];,(convflavor==={2,1})||(convflavor==={1,2}),newconvedges=With[{redprop=Flatten[edges[[#]]&/@Flatten[pos[[#]]&/@Flatten[Position[convflavor,2]]]]},If[Flatten[Position[convnodes,#]&@@Intersection[convnodes,redprop]]===Flatten[Position[redprop,#]&@@Intersection[convnodes,redprop]],{convnodes},{Reverse[convnodes]}]];
prefactor=prefactor  \[Pi]^(dim/2)(Global`TempA@@(convnames[[#]]&/@Flatten[Position[convflavor,1]]))(Global`TempB@@Flatten[{(convnames[[#]]&/@Flatten[Position[convflavor,2]]),dim-(Plus@@convnames)}]);
tempflavor=Flatten[{Delete[flavor,pos],2}];,convflavor==={2,2},newconvedges={convnodes};
prefactor=prefactor (*(-1) \[EGrave] per Clifford (da vedere) *) If[Position[edges[[Flatten[pos][[1]]]],mergenodenumber[[1]]]===Position[edges[[Flatten[pos][[2]]]],mergenodenumber[[1]]],-1,1](-1)\[Pi]^(dim/2)(Global`TempB@@convnames)Global`TempA[dim-(Plus@@convnames)](Global`\[DoubleStruckOne]@@Flatten[pos]);
tempflavor=Flatten[{Delete[flavor,pos],1}];];
newconvnames={convnames[[1]]+convnames[[2]]-dim/2};
temppointcoordinatesandcolors=Delete[pointcoordinatesandcolors,mergenodenumber[[1]]];
tempedges=Flatten[{Delete[edges,pos],newconvedges},1]/.{zz_/;(zz>mergenodenumber[[1]]):>zz-1};
tempnames=Flatten[{Delete[names,pos],newconvnames},1];
pointcoordinatesandcolors=temppointcoordinatesandcolors;
edges=tempedges;
tempmultiedges=Cases[Tally[Sort[#]&/@edges],Except[{_,1}]];
If[tempmultiedges=!={},(*we have multiple edges going between the same two nodes*)tempmultiedges=MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[edges[[#]]&,Flatten[#]&/@(Position[edges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@edges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(temppointcoordinatesandcolors[[#,1]])&,tempmultiedges,{All,1}]]},2];];multiedges=tempmultiedges;
names=tempnames//Simplify;
flavor=tempflavor;];
mergeclick={};ClearAll[mergenodenumber];
pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;];];];,CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];,
(*This is the flip-arrow tool of uniqueness relations.*)
If[addremove==="Flip",
If[Length[mergeclick]<2,mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];,mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
mouse1=Round[MousePosition["Graphics"],0.1];If[!FreeQ[pointcoordinatesandcolors,mouse1],If[FreeQ[mergeclick,mouse1],AppendTo[mergeclick,mouse1]],CreateDialog[{TextCell["No node selected"],DynamicModule[{},DefaultButton[DialogReturn[ClearAll[mouse1];]],InheritScope->True]},Modal->True];];
];
mergenodenumber=Flatten[Position[pointcoordinatesandcolors,{#,_}]]&/@mergeclick;
If[Length[mergenodenumber]===2&&FreeQ[edges,{mergenodenumber[[1,1]],mergenodenumber[[2,1]]}]&&FreeQ[edges,{mergenodenumber[[2,1]],mergenodenumber[[1,1]]}],
CreateDialog[{TextCell["The points have to be adjacent"],DynamicModule[{},DefaultButton[DialogReturn[mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};]],InheritScope->True]},Modal->True],
Table[pointcoordinatesandcolors[[mergenodenumber[[k]],2]]=pointcoordinatesandcolors[[mergenodenumber[[k]],2]]/.{"WI"->"WE","BI"->"BE"},{k,1,Length[mergenodenumber]}];
If[mergenodenumber=!={}&&Length[mergenodenumber]===2&&mergenodenumber[[1]]=!=mergenodenumber[[2]],
If[Count[Sort[#]&/@edges,Sort[Flatten[mergenodenumber]]]===1,
Module[{pp=Flatten[Position[Sort[#]&/@edges,Sort[Flatten[mergenodenumber]]]]},edges=ReplacePart[edges,pp[[1]]->Reverse[edges[[pp[[1]]]]]];
prefactor=(-1)^If[flavor[[pp[[1]]]]===2,1,0] prefactor;];
mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;,nodeinfo=With[{pos1=Flatten[Position[Sort[#]&/@edges,Sort[Flatten[mergenodenumber]]]]},pos1[[#]]&/@Flatten[Position[(flavor[[#]]&/@pos1),2]]];
Which[
nodeinfo==={},mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};,
Length[nodeinfo]===1,
edges=ReplacePart[edges,nodeinfo[[1]]->Reverse[edges[[nodeinfo[[1]]]]]];
multiedges=Module[{pos=(pointcoordinatesandcolors[[#]][[1]]&/@Flatten[mergenodenumber])},multiedges/.{BSplineCurve[{pos[[1]],any_,pos[[2]]}]:>BSplineCurve[{pos[[2]],any,pos[[1]]}],BSplineCurve[{pos[[2]],any_,pos[[1]]}]:>BSplineCurve[{pos[[1]],any,pos[[2]]}]}];
prefactor=-prefactor;mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;,
True,
CreateDialog[{TextCell["Select the propagator to flip"],Multicolumn[Table[With[{name=iiii},DynamicModule[{},
Button[If[edges[[nodeinfo[[iiii]]]]==={mergenodenumber[[1,1]],mergenodenumber[[2,1]]},
Overscript[Style[DoubleLongRightArrow[Style[Global`x[mergenodenumber[[1,1]]],Black],Style[Global`x[mergenodenumber[[2,1]]],Black]],Red],names[[nodeinfo[[iiii]]]]],Overscript[Style[DoubleLongLeftArrow[Style[Global`x[mergenodenumber[[1,1]]],Black],Style[Global`x[mergenodenumber[[2,1]]],Black]],Red],names[[nodeinfo[[iiii]]]]]],DialogReturn[choice=name;
tempnormaledges=ReplacePart[edges,nodeinfo[[choice]]->Reverse[edges[[nodeinfo[[choice]]]]]];
tempmultiedges=Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]];
multiedges=MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[tempnormaledges[[#]]&,Flatten[#]&/@(Position[tempnormaledges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(pointcoordinatesandcolors[[#,1]])&,tempmultiedges,{All,1}]]},2];
edges=tempnormaledges;
prefactor=- prefactor;
ClearAll[nodeinfo,choice];mergeclick={};pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;]],InheritScope->True]],{iiii,1,Length[nodeinfo]}],4]},Modal->True];];];];];];

];];];];];];];
),
"MouseDown":>(
(*if addremove is set to "Add", we are in drawing mode.*)
If[addremove==="Add",
clickedposition=Round[MousePosition["Graphics"],0.1];
(*if the position does not have a node already, add a new node of the specified color and type*)
If[FreeQ[pointcoordinatesandcolors,{clickedposition,_}],
pointcoordinatesandcolors=Append[pointcoordinatesandcolors,{clickedposition,"WI"}];,
testcolor=True;
];
];
(*if addremove is set to "Move", we record where we are now.*)
If[addremove==="Move",
oldposition=Round[MousePosition["Graphics"],0.1];
];
),{"MouseDown",2}:>(
(*if addremove is set to "Add", we are in drawing mode.*)
If[addremove==="Add",
clickedposition=Round[MousePosition["Graphics"],0.1];
(*if the position does not have a node already, add a new node of the specified color and type*)
If[FreeQ[pointcoordinatesandcolors,{clickedposition,_}],
pointcoordinatesandcolors=Append[pointcoordinatesandcolors,{clickedposition,"WI"}];
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;,testcolor=True;
];
];
)
,"MouseDragged":>(
(*if addremove is set to "Add", we are in drawing mode. We draw a scalar dotted edge between the clickedposition and the current position to show where the new scalar edge will be. If we move the mouse outside the box, we force the position back into the box.*)
If[addremove==="Add",
draggedposition=Round[MousePosition["Graphics"],0.1]/.{z1_/;(z1>1.5)->1.5,z2_/;(z2<-1.5)->-1.5};
temporarydottededge={Lighter[Lighter[Lighter[Black]]],Dashed,Line[{clickedposition,draggedposition}]};
];
(*if addremove is set to "Move", we need to relocate the node we clicked on*)
If[addremove==="Move",
newposition=Round[MousePosition["Graphics"],0.1]/.{z1_/;(z1>1.5)->1.5,z2_/;(z2<-1.5)->-1.5};
(*if the new position is not on another existing node, move the node we clicked on (if any) and redraw the bubbles*)
If[Cases[pointcoordinatesandcolors,{newposition,_}]==={},
pointcoordinatesandcolors=pointcoordinatesandcolors/.{oldposition->newposition};
multiedges=Cases[Tally[Sort[#]&/@edges],Except[{_,1}]];
If[multiedges=!={},(*we have multiple edges going between the same two nodes*)multiedges=MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[edges[[#]]&,Flatten[#]&/@(Position[edges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@edges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(pointcoordinatesandcolors[[#,1]])&,multiedges,{All,1}]]},2];];
oldposition=newposition;
];
];
),{"MouseDragged",2}:>(
(*if addremove is set to "Add", we are in drawing mode. We draw a fermionic dotted edge between the clickedposition and the current position to show where the new fermionic edge will be. If we move the mouse outside the box, we force the position back into the box.*)
If[addremove==="Add",
draggedposition=Round[MousePosition["Graphics"],0.1]/.{z1_/;(z1>1.5)->1.5,z2_/;(z2<-1.5)->-1.5};
temporarydottededge={Lighter[Lighter[Lighter[Red]]],Dashed,Line[{clickedposition,draggedposition}]};
];
),
"MouseUp":>(
If[addremove==="Add",
temppointcoordinatesandcolors=pointcoordinatesandcolors;
tempnormaledges=edges;
unclickedposition=Round[MousePosition["Graphics"],0.1]/.{z1_/;(z1>1.5)->1.5,z2_/;(z2<-1.5)->-1.5};
If[FreeQ[temppointcoordinatesandcolors,{unclickedposition,_}],
temppointcoordinatesandcolors=Append[temppointcoordinatesandcolors,{unclickedposition,"WI"}];
];
(*if we released on a position different to the starting one, we need to add new edges*)
If[unclickedposition=!=clickedposition,
tempnormaledges=Append[tempnormaledges,Flatten[{Position[temppointcoordinatesandcolors,{clickedposition,_}],Position[temppointcoordinatesandcolors,{unclickedposition,_}]}]];
tempmultiedges=Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]];
If[tempmultiedges=!={},(*we have multiple edges going between the same two nodes*)tempmultiedges=MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[tempnormaledges[[#]]&,Flatten[#]&/@(Position[tempnormaledges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(temppointcoordinatesandcolors[[#,1]])&,tempmultiedges,{All,1}]]},2];];
flavor=Append[flavor,1];
(*if we released in the same position we started in, we don't draw any new edges, but we swap the color of the node we clicked on.*)
,If[Last[temppointcoordinatesandcolors][[1]]=!=clickedposition||MemberQ[tempnormaledges,{_,Length[temppointcoordinatesandcolors]}|{Length[temppointcoordinatesandcolors],_}]||testcolor,
nodeinfo=Cases[temppointcoordinatesandcolors,{clickedposition,_}][[1]];
temppointcoordinatesandcolors=ReplacePart[temppointcoordinatesandcolors,Position[temppointcoordinatesandcolors,nodeinfo][[1,1]]->{clickedposition,StringJoin[StringTake[nodeinfo[[2]],{1}]/.{"B"->"W","W"->"B"},StringTake[nodeinfo[[2]],{2}]]}];
testcolor=False;
];
];
pointcoordinatesandcolors=temppointcoordinatesandcolors;
If[unclickedposition=!=clickedposition,multiedges=tempmultiedges;
CreateDialog[{TextCell["Edge weight: "],InputField[Dynamic[Global`weight],String,FieldHint->"Enter the weight" ],DynamicModule[{},DefaultButton[DialogReturn[nm=ToExpression[Global`weight];
ClearAll[Global`weight];
names=(names/."weight"->If[nm===Global`weight,Global`w[indext],If[nm===$Failed||nm===Null,Global`w[indext],nm]]);
indext=indext+1;
If[URposition=!=1,URlisttemp=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlisttemp=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URlist=Delete[URlisttemp,{-2}];
URposition=1;]],InheritScope->True]},Modal->True];
names=AppendTo[names,"weight"];
];
(*finally, we remove the dotted edge*)
temporarydottededge={};
edges=tempnormaledges;
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;];
(*if addremove is set to "Move", we need to make the final relocation of the node we clicked on*)
If[addremove==="Move",
unclickedposition=Round[MousePosition["Graphics"],0.1]/.{z1_/;(z1>1.5)->1.5,z2_/;(z2<-1.5)->-1.5};
If[Cases[pointcoordinatesandcolors,{unclickedposition,_}]==={},
pointcoordinatesandcolors=pointcoordinatesandcolors/.{oldposition->unclickedposition};
];
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;
];
),{"MouseUp",2}:>(
If[addremove==="Add",
temppointcoordinatesandcolors=pointcoordinatesandcolors;
tempnormaledges=edges;
unclickedposition=Round[MousePosition["Graphics"],0.1]/.{z1_/;(z1>1.5)->1.5,z2_/;(z2<-1.5)->-1.5};
If[FreeQ[temppointcoordinatesandcolors,{unclickedposition,_}],
temppointcoordinatesandcolors=Append[temppointcoordinatesandcolors,{unclickedposition,"WI"}];
];
(*if we released on a position different to the starting one, we need to add new edges*)
If[unclickedposition=!=clickedposition,
tempnormaledges=Append[tempnormaledges,Flatten[{Position[temppointcoordinatesandcolors,{clickedposition,_}],Position[temppointcoordinatesandcolors,{unclickedposition,_}]}]];
tempmultiedges=Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]];
If[tempmultiedges=!={},(*we have multiple edges going between the same two nodes*)tempmultiedges=MapThread[If[#1,#2/.BSplineCurve[{cc_,dd_,ee_}]:>BSplineCurve[{ee,dd,cc}],#2]&,{MapAt[(#[[2]]-#[[1]])<0&,MapAt[tempnormaledges[[#]]&,Flatten[#]&/@(Position[tempnormaledges,#|Reverse[#]]&/@Map[First,Cases[Tally[Sort[#]&/@tempnormaledges],Except[{_,1}]]]),{All,All}],{All,All}],Map[makeBsplineCurves@@#&,MapAt[Sequence@@(temppointcoordinatesandcolors[[#,1]])&,tempmultiedges,{All,1}]]},2];];
flavor=Append[flavor,2];
(*if we released in the same position we started in, we don't draw any new edges, but we swap the color of the node we clicked on.*)
,If[Last[temppointcoordinatesandcolors][[1]]=!=clickedposition||MemberQ[tempnormaledges,{_,Length[temppointcoordinatesandcolors]}|{Length[temppointcoordinatesandcolors],_}]||testcolor,
nodeinfo=Cases[temppointcoordinatesandcolors,{clickedposition,_}][[1]];
temppointcoordinatesandcolors=ReplacePart[temppointcoordinatesandcolors,Position[temppointcoordinatesandcolors,nodeinfo][[1,1]]->{clickedposition,StringJoin[StringTake[nodeinfo[[2]],{1}]/.{"B"->"W","W"->"B"},StringTake[nodeinfo[[2]],{2}]]}];
testcolor=False;
];
];
pointcoordinatesandcolors=temppointcoordinatesandcolors;
If[unclickedposition=!=clickedposition,multiedges=tempmultiedges;
CreateDialog[{TextCell["Edge weight: "],InputField[Dynamic[Global`weight],String,FieldHint->"Enter the weight" ],DynamicModule[{},DefaultButton[DialogReturn[nm=ToExpression[Global`weight];
ClearAll[Global`weight];
names=(names/."weight"->If[nm===Global`weight,Global`w[indext],If[nm===$Failed||nm===Null,Global`w[indext],nm]]);
indext=indext+1;
If[URposition=!=1,URlisttemp=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlisttemp=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URlist=Delete[URlisttemp,{-2}];
URposition=1;]],InheritScope->True]},Modal->True];
names=AppendTo[names,"weight"];
];
(*finally, we remove the dotted edge*)
temporarydottededge={};
edges=tempnormaledges;
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;];
)
}],Column[{Style["       Add relations",FontSize->15,FontWeight->Bold]," ","      "Row[{RadioButton[Dynamic[addremove],"RelationsT"]," Add triangle relations  "}],"      "Row[{RadioButton[Dynamic[addremove],"RelationsS"]," Add star relations  "}],
"      "Button["Clear selection",mergeclick={};
pointcoordinatesandcolors=pointcoordinatesandcolors/.{"WE"->"WI","BE"->"BI"};,ImageSize->Large],
"      "Button["Clear relations ",relations={};STRrelations={};
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;,ImageSize->Large]," "," "," ",Style["       Compute graph",FontSize->15,FontWeight->Bold]," ","      "Row[{RadioButton[Dynamic[addremove],"Flip"]," Flip arrow  "}],"      "Row[{RadioButton[Dynamic[addremove],"Merge"]," Merge  "}],"      "Row[{RadioButton[Dynamic[addremove],"Convolution"]," Chain rule  "}],"      "Row[{RadioButton[Dynamic[addremove],"Triangle"]," Triangle-star  "}],"      "Row[{RadioButton[Dynamic[addremove],"Star"]," Star-triangle  "}],
"      "Button["Clear prefactor",prefactor=1;STRprefactor=1;
If[URposition=!=1,URlist=Append[Drop[URlist,{-(URposition-1),Length[URlist]}],{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];,URlist=Append[URlist,{pointcoordinatesandcolors,edges,multiedges,names,relations,prefactor,flavor}];];
URposition=1;,ImageSize->Large]}]}]
},
(*Row4*)
(*This row contains a single object called Row, which contains 3 buttons and an ActionMenu. All of them are needed to print or modify the output of the graphical environment. There is also white space between each of these buttons*)
{Row[{(*some space*)"                  ",
(*"Print relations" button*)
Button["Print relations",Print[DeleteDuplicates[relations//Simplify]];],
"       ",
(*"Print prefactor" button*)
Button["Print prefactor",Print[prefactor/.Global`TempA[]:>1/.Global`TempB[]:>1/.Global`TempC[]:>1/.Global`TempA[a___]:>Global`\[DoubleStruckA][0][a]/.Global`TempB[a___]:>Global`\[DoubleStruckA][1/2][a]/.Global`TempC[a___]:>Global`\[DoubleStruckA][1][a]//Simplify];],
(*some space*)"       ",
(*"Print integral" button*)
Button["Print integral",If[pointcoordinatesandcolors==={}||(edges==={}&&Count[pointcoordinatesandcolors,{_,"WI"}]===Length[pointcoordinatesandcolors]),Print[0],Print[(Times@@MapThread[#1^#2&,{(Global`\[CapitalDelta][1/2]@@@(edges[[#]]&/@Flatten[Position[flavor,2]]))/.Global`\[CapitalDelta][1/2][a_,b_]:>Global`\[CapitalDelta][1/2][Global`x[a],Global`x[b]],names[[#]]&/@Flatten[Position[flavor,2]]}])(Times@@MapThread[#1^#2&,{(Global`B@@@(edges[[#]]&/@Flatten[Position[flavor,1]]))/.Global`B[a_,b_]:>Global`B[Global`x[a],Global`x[b]],names[[#]]&/@Flatten[Position[flavor,1]]}])(Times@@(DifferentialD[#]&/@(Global`x[#]&/@(Cases[Nodecolor[pointcoordinatesandcolors],{_,"BI"}]/.{a_,"BI"}:>a))))/.Global`B[a_,b_]:>Global`\[CapitalDelta][0][a,b]]];],
(*some space*)"                                      ",
(*Export action menu*)
ActionMenu["Export",
{"Data":>(STRintegral=If[pointcoordinatesandcolors==={}||(edges==={}&&Count[pointcoordinatesandcolors,{_,"WI"}]===Length[pointcoordinatesandcolors]),0,(Times@@MapThread[#1^#2&,{(Global`\[CapitalDelta][1/2]@@@(edges[[#]]&/@Flatten[Position[flavor,2]]))/.Global`\[CapitalDelta][1/2][a_,b_]:>Global`\[CapitalDelta][1/2][Global`x[a],Global`x[b]],names[[#]]&/@Flatten[Position[flavor,2]]}])(Times@@MapThread[#1^#2&,{(Global`B@@@(edges[[#]]&/@Flatten[Position[flavor,1]]))/.Global`B[a_,b_]:>Global`B[Global`x[a],Global`x[b]],names[[#]]&/@Flatten[Position[flavor,1]]}])(Times@@(DifferentialD[#]&/@(Global`x[#]&/@(Cases[Nodecolor[pointcoordinatesandcolors],{_,"BI"}]/.{a_,"BI"}:>a))))/.Global`B[a_,b_]:>Global`\[CapitalDelta][0][a,b]];
STRprefactor=prefactor/.Global`TempA[]:>1/.Global`TempB[]:>1/.Global`TempC[]:>1/.Global`TempA[a___]:>Global`\[DoubleStruckA][0][a]/.Global`TempB[a___]:>Global`\[DoubleStruckA][1/2][a]/.Global`TempC[a___]:>Global`\[DoubleStruckA][1][a]//Simplify;
STRrelations=DeleteDuplicates[relations//Simplify];),
"Graph":>(graph=Graphics[{Thickness[0.005],
Sequence@@drawLines[pointcoordinatesandcolors,edges,multiedges,showarrow,edgenametext,flavor],
{Black,EdgeForm[{Thick,Black}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"BI"}][[All,1]]]},{Black,EdgeForm[{Thick,Red}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"BE"}][[All,1]]]},{White,EdgeForm[{Thick,Black}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"WI"}][[All,1]]]},{White,EdgeForm[{Thick,Red}],Map[Disk[#,0.035]&,Cases[pointcoordinatesandcolors,{_,"WE"}][[All,1]]]},
makeNodeNumbers[nodenumberstext,pointcoordinatesandcolors],
drawEdgeNames[pointcoordinatesandcolors,edges,edgenametext,names,multiedges]}];
STRgraph=graph;)},Method->"Queued",Appearance->"PopupMenu"]}]}},Spacings->{{Automatic,Automatic},{Automatic,0,0,Automatic,Automatic,Automatic}}],Background->RGBColor[0.07,0.55,0.49,0.43]]]


STRSimplify[A_,dim_]:=A/.Global`\[DoubleStruckA][0][a_,b_,c_]:>Global`\[DoubleStruckA][0][a]Global`\[DoubleStruckA][0][b]Global`\[DoubleStruckA][0][c]/.Global`\[DoubleStruckA][0][a_]:>Gamma[dim/2-a]/Gamma[a]/.Global`\[DoubleStruckA][1/2][a_,b_]:>Global`\[DoubleStruckA][1/2][a]Global`\[DoubleStruckA][1/2][b]/.Global`\[DoubleStruckA][1/2][a_]:>Gamma[dim/2-a+1/2]/Gamma[a+1/2]


End[]


EndPackage[]