simpleclosedcurvenumber=1;
loop={};
simple={};
GENUS=3;
current={};
admitpreserve=0;
NotebookWrite[CreateDocument[],"drawcurve[]"];

CreatePalette[Graphics[{Inset[Button[StringForm["A1+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[1]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,0}],Inset[Button[StringForm["A1-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-1]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,-0.5}],Inset[Button[StringForm["B1+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[2]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,-1}],Inset[Button[StringForm["B1-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-2]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,-1.5}],Inset[Button[StringForm["C1+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[3]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,-2}],Inset[Button[StringForm["C1-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-3]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,-2.5}],Inset[Button[StringForm["D1+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[4]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{1,-1}],Inset[Button[StringForm["D1-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-4]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{1,-1.5}],Inset[Button[StringForm["A2+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[5]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{2,0}],Inset[Button[StringForm["A2-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-5]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{2,-0.5}],Inset[Button[StringForm["B2+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[6]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{2,-1}],Inset[Button[StringForm["B2-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-6]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{2,-1.5}],Inset[Button[StringForm["C2+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[7]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{2,-2}],Inset[Button[StringForm["C2-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-7]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{2,-2.5}],Inset[Button[StringForm["D2+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[8]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{3,-1}],Inset[Button[StringForm["D2-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-8]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{3,-1.5}],Inset[Button[StringForm["A3+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[9]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{4,0}],Inset[Button[StringForm["A3-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-9]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{4,-0.5}],Inset[Button[StringForm["B3+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[10]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{4,-1}],Inset[Button[StringForm["B3-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-10]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{4,-1.5}],Inset[Button[StringForm["C3+"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[11]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{4,-2}],Inset[Button[StringForm["C3-"],SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell[StringForm["tw[-11]"],"Input"],All];
SelectionEvaluate[InputNotebook[]]],{4,-2.5}]},ImageSize->400]];


CreatePalette[{"Choose direction:",Graphics[{Circle[{0,0},4],Inset[Button["↑",north],{0,4}],Inset[Button["→",east],{4,0}],Inset[Button["↓",south],{0,-4}],Inset[Button["←",west],{-4,0}],Inset[Button["↖",nw],{-2.84,2.3}],Inset[Button["↗",ne],{2.84,2.3}],Inset[Button["↙",sw],{-2.84,-2.3}],Inset[Button["↘",se],{2.84,-2.3}],Inset[Button["setthecurve",SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell["setthecurve","Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,-7}],Inset[Button["preserve",SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell["preserve","Input"],All];
SelectionEvaluate[InputNotebook[]]],{0,-9.1}],Inset[Button["drawcurve",SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell["drawcurve[]","Input"],All]],{0,-11.2}],Inset[Button["twist",SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell["twistCurrentAlongSimple[]","Input"],All]],{0,-13.3}],Inset[Button["picture",SelectionMove[InputNotebook[],Next,Cell];
NotebookWrite[InputNotebook[],Cell["picture[simple[[]]]","Input"],All]],{0,-15.4}]},ImageSize->150]}];


pictureofsurface[shusuu_]:=Module[{n},Join[{AbsoluteThickness[2]},Table[Circle[{6 n,0},1],{n,0,shusuu-1}],{Circle[{0,0},3,{π/2,3 π/2}],Circle[{6 shusuu-6,0},3,{-π/2,π/2}],Line[{{0,3},{6 shusuu-6,3}}],Line[{{0,-3},{6 shusuu-6,-3}}],Table[Text[n,{6 n-6,0}],{n,1,shusuu}]}]]

cellcoord[cellno_]:=Which[Abs[cellno]==1,{-1.5,-1.5 (Re[cellno]-Im[cellno])},Abs[cellno]==GENUS+1,{6 GENUS-4.5,-1.5 Sign[Re[cellno]-Im[cellno]]},True,{6 Abs[cellno]-9,-2 Sign[Re[cellno]-Im[cellno]]}]

drawcurve[cpx_]:=Module[{pt},now=cpx;
kyokusen={now};
pt=cellcoord[cpx];
Dynamic[Show[drawloop[from2to5[kyokusen],1],Graphics[pictureofsurface[GENUS]],PlotRange->{{-4,6 GENUS-2},{-4,4}},ImageSize->700]]]

north:=Module[{},If[Re[now]+Im[now]>0,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I]]

south:=Module[{},If[Re[now]+Im[now]>0,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I]]

west:=Module[{},Which[Abs[Re[now]]==1,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I,Abs[Im[now]]==1,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I,Re[now]≠0,kyokusen=Join[kyokusen,{10 now-5 Sign[now],now-Sign[now]}];
now=now-Sign[now],Im[now]≠0,kyokusen=Join[kyokusen,{10 now-5 I*Sign[Im[now]],now-I*Sign[Im[now]]}];
now=now-I*Sign[Im[now]],True,Print["error at west now="];Print[now];Abort[]]]

east:=Module[{},Which[Abs[Re[now]]==GENUS+1,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I,Abs[Im[now]]==GENUS+1,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I,Re[now]≠0,kyokusen=Join[kyokusen,{10 now+5 Sign[now],now+Sign[now]}];
now=now+Sign[now],Im[now]≠0,kyokusen=Join[kyokusen,{10 now+5 I*Sign[Im[now]],now+I*Sign[Im[now]]}];
now=now+I*Sign[Im[now]],True,Print["error at east now="];Print[now];Abort[]]]

nw:=Module[{},Which[Re[now]-Im[now]<0,If[Re[now]+Im[now]>0,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I],now==1,kyokusen=Join[kyokusen,{10,-I}];now=-I,now==-I,kyokusen=Join[kyokusen,{10,1}];now=1,True,kyokusen=Join[kyokusen,{Abs[now]*10-2,-now*I*Sign[Re[now]+Im[now]]}];
now=-now*I*Sign[Re[now]+Im[now]]]]

ne:=Module[{},Which[Re[now]-Im[now]<0,If[Re[now]+Im[now]>0,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I],now==GENUS+1,kyokusen=Join[kyokusen,{(GENUS+1)*10,-(GENUS+1)*I}];
now=-(GENUS+1)*I,now==-(GENUS+1)*I,kyokusen=Join[kyokusen,{(GENUS+1)*10,GENUS+1}];
now=GENUS+1,True,kyokusen=Join[kyokusen,{Abs[now]*10+3,-now*I*Sign[Re[now]+Im[now]]}];
now=-now*I*Sign[Re[now]+Im[now]]]]

sw:=Module[{},Which[Re[now]-Im[now]>0,If[Re[now]+Im[now]>0,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I],now==I,kyokusen=Join[kyokusen,{-10,-1}];now=-1,now==-1,kyokusen=Join[kyokusen,{-10,I}];now=I,True,kyokusen=Join[kyokusen,{-Abs[now]*10+2,now*I*Sign[Re[now]+Im[now]]}];
now=now*I*Sign[Re[now]+Im[now]]]]

se:=Module[{},Which[Re[now]-Im[now]>0,If[Re[now]+Im[now]>0,kyokusen=Join[kyokusen,{now*10,-now*I}];
now=-now*I,kyokusen=Join[kyokusen,{now*10 I,now*I}];
now=now*I],now==(GENUS+1)*I,kyokusen=Join[kyokusen,{-(GENUS+1)*10,-GENUS-1}];
now=-GENUS-1,now==-GENUS-1,kyokusen=Join[kyokusen,{-(GENUS+1)*10,(GENUS+1)*I}];
now=(GENUS+1)*I,True,kyokusen=Join[kyokusen,{-Abs[now]*10-3,now*I*Sign[Re[now]+Im[now]]}];
now=now*I*Sign[Re[now]+Im[now]]]]

setthecurve:=Module[{l,rw,lockyokusen},lockyokusen=kyokusen;
kyokusen={1};
Print["Input curve:"];
Print[Show[drawloop[from2to5[lockyokusen],1],Graphics[pictureofsurface[GENUS]],PlotRange->{{-4,6 GENUS-2},{-4,4}}]];
l=Length[lockyokusen];
If[lockyokusen[[1]]≠lockyokusen[[l]],Print["This is not a closed curve!"],rw=wordreduce[lockyokusen];
If[Length[rw]==1,Print["This curve is homotopic to a point!"],rw=simplicitycheck[rw];
admitpreserve=rw[[1]];
(*Print[rw];*)If[rw[[1]]==1,Print["This defines a SCC."];
Print["current:"];
current=rw[[2]];
picture[current],Print["This curve is NOT homotopic to some SCC!"];
current=rw[[2]];
picture[current]]]]]


f[t_,b_]:=(2 b[[1]]-2 b[[2]]+b[[3]]+b[[4]])*(t^3)+(3 b[[2]]-3 b[[1]]-2 b[[3]]-b[[4]])*(t^2)+b[[3]]*t+b[[1]]

(*This function is based on Ahara's algorithm*)
bezier[init_,foreback_,term_,clrno_]:=Module[{ini,fb,ter,t,s,b,clromote,clrura},(*These are the lists of colors*)clromote={1,0,0,0,0,1,0,1,0};
clrura={1,0.8,0,0.8,0,1,0.5,1,0.9};
fb=foreback;
ini=init;ter=term;
Which[Re[fb]+Im[fb]>0,(*omote*)ParametricPlot[{f[s,{ini[[1]],ter[[1]],ini[[3]],ter[[3]]}],f[s,{ini[[2]],ter[[2]],ini[[4]],ter[[4]]}]},{s,0,1},DisplayFunction->Identity,PlotStyle->{RGBColor[clromote[[3 clrno-2]],clromote[[3 clrno-1]],clromote[[3 clrno]]],AbsoluteThickness[2]}],Re[fb]+Im[fb]<0,(*ura*)ParametricPlot[{f[s,{ini[[1]],ter[[1]],ini[[3]],ter[[3]]}],f[s,{ini[[2]],ter[[2]],ini[[4]],ter[[4]]}]},{s,0,1},DisplayFunction->Identity,PlotStyle->{RGBColor[clrura[[3 clrno-2]],clrura[[3 clrno-1]],clrura[[3 clrno]]],AbsoluteThickness[2]}],True,(*midpoint of the bezier curve*)Graphics[{AbsolutePointSize[5],Point[{f[0.5,{ini[[1]],ter[[1]],ini[[3]],ter[[3]]}],f[0.5,{ini[[2]],ter[[2]],ini[[4]],ter[[4]]}]}]}]]]

(*This function is based on Ahara's algorithm*)
naibunten[edgenumber_,sousuu_,bangou_,orientation_]:=Module[{en,so,ba,pa,si,co,a},en=edgenumber;
so=sousuu;
ba=bangou;
pa=orientation;
si[a_]:=Sin[a*Degree];
co[a_]:=Cos[a*Degree];
Which[Abs[Re[en]]==10,{3*co[225+45 Sign[en]-(90*ba)/(so+1)],3*si[225+45 Sign[en]-(90*ba)/(so+1)],3*pa*co[135+45 Sign[en]-(90*ba)/(so+1)],3*pa*si[135+45 Sign[en]-(90*ba)/(so+1)]},Abs[Im[en]]==10,{-3+(2 ba/(so+1)),0,0,(-3+(2 ba/(so+1)))*pa},Abs[Re[en]]==(GENUS+1)*10,{6 GENUS-6+3*co[45-45 Sign[en]-(90*ba)/(so+1)],3*si[45-45 Sign[en]-(90*ba)/(so+1)],3*pa*co[-45-45 Sign[en]-(90*ba)/(so+1)],3*pa*si[-45-45 Sign[en]-(90*ba)/(so+1)]},Abs[Im[en]]==(GENUS+1)*10,{6 GENUS-3-(2 ba/(so+1)),0,0,(-3+(2 ba/(so+1)))*pa},Mod[Abs[en],10]==5,{6 Quotient[Abs[en],10]-6,(-3+(2 ba/(so+1)))Sign[Re[en]-Im[en]],(3-(2 ba/(so+1))) Sign[Re[en]-Im[en]]*pa,0},Mod[Abs[en],5]==3,{6 Quotient[Abs[en],10]-6+co[45 ((Sign[en]+2) (2 Mod[en,2]-1)+1)+(90 ba/(so+1))],si[45 ((Sign[en]+2) (2 Mod[en,2]-1)+1)+(90 ba/(so+1))],1.5 co[45 ((Sign[en]+2) (2 Mod[en,2]-1)+3)+(90 ba/(so+1))]*pa,1.5 si[45 ((Sign[en]+2) (2 Mod[en,2]-1)+3)+(90 ba/(so+1))]*pa},Re[en]≠0,{6 Quotient[Abs[en],10]-9+(3-6 ba/(so+1)) Sign[en],-3 Sign[en],-3 Sign[en]*pa,0},True,{6 Quotient[Abs[en],10]-11+(4 ba/(so+1)),0,0,-3*pa}]]

kasaneru[a_]:=Which[OddQ[Im[a]],a*I,Im[a]<0,-a,True,a]

(*This function is based on Ahara's algorithm*)
from2to5[from_]:=Module[{to,evenli,edgeno,i},to={};
edgeno=(Length[from]-1)/2;
evenli=Table[kasaneru[from[[2 i]]],{i,1,edgeno}];
i=1;
While[i≤edgeno,to=Join[to,{from[[2 i-1]],from[[2 i]],Count[evenli,evenli[[i]]],Count[Take[evenli,i],evenli[[i]]],1}];
i=i+1;];
Join[to,{from[[2 edgeno+1]]}]]

picture[loopdata_]:=drawpicture[{loopdata}]

tubusu[a_]:=Which[OddQ[Im[a]],a*I,Im[a]<0,-a,True,a]

drawloop[curvedata_,clrnum_]:=Module[{l,surface,endpt,startpt,firstedge,lastedge,k,curve,bezierpath},curve=tangentialorientation[curvedata];
(*curve has length of 5x+1*)l=Length[curve];
Which[l==1,Graphics[{RGBColor[1,0,0],AbsolutePointSize[5],Point[cellcoord[curve[[1]]]]}],curve[[1]]≠curve[[l]],(*This is the case of NOT-closed curve*)startpt=Graphics[{AbsolutePointSize[5],Point[cellcoord[curve[[1]]]]}];
If[Re[curve[[1]]]+Im[curve[[1]]]>0,firstedge=Graphics[{RGBColor[1,0,0],AbsoluteThickness[2],Line[{cellcoord[curve[[1]]],Take[naibunten[curve[[2]],curve[[3]],curve[[4]],curve[[5]]],2]}]}],firstedge=Graphics[{RGBColor[1,0.8,0],AbsoluteThickness[2],Line[{cellcoord[curve[[1]]],Take[naibunten[curve[[2]],curve[[3]],curve[[4]],curve[[5]]],2]}]}]];
endpt=Graphics[{AbsolutePointSize[5],Point[cellcoord[curve[[l]]]]}];
If[Re[curve[[l]]]+Im[curve[[l]]]>0,lastedge=Graphics[{RGBColor[1,0,0],AbsoluteThickness[2],Line[{cellcoord[curve[[l]]],Take[naibunten[curve[[l-4]],curve[[l-3]],curve[[l-2]],curve[[l-1]]],2]}]}],lastedge=Graphics[{RGBColor[1,0.8,0],AbsoluteThickness[2],Line[{cellcoord[curve[[l]]],Take[naibunten[curve[[l-4]],curve[[l-3]],curve[[l-2]],curve[[l-1]]],2]}]}]];
k=1;
bezierpath={};
While[5 k-3≤l-9,bezierpath=Join[bezierpath,{bezier[naibunten[curve[[5 k-3]],curve[[5 k-2]],curve[[5 k-1]],curve[[5 k]]],curve[[5 k+1]],naibunten[curve[[5 k+2]],curve[[5 k+3]],curve[[5 k+4]],curve[[5 k+5]]],1]}];
k=k+1];
Join[{startpt,firstedge,endpt,lastedge},bezierpath],True,(*This is the case of closed curve*)k=1;
bezierpath={};
While[5 k-3≤l-9,bezierpath=Join[bezierpath,{bezier[naibunten[curve[[5 k-3]],curve[[5 k-2]],curve[[5 k-1]],curve[[5 k]]],curve[[5 k+1]],naibunten[curve[[5 k+2]],curve[[5 k+3]],curve[[5 k+4]],curve[[5 k+5]]],clrnum]}];
k=k+1];
bezierpath=Join[bezierpath,{bezier[naibunten[curve[[l-4]],curve[[l-3]],curve[[l-2]],curve[[l-1]]],curve[[l]],naibunten[curve[[2]],curve[[3]],curve[[4]],curve[[5]]],clrnum]}];
startpt=bezier[naibunten[curve[[l-4]],curve[[l-3]],curve[[l-2]],curve[[l-1]]],0,naibunten[curve[[2]],curve[[3]],curve[[4]],curve[[5]]],clrnum];
Join[{startpt},bezierpath]]]

drawpicture[looplist_]:=Module[{noofcurves,i,edgenumlist,loophyo,subloop,num1,num2,num3,refedge,clrnum},noofcurves=Length[looplist];
(*Print["noofcurves=",noofcurves];*)edgenumlist=Table[(Length[looplist[[i]]]-1)/5,{i,noofcurves}];
(*Print["edgenumlist=",edgenumlist];*)num1=1;refedge={};
While[num1≤noofcurves,num2=1;
While[num2≤edgenumlist[[num1]],(*Print["{num1,num2}=",{num1,num2}];*)refedge=Join[refedge,{tubusu[looplist[[num1,5 num2-3]]]}];
(*Print["m_refedge=",refedge];*)num2=num2+1];
num1=num1+1];
(*Print["refedge=",refedge];*)num1=1;loophyo={};
While[num1≤noofcurves,num2=1;
subloop={};
While[num2≤edgenumlist[[num1]],(*Print["{num1,num2}=",{num1,num2}];*)subloop=Join[subloop,{looplist[[num1,5 num2-4]],looplist[[num1,5 num2-3]],Count[refedge,tubusu[looplist[[num1,5 num2-3]]]],looplist[[num1,5 num2-1]]+Count[Take[refedge,Apply[Plus,Take[edgenumlist,num1-1]]],tubusu[looplist[[num1,5 num2-3]]]],1}];
num2=num2+1];
subloop=Join[subloop,{looplist[[num1,5 num2-4]]}];
(*Print["{num1,subloop}",{num1,subloop}];*)loophyo=Join[loophyo,{subloop}];
(*Print["m-loophyo",loophyo];*)num1=num1+1];
(*Print["loophyo=",loophyo];*)surface=Graphics[pictureofsurface[GENUS]];
Show[Join[{surface},Table[drawloop[loophyo[[i]],Mod[i,3]+1],{i,noofcurves}]],AspectRatio->Automatic,PlotRange->All,DisplayFunction->$DisplayFunction]]


subfunc[pre_,now_,next_]:=Module[{n2,li1,li2,subsub},subsub[li1_,li2_]:=Module[{vxy,vyz,vxz,junban,a,b},junban[a_,b_]:=Module[{ks,c},ks[c_]:=Which[OddQ[Im[c]],c*I,Im[c]<0,-c,True,c];
(*Print[StringForm["{li1,li2}=``",{li1,li2}]];*)(*Print[ks[a[[2]]][[1,1]]];*)(*Print[StringForm["{a[[2]],ks[a[[2]]]}=``",{a[[2]],ks[a[[2]]]}]];*)Which[Position[li1,ks[a[[2]]]][[1,1]]-Position[li1,ks[b[[2]]]][[1,1]]>0,1,Position[li1,ks[a[[2]]]][[1,1]]-Position[li1,ks[b[[2]]]][[1,1]]<0,-1,True,If[(a[[4]]-b[[4]])*li2[[Position[li1,ks[a[[2]]]][[1,1]]]]>0,1,-1]]];
vxy=junban[pre,now];
vyz=junban[now,next];
vxz=junban[pre,next];
(*Print[StringForm["{pre,now,next}=``",{pre,now,next}]];*)(*Print[StringForm["{vxy,vxz,vyz}=``",{vxy,vxz,vyz}]];*)-vxy*vxz*vyz];
n2=now[[2]];
(*Print[now];*)Which[(Im[n2]≠0&&EvenQ[Im[n2]]),If[Re[now[[1]]]-Im[now[[1]]]>0,-1,1],Mod[Abs[n2],10]==5,If[Re[now[[1]]]-Im[now[[1]]]<Re[next[[1]]]-Im[next[[1]]],1,-1],(n2==10||n2==13),subsub[{10 I,13,15,10},{1,1,-1,1}],(n2==-13||n2==-10),subsub[{-10,-15,-13,10 I},{1,1,1,-1}],(n2==-10 GENUS-10||n2==-10 GENUS-8),(*Print["here"];*)(*Print[n2];*)-subsub[{10 (GENUS+1) I,-10 GENUS-10,-(10 GENUS+5),-10 GENUS-8},{-1,-1,1,-1}],(n2==10 GENUS+10||n2==10 GENUS+8),subsub[{10 GENUS+5,10 GENUS+8,10 (GENUS+1) I,10 (GENUS+1)},{1,1,-1,1}],Re[n2]>0,subsub[{Abs[now[[1]]]*10 I,Abs[now[[1]]]*10+3,Abs[now[[1]]]*10+5,Abs[now[[1]]]*10,Abs[now[[1]]]*10-5,Abs[now[[1]]]*10-2},{1,1,-1,1,1,1}],True,-subsub[{Abs[now[[1]]]*10 I,-Abs[now[[1]]]*10-3,-Abs[now[[1]]]*10-5,-Abs[now[[1]]]*10,-Abs[now[[1]]]*10+5,-Abs[now[[1]]]*10+2},{1,-1,-1,-1,1,-1}]]]


(*This function is based on Ahara's algorithm*)
tangentialorientation[list_]:=Module[{l,li,i},li=list;
l=Length[li];
If[l≤6,li,Which[li[[1]]==li[[l]],li[[5]]=subfunc[{li[[l-5]],li[[l-4]],li[[l-3]],li[[l-2]]},{li[[1]],li[[2]],li[[3]],li[[4]]},{li[[6]],li[[7]],li[[8]],li[[9]]}],(Im[li[[2]]]≠0||Mod[Abs[li[[2]]],10]==5),If[cellcoord[li[[6]]][[1]]==cellcoord[li[[1]]][[1]],li[[5]]=Sign[cellcoord[li[[1]]][[2]]],li[[5]]=Sign[cellcoord[li[[1]]][[1]]-cellcoord[li[[6]]][[1]]]*Sign[cellcoord[li[[1]]][[2]]]],True,li[[5]]=1];
i=1;
While[5 i+5≤l-6,li[[5 i+5]]=subfunc[{li[[5 i-4]],li[[5 i-3]],li[[5 i-2]],li[[5 i-1]]},{li[[5 i+1]],li[[5 i+2]],li[[5 i+3]],li[[5 i+4]]},{li[[5 i+6]],li[[5 i+7]],li[[5 i+8]],li[[5 i+9]]}];
i=i+1];
Which[li[[1]]==li[[l]],li[[l-1]]=subfunc[{li[[l-10]],li[[l-9]],li[[l-8]],li[[l-7]]},{li[[l-5]],li[[l-4]],li[[l-3]],li[[l-2]]},{li[[1]],li[[2]],li[[3]],li[[4]]}],(Im[li[[l-4]]]≠0||Mod[Abs[li[[l-4]]],10]==5),If[cellcoord[li[[l]]][[1]]==cellcoord[li[[l-5]]][[1]],li[[l-1]]=Sign[cellcoord[li[[l-5]]][[2]]],li[[l-1]]=Sign[cellcoord[li[[l-5]]][[1]]-cellcoord[li[[l]]][[1]]]*Sign[cellcoord[li[[l-5]]][[2]]]],True,li[[l-1]]=1];
li]]

renum[num_,modulo_]:=Module[{t},t=Mod[num,modulo];If[t==0,modulo,t]]

uragaeshi[num5_]:=If[Mod[Abs[num5],10]==0,-num5,-I (Abs[num5]^2)/num5]

intorext[num6_]:=If[(Mod[Abs[num6],10]==5||Im[num6]≠0),1,0]

adjacent[intnum_,extnum_]:=Which[Abs[Im[intnum]]==10,If[Abs[extnum]<14,1,0],Abs[Im[intnum]]==10 (GENUS+1),If[Abs[extnum]>10 GENUS+7,1,0],Mod[Abs[intnum],10]==5,If[MemberQ[Sign[Re[intnum]-Im[intnum]] (Abs[intnum]+{-5,-2,3,5}),extnum],1,0],True,If[MemberQ[(Abs[intnum]+{-2,-2,3,3})*{-1,1,-1,1},extnum],1,0]]

crossroad[intnum2_,extnum2_]:=Which[adjacent[intnum2,extnum2]==0,Print[{intnum2,extnum2}];Print["error"];xx,Mod[Abs[intnum2],10]==5,If[Mod[Abs[extnum2],10]==0,{uragaeshi[intnum2],2 (Re[intnum2]-Im[intnum2])-extnum2},{uragaeshi[intnum2],2 (Re[intnum2]-Im[intnum2])+Sign[Re[intnum2]-Im[intnum2]]-extnum2}],True,{uragaeshi[intnum2],-extnum2}]


(*This function is based on Ahara's algorithm*)
wordreduce[word_]:=Module[{word4,word3,wordreduce2},wordreduce2[word4_]:=Module[{n,rewriting,i,result,rewrited,num2,relation},result=word4;
rewriting[num2_,word2_]:=Module[{j=1,subresult,l,k,nn,nn2,tt,tt2,sequencecheck,nextodd},l=Length[word2]/2;
subresult=word2;
Switch[num2,1,While[j≤l&&rewrited==0,If[subresult[[2 j-1]]==subresult[[renum[2 j+1,2 l]]],rewrited=1;
subresult=Drop[subresult,{2 j-1,2 j}]
(*;Print["w1"];Print[subresult]*),j=j+1]],2,While[j≤l&&rewrited==0,If[subresult[[2 j]]==subresult[[renum[2 j+2,2 l]]],rewrited=1;
subresult[[renum[2 j+1,2 l]]]=subresult[[2 j-1]]
(*;Print["w2"];Print[subresult]*),j=j+1]],3,While[j≤l&&rewrited==0,If[(Im[subresult[[2 j]]]≠0||Mod[Abs[subresult[[2 j]]],10]==5),j=j+1,k=renum[j+1,l];
nextodd=0;
While[k≠j&&nextodd==0,If[(Im[subresult[[2 k]]]≠0||Mod[Abs[subresult[[2 k]]],10]==5),k=renum[k+1,l],nextodd=1]];
Which[Mod[subresult[[2 j]],10]^2+Mod[subresult[[2 k]],10]^2==0,nn=nn2=renum[j+1,l];
sequencecheck=1;
While[nn≠k,sequencecheck=sequencecheck*If[((Mod[Abs[subresult[[2 nn]]],10]==5)||(Abs[Im[subresult[[2 nn]]]]==10)||(Abs[Im[subresult[[2 nn]]]]==10 (GENUS+1))),1,0];
nn=renum[nn+1,l]];
If[sequencecheck==1,rewrited=1;
While[nn2≠k,subresult[[2 nn2-1]]=-I (Abs[subresult[[2 nn2-1]]]^2)/subresult[[2 nn2-1]];
subresult[[2 nn2]]=uragaeshi[subresult[[2 nn2]]];
nn2=renum[nn2+1,l]];
subresult[[2 k-1]]=-I (Abs[subresult[[2 k-1]]]^2)/subresult[[2 k-1]]
(*;Print["w3"];Print[subresult]*),j=j+1],(Mod[subresult[[2 j]]*subresult[[2 k]],10]≠0&&Quotient[Abs[subresult[[2 j]]],10]==Quotient[Abs[subresult[[2 k]]],10]),nn=nn2=renum[j+1,l];
tt=Quotient[Abs[subresult[[2 j]]],10];
sequencecheck=1;
While[nn≠k,sequencecheck=sequencecheck*If[(10 tt≤Abs[subresult[[2 nn]]]≤10 tt+10),1,0];
nn=renum[nn+1,l]];
If[sequencecheck==1,rewrited=1;
While[nn2≠k,subresult[[2 nn2-1]]=-I (Abs[subresult[[2 nn2-1]]]^2)/subresult[[2 nn2-1]];
subresult[[2 nn2]]=uragaeshi[subresult[[2 nn2]]];
nn2=renum[nn2+1,l]];
subresult[[2 k-1]]=-I (Abs[subresult[[2 k-1]]]^2)/subresult[[2 k-1]]
(*;Print["w3-2"];Print[subresult]*),j=j+1],True,(*Print["xxx"];Print[subresult];*)j=j+1];];],4,While[j≤l&&rewrited==0,If[intorext[subresult[[2 j]]]+intorext[subresult[[renum[2 j+2,2 l]]]]≠1,j=j+1,(*Print["here"];Print[j];*)Which[(intorext[subresult[[2 j]]]==1&&Re[subresult[[2 j]]]+Im[subresult[[2 j]]]<0),(*Print["aaaa"];
Print[{subresult[[2j]],subresult[[renum[2j+2,2l]]]}];*)relation=adjacent[subresult[[2 j]],subresult[[renum[2 j+2,2 l]]]];
(*Print[relation];*)If[relation==0,j=j+1,rewrited=1;
(*Print["aaaaa"];*)(*Print[{subresult[[2j]],subresult[[renum[2j+2,2l]]]}];*)tt2=crossroad[subresult[[2 j]],subresult[[renum[2 j+2,2 l]]]];
(*Print[tt2];*)subresult[[2 j]]=tt2[[2]];
subresult[[renum[2 j+1,2 l]]]=-I (Abs[subresult[[2 j-1]]]^2)/subresult[[2 j-1]];
subresult[[renum[2 j+2,2 l]]]=tt2[[1]];
(*Print["w4-1"];Print[subresult];*)],(intorext[subresult[[2 j]]]==0&&Re[subresult[[renum[2 j+2,2 l]]]]+Im[subresult[[renum[2 j+2,2 l]]]]<0),(*Print["bbbb"];
Print[{subresult[[renum[2j+2,2l]]],subresult[[2j]]}];*)relation=adjacent[subresult[[renum[2 j+2,2 l]]],subresult[[2 j]]];
(*Print[relation];*)If[relation==0,j=j+1,rewrited=1;
(*Print["bbbbb"];*)tt2=crossroad[subresult[[renum[2 j+2,2 l]]],subresult[[2 j]]];
subresult[[2 j]]=tt2[[1]];
subresult[[renum[2 j+1,2 l]]]=-I (Abs[subresult[[renum[2 j+3,2 l]]]]^2)/subresult[[renum[2 j+3,2 l]]];
subresult[[renum[2 j+2,2 l]]]=tt2[[2]];
(*Print["w4-2"];Print[subresult];*)],True,(*Print["ccccc"];*)j=j+1](*end of Which*)];(*end of If*)],5,While[j≤l&&rewrited==0,If[(subresult[[2 j-1]]==subresult[[renum[2 j+3,2 l]]]&&subresult[[renum[2 j+1,2 l]]]==-I (Abs[subresult[[2 j-1]]]^2)/subresult[[2 j-1]]&&intorext[subresult[[renum[2 j+4,2 l]]]]==1&&adjacent[subresult[[renum[2 j+4,2 l]]],subresult[[2 j]]]==1&&adjacent[subresult[[renum[2 j+4,2 l]]],subresult[[renum[2 j+2,2 l]]]]==1),(*Print["type5"];*)If[((Mod[Abs[subresult[[renum[2 j+4,2 l]]]],10]==5&&Mod[Abs[subresult[[renum[2 j+2,2 l]]]],10]==0)||(Mod[Abs[subresult[[renum[2 j+4,2 l]]]],10]==0&&Abs[subresult[[renum[2 j+2,2 l]]]]==Abs[subresult[[renum[2 j+4,2 l]]]]-2&&Abs[subresult[[renum[2 j+4,2 l]]]]<10 (GENUS+1))||(Abs[subresult[[renum[2 j+4,2 l]]]]==Abs[subresult[[renum[2 j+2,2 l]]]]==10 (GENUS+1))||(Abs[subresult[[renum[2 j+4,2 l]]]]==Abs[subresult[[renum[2 j+2,2 l]]]]==10)),(*rewriting*)rewrited=1;
Module[{x1,x2,x3},x1=subresult[[renum[2 j+4,2 l]]];
x2=crossroad[subresult[[renum[2 j+4,2 l]]],subresult[[2 j]]][[2]];
x3=crossroad[subresult[[renum[2 j+4,2 l]]],subresult[[renum[2 j+2,2 l]]]][[2]];
subresult[[2 j]]=x1;
subresult[[renum[2 j+1,2 l]]]=subresult[[renum[2 j+5,2 l]]];
subresult[[renum[2 j+2,2 l]]]=x2;
subresult[[renum[2 j+3,2 l]]]=-I (Abs[subresult[[renum[2 j+5,2 l]]]]^2)/subresult[[renum[2 j+5,2 l]]];
subresult[[renum[2 j+4,2 l]]]=x3;],j=j+1];,(*Print["jjjjj"];*)j=j+1](*end of If*)],6,While[j≤l&&rewrited==0,If[(subresult[[2 j-1]]==subresult[[renum[2 j+3,2 l]]]&&subresult[[renum[2 j+1,2 l]]]==-I (Abs[subresult[[2 j-1]]]^2)/subresult[[2 j-1]]&&intorext[subresult[[renum[2 j-2,2 l]]]]==1&&adjacent[subresult[[renum[2 j-2,2 l]]],subresult[[2 j]]]==1&&adjacent[subresult[[renum[2 j-2,2 l]]],subresult[[renum[2 j+2,2 l]]]]==1),(*Print["type6"];Print[subresult];Print[j];*)If[((Mod[Abs[subresult[[renum[2 j-2,2 l]]]],10]==5&&Mod[Abs[subresult[[2 j]]],10]==0)||(Mod[Abs[subresult[[renum[2 j-2,2 l]]]],10]==0&&Abs[subresult[[2 j]]]==Abs[subresult[[renum[2 j-2,2 l]]]]-2&&Abs[subresult[[renum[2 j+4,2 l]]]]<10 (GENUS+1))||(Abs[subresult[[renum[2 j-2,2 l]]]]==Abs[subresult[[renum[2 j,2 l]]]]==10 (GENUS+1))||(Abs[subresult[[renum[2 j-2,2 l]]]]==Abs[subresult[[2 j]]]==10)),(*rewriting*)rewrited=1;
Module[{x1,x2,x3},x1=crossroad[subresult[[renum[2 j-2,2 l]]],subresult[[2 j]]][[2]];
x2=crossroad[subresult[[renum[2 j-2,2 l]]],subresult[[renum[2 j+2,2 l]]]][[2]];
x3=subresult[[renum[2 j-2,2 l]]];
subresult[[renum[2 j-2,2 l]]]=x1;
subresult[[renum[2 j-1,2 l]]]=-I (Abs[subresult[[renum[2 j-3,2 l]]]]^2)/subresult[[renum[2 j-3,2 l]]];
subresult[[renum[2 j,2 l]]]=x2;
subresult[[renum[2 j+1,2 l]]]=subresult[[renum[2 j-3,2 l]]];
subresult[[renum[2 j+2,2 l]]]=x3;],j=j+1](*end of If*),(*Print["kkkkk"];*)j=j+1](*end of If*)](*end of While*)];(*end of Switch*)subresult];
rewrited=1;
While[rewrited==1,i=1;
rewrited=0;
While[i≤6&&rewrited==0,result=rewriting[i,result];
(*Print[i];Print[rewrited];*)i=i+1;];];
result];
word3=wordreduce2[Delete[word,-1]];
If[Length[word3]≠0,Join[word3,{word3[[1]]}],{word[[1]]}]]

kasaneru2[num1_]:=Which[OddQ[Im[num1]],num1*I,Im[num1]<0,-num1,True,num1]


(*This function is based on Ahara's algorithm*)
simplicitycheck[reducedword_]:=Module[{branch,bn,modeno,complete,l,result,now,modelist,nextstep,failure,gonext,leftright,rireki,num1,num2,num3,num4,nocrossing,sccresult,aaa,bbb,num5,num6,slide},slide[num1_,num_ 2]:=Which[OddQ[Im[num1]],num2+2,Im[num1]<0,num2+2,True,num2];
branch=Flatten[Position[Partition[reducedword,2],{reducedword[[1]],reducedword[[2]]}]];
bn=Length[branch]-1;
modeno=2^bn-1;
complete=0;
l=(Length[reducedword]-1)/2;
(*Print[{branch,bn,modeno,l}];*)While[modeno≥0&&complete==0,result={reducedword[[1]],reducedword[[2]],1/2,0};
now=2;
(*Print["modeno=",modeno];*)modelist=IntegerDigits[modeno,2,bn];
nextstep=2^bn;
failure=0;
While[now≤l&&failure==0,(*Print["now=",now];*)gonext=0;
If[MemberQ[branch,now],nextstep=nextstep/2;
leftright=modelist[[Position[branch,now][[1,1]]-1]];
rireki={0};num1=1;
While[num1<now,If[result[[4 num1-2]]==reducedword[[2 now]],rireki=Join[rireki,{result[[4 num1-1]]}];
num1=num1+1,num1=num1+1]];
rireki=Join[rireki,{1}];
(*Print["rireki_1 ",rireki];*)rireki=Apply[Plus,Partition[Sort[rireki],2,1],{1}]/2;
num2=1;
While[num2≤Length[rireki]&&gonext==0,If[leftright/2<rireki[[num2]]<1/2+leftright/2,(*Check whether it crosses with the line already drawn.*)(*Print["rireki_1_2=",rireki[[num2]]];*)(*num3=1;*)num3=2;
nocrossing=1;
While[num3<now&&nocrossing==1,If[result[[4 num3-3]]==reducedword[[2 now-1]],nocrossing=nocrossing*crosscheck[reducedword[[2 now-1]],{result[[4 now-6]],result[[4 now-5]]},{reducedword[[2 now]],rireki[[num2]]},{result[[4 num3-6]],result[[4 num3-5]]},{result[[4 num3-2]],result[[4 num3-1]]}];num3=num3+1,num3=num3+1]];
(*Print["nocrossing1=",nocrossing];*)If[nocrossing==1,gonext=1,gonext=0]];
num2=num2+1];
If[gonext==0,failure=1],rireki={0};num1=1;
While[num1<now,If[result[[4 num1-2]]==reducedword[[2 now]],rireki=Join[rireki,{result[[4 num1-1]]}];
num1=num1+1,num1=num1+1]];
rireki=Join[rireki,{1}];
rireki=Apply[Plus,Partition[Sort[rireki],2,1],{1}]/2;
(*Print["rireki_2_sellect=",rireki];*)num2=1;
While[num2≤Length[rireki]&&gonext==0,(*whether crossed or not*)num3=2;
nocrossing=1;
While[num3<now&&nocrossing==1,If[result[[4 num3-3]]==reducedword[[2 now-1]],nocrossing=nocrossing*crosscheck[reducedword[[2 now-1]],{result[[4 now-6]],result[[4 now-5]]},{reducedword[[2 now]],rireki[[num2]]},{result[[4 num3-6]],result[[4 num3-5]]},{result[[4 num3-2]],result[[4 num3-1]]}];
num3=num3+1,num3=num3+1]];
(*Print["nocrossing2=",nocrossing];*)If[nocrossing==1,gonext=1,gonext=0];
num2=num2+1];
If[gonext==0,failure=1]];
If[gonext==1,result=Join[result,{reducedword[[2 now-1]],reducedword[[2 now]],rireki[[num2-1]],0}]];
(*Print["result=",result];*)now=now+1;];
If[now==l+1&&failure==0,(*connected or not*)(*Print["lastcheck"];*)num3=2;
nocrossing=1;
While[num3≤l&&nocrossing==1,If[result[[4 num3-3]]==reducedword[[1]],nocrossing=nocrossing*crosscheck[reducedword[[1]],{result[[4 l-2]],result[[4 l-1]]},{reducedword[[2]],1/2},{result[[4 num3-6]],result[[4 num3-5]]},{result[[4 num3-2]],result[[4 num3-1]]}];
num3=num3+1,num3=num3+1]];
(*Print["nocrossing_last=",nocrossing];*)If[nocrossing==1,complete=1,modeno=modeno-nextstep],modeno=modeno-nextstep];];
If[complete≠1,(*draw closed curve*){0,from2to5[reducedword]},(*draw SCC*)(*Print["result=",result];*)(*result has length of 4x*)(*rewrite to 5x+1*)sccresult=from2to5[reducedword];
(*Print["sccresult_1=",sccresult];*)num4=1;
While[num4≤Length[result]/4,If[result[[4 num4]]==1,(*sccresult[[5num4-1]]=result[[4num4-1]];*)num4=num4+1,aaa={};num5=1;
While[num5≤Length[result]/4,If[kasaneru2[result[[4 num4-2]]]==kasaneru2[result[[4 num5-2]]],aaa=Join[aaa,{num5,slide[result[[4 num5-2]],result[[4 num5-1]]]}];
num5=num5+1,num5=num5+1]];
bbb=Sort[Table[aaa[[2 num6]],{num6,Length[aaa]/2}]];
num6=1;
While[num6≤Length[bbb],aaa[[2 num6]]=Position[bbb,aaa[[2 num6]]][[1,1]];
num6=num6+1];
num6=1;
While[num6≤Length[bbb],(*result[[4aaa[[2num6-1]]-1]]=aaa[[2num6]];*)(*The above row may be unnecessary*)sccresult[[5 aaa[[2 num6-1]]-1]]=aaa[[2 num6]];
result[[4 aaa[[2 num6-1]]]]=1;
num6=num6+1];
num4=num4+1](*end of If*)];(*end of While*){1,sccresult}]]

(*This function is based on Ahara's algorithm*)
crosscheck[faceno_,ne1_,ne2_,ol1_,ol2_]:=If[relation[faceno,ne1,ol1]*relation[faceno,ne1,ol2]*relation[faceno,ne2,ol1]*relation[faceno,ne2,ol2]>0,1,0]

(*This function is based on Ahara's algorithm*)
relation[faceno_,edge1_,edge2_]:=Module[{f,ks,edgeorder,edgeparity,a,b},(*last variables are lists{edgeno,edgecoord}*)ks[c_]:=Which[OddQ[Im[c]],c*I,Im[c]<0,-c,True,c];
f=Re[faceno]-Im[faceno];
a={ks[edge1[[1]]],edge1[[2]]};
b={ks[edge2[[1]]],edge2[[2]]};
edgeorder=Which[f==1,{10 I,13,15,10},f==-1,{10 I,-10,-15,-13},f==GENUS+1,{10 GENUS+5,10 GENUS+8,10 (GENUS+1) I,10 (GENUS+1)},f==-GENUS-1,{10 (GENUS+1) I,-10 GENUS-8,-(10 GENUS+5),-10 GENUS-10},f>0,{f*10 I,10 f+3,10 f+5,10 f,10 f-5,10 f-2},True,{-f*10 I,10 f+2,10 f+5,10 f,10 f-5,10 f-3}];
edgeparity=Which[f==1,{1,1,-1,1},f==-1,{-1,1,1,1},f==GENUS+1,{1,1,-1,1},f==-GENUS-1,{1,1,-1,1},f>0,{1,1,-1,1,1,1},True,{-1,1,-1,1,1,1}];
Which[Position[edgeorder,a[[1]]][[1,1]]-Position[edgeorder,b[[1]]][[1,1]]>0,1,Position[edgeorder,a[[1]]][[1,1]]-Position[edgeorder,b[[1]]][[1,1]]<0,-1,True,If[(a[[2]]-b[[2]])*edgeparity[[Position[edgeorder,a[[1]]][[1,1]]]]≥0,1,-1]]]

(*This function is based on Ahara's algorithm*)
dehntwist[scclist_,plusminus_,cclist_]:=Module[{l,i},i=1;
kyokusen2={};
l=(Length[cclist]-1)/5;
While[i≤l,kyokusen2=Join[kyokusen2,{cclist[[5 i-4]],cclist[[5 i-3]]}];
i=i+1];
(*Print[kyokusen2];*)kyokusen2=twistmap[scclist,plusminus,Join[kyokusen2,{cclist[[5 l+1]]}]];
aftertwist]

(*This function is based on Ahara's algorithm*)
twistmap[scclist_,plusminus_,cclist_]:=Module[{lscc,lcc,result,i,j,k,preorder,lpr,rewritingorder,leftest},(*scclist has length of 5x+1*)(*cclist has length of 2x+1*)lscc=(Length[scclist]-1)/5;
lcc=(Length[cclist]-1)/2;
(*Print["{lscc,lcc}=",{lscc,lcc}];*)result={cclist[[1]],cclist[[2]]};
i=2;
While[i≤lcc+1,(*Print["{i,result}=",{i,result}];*)j=1;preorder={};rewritingorder={};
While[j≤lscc,If[cclist[[2 i-1]]==scclist[[5 j-4]],(*search edges on the same cell and crossing check*)If[crosscheck[cclist[[2 i-1]],{scclist[[5 j-3]],scclist[[5 j-1]]/scclist[[5 j-2]]},{scclist[[renum[5 j-8,5 lscc]]],scclist[[renum[5 j-6,5 lscc]]]/scclist[[renum[5 j-7,5 lscc]]]},{cclist[[2 i-2]],2},{cclist[[renum[2 i,2 lcc]]],2}]==0,(*crossed case*)(*Print["type1 {i,j}=",{i,j}];*)If[(*on the left*)relation[cclist[[2 i-1]],{scclist[[5 j-3]],scclist[[5 j-1]]/scclist[[5 j-2]]},{cclist[[2 i-2]],2}]*relation[cclist[[2 i-1]],{scclist[[5 j-3]],scclist[[5 j-1]]/scclist[[5 j-2]]},{scclist[[renum[5 j-8,5 lscc]]],scclist[[renum[5 j-6,5 lscc]]]/scclist[[renum[5 j-7,5 lscc]]]}]*relation[cclist[[2 i-1]],{cclist[[2 i-2]],2},{scclist[[renum[5 j-8,5 lscc]]],scclist[[renum[5 j-6,5 lscc]]]/scclist[[renum[5 j-7,5 lscc]]]}]<0,preorder=Join[preorder,{j,scclist[[5 j-3]],scclist[[5 j-1]]/scclist[[5 j-2]],1}],preorder=Join[preorder,{j,scclist[[renum[5 j-8,5 lscc]]],scclist[[renum[5 j-6,5 lscc]]]/scclist[[renum[5 j-7,5 lscc]]],-1}]]
(*,Print["type2 {i,j}=",{i,j}];*)
(*if uncrossed,we do nothing*)];
j=j+1,(*Print["type3 {i,j}=",{i,j}];*)j=j+1]];
(*Print["preorder=",preorder];*)lpr=Length[preorder]/4;
If[lpr==0,If[i≠lcc+1,result=Join[result,{cclist[[2 i-1]],cclist[[2 i]]}],result=Join[result,{cclist[[2 i-1]]}]],(*sort of the right hand side*)While[Length[preorder]>0,j=2;leftest=1;
While[j≤Length[preorder]/4,If[relation[cclist[[2 i-1]],{preorder[[4 j-2]],preorder[[4 j-1]]},{preorder[[4 leftest-2]],preorder[[4 leftest-1]]}]*relation[cclist[[2 i-1]],{preorder[[4 j-2]],preorder[[4 j-1]]},{cclist[[2 i-2]],2}]*relation[cclist[[2 i-1]],{preorder[[4 leftest-2]],preorder[[4 leftest-1]]},{cclist[[2 i-2]],2}]<0,j=j+1,leftest=j;j=j+1]];
rewritingorder=Join[rewritingorder,{preorder[[4 leftest-3]],plusminus*Sign[Re[cclist[[2 i-1]]]+Im[cclist[[2 i-1]]]]*preorder[[4 leftest]]}];
preorder=Drop[preorder,{4 leftest-3,4 leftest}]];
(*Print["rewritingorder=",rewritingorder];*)(*watch out for rewriting,sign,plusminus,omoteura*)j=1;
While[j≤lpr,If[rewritingorder[[2 j]]==1,result=Join[result,{scclist[[5 rewritingorder[[2 j-1]]-4]],scclist[[5 rewritingorder[[2 j-1]]-3]]}];
(*Print["result_a=",result];*)k=renum[rewritingorder[[2 j-1]]+1,lscc];
(*Print["{j,k}=",{j,k}];*)While[rewritingorder[[2 j-1]]≠k,result=Join[result,{scclist[[5 k-4]],scclist[[5 k-3]]}];
k=renum[k+1,lscc]],result=Join[result,{scclist[[5 rewritingorder[[2 j-1]]-4]],scclist[[renum[5 rewritingorder[[2 j-1]]-8,5 lscc]]]}];
(*Print["result_b=",result];*)k=renum[rewritingorder[[2 j-1]]-1,lscc];
(*Print["{j,k}=",{j,k}];*)While[rewritingorder[[2 j-1]]≠k,result=Join[result,{scclist[[5 k-4]],scclist[[renum[5 k-8,5 lscc]]]}];
k=renum[k-1,lscc]]];
j=j+1];
If[i≠lcc+1,result=Join[result,{cclist[[2 i-1]],cclist[[2 i]]}],result=Join[result,{cclist[[2 i-1]]}]]];
i=i+1];
result]

commutator[i_]:=If[i>0,{2 i-1,2 i,-2 i+1,-2 i},{-2 i,-2 i-1,2 i,2 i+1}]


freewordreduce[freeword_]:=Block[{wl,i,j,result},j=0;
result=freeword;
While[j==0,wl=Length[result];
If[wl≤1,j=1,i=1;
While[(i<wl&&result[[i]]+result[[i+1]])≠0,i=i+1];
If[i==wl,j=1,result=Drop[result,{i,i+1}]]]];
result]


(*This function is based on Ahara's algorithm*)
actiononpi1[scclist_]:=Block[{sccno,autpi1,autinvpi1,genus,pialpha,pibeta,num,i,j,k,pinum,edge2word,freewordreduce,cell2,cell1},sccno=Length[scclist]/2;
genus=Max[Table[GENUS,{i,sccno}]];
pialpha[num_]:=Flatten[Join[{genus+1},Table[{10*i+5,i},{i,genus,num,-1}],{num*10 I,num*I,(num*10+5) I,(num+1) I,10 I (num+1),num+1},Table[{10*i+5,i+1},{i,num+1,genus}]]];
pibeta[num_]:=Flatten[Join[{genus+1},Table[{10*i+5,i},{i,genus,num+1,-1}],{10 (num+1) I,(num+1) I,-10 num-10,-num-1,-10 num-8,(num+1) I,10 (num+1) I,num+1},Table[{10*i+5,i+1},{i,num+1,genus}]]];
edge2word[cell2_,cell1_]:=Module[{j},Which[(Re[cell1]<0&&Mod[Re[cell1],10]==0),(*-10,-20,,,*)If[Re[cell2]+Im[cell2]>0,Flatten[Table[commutator[j],{j,1+Re[cell1]/10,-1}]],-Reverse[Flatten[Table[commutator[j],{j,1+Re[cell1]/10,-1}]]]],Mod[Abs[cell1],5]==3,(*13,18,-13,-18,,,*)If[Re[cell2]+Im[cell2]>0,Flatten[Join[{-2 Quotient[Abs[cell1],10]},Table[commutator[j],{j,-Quotient[Abs[cell1],10],-1}]]],-Reverse[Flatten[Join[{-2 Quotient[Abs[cell1],10]},Table[commutator[j],{j,-Quotient[Abs[cell1],10],-1}]]]]],(Im[cell1]>0&&Mod[Im[cell1],10]==5),(*15I,25I,,,*)If[10 Abs[cell2]<Abs[cell1],{(Im[cell1]-5)/5-1},-{(Im[cell1]-5)/5-1}],(Re[cell1]<0&&Mod[Re[cell1],10]==5),(*-15,-25,,,*)If[10 Abs[cell2]<Abs[cell1],Flatten[Join[If[cell1==-15,{},Table[commutator[j],{j,(-cell1-15)/10}]],{2 Quotient[Abs[cell1],10]-1},Table[commutator[j],{j,(cell1+5)/10,-1}]]],-Reverse[Flatten[Join[If[cell1==-15,{},Table[commutator[j],{j,(-cell1-15)/10}]],{2 Quotient[Abs[cell1],10]-1},Table[commutator[j],{j,(cell1+5)/10,-1}]]]]],True,{}]];
autpi1=Flatten[Table[{pialpha[j],pibeta[j]},{j,genus}],1];
autinvpi1=Flatten[Table[{pialpha[j],pibeta[j]},{j,genus}],1];
j=1;
While[j≤sccno,pinum=1;
While[pinum≤genus,Do[autpi1[[2 pinum-1]]=twistmap[scclist[[2 sccno-2 j+1]],Sign[scclist[[2 sccno-2 j+2]]],autpi1[[2 pinum-1]]],{Abs[scclist[[2 sccno-2 j+2]]]}];
Do[autpi1[[2 pinum]]=twistmap[scclist[[2 sccno-2 j+1]],Sign[scclist[[2 sccno-2 j+2]]],autpi1[[2 pinum]]],{Abs[scclist[[2 sccno-2 j+2]]]}];
Do[autinvpi1[[2 pinum-1]]=twistmap[scclist[[2 j-1]],-Sign[scclist[[2 j]]],autinvpi1[[2 pinum-1]]],{Abs[scclist[[2 j]]]}];
Do[autinvpi1[[2 pinum]]=twistmap[scclist[[2 j-1]],-Sign[scclist[[2 j]]],autinvpi1[[2 pinum]]],{Abs[scclist[[2 j]]]}];
pinum=pinum+1];
(*Print["j=",{j}];*)(*Print["autpi1=",autpi1];*)(*Print["autinvpi1=",autinvpi1];*)j=j+1];
(*rewrite edge word into word of free group*)(*Print["edge_{autpi1,autinvpi1}=",{autpi1,autinvpi1}];*)$RecursionLimit=5000;
j=1;
While[j≤2 genus,autpi1[[j]]=freewordreduce[Flatten[Table[edge2word[autpi1[[j,2 k-1]],autpi1[[j,2 k]]],{k,(Length[autpi1[[j]]]-1)/2}]]];
autinvpi1[[j]]=freewordreduce[Flatten[Table[edge2word[autinvpi1[[j,2 k-1]],autinvpi1[[j,2 k]]],{k,(Length[autinvpi1[[j]]]-1)/2}]]];
j=j+1];
$RecursionLimit=256;
{autpi1,autinvpi1}]

spAction[listOfTwists_]:=Module[{aaaaa,i,j,auto,narabikae},narabikae[n_]:=If[n≤GENUS,2n-1,2(n-GENUS)];
auto=actiononpi1[listOfTwists][[1]];
Print[drawpicture[Table[listOfTwists[[2 i-1]],{i,Length[listOfTwists]/2}]]];
Table[Count[auto[[narabikae[j]]],narabikae[i]]-Count[auto[[narabikae[j]]],-narabikae[i]],{i,2GENUS},{j,2GENUS}]//MatrixForm];


aftertwist:=Module[{l,rw},l=Length[kyokusen2];
rw=wordreduce[kyokusen2];
rw=simplicitycheck[rw];
(*Print[rw];*)admitpreserve=rw[[1]];
If[rw[[1]]==1,current=rw[[2]];Print["current:"];
picture[current],Print["Error! This curve is NOT homotopic to some SCC !"];]]

preserve:=Module[{},If[admitpreserve==0,Print["The curve on the picture is NOT homotopic to some SCC !"],Print[StringForm["This SCC is named simple[[``]]",simpleclosedcurvenumber]];
simple=Join[simple,{current}];
simpleclosedcurvenumber=simpleclosedcurvenumber+1];]

tw[n_]:=Module[{g,k},k=Abs[n];
If[(k==0||k>4 GENUS-1),Print[StringForm["tw[n] is now defined for 1≤|n|≤``",4 GENUS-1]],Switch[Mod[k,4],0,Print[StringForm["D````",k/4,If[n>0,"+","-"]]],1,Print[StringForm["A````",(k+3)/4,If[n>0,"+","-"]]],2,Print[StringForm["B````",(k+2)/4,If[n>0,"+","-"]]],3,Print[StringForm["C````",(k+1)/4,If[n>0,"+","-"]]]];
dehntwist[lic[Abs[n]],Sign[n],current]]]

involution:=Module[{to},to={};
edgeno=(Length[current]-1)/5;
i=1;
While[i≤edgeno,to=Join[to,{current[[5 i-4]],current[[5 i-3]]}];
i=i+1];
kyokusen2=-Join[to,{current[[5 edgeno+1]]}];
aftertwist]


twistCurrentAlongSimple[n_]:=If[Abs[n]<simpleclosedcurvenumber&&n≠0,dehntwist[simple[[Abs[n]]],Sign[n],current],Print[StringForm["We have not defined simple[[``]] yet",simpleclosedcurvenumber]];]

lic[n_]:=Module[{g},Switch[Mod[n,4],0,g=(n+4)/4;
{g,10*g-2,1,1,1,-g I,10 g+3,1,1,1,g},1,g=(n+3)/4;
{(g+1)*I,-10*g-8,1,1,1,-(g+1),-10 (g+1),1,1,1,(g+1)*I},2,g=(n+2)/4;
{g,10 g I,1,1,1,g I,(10 g+5) I,1,1,1,(g+1) I,10 (g+1) I,1,1,1,g+1,10 g+5,1,1,1,g},3,g=(n+1)/4;
{g+1,10*g+8,1,1,1,-(g+1) I,10 (g+1),1,1,1,g+1}]]

genuschange[n_]:=If[IntegerQ[n]&&n>0,simpleclosedcurvenumber=1;
loop={};
simple={};
current={};
admitpreserve=0;
GENUS=n;
Print["genus=",GENUS],Print["?"]]