(* PRESS SHIFT-ENTER TO RUN THIS CELL, THEN USE ROOTLOOPS IN THE OUTPUT *)

DynamicModule[
{pointList={},  
curPoly=z^2 - t, 
inputPolynomial= z^2 - t,
degree=2, 
plottedRamPoints= Text[Style["X",FontSize->14,FontWeight->Bold,FontColor->Red], {0,0}] ,
rootLists=Table[{}, 2],
rootColors= Take[ColorData[97, "ColorList"], 2],
parameterRange={{-5,5},{-5,5}},
rootRange={{-5,5},{-5,5}},
parameterZoomFactor=1,
rootZoomFactor=1,
rootDimension=2,
showText=False,
showAxes=False,
labelRoots=False,
rootCollision=False
},

Column[{
(* Controls *)
Style["Instructions: Click and drag to draw a loop in the parameter space on the left; the paths followed by the roots of f_t(z) are drawn on the right. Avoid the red x's which denote t such that f_t(x) has a repeated root. To change the polynomial, change it in the text box then press the update button.\n", FontSize->20],  
Row[{ 
Style["Polynomial family (variable z, parameter t): f_t(z)=", FontSize->20],
Style[ InputField[Dynamic[inputPolynomial]], FontSize->20]
}, " "],
Row[{
Button[Style["Update polynomial family", FontSize->20], 
curPoly=inputPolynomial;
degree=Exponent[curPoly, z];
pointList={};
rootLists=Table[{}, degree];
rootColors= Take[ColorData[97, "ColorList"], degree];

cRamPoints=Solve[ Discriminant[curPoly,z] == 0, t]; (*Ramification points as complex numbers *)
If[Length[cRamPoints]≥1,
ramPoints= {Re[t], Im[t]}/. cRamPoints; (*Convert these complex numbers to (x,y) coordinates *)
plottedRamPoints= Text[Style["X",FontSize->14,FontWeight->Bold,FontColor->Red], #] &/@ ramPoints;
,
plottedRamPoints={}]],

Style[" (remember to put a * between t's and z's, e.g. z*t^2 instead of zt^2 when entering polynomial)\n",FontSize->16]

}],
Row[{
Row[ {Style["Show values: ",  FontSize->20],  Checkbox[Dynamic[showText]]}],
Row[ {Style["      Number roots: ", FontSize->20],  Checkbox[Dynamic[labelRoots]]}],
Row[ {Style["      Show axes: ", FontSize->20],  Checkbox[Dynamic[showAxes]]}],
Style[Row[ {"      Root display type: ",  SetterBar[Dynamic[rootDimension],{2->"Loops",3->"Braids"}]}], FontSize->20]
}],

Dynamic[
If[rootCollision==True, 
Style["STATUS: ROOT COLLISION; RESTART LOOP\n", FontColor->Red,  FontWeight->Bold, FontSize->20],
Style["STATUS: WORKING PROPERLY, DRAW SOME LOOPS IN THE t-PARAMETER SPACE ON THE LEFT! \n",  FontWeight->Bold, FontSize->20]
]],

(* Graphics *)
Grid[{{
Column[{
EventHandler[
Dynamic[Graphics [ {plottedRamPoints,ColorArrowDraw[pointList, Black]}
, ImageSize->Large, PlotRange->parameterZoomFactor*parameterRange, Axes->showAxes, GridLines->Automatic]],
{"MouseDown":>(
curPoint= MousePosition["Graphics"];
pointList={curPoint};
curRoots=ComputeRoots[curPoint, curPoly];
rootLists={#} &/@ curRoots;
rootCollision=False;
), 
"MouseDragged":>
(
  If [Length[pointList]>0,
curPoint= MousePosition["Graphics"];
AppendTo[ pointList, curPoint];

curRoots= ComputeRoots[curPoint, curPoly];
collisionTest={};
If [ Length[curRoots]== degree,
	For[j=1, j≤ degree, j++,
	nearestRoot= Nearest[curRoots, Last[rootLists[[j]] ] ][[1]];
	AppendTo[ rootLists[[j]], nearestRoot ];
	AppendTo[collisionTest, nearestRoot];
]
If [Signature[collisionTest]==0, rootCollision=True]


]
]
)
}
],

Row[{
Button[Style["Zoom in", FontSize->20], parameterZoomFactor= .8* parameterZoomFactor],
Button[Style["Zoom out", FontSize->20], parameterZoomFactor = (1/.8)* parameterZoomFactor]
}],

Dynamic[If[pointList≠{} && showText==True,
valOft=SetPrecision[ Last[pointList][[1]]+Last[pointList][[2]]*I, 3];
Style[ Column[{Row[{"t=",valOft}],
Row[{Subscript["f","t"],"(z)=",(curPoly /. t->valOft)    }]}],  FontWeight->Bold, FontSize->20],
" "]]
}, Alignment->Center]
,

Column[{
Dynamic[
If[rootDimension==2,
Graphics [  Table[{ColorArrowDraw[rootLists[[i]], rootColors[[i]]], If[labelRoots==True && pointList≠{}, Text[Style[i, FontColor->White,  FontWeight->Bold, FontSize->16], rootLists[[i]][[1]]],{}]},{i,1,degree}] , ImageSize->Large, PlotRange->rootZoomFactor*rootRange, Axes-> showAxes, GridLines->Automatic], ""]
If[rootDimension==3,
Graphics3D [  Table[{ColorArrowDraw3D[rootLists[[i]], rootColors[[i]]], If[labelRoots==True && pointList≠{}, Text[Style[i, FontColor->Black,  FontWeight->Bold, FontSize->20], Append[rootLists[[i]][[1]],0]],{}]},{i,1,degree}] , ImageSize->Large, PlotRange->Append[rootZoomFactor*rootRange,{-1,6}], Axes-> showAxes], ""]

],

Row[{
Button[Style["Zoom in", FontSize->20], rootZoomFactor= .8* rootZoomFactor],
Button[Style["Zoom out", FontSize->20], rootZoomFactor = (1/.8)* rootZoomFactor]
}],

Dynamic[If[pointList≠{} && showText==True,
Column[
Style[Row[{Subscript["z",#] ,"=", SetPrecision[Last[rootLists[[#]]][[1]] +Last[rootLists[[#]]][[2]]*I ,3]}], FontColor->rootColors[[#]],  FontWeight->Bold, FontSize->20] &/@ Range[1,degree] 
], ""]]
},
Alignment->Center
]

}},  Alignment->Top]


}, Alignment->Left],



Initialization:> ( 
ArrowPartial[w_, m_, color_]:= {color, Point[w[[1]]], Arrow[w[[1;;m]]]};

ColorArrowDraw[w_, color_]:= Which[Length[w]==0, {}, 
Length[w]==1, {color, PointSize[0.03],Point[w[[1]]]},
Length[w]>1,{color,Thickness[0.007],PointSize[0.03],Point[w[[1]]],BSplineCurve[w]}]; 

ColorArrowDraw3D[w_, color_]:= (list3d={};  For[k=1, k≤Length[w], k++, AppendTo[list3d, Append[w[[k]], 5*(k-1)/Length[w]]]];
Which[Length[w]==0, {}, 
Length[w]==1, {color, PointSize[0.02],Point[list3d[[1]]]},
Length[w]>1,{color,Thickness[0.007],PointSize[0.02],Point[list3d[[1]]], Point[Append[w[[1]],5*(1-1/Length[w])]], BSplineCurve[list3d]}] ); 

ComputeRoots[parameter_, poly_]:= 
(
	subsPoly = poly /. t->(parameter[[1]]+parameter[[2]]*I);
	zList=NSolve[ subsPoly==0, z] ;
	{Re[z], Im[z]} /. zList
)
 )
]