(* This is a program for animating parametrized solutions            *)
(* of polynomials, with mathematica. f[b_,c_] is the                 *)
(* branch curve, where b will be taken as parameter,                 *)
(* and we solve for c. To run it, type <<filename                    *)
(* Note this plots in LOGARITHMIC COORDINATES                        *)

i = \[ImaginaryI];
endpoints = {
 0.73626945571942827171515513562+i*0.747493839805694529021982547344,
 0.771177053861809066918444291181+i*0.771177053861809066918444291181,
 0.747493839805694529021982547344+i*0.736269455719428271715155135621,
 0.747493839805694529021982547344-i*0.736269455719428271715155135621,
 0.771177053861809066918444291181-i*0.771177053861809066918444291181,
 0.736269455719428271715155135621-i*0.747493839805694529021982547345,
 -0.736269455719428271715155135621-i*0.747493839805694529021982547344,
 -0.771177053861809066918444291181-i*0.771177053861809066918444291181,
 -0.747493839805694529021982547344-i*0.736269455719428271715155135621,
 -0.747493839805694529021982547344+i*0.736269455719428271715155135621,
 -0.771177053861809066918444291181+i*0.771177053861809066918444291181,
 -0.736269455719428271715155135621+i*0.747493839805694529021982547344
};

delta = 0.25;
steps = 300;
scale = 1.5;
center = 0.5;

f[b_,c_] := 
262144*b^6*c^2+557056*b^5*c^3+508928*b^4*c^4+263168*b^3*c^5+82432*b^2*c^6+14976*b*c^7+1296*c^8-216320*b^3*c-221376*b^2*c^2-68928*b*c^3-2920*c^4+45387;

degreef = 8;

points = {};
source = Input["Starting point (complex number, e.g. 0.0+0.0*i) ?"];
notarget = Input["Endpoint number (1...12 by vanishing cycle) ?"];
target = endpoints[[notarget]];
Output(target);
Do[
  l = 1-(k-1)^2;
  points = Append[points, l*target + (1-l)*source],
  {k,0,1,1/steps}
  ];

plane = {};
plotcommand = {};
Do[
  l=1-(k-1)^2;
  g[c_] := Expand[f[points[[k]],c]];
  zeros = c /. N[Solve[g[c] == 0, c]];
  partial = {};
  Do[
     z = Log[zeros[[q]]];
     pair = {Re[z],Im[z]};
     partial = Append[partial,pair]
    ,{q,1,degreef,1}
  ];
  plane = Append[plane,partial]
  ,{k,1,steps+1,1}
];

myplot = Table[ListPlot[plane[[t]], Axes->True, ImageSize->Full,
  PlotStyle->PointSize[0.002],
  PlotRange->{{-scale+center,scale+center},{-\[Pi],\[Pi]}}],{t,1,steps+1,1}];

ListAnimate[myplot]