with(Groebner):
with(RootFinding):
with(algcurves):
with(plots):
with(plottools):
with(ListTools):


#################
### main procedure: grafo(Pi,Pr,x,y,t,s,dig);
### The procedure parameters are:
##### Pi: the mapping P in x,y,
##### Pr: parametric rational curve in t,
##### dig: number of digits that Maple uses when making calculations. Usually dig=34 is enough for calculations. In the paper, Examples 1,2,5 and 6 require 34 digits; Example 3 requires 22; example 4 requires 19 and Example 7 requires 21.
### Example: 
### grafo([(-x^2 - y^2 - 2*x)/(x^2 + y^2 - x), (x^8 + 4*x^6*y^2 + 6*x^4*y^4 + 4*x^2*y^6 + y^8 - x^5*y - 2*x^3*y^3 - x*y^5 + x^4 - 2*x^3*y)/((2*x^6 + 6*x^4*y^2 + 6*x^2*y^4 + 2*y^6 - 2*x^5 - 4*x^3*y^2 - 2*x*y^4 + x^2*y)*(x^2 + y^2))],[-40*t^2 + 20 + 130/3*t^4, 32*t - 136/3*t^3],x,y,t,s,34)
### In order to improve the quality of the graph, horizontal ramification points have been added, even if they are not necessary in order to get the graph.
#################


Inversa_test:=proc(pi,x,y,X,Y) local FE1,FE2,Inversa,Jp,JJ,Ex,Ey,R,pi1,pi2,a,b,kk,i,f1,f2,npi1,npi2,dpi1,dpi2;

pi1:=pi[1];pi2:=pi[2];
f1:=numer(X-normal(pi1));#print(f1);
f2:=numer(Y-normal(pi2));#print(f2);

npi1:=numer(pi1):npi2:=numer(pi2):
dpi1:=denom(pi1):dpi2:=denom(pi2):

if indets(pi1)={x} and indets(pi2)={x,y} then 
	if degree(npi1,x)*degree(dpi1,x)<2 and degree(npi2,y)*degree(dpi2,y)<2 then kk:=solve(X-pi1,x):
		return [kk,solve(simplify(subs(x=kk,pi2)-Y),y)];
	fi;
elif indets(pi1)={y} and indets(pi2)={x,y} then 
	if degree(npi1,y)*degree(dpi1,y)<2 and degree(npi2,x)*degree(dpi2,x)<2 then kk:=solve(X-pi1,y):
		return [solve(simplify(subs(y=kk,pi2)-Y),x),kk];
	fi;
elif indets(pi1)={x,y} and indets(pi2)={y} then 
	if degree(npi2,y)*degree(dpi2,y)<2 and degree(npi1,x)*degree(dpi1,x)<2 then kk:=solve(Y-pi2,y):
		return [solve(simplify(subs(y=kk,pi1)-X),x),kk];
	fi;

elif indets(pi1)={x,y} and indets(pi2)={x} then 
	if degree(npi2,x)*degree(dpi2,x)<2 and degree(npi1,y)*degree(dpi1,y)<2 then kk:=solve(Y-pi2,x):
		return [kk,solve(simplify(subs(x=kk,pi1)-X),y)];
	fi;
fi;

 
Ex:= resultant(f1,f2,y); 
Ey:= resultant(f1,f2,x); 
FE1:= factors(Ex); 
FE2:= factors(Ey); 



for i from 1 to nops(FE1[2]) do 
	if indets(FE1[2][i][1])={x,X,Y} then 
		if degree(FE1[2][i][1],x)<>1  then WARNING("degree in x > 1");return False;
		else R:=[-coeff(FE1[2][i][1],x,0)/lcoeff(FE1[2][i][1],x) ] ;
		fi; 	
	elif indets(FE1[2][i][1]) in [{X},{Y},{x,Y},{x,X},{X,Y}] then WARNING("odd factors"); return False;  
	fi;
od:

for i from 1 to nops(FE2[2]) do 
	if indets(FE2[2][i][1])={y,X,Y} then 
		if degree(FE2[2][i][1],y)<>1  then  WARNING("degree in y > 1");return False;
		else R:=[R[],-coeff(FE2[2][i][1],y,0)/lcoeff(FE2[2][i][1],y) ] ;
		fi; 
	elif indets(FE2[2][i][1]) in [{X},{Y},{y,Y},{y,X},{X,Y}] then WARNING("odd factors"); return False;  
	fi;
od:


return  normal(R);
end:


###################
 
TestCurva:=proc(Pi,Pr,x,y,t) local F,G,X1,X2,Y1,Y2,A,B,C,D,a,b,c,d,Pit;

X1:=numer(Pr[1]);
X2:=denom(Pr[1]);
Y1:=numer(Pr[2]);
Y2:=denom(Pr[2]);
A:=numer(Pi[1]);
B:=denom(Pi[1]);
C:=numer(Pi[2]);
D:=denom(Pi[2]);


if degree(gcd(A,B))>0 or degree(gcd(C,D))>0 then error "invalid mapping Pi";fi;


F:=X1*subs(t=s,X2)-X2*subs(t=s,X1);
G:=Y1*subs(t=s,Y2)-Y2*subs(t=s,Y1); 
if degree(gcd(F,G))>1 

then  

 error "invalid parametrization: it is not proper";

fi;

a:=normal(subs(x=Pr[1],y=Pr[2],A));
b:=normal(subs(x=Pr[1],y=Pr[2],B));
c:=normal(subs(x=Pr[1],y=Pr[2],C));
d:=normal(subs(x=Pr[1],y=Pr[2],D));

if b=0 then error "pi1 no definido"; 
elif d=0 then error "pi2 no definido"; 
elif  type(normal(a/b)*normal(c/d) , constant) then error "no es birracional en la curva"; 
else return [normal(a/b),normal(c/d) ];
fi;

end:

  
########################

polmAC:=proc(Pr,t,s) local X1,Y1,X2,Y2,F,G,u,v,T,M;

#description "polynomials whose roots are the t-values that define self-auto intersections of C";


X1:=numer(Pr[1]);
X2:=denom(Pr[1]);
Y1:=numer(Pr[2]);
Y2:=denom(Pr[2]);
F:=X1*subs(t=s,X2)-X2*subs(t=s,X1); 

G:=Y1*subs(t=s,Y2)-Y2*subs(t=s,Y1); 

F:=normal(F/(t-s)); 

G:=normal(G/(t-s));  

T:=resultant(F,G,s);  

T:=PolynomialTools[SquareFreePart](T); 

T:=quo(T,gcd(T,lcm(X2,Y2)),t); 

 
return sort(T);

end:

########################

polmInversaNo:=proc(Pi,Pr,x,y) local X1,Y1,X2,Y2,Pol,Po,Pit,In;
 
X1:=numer(Pr[1]);
X2:=denom(Pr[1]);
Y1:=numer(Pr[2]);
Y2:=denom(Pr[2]);

In:=Inversa_test(Pi,x,y,X,Y): 

Pol:=PolynomialTools[SquareFreePart](denom(In[1])*denom(In[2])): 

Pit:=map(x->normal(simplify(x)),subs(x=Pr[1],y=Pr[2],Pi)); 

Po:=PolynomialTools[SquareFreePart]( numer(normal(subs(X=Pit[1],Y=Pit[2],Pol)))) :

return sort(Po);

end:


###################

polmR:=proc(Pi,Pr,x,y,t) local Elotro,Pit,N,M; 


#description:  Pi(Pr)(x)'=0

 
N:=numer(normal(subs(x=Pr[1],y=Pr[2],diff(Pi[1],x))*diff(Pr[1],t) +subs(x=Pr[1],y=Pr[2],diff(Pi[1],y))*diff(Pr[2],t)));
 
M:=numer(normal(subs(x=Pr[1],y=Pr[2],diff(Pi[2],x))*diff(Pr[1],t) +subs(x=Pr[1],y=Pr[2],diff(Pi[2],y))*diff(Pr[2],t)));

N:=PolynomialTools[SquareFreePart](M*N);

return N;

end:

 
 
###################

polm:=proc(Pi,Pr,x,y,t,s) local elpol;

elpol:=polmAC(Pr,t,s)*polmInversaNo(Pi,Pr,x,y)*polmR(Pi,Pr,x,y,t);

elpol:=PolynomialTools[SquareFreePart](elpol);

return elpol;

end:

###################

puntosIV:=proc(Pi,Pr,PiC,x,y,t,s) local X1,X2,Y1,Y2,L,Lm,Tes2,F,L2,M,puntoinfinito,newF,T,newsT,Tes,Xm,X,Xc,Xa,kk,oldX,newX,Yc,Ym,X2lc,Y2lc,xi,yi,yj,m,n,i,j,k; 


global tolerancia; 


description "puntos criticos por pi pero sus imágenes por Pr mas puntos en sus verticales, con sus t's, Pr=(p1(t),q1(t),p2(t),q2(t))";
 
X1:=numer(PiC[1]);
X2:=denom(PiC[1]);
Y1:=numer(PiC[2]);
Y2:=denom(PiC[2]);

 

X2lc:= PolynomialTools[ SquareFreePart](X2);  

Y2lc:=PolynomialTools[ SquareFreePart](Y2); 
kk:=lcm(Y2lc,X2lc);   

m:=polm(Pi,Pr,x,y,t,s); 

m:=quo(m,gcd(kk, m),t);   

F:=resultant(m,X1-x*X2,t);  

F:=PolynomialTools[SquareFreePart](F); print(F);

L:=sort([seq(op(i)[2] , i in Isolate(F,x ))]); 

puntoinfinito:=map(x->limit(x,t=infinity),PiC);
 
if not type(puntoinfinito[1] ,infinity) and not type(puntoinfinito[2],infinity) then 
	if not evalb(evalf(puntoinfinito[1]) in L) then L:=sort([puntoinfinito[1],L[]]);fi;
fi;


if nops(L)=1 then  M:=1;
	else 
	M:=max([seq ( abs(L[i]-L[i+1]), i=1..nops(L)-1 ) ] ) : 
fi:
	
Lm:=[L[1]-M,seq ( (L[i]+L[i+1])/2, i=1..nops(L)-1 ),L[nops(L)]+M];   print(Lm);

Xm:=[ ]; 
for xi in Lm do  
 Tes2:=MakeUnique([fsolve(X1-xi*X2)]): 
 Tes:=[seq(op(i)[2] , i in Isolate(X1-xi*X2,t) )]:
 if nops(Tes)>0 or nops(Tes2)>0 then	
	if nops(Tes)< nops(Tes2) then Tes:=Tes2;
	fi;
 	newsT:=[ Tes[1] ];  
 	for j in subsop(1=NULL,Tes) do
  	 if nops(select(verify,[seq(abs(j-k),k in newsT)],tolerancia,'truefalse'('less_equal')))=0 then

  	      newsT:=[op(newsT),j];
   	 fi; 
 	od;

	Xm:=[op(Xm), seq( [ [xi, subs(t=j,Y1/Y2) ],j,2 ] , j in newsT )];
 

 	 
 fi;
od;


Xc:=[ ]; 

 
for xi in L do  
 Tes2:=MakeUnique([fsolve(X1-xi*X2)]): Tes:=[seq(op(i)[2] , i in Isolate(X1-xi*X2,t) )]:
 if nops(Tes)>0 or nops(Tes2)>0 then	
	if nops(Tes)< nops(Tes2) then Tes:=Tes2;fi;
 	newsT:=[ Tes[1] ];  
 	for j in subsop(1=NULL,Tes) do
  	 if nops(select(verify,[seq(abs(j-k),k in newsT)],tolerancia,'truefalse'('less_equal')))=0 then

  	      newsT:=[op(newsT),j];
   	 fi; 
 	od;

 	Yc:=[subs(t=newsT[1],Y1/Y2)];
 	Xc:=[op(Xc) ,[  [ xi,Yc[1] ], newsT[1]  ]]; 
 	if nops(newsT)>1 then 
 		for j in subsop(1=NULL,newsT) do  
 			 yj:=subs(t=j,Y1/Y2);
  			 if nops(select(verify,[seq(abs(yj-k),k in Yc)],tolerancia,'truefalse'('less_equal')))=0 then

      			  Yc:=[op(Yc),yj];
      			  Xc:=[op(Xc),[ [xi,yj], j ] ]; 
   			 else  
      			 yi:=Yc[1];for k from 1 while abs(yj-Yc[k])>tolerancia do yi:= Yc[k+1];od; 

       			 Xc:=[op(Xc),[ [xi,yi], j ] ];
   			fi;
  		od;
	fi; 
  else 
	Tes:=[seq(op(i)[2] , i in Isolate(m,t))]; 
	for i in Tes do if abs(subs(t=i,X1/X2)-xi)<tolerancia then Xc:=[op(Xc),[ [xi,subs(t=i,Y1/Y2)], i ] ];fi;od;
 fi;
od;
 
 
X:=[Xc[],Xm[]]:  

L:=sort([seq(X[i][2],i=1..nops(X))]):newX:=[];oldX:=X:

for i in L do  
	newX:=[newX[],oldX[ Search(i,[seq(oldX[j][2],j=1..nops(oldX))]) ] ]: 
	subsop(Search(i,[seq(oldX[j][2],j=1..nops(oldX))]) = NULL, oldX);
od:

if not type(puntoinfinito[1] ,infinity) and not type(puntoinfinito[2],infinity) then  
	if nops(newX[1])=2 and nops(newX[nops(newX)])=2 then 
		newX:=[ [puntoinfinito,-infinity,2],newX[],[puntoinfinito, infinity,2] ] ;
	elif nops(newX[1])=2 and nops(newX[nops(newX)])=3 then 
		newX:=[ [puntoinfinito,-infinity,2],newX[],[puntoinfinito, infinity] ] ;
	elif nops(newX[1])=3 and nops(newX[nops(newX)])=3 then 
		newX:=[ [puntoinfinito,-infinity],newX[],[puntoinfinito, infinity] ] ;
	else 
		newX:=[ [puntoinfinito,-infinity],newX[],[puntoinfinito, infinity,2] ] ;	
	fi;

else  
	if nops(newX[1])=2 and nops(newX[nops(newX)])=2 then 
		newX:=[ [subs(t=newX[1][2]-0.5,PiC),newX[1][2]-0.5,2 ],newX[],[subs(t=newX[nops(newX)][2]+0.5,PiC),newX[nops(newX)][2]+0.5,2 ] ] 
	elif nops(newX[1])=2 and nops(newX[nops(newX)])=3 then 
		newX:=[ [subs(t=newX[1][2]-0.5,PiC),newX[1][2]-0.5,2 ],newX[],[subs(t=newX[nops(newX)][2]+0.5,PiC),newX[nops(newX)][2]+0.5 ] ] 
	elif nops(newX[1])=3 and nops(newX[nops(newX)])=3 then 
		newX:=[ [subs(t=newX[1][2]-0.5,PiC),newX[1][2]-0.5 ],newX[],[subs(t=newX[nops(newX)][2]+0.5,PiC),newX[nops(newX)][2]+0.5 ] ] 
	else 
		newX:=[ [subs(t=newX[1][2]-0.5,PiC),newX[1][2]-0.5 ],newX[],[subs(t=newX[nops(newX)][2]+0.5,PiC),newX[nops(newX)][2]+0.5 ,2] ] 
	fi;	

fi:

Xa:=[]:
if sturm(sturmseq(kk,t),t,-infinity,infinity)<>0 then 
 	  
 	Tes2:=sort(MakeUnique([fsolve(kk)])): 
 	Tes:=sort([seq(op(i)[2] , i in Isolate(kk,t) )]):
 	if nops(Tes)>0 or nops(Tes2)>0 then 
		if nops(Tes)< nops(Tes2) then Tes:=Tes2;fi;
	fi;
 	Xa:=[seq([[subs(t=i,X1/X2),infinity],i] , i in Tes)]; 
fi;
 

return Xa,newX;

end:
###############################################


partir:=proc(rama,T,PiC ) local R,puestos2, puestos3,puestos4,k,i,j,f;
 
R:=[ ]:
		
puestos3:=[]:
for i in T do  
	for j from 1 to nops(rama)-1 do 
		if rama[j][2]<i and i <rama[j+1][2] then puestos3:=[puestos3[],[i,j]];break; fi;
	od;
od;
 
f := (x, y) -> x[2]=y[2] :

puestos2:=[Categorize(f, puestos3)]: #[[[a1, 1]], [[a2, 2], [a3, 2], [a4, 2]], [[a5, 3], [a6, 3]], [[a7, 4]]]

if nops(puestos2)=nops(puestos3) then	
	
	if type(rama[ puestos3[1][2] ][2] ,finite) then 
	  R:=[  [ rama[1..puestos3[1][2]][],[subs(t=(puestos3[1][1]+ rama[ puestos3[1][2] ][2]  )/2 ,PiC)] ] ];
	else
	R:=[  [ rama[1..puestos3[1][2]][],[subs(t=puestos3[1][1] -2  ,PiC)] ] ];
	fi;
 
	
	for i from 2 to nops(puestos3) do 
		  R:=[R[],[[subs(t=(puestos3[i-1][1]+ rama[ puestos3[i-1][2]+1 ][2]  )/2 ,PiC)],rama[puestos3[i-1][2]+1..puestos3[i][2]][],[subs(t=(puestos3[i][1]+ rama[ puestos3[i][2] ][2]  )/2 ,PiC)] ] ]; 
	od;
	
	if type(rama[ puestos3[nops(puestos3)][2]+1 ][2] ,finite) then 
		R:=[R[],[[subs(t=(puestos3[nops(puestos3)][1]+ rama[ puestos3[nops(puestos3)][2]+1 ][2]  )/2 ,PiC)],rama[puestos3[nops(puestos3)][2]+1..nops(rama)][]  ] ];
	else
		R:=[R[],[[subs(t=puestos3[nops(puestos3)][1] +1   ,PiC)],rama[puestos3[nops(puestos3)][2]+1..nops(rama)][]  ] ];
	fi;

	else  	
	 
	puestos3:=[seq( [seq( j[1],j in i),i[1][2]],i in puestos2)]:
	
	k:=nops(puesto3[1]):
	if k=2 then 
		R:=[  [ rama[1..puestos3[1][2]][],[subs(t=(puestos3[1][1]+ rama[ puestos3[1][2] ][2]  )/2 ,PiC)] ]  ,
	[[subs(t=(puestos3[1][1]+ rama[ puestos3[1][2]+1 ][2]  )/2 ,PiC)],rama[puestos3[1][2]+1..puestos3[2][nops(puesto3[2])]][],[subs(t=(puestos3[2][1]+ rama[ puestos3[2][nops(puesto3[2])] ][2]  )/2 ,PiC)] ] ];


	else
	
		R:=[ [ rama[1..puestos3[1][k]][],[subs(t=(puestos3[1][1]+ rama[ puestos3[1][k] ][2]  )/2 ,PiC)] ]  ];
		for j from 1 to k-2 do
			R:=[R[],[ [ subs(t= puestos3[1][j]+(puestos3[1][j+1]-puestos3[1][j])/3,PiC) ],[subs( t= puestos3[1][j]+2*(puestos3[1][j+1]-puestos3[1][j])/3,PiC) ]  ] ]:
		od:
	fi;

	for i from 2 to nops(puestos3) do
		k:=nops(puesto3[i]):
		R:=[R[],[[subs(t=(puestos3[i-1][  nops(puestos3[i-1] )-1]+ rama[ puestos3[i-1][nops(puestos3[i-1] )]+1 ][2]  )/2 ,PiC)],rama[puestos3[i-1][nops(puestos3[i-1] )]+1..puestos3[i][k]][],[subs(t=(puestos3[i][1]+ rama[ puestos3[i][k] ][2]  )/2 ,PiC)] ] ]; 
		if k>2 then 
			for j from 1 to k-2 do
			R:=[R[],[ [ subs(t= puestos3[i][j]+(puestos3[i][j+1]-puestos3[i][j])/3,PiC) ],[subs( t= puestos3[i][j]+2*(puestos3[i][j+1]-puestos3[i][j])/3,PiC) ]  ] ]:
			od:	
		fi;
	od:
	R:=[R[],[[subs(t=(puestos3[nops(puestos3)][nops(puestos3[nops(puestos3)])-1]+ rama[ puestos3[nops(puestos3)][nops(puestos3[nops(puestos3)])]+1 ][2]  )/2 ,PiC)],rama[puestos3[nops(puestos3)][nops(puestos3[nops(puestos3)])]+1..nops(rama)][]  ] ];

fi:

return R; 
		 
end;


################################################################

grafo:=proc(Pi,Pr,x,y,t,s,dig) local asin,asin2,puntos,R,PiC,i,rama,puestos,puestos2,puestos3,puestos4,lasramas,r,k,T,j; 
global tolerancia;

tolerancia:=10^(-10):
Digits:=dig:

PiC:=TestCurva(Pi,Pr,x,y,t);

if type(PiC[1],polynom) and type(PiC[2],polynom) and degree(PiC[2])=1 and degree(PiC[1])=1 then 
return( display( pointplot([subs(t=-1,PiC), subs(t=1,PiC)],symbolsize=12,color='blue'),line(subs(t=-1,PiC), subs(t=1,PiC) ,color='red') )  ); 
fi: 

asin,puntos:=puntosIV(Pi,Pr,PiC,x,y,t,s);
  
puestos:=[]: 
 
for i from 1 to nops(puntos)-1 do 
	 if nops(puntos[i])=nops(puntos[i+1]) then puestos:=[puestos[],i];fi;
od; 

 
	if nops(puestos)=0 and nops(asin)=0 then 
		return display(pointplot([seq(i[1], i in puntos)],symbolsize=12,color='blue'),listplot(Matrix([seq(i[1], i in puntos)]),color='red'));

	elif nops(asin)=0 then #puestos \=[]
		R:=[puntos[1..puestos[1]] ];
		for i from 2 to nops(puestos) do
			  R:=[R[],puntos[puestos[i-1]+1..puestos[i]] ]; 
		od; 
		R:=[R[],puntos[puestos[nops(puestos)]+1..nops(puntos)] ];
		return display(pointplot([seq(i[1], i in puntos)],symbolsize=12,color='blue'),seq(   listplot(Matrix([seq(i[1], i in rama)]  ),color='red')   ,rama in R));

	elif nops(puestos)=0 then  		
		R:=[]:
		asin2:=asin: 
		puestos2:=[]:
		for i in asin while i[2]<puntos[1][2] do 
			puestos2:=[puestos2[],i[2] ];
			asin2:=subsop( Search(i, asin2) = NULL,asin2);
		od; 
		
		if nops(puestos2)>0 then 
			puestos2:=sort(puestos2, `>`): 
			puntos:=[[subs(t=(puestos2[1]+puntos[1][2])/2,PiC) ,(puestos2[1]+puntos[1][2])/2],puntos[]];
			if nops(puestos2)>1 then
				for k from 1 to nops(puestos2)-1 do R:=[R[],[subs(t=puestos2[k]+(puestos2[k+1]-puestos2[k])/3 ,PiC )
],[subs(t=puestos2[k]+2*(puestos2[k+1]-puestos2[k])/3,PiC ) ]];
				od;
			fi;
			R:=[R[],[ subs(t= min(puestos2[])-1  ,PiC)],[subs(t= min(puestos2[])  -0.2 ,PiC) ] ];
			asin:=asin2:
		fi;

		puestos4:=[]:
		for i in asin do 
			if i[2]>puntos[nops(puntos)][2] then 
				puestos4:=[puestos4[],i[2]];
				asin2:=subsop( Search(i, asin2) = NULL,asin2);
			fi;

		od; 
		if nops(puestos4)>0 then 
			puestos4:=sort(puestos4): 

			puntos:=[puntos[],[subs(t=(puestos4[1]+puntos[nops(puntos)][2])/2,PiC) ,(puestos4[1]+puntos[nops(puntos)][2])/2]];
			if nops(puestos4)>1 then
				for k from 1 to nops(puestos4)-1 do R:=[R[],[subs(t=puestos4[k]+(puestos4[k+1]-puestos4[k])/3 ,PiC )],[subs(t=puestos4[k]+2*(puestos4[k+1]-puestos4[k])/3,PiC ) ]];
				od;
			fi;
			R:=[R[],[ subs(t= max(puestos4[])+0.2  ,PiC)],[subs(t= max(puestos4[])+1 ,PiC) ] ];
			asin:=asin2:
		fi;
		
		if nops(asin)=0 then 
		 
			R:=[R[], puntos];	 
			return display(pointplot([seq(i[1], i in puntos)],symbolsize=12,color='blue'),seq(   listplot(Matrix([seq(i[1], i in rama)]  ),color='red') , rama in R)); 
		else  
			R:=[R[],partir(puntos,sort([seq(i[2],i in asin)]),PiC )[]];   
			return display(pointplot([seq(i[1], i in puntos)],symbolsize=12,color='blue'),seq(   listplot(Matrix([seq(i[1], i in rama)]  ),color='red')   ,rama in R));

		fi;



	else  
		
		lasramas:=[puntos[1..puestos[1]]];
		for i from 2 to nops(puestos) do
			  lasramas:=[lasramas[],puntos[puestos[i-1]+1..puestos[i]] ]; 
		od; 
		lasramas:=[lasramas[],puntos[puestos[nops(puestos)]+1..nops(puntos)] ]; 
		R:=[];
		asin2:=asin:
 
		puestos2:=[]: 
		for i in asin while i[2]<puntos[1][2] do 
			puestos2:=[puestos2[],i[2] ];
			asin2:=subsop( Search(i, asin2) = NULL,asin2);
		od;
		
		if nops(puestos2)>0 then 
			asin:=asin2:
			puestos2:=sort(puestos2, `>`): 
			lasramas[1]:=[[subs(t=(puestos2[1]+puntos[1][2])/2,PiC) ,(puestos2[1]+puntos[1][2])/2],lasramas[1][]];
			if nops(puestos2)>1 then
				for k from 1 to nops(puestos2)-1 do R:=[R[],[subs(t=puestos2[k]+(puestos2[k+1]-puestos2[k])/3 ,PiC )
],[subs(t=puestos2[k]+2*(puestos2[k+1]-puestos2[k])/3,PiC ) ]];
				od;
			fi;
			R:=[R[],[ subs(t= min(puestos2[])-1  ,PiC)],[subs(t= min(puestos2[])-0.2 ,PiC) ] ];	
		fi;

		puestos4:=[]: 
		for i in asin do 
			if i[2]>puntos[nops(puntos)][2] then 
				puestos4:=[puestos4[],i[2]];
				asin2:=subsop( Search(i, asin2) = NULL,asin2);
			fi;

		od;
		if nops(puestos4)>0 then 
			asin:=asin2:
			puestos4:=sort(puestos4): 
			lasramas[nops(lasramas)]:=[lasramas[nops(lasramas)][],[subs(t=(puestos4[1]+puntos[nops(puntos)][2])/2,PiC) ,(puestos4[1]+puntos[nops(puntos)][2])/2]];
			if nops(puestos4)>1 then
				for k from 1 to nops(puestos4)-1 do R:=[R[],[subs(t=puestos4[k]+(puestos4[k+1]-puestos4[k])/3 ,PiC )],[subs(t=puestos4[k]+2*(puestos4[k+1]-puestos4[k])/3,PiC ) ]];
				od;
			fi;
			R:=[R[],[ subs(t= max(puestos4[])+0.2  ,PiC)],[subs(t= max(puestos4[])+1 ,PiC) ] ];
		fi;

		for r in lasramas do 
			T:=[]; 
			for i in asin do 
				if verify(i[2], min(seq(r[i][2],i=1..nops(r) )) .. max(seq(r[i][2],i=1..nops(r) )), 'interval')
					then 
						T:=[T[],i[2]];
						asin2:=subsop( Search(i, asin2) = NULL,asin2);
				fi;
			od;
			
			if nops(T)>0 then 
				asin:=asin2:	 
				R:=[R[],partir(r,T,PiC )[]];else R:=[R[],r];
			fi; 
		od;
		if nops(asin)>0 then  
			for i in puestos do
				T:=[puntos[i][2],puntos[i+1][2] ]:
				for j in asin do	
					if puntos[i][2]<j[2] and j[2]<puntos[i+1][2] then T:=[T[],j[2]];fi;
				od;
				T:=sort(T); 
				if nops(T)>2 then
					R:=[R[],[ puntos[i],[subs(t=T[1]+( T[2]-T[1])/10 ,PiC)  ] ] , [ [subs(t=T[nops(T)]-( T[nops(T)]-T[nops(T)-1])/10 ,PiC)  ], puntos[i+1] ] ];  
					if nops(T)>3 then 
						for j from 2 to nops(T)-2 do
							R:=[R[],[[subs(t=T[j]+4*(T[j+1]-T[j])/10,PiC)],[subs(t=T[j]+6*(T[j+1]-T[j])/10,PiC)] ]];
						od;	
					fi;	
 				fi;


			od;	
		fi; 
		
		return display(pointplot([seq(i[1], i in puntos)],symbolsize=12,color='blue'),seq(   listplot(Matrix([seq(i[1], i in rama)]  ),color='red'), rama in R));

	fi;		 
 
			

end:


