===================================================================
RCS file: /home/cvs/OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v
retrieving revision 1.22
retrieving revision 1.50
diff -u -p -r1.22 -r1.50
--- OpenXM/src/asir-contrib/packages/src/os_muldif.rr	2017/08/29 01:13:54	1.22
+++ OpenXM/src/asir-contrib/packages/src/os_muldif.rr	2019/06/27 02:53:26	1.50
@@ -1,4 +1,4 @@
-/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.21 2017/08/21 05:44:57 takayama Exp $ */
+/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.49 2019/05/23 01:47:53 takayama Exp $ */
 /* The latest version will be at ftp://akagi.ms.u-tokyo.ac.jp/pub/math/muldif
  scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs
 */
@@ -6,7 +6,7 @@
 /* #undef USEMODULE */
 
 /*             os_muldif.rr (Library for Risa/Asir) 
- *          Toshio Oshima (Nov. 2007 - Aug. 2017)
+ *          Toshio Oshima (Nov. 2007 - Feb. 2019)
  *
  *   For polynomials and differential operators with coefficients
  *   in rational funtions (See os_muldif.pdf)
@@ -43,6 +43,7 @@ static Canvas$
 static ID_PLOT$
 static Rand$
 static LQS$
+static SVORG$
 localf spType2$
 localf erno$
 localf chkfun$
@@ -116,6 +117,7 @@ localf lchange$
 localf llsize$
 localf llbase$
 localf lsort$
+localf rsort$
 localf lpair$
 localf lmax$
 localf lmin$
@@ -241,6 +243,10 @@ localf expower$
 localf seriesHG$
 localf seriesMc$
 localf seriesTaylor$
+localf mulpolyMod$
+localf solveEq$
+localf baseODE$
+localf taylorODE$
 localf evalred$
 localf toeul$
 localf fromeul$
@@ -300,6 +306,7 @@ localf cutgrs$
 localf mcgrs$
 localf mc2grs$
 localf mcmgrs$
+localf spslm$
 localf anal2sp$
 localf delopt$
 localf str_char$
@@ -346,6 +353,11 @@ localf getbygrs$
 localf mcop$
 localf shiftop$
 localf conf1sp$
+localf confexp$
+localf confspt$
+localf mcvm$
+localf s2csp$
+localf partspt$
 localf pgen$
 localf diagm$
 localf mgen$
@@ -380,6 +392,7 @@ localf varargs$
 localf ptype$
 localf pfargs$
 localf average$
+localf tobig$
 localf sint$
 localf frac2n$
 localf xyproc$
@@ -411,6 +424,7 @@ localf xyarrow$
 localf xyarrows$
 localf xyang$
 localf xyoval$
+localf xypoch$
 localf ptcommon$
 localf ptcopy$
 localf ptaffine$
@@ -456,11 +470,12 @@ extern Canvas$
 extern ID_PLOT$
 extern Rand$
 extern LQS$
+extern 	SV=SVORG$
 #endif
 static S_Fc,S_Dc,S_Ic,S_Ec,S_EC,S_Lc$
 static S_FDot$
 extern AMSTeX$
-Muldif.rr="00170826"$
+Muldif.rr="00190620"$
 AMSTeX=1$
 TeXEq=5$
 TeXLim=80$
@@ -479,6 +494,7 @@ LCOPT=["red","green","blue","yellow","cyan","magenta",
 COLOPT=[0xff,0xff00,0xff0000,0xffff,0xffff00,0xff00ff,0,0xffffff,0xc0c0c0]$
 LPOPT=["above","below","left","right"]$
 LFOPT=["very thin","thin","dotted","dashed"]$
+SVORG=["x","y","z","w","u","v","p","q","r","s"]$
 Canvas=[400,400]$
 LQS=[[1,0]]$
 
@@ -618,6 +634,7 @@ def mycat(L)
 		Do = 1;
 	}
 	if(CR) print("");
+	else print("",2);
 }
 
 def fcat(S,X)
@@ -656,6 +673,7 @@ def mycat0(L,T)
 		Do = 1;
 	}
 	if(T) print("");
+	else print("",2);
 }
 
 def findin(M,L)
@@ -883,6 +901,7 @@ def mulsubst(F,L)
 	if(N == 0)
 		return F;
 	if(type(L[0])!=4)	L=[L];
+	if(getopt(lpair)==1||(type(L[0])==4&&length(L[0])>2)) L=lpair(L[0],L[1]);
 	if(getopt(inv)==1){
 		for(R=[];L!=[];L=cdr(L)) R=cons([car(L)[1],car(L)[0]],R);
 		L=reverse(R);
@@ -1259,20 +1278,33 @@ def mulseries(V1,V2)
 
 def scale(L)
 {
-	T=0;LS=1;
+	T=F=0;LS=1;
 	Pr=getopt(prec);
-	if(type(L)!=4){
+	Inv=getopt(inv);
+	Log10=dlog(10);
+	if(type(L)==7){
+		V=findin(L,["CI","DI","CIF","CIF'","DIF","DIF'","SI","TI1","TI2","STI"]);
+		if(V>=0){
+			L=["C","D","CF","CF'","DF","DF'","S","T1","T2","ST"];
+			Inv=1;L=L[V];
+		}
+		V=findin(L,["C","A","K","CF","CF'","S","T1","T2","ST","LL0","LL1","LL2","LL3","LL00",
+			"LL01","LL02","LL03"])+1;
+		if(V==0) V=findin(L,["D","B","K","DF","DF'"])+1;
+		if(V>0) L=V;
+	}
+	if(type(OL=L)!=4){
 		if(L==2){
-			L=(Pr!=1)?
+			L=(Pr==0)?
 			  [[[1,2,1/20],[2,5,1/10],[5,10,1/5], [10,20,1/2],[20,50,1],[50,100,2]],
     		   [[1,2,1/10],[2,5,1/2], [10,20,1],[20,50,5]],
     		   [[1,2,1/2],[2,10,1], [10,20,5],[20,100,10]]]:
 			   [[[1,2,1/50],[2,5,1/20],[5,10,1/10], [10,20,1/5],[20,50,1/2],[50,100,1]],
 				[[1,5,1/10],[5,10,1/2], [10,20,1],[50,100,5]],
 				[[1,5,1/2],[5,10,1], [10,50,5],[50,100,10]]];
-			LS=2;
+			LS=2;M2=[[1,10,1],[10,100,10]];
 		}else if(L==3){
-			L=(Pr!=1)?
+			L=(Pr==0)?
 			  [[[1,2,1/20],[2,5,1/10],[5,10,1/5], [10,20,1/2],[20,50,1],[50,100,2],
                   [100,200,5],[200,500,10],[500,1000,20]],
     			[[1,2,1/10],[2,5,1/2], [10,20,1],[20,50,5], [100,200,10],[200,500,50]],
@@ -1280,16 +1312,100 @@ def scale(L)
 			  [[[1,2,1/50],[2,5,1/20],[5,10,1/10],[10,20,1/5],[20,50,1/2],[50,100,1], 
 			      [100,200,2],[200,500,5],[500,1000,10]],
 				[[1,5,1/10],[5,10,1/2], [10,50,1],[50,100,5], [100,500,10],[500,1000,50]],
-				[[1,5,1/2],[5,10,1], [10,50,5],[50,100,10], [100,500,50],[500,1000,100]]];
-			LS=3;
+				[[1,5,1/2],[5,10,1],[10,50,5],[50,100,10], [100,500,50],[500,1000,100]]];
+			LS=3;M2=[[1,5,1],[10,50,10],[100,500,100],[500,1000,500]];
+		}else if(L>9&&L<18){
+			if(L<18){	/* LL0 - LL3, LL00 - LL03 */
+				if(L==10){
+					L=[ [[1.001,1.002,0.00001],[1.002,1.005,0.00002],[1.005,1.0105,0.00005]],
+						[[1.001,1.002,0.00005],[1.002,1.005,0.0001], [1.005,1.0105,0.0001]],
+						[[1.001,1.002,0.0001],[1.002,1.005,0.0005], [1.005,1.0105,0.0005]]];
+					M2=[1.001,1.0015,1.002,1.003,1.004,1.005,1.006,1.007,1.008,1.009,1.01];
+				}
+				if(L==11){
+					L=[ [[1.01,1.02,0.0001],[1.02,1.05,0.0002],[1.05,1.105,0.0005]],
+						[[1.01,1.02,0.0005],[1.02,1.05,0.001], [1.05,1.105,0.001]],
+						[[1.01,1.02,0.001],[1.02,1.05,0.005], [1.05,1.105,0.005]]];
+					M2=[1.01,1.015,1.02,1.03,1.04,1.05,1.06,1.07,1.08,1.09,1.10];
+				}else if(L==12){
+					L=[ [[1.105,1.2,0.001],[1.2,1.4,0.002],[1.4,1.8,0.005],[1.8,2.5,0.01],
+					      [2.5,2.72,0.02]],
+						[[1.105,1.2,0.005],[1.2,1.4,0.01],[1.4,1.8,0.01],[1.8,2.5,0.05],
+					      [2.5,2.72,0.1]],
+						[[1.105,1.2,0.01],[1.2,1.4,0.05],[1.4,1.8,0.05],[1.8,2.5,0.1],
+					      [2.5,2.72,0.1]]];
+					M2=[1.11,1.15,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9,2.0,2.2,2.5];
+				}else if(L==13){
+					L=[ [[2.72,4,0.02],[4,6,0.05],[6,10,0.1],[10,15,0.2],[15,30,0.5],[30,50,1],
+						 [50,100,2],[100,200,5],[200,400,10],[400,500,20],[500,1000,50],
+						 [1000,2000,100],[2000,5000,200],[5000,10000,500],[10000,22000,1000]],
+						[[2.7,4,0.1],[4,6,0.1],[6,10,0.5],[10,15,1],[15,30,1],[30,50,5],
+						 [50,100,10],[100,200,10],[200,400,50],[400,500,100],[500,1000,100],
+						 [1000,2000,500],[2000,5000,1000],[5000,10000,1000],[10000,22000,5000]],
+						[[3,4,0.5],[4,6,0.5],[6,10,1],[10,15,5],[15,30,5],[30,50,10],
+						 [50,100,50],[100,200,50],[200,400,100],[400,500,100],[500,1000,500],
+						 [1000,2000,1000],[2000,5000,3000],[5000,10000,5000],[10000,22000,10000]]];
+					M2=[3,4,5,6,7,8,9,10,15,20,30,40,50,100,200,500,1000,2000,5000,10000,20000];
+				}else if(L==14){
+					L=[ [[0.998,0.999,0.00001],[0.995,0.998,0.00002],[0.99,0.995,0.00005]],
+						[[0.998,0.999,0.00005],[0.995,0.998,0.0001],[0.99,0.995,0.0001]],
+						[[0.998,0.999,0.0001],[0.995,0.998,0.0005],[0.99,0.995,0.0005]]];
+					M2=[0.999,0.9985,0.998,0.997,0.996,0.995,0.994,0.993,0.992,0.991,0.99];
+				}else if(L==15){
+					L=[ [[0.98,0.9901,0.0001],[0.95,0.98,0.0002],[0.905,0.95,0.0005]],
+						[[0.98,0.99,0.0005],[0.95,0.98,0.001], [0.905,0.95,0.001]],
+						[[0.98,0.99,0.001],[0.95,0.98,0.005], [0.91,0.95,0.005]]];
+					M2=[0.99,0.985,0.98,0.97,0.96,0.95,0.94,0.93,0.92,0.91];
+				}else if(L==16){
+					L=[ [[0.8,0.906,0.001],[0.6,0.8,0.002],[0.37,0.6,0.005]],
+						[[0.8,0.906,0.005],[0.6,0.8,0.01],[0.37,0.6,0.01]],
+						[[0.8,0.9,0.01],[0.6,0.8,0.05],[0.4,0.6,0.05]]];
+					M2=[0.9,0.85,0.8,0.75,0.7,0.65,0.6,0.55,0.5,0.45,0.4];
+				}else{
+					L=[ [[0.05,0.37,0.002],[0.02,0.05,0.001],[0.01,0.02,0.0005],
+						 [0.005,0.01,0.0002],[0.001,0.005,0.0001],
+						 [0.0005,0.001,0.00002],[0.0001,0.0005,0.00001],[0.00005,0.0001,0.000002]],
+						[[0.05,0.37,0.01],[0.02,0.05,0.002],[0.01,0.02,0.001],
+						 [0.005,0.01,0.001],[0.001,0.005,0.0002],
+						 [0.0005,0.001,0.0001],[0.0001,0.0005,0.00002],[0.00005,0.0001,0.00001]],
+						[[0.05,0.37,0.05],[0.02,0.05,0.01],[0.01,0.02,0.005],
+						 [0.005,0.01,0.005],[0.002,0.005,0.001],
+						 [0.0005,0.001,0.0005],[0.0001,0.0005,0.0001],[0.00005,0.0001,0.00005]]];
+					M2=[0.3,0.2,0.1,0.05,0.03,0.02,0.01,0.005,0.002,0.001,0.0005,0.0002,0.0001];
+				}
+			}
 		}else{
-			L=(Pr!=1)?
-			   [[[1,2,1/50],[2,5,1/20],[5,10,1/10]],
-				[[1,5,1/10],[5,10,1/2]],
-				[[1,5,1/2],[5,10,1]]]:
-			   [[[1,2,1/100],[2,5,1/50],[5,10,1/20]],
-			    [[1,2,1/20],[2,10,1/10]],
-			    [[1,2,1/10],[2,10,1/2]]];
+			if(L==6){	/* S */
+				L=[ [[6-3/12,15,1/12],[15,30,1/6],[30,50,1/3],[50,70,1/2],[70,80,1],[80,90,5]],
+					[[6-1/6,15,1/6],[15,30,1/2],[30,70,1],[70,80,5],[80,90,10]],
+					[[6,15,1/2],[15,30,1],[30,70,5],[70,90,10]] ];
+				M2=[6,7,8,9,10,15,20,30,40,50,60,70,90];
+			}else if(L==7){ /* T1 */
+				F=log(tan(x*3.1416/180))/Log10+1;
+				L=[ [[6-1/3,15,1/12],[15,45,1/6]],
+					[[6-1/3,15,1/6],[15,45,1/2]],
+					[[6,45,1]] ];
+				M2=[6,7,8,9,10,15,20,30,40,45];
+			}else if(L==8){	/* T2 */
+				L=[ [[45,75,1/6],[75,84+1/6,1/12]],
+					[[45,75,1],[75,84+1/6,1/6]],
+					[[45,84,1]] ];
+				M2=[45,50,60,70,75,80,81,82,83,84];
+			}else if(L==9){	/* ST */
+				L=[ [[35/60,1,1/120],[1,2,1/60],[2,5+9/12,1/30]],
+					[[35/60,1,1/60],[1,2,1/6],[2,5+9/12,1/6]],
+					[[40/60,1,1/6],[1,2,1/2],[2,5+9/12,1]] ];
+				M2=[1,2,3,4,5];
+			}else{
+				M2=(L==4||L==5)?[[1,2,1/2],[2,9,1]]:[[1,2,1/2],[2,10,1]];
+				L=(Pr==0)?
+			  	[ [[1,2,1/50],[2,5,1/20],[5,10,1/10]],
+				  [[1,5,1/10],[5,10,1/2]],
+				  [[1,5,1/2],[5,10,1]] ]:
+				[[[1,2,1/100],[2,5,1/50],[5,10,1/20]],
+			      [[1,2,1/20],[2,10,1/10]],
+			      [[1,2,1/10],[2,10,1/2]] ];
+			}
 		}
 	}else if(type(L[0])!=4){
 		L=[L];
@@ -1319,15 +1435,34 @@ def scale(L)
 	}else return T;
 	if(type(D=getopt(shift))==4){
 		D0=D[0];D1=D[1];
+	}else if(type(D)<2&&type(D)>=0){
+		D0=0;D1=D;
+	};
+	if(Inv==1){
+		D0+=S0;S0=-S0;
 	}
-	if(type(F=getopt(f))>1) F=f2df(F);
-	else F=0;
+	if(type(TF=getopt(f))>1) F=TF;
+	if(F) F=f2df(F);
+	if(type(I=getopt(ol))==1&&OL>3) OL=I;
 	for(M=M0=[],I=length(T);T!=[];T=cdr(T),I--){
 		for(S=car(T);S!=[];S=cdr(S)){
-			V=((!F)?dlog(car(S))/dlog(10)/LS:myfdeval(F,car(S)))*S0;
+			VS=car(S);
+			if(F) V=myfdeval(F,car(S));
+			else if(OL==4) V=frac(dlog(VS)/Log10+0.5);
+			else if(OL==5) V=frac(dlog(VS*3.1416)/Log10);
+			else if(OL>5&&OL<10){
+				VS=VS*3.1416/180;
+				if(OL==6) V=dlog(dsin(VS))/Log10+1;
+				else if(OL==9) V=dlog(VS)/Log10+2;
+				else V=dlog(dtan(VS))/Log10+8-OL; 
+			}
+			else if(OL>9&&OL<14) V=dlog(dlog(VS))/Log10+13-OL;
+			else if(OL>13&&OL<18) V=dlog(-dlog(VS))/Log10+17-OL;
+			else V=dlog(VS)/Log10/LS;
+			V*=S0;
 			if(S1!=0){
 				M=cons([V+D0,D1],M);
-				M=cons([V+D0,I*((length(SC)>2)?SC[I]:S1)+D1],M);
+				M=cons([V+D0,((length(SC)>2)?SC[I]:(I*S1))+D1],M);
 				M=cons(0,M);
 			}else M0=cons(V+D0,M0);
 		}
@@ -1336,25 +1471,57 @@ def scale(L)
 	if(S1!=0) M=cdr(M);
 	if(S1==0||getopt(TeX)!=1) return M;
 	M=reverse(M);
-	if(type(U=getopt(line))==4)
+	if(type(U=getopt(line))==4){
+		if(Inv==1) U=[U[0]+S0,U[1]+S0];
 		M=cons([U[0]+D0,D1],cons([U[1]+D0,D1],cons(0,M)));
+	}
+	if((VT=getopt(vert))==1){
+		for(N=[];M!=[];M=cdr(M)){
+			if(type(TM=car(M))==4) N=cons([TM[1],TM[0]],N);
+			else N=cons(TM,N);
+		}
+		M=reverse(N);
+	}
 	if(type(Col=getopt(col))<1) S=xylines(M);
 	else S=xylines(M|opt=Col);
 	if(type(Mes=getopt(mes))==4){
+		if(length(Mes)==1&&type(M2)==4) Mes=cons(car(Mes),M2);
 		S3=car(Mes);
 		if(type(S3)==4){
 			Col=S3[1];
 			S3=car(S3);
 		}else Col=0;
 		V=car(scale(cdr(Mes)));
-		if(!F) Mes=scale(cdr(Mes)|scale=[S0/LS,0],shift=[D0,D1]);
+		if(!F) Mes=scale(cdr(Mes)|scale=[S0/LS,0],shift=[D0,D1],ol=OL);
 		else Mes=scale(cdr(Mes)|f=F,scale=[S0,0],shift=[D0,D1]);
 		for(M=car(Mes);M!=[];M=cdr(M),V=cdr(V)){
-			VT=deval(car(V));
-			if(Col!=0) VT=[Col,VT];
-			S+=xyput([car(M),S3,VT]);
+			TV=deval(car(V));
+			if(Col!=0) TV=[Col,TV];
+			S+=(VT==1)?xyput([S3+D1,car(M),TV]):xyput([car(M),S3+D1,TV]);
 		}
 	}
+	if(type(Mes=getopt(mes2))==4){
+		if(type(car(Mes))!=4) Mes=[Mes];
+		for(;Mes!=[];Mes=cdr(Mes)){
+			TM=car(Mes);
+			if(!F) V=scale([car(TM)]|scale=[S0/LS,0],shift=[D0,D1],ol=OL);
+			else V=scale([car(TM)]|f=F,scale=[S0,0],shift=[D0,D1]);
+			V=car(car(V));
+			TM=cdr(TM);
+			if(type(Col=car(TM))==4){
+				C0=Col[0];C1=Col[1];
+				if(length(Col)==3){
+					S+=(VT==1)?xyline([D1+C0,V],[D1+C1,V]|opt=Col[2])
+						:xyline([V,D1+C0],[V,D1+C1]|opt=Col[2]);
+				}else S+=(VT==1)?xyline([D1+C0,V],[D1+C1,V]):xyline([V,D1+C0],[V,D1+C1]);
+			}
+			if(type(TM[1]<2)){
+				TM=cdr(TM);
+				S3=car(TM);
+			}
+			S+=(VT==1)?xyput([S3+D1,V,TM[1]]):xyput([V,S3+D1,TM[1]]);
+		}
+	}
 	return S;
 }
 
@@ -1532,6 +1699,7 @@ def mtoupper(MM, F)
 	if(type(St = getopt(step))!=1) St=0;
 	Opt = getopt(opt);
 	if(type(Opt)!=1) Opt=0;
+	if(type(Main=getopt(main))!=1) Main=0;
 	TeX=getopt(dviout);
 	if(type(Tab=getopt(tab))!=1 && Tab!=0) Tab=2;
 	Line="\\text{line}";
@@ -1562,6 +1730,13 @@ def mtoupper(MM, F)
 			Top+=(TeX)?"\\ ":" ";
 	}
 	PC=IF=1;
+	if(Opt>3){
+		for(P=[1],K=0;K<Size[1]-F;K++){
+			for(J=0;J<Size[0];J++)
+				if(type(dn(M[J][K]))==2) P=cons(dn(M[J][K]),P);
+		}
+		PC=llcm(P|poly=1);
+	}
 	for(K = JJ = 0; K < Size[1] - F; K++){
 		for(J = JJ; J < Size[0]; J++){
 			if(M[J][K] != 0){		/* search simpler element */
@@ -1642,7 +1817,7 @@ def mtoupper(MM, F)
 								KRC=-KRC;Sgn=1;
 							}else
 								Sgn=0;
-							if(St){
+							if(St&&!Main){
 								if(TeX){
 									if(KRC==1)
 										Lout=cons([Top+"\\xrightarrow{", Line,KJ0+1,TeXs[Sgn],
@@ -1667,6 +1842,7 @@ def mtoupper(MM, F)
 				}
 			/* a parameter Var */
 				Var=0;
+/* mycat(["start",J,K]); */
 				if(St && Opt>4 && length(Var=vars(nm(M[J][K])))==1){
 					J0=J;Jv=mydeg(nm(M[J0][K]),car(Var));
 					for(I=JJ;I<Size[0]; I++){
@@ -1676,12 +1852,14 @@ def mtoupper(MM, F)
 						}
 						if(length(T)>1) continue;
 						if(mydeg(MIK,T[0])<Jv){
-							J0=I;Jv=mydeg(MIK);Var=T;	/* search minimal degree */
+							J0=I;Jv=mydeg(MIK,T[0]);Var=T;	/* search minimal degree */
 						}
 					}
 					if(length(Var)==1){
 						Var=car(Var);
 						Q=nm(M[J0][K]);
+/* mycat(["min",Q,M[J0][K],"J0=",J0,"J=",J,"JJ=",JJ,K,M]); */
+J=J0;
 						for(I=JJ; I<Size[0]; I++){
 							if(I==J0 || mydeg(nm(M[I][K]),Var)<0) continue;
 							T=rpdiv(nm(M[I][K]),Q,Var);
@@ -1692,6 +1870,7 @@ def mtoupper(MM, F)
 				if(type(Var)==2){ /* 1 variable */
 					if(I==Size[0]){
 						for(QF=0,Q0=1,QR=getroot(Q,Var|mult=1);QR!=[];QR=cdr(QR)){
+/* mycat(["root",Q,QR,PC]); */
 							if(deg(T=QR[0][1],Var)>0){
 								QF=1;Q0*=T; continue;
 							}
@@ -1702,10 +1881,10 @@ def mtoupper(MM, F)
 								if(TeX){
 									Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }",
 										Var,"=",T,","] ,Lout);
-									Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab),Lout);
+									Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab,main=Main),Lout);
 								}else{
 									mycat([str_times(" ",St-1)+"If",Var,"=",T,","]);
-									mtoupper(M0,F|step=St+1,opt=Opt);
+									mtoupper(M0,F|step=St+1,opt=Opt,main=Main);
 								}
 							}
 						}
@@ -1722,11 +1901,13 @@ def mtoupper(MM, F)
 						KRC=-red((T[2]*dn(M[J0][K]))/(T[1]*dn(M[I][K])));
 						for(II=K;II<Size[1];II++)
 							M[I][II]=radd(M[I][II],rmul(M[J0][II],KRC));
-						if(TeX)
-							Lout=cons([Top+"\\xrightarrow{", Line,I+1,"\\ +=\\ ",Line,
-								J0+1,"\\times\\left(",KRC,"\\right)}",dupmat(M)],Lout);
-						else
-							mycat([Top+"line",I+1,"+=",Line,J0+1," * (",KRC,")\n",M,"\n"]);
+						if(!Main){
+							if(TeX)
+								Lout=cons([Top+"\\xrightarrow{", Line,I+1,"\\ +=\\ ",Line,
+									J0+1,"\\times\\left(",KRC,"\\right)}",dupmat(M)],Lout);
+							else
+								mycat([Top+"line",I+1,"+=",Line,J0+1," * (",KRC,")\n",M,"\n"]);
+						}
 						J=JJ-1;
 						continue;
 					}
@@ -1761,11 +1942,11 @@ def mtoupper(MM, F)
 									if(TeX){
 										Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }",
 											X,"=",T,","] ,Lout);
-										Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab),
+										Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab,main=Main),
 											Lout);
 									}else{
 										mycat([str_times(" ",St-1)+"If",X,"=",T,","]);
-										mtoupper(M0,F|step=St+1,opt=Opt);
+										mtoupper(M0,F|step=St+1,opt=Opt,main=Main);
 									}
 									break;
 								}
@@ -1792,11 +1973,11 @@ def mtoupper(MM, F)
 											if(TeX){
 												Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }",
 													X0,"=",T0,","] ,Lout);
-												Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab),
+												Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab,main=Main),
 													Lout);
 											}else{
 												mycat([str_times(" ",St-1)+"If",X0,"=",T0,","]);
-												mtoupper(M0,F|step=St+1,opt=Opt);
+												mtoupper(M0,F|step=St+1,opt=Opt,main=Main);
 											}
 										}
 										
@@ -1840,7 +2021,7 @@ def mtoupper(MM, F)
 						for(I = K+1; I < Size[1]; I++)
 							M[J][I] = radd(M[J][I],rmul(M[JJ][I],Mul));
 						M[J][K] = 0;
-						if(St){
+						if(St&&!Main){
 							if(Mul<0){
 								Mul=-Mul;Sgn=0;
 							}else	Sgn=1;
@@ -2069,8 +2250,12 @@ def vgen(V,W,S)
 def mmc(M,X)
 {
 	Mt=getopt(mult);
-	if(type(M)==7) M=os_md.s2sp(M);
-	if(type(M)!=4||type(M[0])!=6) return 0;
+	if(type(M)==7) M=s2sp(M);
+	if(type(M)!=4) return 0;
+	if(type(M[0])<=3){
+		for(RR=[];M!=[];M=cdr(M)) RR=cons(mat([car(M)]),RR);
+		M=reverse(RR);
+	}
 	if(type(M[0])!=6){			/* spectre type -> GRS */
 		G=s2sp(M|std=1);
 		L=length(G);
@@ -3179,6 +3364,16 @@ def llbase(VV,L)
 	return V;
 }
 
+def rsort(L,T,K)
+{
+	for(R=[];L!=[];L=cdr(L))
+		R=cons((type(car(L))==4)?rsort(car(L),T-1,K):car(L),R);
+	if(T>0||iand(T,iand(K,2)/2)) return reverse(R);
+	R=qsort(R);
+	return (iand(K,1))? reverse(R):R;
+}
+
+
 def lsort(L1,L2,T)
 {
 	C1=getopt(c1);C2=getopt(c2);
@@ -4796,6 +4991,7 @@ def myswap(P,L)
 def mysubst(P,L)
 {
 	if(P==0) return 0;
+	if(getopt(lpair)==1||(type(L[0])==4&&length(L[0])>2)) L=lpair(L[0],L[1]);
 	Inv=getopt(inv);
 	if(type(L[0]) == 4){
 		while((L0 = car(L))!=[]){
@@ -4991,11 +5187,11 @@ def muldo(P,Q,L)
 def jacobian(F,X)
 {
 	F=ltov(F);X=ltov(X);
-	N=length(F);
-	M=newmat(N,N);
+	N=length(F);L=length(X);
+	M=newmat(N,L);
 	for(I=0;I<N;I++)
-		for(J=0;J<N;J++) M[I][J]=red(diff(F[I],X[J]));
-	if(getopt(mat)==1) return M;
+		for(J=0;J<L;J++) M[I][J]=red(diff(F[I],X[J]));
+	if(N!=L||getopt(mat)==1) return M;
 	return mydet(M);
 }
 
@@ -5261,6 +5457,12 @@ def mulpdo(P,Q,L);
 
 def transpdosub(P,LL,K)
 {
+	if(type(P)>3) return 
+#ifdef	USEMODULE
+		mtransbys(os_md.transpdosub,P,[LL,K]);
+#else
+		mtransbys(transpdosub,P,[LL,K]);
+#endif
 	Len = length(K)-1;
 	if(Len < 0 || P == 0)
 		return P;
@@ -5286,12 +5488,11 @@ def transpdosub(P,LL,K)
 
 def transpdo(P,LL,K)
 { 
-	if(type(K[0]) < 4)
-		K = [K];
 	Len = length(K)-1;
 	K1=K2=[];
 	if(type(LL)!=4) LL=[LL];
 	if(type(LL[0])!=4) LL=[LL];
+	if(type(car(K)) < 4 && length(LL)!=length(K)) K = [K];
 	if(getopt(ex)==1){
 		for(LT=LL, KT=K; KT!=[]; LT=cdr(LT), KT=cdr(KT)){
 			L = vweyl(LL[J]);
@@ -5300,10 +5501,25 @@ def transpdo(P,LL,K)
 		}
 		K2=append(K1,K2);
 	}else{
+		if(length(LL)==length(K) && type(car(K))!=4){
+			for(DV=V=TL=[],J=length(LL)-1;J>=0;J--){
+				TL=cons(vweyl(LL[J]),TL);
+				V=cons(car(TL)[0],V);
+				DV=cons(car(TL)[1],DV);
+			}
+			LL=TL;
+			if(type(RK=solveEq(K,V|inv=1))!=4) return TK;
+			if(!isint(Inv=getopt(inv))) Inv=0;
+			if(iand(Inv,1)){J=K;K=RK;RK=J;} 
+			M=jacobian(RK,V|mat=1);
+			M=mulsubst(M,[V,K]|lpair=1);
+			RK=vtol(M*ltov(DV));
+			if(Inv>1) return RK;
+			K=lpair(K,RK);
+		}
 		for(J = length(K)-1; J >= 0; J--){
 			L = vweyl(LL[J]);
-			if(L[0] != K[J][0])
-				K1 = cons([L[0],K[J][0]],K1);
+			if(L[0]!= K[J][0]) K1=cons([L[0],K[J][0]],K1);
 			K2 = cons(K[J][1],K2);
 		}
 		P = mulsubst(P, K1);
@@ -5356,7 +5572,8 @@ def texbegin(T,S)
 {
 	if(type(Opt=getopt(opt))==7) Opt="["+Opt+"]\n";
 	else Opt="\n";
-	return "\\begin{"+T+"}"+Opt+S+"%\n\\end{"+T+"}\n";
+	U=(str_chr(S,str_len(S)-1,"\n")<0)?"%\n":"";
+	return "\\begin{"+T+"}"+Opt+S+U+"\\end{"+T+"}\n";
 }
 
 def mygcd(P,Q,L)
@@ -5998,6 +6215,307 @@ def seriesTaylor(F,N,V)
 	return F;
 }
 
+def mulpolyMod(P,Q,X,N)
+{
+	Red=(type(P)>2||type(Q)>2)?1:0;
+	for(I=R=0;I<=N;I++){
+		P0=mycoef(P,I,X);
+		for(J=0;J<=N-I;J++){
+			R+=P0*mycoef(Q,J,X)*X^(I+J);
+			if(Red) R=red(R);
+		}
+	}
+	return R;
+}
+
+def solveEq(L,V)
+{
+	Inv=0;K=length(V);
+	H=(getopt(h)==1)?1:0;
+	if(getopt(inv)==1){
+		if(K!=length(L)) return -5;
+		Inv=1;
+		VN=makenewv(vars(L)|num=K);
+		for(TL=[],I=K-1;I>=0;I--) TL=cons(VN[I]-L[I],TL);
+		S=solveEq(TL,V|h=H);
+		if(type(S)!=4) return S;
+		return mysubst(S,[VN,V]|lpair=1);
+	}
+	for(TL=[];L!=[];L=cdr(L)) TL=cons(nm(red(car(L))),TL);
+	S=gr(TL,reverse(V),2);
+	if(length(S)!=K) return -1;
+	for(R=[],I=F=0;I<K;I++){
+		TS=S[I];
+		VI=lsort(vars(TS),V,2);
+		if(length(VI)!=1) return -2;
+		if((VI=car(VI))!=V[I]) return -3;
+		if(mydeg(TS,VI)!=1){
+			F=1;R=cons([VI,TS],R);
+		}else R=cons(-red(mycoef(TS,0,VI)/mycoef(TS,1,VI)),R);
+	}
+	R=reverse(R);
+	if(!F||H==1) return R;
+	return -4;
+}
+
+/* Opt: f, var, ord, to, in, TeX */
+def baseODE(L)
+{
+	SV=SVORG;
+	if(type(TeX=getopt(TeX))!=1) TeX=0;
+	if(type(F=getopt(f))!=1) F=0;
+	if(isint(In=getopt(in))!=1) In=0;
+	if(type(Ord=getopt(ord))!=1&&Ord!=0) Ord=2;
+	if(Ord>3){
+		Ord-=4; Hgr=1;
+	}else Hgr=0;
+	if(type(car(L))==4&&type(L[1])==7){
+		Tt=L[1];L=car(L);
+	}
+	M=N=length(L);	SV=SVORG;
+	if(type(Var=getopt(var))==4&&(In>0||length(Var)==N)){
+		SV=Var;
+		M=length(SV);
+		if(type(car(SV))==2){
+			for(R=[];SV!=[];SV=cdr(SV)) R=cons(rtostr(car(SV)),R);
+			SV=reverse(R);
+		}
+	}else{
+		if(N>10){
+			R=[];
+			for(K=M-1;K>9;K++) R=cons(SV[floor(K/10)-1]+SV[K%10],R);
+			SV=append(SV,R);
+		}
+		for(Var=[],I=M-1;I>=0;I--) Var=cons(makev([SV[I]]),Var);
+	}
+	if(type(To=getopt(to))<2||type(To)>4) To=0;
+	else if(!isvar(To)){
+		if(type(To)!=4){
+			To=red(To);
+			for(K=0;K<length(Var);K++){
+				I=mydeg(nm(To),Var[K]);J=mydeg(dn(To),Var[K]);
+				if(I+J>0&&I<2&&J<2) break;
+			}
+			if(K==length(Var)) return -9;
+			J=To;
+			for(To=[],I=length(Var)-1;I>=0;I--)
+				if(I!=K) To=cons(Var[I],To);
+			To=cons(J,To);
+		}
+		if(type(To)==4){
+			if(type(car(To))==4){
+				R=1;To=car(To);
+			}else R=0;
+			if(type(IL=solveEq(To,Var|inv=1))!=4) return IL;
+			if(R==1){
+				R=To;To=IL;IL=R;
+			}
+			L=mulsubst(L,[Var,IL]|lpair=1);
+			if(!In){   /* X_i'=\sum_j(\p_{x_j}X_i)*x_j' */
+				for(TL=[],I=M-1;I>=0;I--){
+					P=To[I];Q=mydiff(P,t);
+					for(J=0;J<M;J++) Q=red(Q+mydiff(P,Var[J])*L[J]);
+					TL=cons(Q,TL);
+				}
+				L=TL;
+			}else{	/* x_i'=\sum_j(\p_{X_j}x_i)*X_j' */
+				for(I=M-1;I>=0;I--){
+					P=IL[I];Q=mydiff(P,t);
+					for(J=0;J<M;J++){
+						V=makev([SV[J],1]);
+						Q=red(Q+mydiff(P,V)*V);
+					}
+					L=mysubst(L,[makev([SV[I],1]),TL[I]]);
+				}
+				for(TL=L,L=[],I=M-1;I>=0;I--) L=cons(num(TL[I]),L);
+			}
+		}
+	}
+	if(F==-3) return [Var,L];
+	for(I=0;I<M;I++) L=subst(L,Var[I],makev([SV[I],0]));
+	if(TeX){
+		for(TL=L,I=0;I<M;I++) 
+			TL=subst(TL,makev([SV[I],0]),Var[I]);
+		for(I=0;I<N;I++){
+			if(I) S0+=",\\\\\n";
+			if(In) S0+=" "+my_tex_form(TL[I])+"=0";
+			else S0+=" "+SV[I]+"'\\!\\!\\! &= "+my_tex_form(TL[I]);
+		}
+		S0+=".\n";
+		S0=texbegin("cases", S0);
+		S0=texbegin("align",S0);
+		if(type(Tt)==7) S0=Tt+"\n"+S0;
+		if(F<0){
+			if(TeX==2) dviout(S0);
+			return S0;
+		}
+	}
+	for(I=0,TL=[];L!=[];L=cdr(L),I++){
+		T=car(L);
+		if(!In) T=makev([SV[I],1])-T;
+		TL=cons(nm(red(T)),TL);
+	}
+	if(isvar(To)){
+		T=rtostr(To);
+		IT=findin(T,SV);
+		if(IT>=0 && IT<M){
+			R=[SV[IT]];
+			for(J=0;SV!=[];SV=cdr(SV),J++){
+				if(J==IT) continue;
+				R=cons(car(SV),R);
+			}
+			SV=reverse(R);
+		}else{
+			IT=0;
+			mycat(["Cannot find variable", T, "!\n"]);
+		}
+	}
+	for(S=1;S<M;S++){
+		L=append(TL,L);
+		TL=reverse(TL);
+		for(RL=[];TL!=[];TL=cdr(TL)){
+			if(In==0&&S==N-1&&length(TL)!=N-IT) continue;
+			T=car(TL);R=mydiff(V,t);
+			for(I=0;I<M;I++){
+				for(J=0;J<=S;J++){
+					V=makev([SV[I],J]|num=1);
+					if((DR=mydiff(T,V))!=0) R+=DR*makev([SV[I],J+1]|num=1);
+				}
+			}
+			RL=cons(R,RL);
+		}
+		TL=RL;
+	}
+	L=append(TL,L);
+	for(I=0;I<M;I++) L=subst(L,makev([SV[I],0]),Var[I]);
+	for(V=VV=[],I=0;I<M;I++){
+		for(J=0;J<M;J++) V=cons(J?makev([SV[I],J]):makev([SV[I]]),V);
+		if(!I||In) V=cons(makev([SV[0],M]),V);
+		if(F==-2){
+			VV=cons(V,VV);
+			V=[];
+		}
+	}
+	if(F>=0&&!chkfun("gr",0)){
+		mycat("load(\"gr\"); /* <- do! */\n");
+		F=-1;
+	}
+	if(F==-2) return [VV,L];
+	if(F<0) return [V,L];
+	 LL=(Hgr==1)?hgr(L,V,Ord):gr(L,V,Ord);
+	if(F==2) return [V,L,LL];
+	if(Ord==2) P=LL[0];
+	else{
+		P=LL[length(LL)-1];
+		for(RV=reverse(V), I=0;I<M+1;I++) RV=cdr(RV);
+		if(lsort(vars(P),RV,2)!=[]){
+			LL=tolex_tl(LL,V,Ord,V,2);P=LL[0];
+		}
+	}
+	V0=makev([car(SV),M]);
+	CP=mycoef(P,mydeg(P,V0),V0);
+	if(cmpsimple(-CP,CP)<0) P=-P;
+	if(TeX){
+		for(V0=[makev([car(SV)])],I=1;I<=M;I++) V0=cons(makev([car(SV),I]),V0);
+		T="&\\!\\!\\!"+fctrtos(P|var=VV,dic=1,TeX=3);
+		S=((F==1)?(Tt+"\n"):S0)+texbegin("align*",texbegin("split",T));
+		if(TeX==2) dviout(S);
+		return S;
+	}
+	return (F==1)? P:[P,V,L,LL];
+}
+
+def taylorODE(D){
+	Dif=(getopt(dif)==1)?1:0;
+	if(D==0) return Dif?f:f_00;
+	if(type(T=getopt(runge))!=1||ntype(T)!=0) T=0;
+	if(type(F=getopt(f))!=7&&type(F)<2) F="f_";
+	if(type(D)!=1||ntype(D)!=0||D<0||D>30) return 0;
+	if(type(H=getopt(taylor))==4&&length(H)==2){
+		if(type(Lim=getopt(lim))==2) DD=D;
+		else if(type(Lim)==4){
+			DD=Lim[1];Lim=Lim[0];
+		}else Lim=0;
+		for(R=I=0;I<=D;I++){
+			if(I){
+				if(Lim) H0=mulpolyMod(H0,H[0],Lim,DD);
+				else H0*=H[0];
+			}else  H0=1;
+			if(type(F)!=7) G=I?mydiff(G,x):F;
+			for(J=0;J<=D-I;J++){
+				if(J){
+					if(Lim) H1=mulpolyMod(H1,H[1],Lim,DD);
+					else H1*=H[1];
+				}else H1=H0;
+				if(type(F)==7) G=makev([F,I,J]);
+				else if(J) G=mydiff(G,y);
+				R+=G*H1/fac(I)/fac(J);
+			}
+		}
+		if(Lim) R=os_md.polcut(R,DD,Lim);
+		return R;
+	}else{
+		if(type(H=getopt(series))>=0||getopt(list)==1){
+			if(type(F)!=7){
+				for(PP=[F],I=1;I<D;I++)
+					PP=cons(mydiff(car(PP),x)+mydiff(car(PP),y)*F,PP);
+				if(type(H)<0) return PP;
+				for(R=0,DD=D;DD>=1;DD--,PP=cdr(PP)) R+=car(PP)*H^DD/fac(DD);
+				return red(R);
+			}
+			if(type(H)>=0) D--;
+			PP=taylorODE(D-1|list=1);
+			if(type(PP)!=4) PP=[PP];
+			P=car(PP);
+		}else P=taylorODE(D-1);
+		for(R=I=0;I<D;I++){
+			for(J=0;J<D-I;J++){
+				Q=diff(P,makev([F,I,J]));
+				if(Q!=0) R+=Q*(f_00*makev([F,I,J+1])+makev([F,I+1,J]));
+			}
+		}
+		if(getopt(list)==1){
+			R=cons(R,PP);
+			if(Dif!=1) return R;
+		}else if(type(H)>=0){
+			R=y+R*H^(D+1)/fac(D+1);
+			for(DD=D;DD>0;PP=cdr(PP),DD--) R+=car(PP)*H^(DD)/fac(DD);
+			if(T){
+				if(T<0){
+					Dif=0;TT=-T;
+				}else TT=T;
+				K=newvect(TT);K[0]=Dif?f:f_00;
+				if(getopt(c1)==1) K[0]=taylorODE(D|taylor=[c_1*H,0]);
+				for(I=1;I<TT;I++){
+					for(S=J=0;J<I;J++) S+=makev(["a_",I+1,J+1])*K[J];
+					K[I]=taylorODE(D|taylor=[makev(["c_",I+1])*H,S*H],lim=[H,D]);
+				}
+				for(S=I=0;I<TT;I++) S+=makev(["b_",I+1])*K[I];
+				S=S*H+y;
+				R=S-R;
+				if(T<0){
+					for(V=[H],I=0;I<=D;I++)
+						for(J=0;J<=D-I;J++) V=cons(makev([F,I,J]),V);
+					return os_md.ptol(R,reverse(V)|opt=0);
+				}
+			}else T=0;
+		}
+	}
+	if(Dif){
+		for(I=0;I<=D;I++){
+			for(J=0;J<=D;J++){
+				if(I==0&&J==0){
+					R=subst(R,f_00,f);
+					continue;
+				}
+				V=makev([F,str_times("x",I),str_times("y",J)]);
+				R=subst(R,makev([F,I,J]),V);
+			}
+		}
+	}
+	return R;
+}
+
 def toeul(F,L,V)
 {
 	L = vweyl(L); 
@@ -6465,6 +6983,10 @@ def expat(F,L,V)
 
 def polbyroot(P,X)
 {
+	if(isvar(V=getopt(var))&&length(P)>1&&isint(car(P))){
+		for(Q=[],I=car(P);I<=P[1];I++) Q=cons(makev([V,I]),Q);
+		P=Q;
+	}
 	R = 1;
 	while(length(P)){
 		R *= X-car(P);
@@ -7534,6 +8056,12 @@ def calc(X,L)
 	return X;
 }
 
+def tobig(X)
+{
+	if((type(X)==1 && ntype(X)==3)||type(X)>3) return X;
+	return eval(X*exp(0));
+}
+
 def isint(X)
 {
 	if(X==0||(type(X)==1 && ntype(X)==0 && dn(X)==1)) return 1;
@@ -7779,6 +8307,8 @@ def spgen(MO)
 	if(F!=1&&F!=-1) F=0;
 	if(type(LP)==4){
 		L0=LP[0]; L1=LP[1];
+	}else if(type(LP)==1){
+		L0=L1=LP;
 	}else{
 		L0=0; L1=MO+1;
 	}
@@ -8069,7 +8599,7 @@ def chkspt(M)
 	Opt= getopt(opt);
 	Mat= getopt(mat);
 	if(type(M)==7) M=s2sp(M);
-	if(type(Opt) >= 0){
+	if(type(Opt) >= 0&&Opt!="idx"){
 		if(type(Opt) == 7)
 			Opt = findin(Opt, ["sp","basic","construct","strip","short","long","sort","root"]);
 		if(Opt < 0){
@@ -8078,7 +8608,6 @@ def chkspt(M)
 		}
 		return fspt(M,Opt);
 	}
-	MR = fspt(M,1);
 	P  = length(M);
 	OD = -1;
 	XM = newvect(P);
@@ -8101,8 +8630,8 @@ def chkspt(M)
 		if(OD < 0)
 			OD = SM;
 		else if(OD != SM){
-			print("irregal partitions");
-			return 0;
+			if(getopt(dumb)!=1) print("irregal partitions");
+			return -1;
 		}
 		XM[I] = JM;
 	}
@@ -8119,13 +8648,14 @@ def chkspt(M)
 		SM += MV;
 	}
 	SM -= (P-2)*OD;
+	if(Opt=="idx") return SSM;
 	if(SM > SMM && SM != 2*OD){
-		print("not realizable");
-		return -1;
+		if(getopt(dumb)!=1) print("not realizable");
+		return 0;
 	}
 	if(JM==1 && Mat!=1)
 		Fu -= OD - SSM/2;
-	return [P, OD, SSM, Fu, SM, XM, MR];
+	return [P, OD, SSM, Fu, SM, XM, fspt(M,1)];
 }
 
 def cterm(P)
@@ -8240,7 +8770,7 @@ def redgrs(M)
 				}
 				L = cons([VM,EV], L);
 /*
-				if(R[2] >= 2){ */ /* digid */
+				if(R[2] >= 2){ */ /* rigid */
 /*          P = dx^(R[1]);
 				} */
 			}
@@ -8267,62 +8797,140 @@ def mcgrs(G, R)
 {
 	NP = length(G);
 	Mat = (getopt(mat)==1)?0:1;
+	if(Mat==0 && type(SM=getopt(slm))==4){
+		SM0=SM[0];SM1=anal2sp(SM[1],["*",-1]);
+		if(findin(0,SM0)>=0){
+			for(SM=[],I=length(G)-1;I>0;I--)
+				if(findin(I,SM0)<0) SM=cons(I,SM);
+			SM=[SM,SM1];
+			G=mcgrs(G,R|mat=1,slm=SM);
+			return [G[0],anal2sp(G[1],["*",-1])];
+		}
+	}else SM0=0;
 	for(R = reverse(R) ; R != []; R = cdr(R)){
 		GN = [];
 		L = length(G)-1;
 		RT = car(R);
 		if(type(RT) == 4){
-			RT = reverse(RT); S = 0;
-			for(G = reverse(G); G != []; G = cdr(G), L--){
-				AD = car(RT); RT = cdr(RT);
-				if(L > 0)
+			if(length(RT)==L+1&&RT[0]!=0){
+				R=cons(cdr(RT),cdr(R));
+				R=cons(RT[0],R);
+				R=cons(0,R);
+				continue;
+			}		/* addition */
+			RT = reverse(RT); S = ADS = 0;
+			for(G = reverse(G); G != []; G = cdr(G), L--, RT=cdr(RT)){
+				AD = car(RT);
+				if(L > 0){
 					S += AD;
-				else
+					if(SM && findin(L,SM0)>=0) ADS+=AD;
+				}else
 					AD = -S;
 				for(GTN = [], GT = reverse(car(G)); GT != []; GT = cdr(GT))
 					GTN = cons([car(GT)[0],car(GT)[1]+AD], GTN);
 				GN = cons(GTN, GN);
 			}
 			G = GN;
+			if(SM0){
+				for(ST=reverse(SM1),SM1=[]; ST!=[]; ST=cdr(ST))
+					SM1 = cons([car(ST)[0],car(ST)[1]+ADS], SM1);
+			}
 			continue;
 		}
-		VP = newvect(L+1); GV = ltov(G);
+		if(RT==0) continue;
+		VP = newvect(L+1); GV = ltov(G);	/* middle convolution */
 		for(I = S = OD = 0; I <= L; I++){
 			RTT = (I==0)?(Mat-RT):0;
 			VP[I] = -1;
-			for(J = M = 0, GT = GV[I]; GT != []; GT = cdr(GT), J++){
+			for(J = M = K = 0, GT = GV[I]; GT != []; GT = cdr(GT), J++){
 				if(I == 0)
 					OD += car(GT)[0];
 				if(car(GT)[1] == RTT && car(GT)[0] > M){
 					S += car(GT)[0]-M;
+					M=car(GT)[0];
 					VP[I] = J;
 				}
 			}
-			S -= (L-1)*OD;
-			for(GN = [] ; L >= 0; L--){
-				GT = GV[L];
-				RTT = (L==0)?(-RT):RT;
-				FTN = (VP[L] >= 0 || S == 0)?[]:[-S,(L==0)?(Mat-RT):0];
-				for(J = 0; GT != []; GT = cdr(GT), J++){
-					if(J != VP[L]){
-						GTN = cons([car(GT)[0],car(GT)[1]+RTT], GTN);
-						continue;
-					}
-					K = car(GT)[0] - S;
-					if(K < 0){
-						print("Not realizable");
-						return;
-					}
-					GTN = cons([K,(L==0)?(Mat-RT):0], GTN);
+		}
+		S -= (L-1)*OD;
+		for(GN = []; L >= 0; L--){
+			GT = GV[L];
+			RTT = (L==0)?(-RT):RT;
+			GTN = (VP[L]>=0 || S == 0)?[]:[[-S,(L==0)?(Mat-RT):0]];
+			for(J = 0; GT != []; GT = cdr(GT), J++){
+				if(J != VP[L]){
+					GTN = cons([car(GT)[0],car(GT)[1]+RTT], GTN);
+					continue;
 				}
-				GN = cons(reverse(GTN), GN);
+				K = car(GT)[0] - S;
+				if(K < 0){
+					print("Not realizable");
+					return;
+				}
+				if(K>0) GTN = cons([K,(L==0)?(Mat-RT):0], GTN);
 			}
+			GN = cons(reverse(GTN), GN);
 		}
+		if(SM0&&RT!=0){
+			for(M0=M1=-OD,L=length(G)-1;L>=0;L--){
+				if(findin(L,SM0)>=0){
+					M0+=OD;
+					if(VP[L]>=0) M0-=GV[L][VP[L]][0];
+				}else{
+					 M1+=OD;
+					if(VP[L]>=0) M1-=GV[L][VP[L]][0];
+				}
+			}
+			SM2=[];
+			if((Mx1=anal2sp(SM1,["max",1,-RT])[0])<0){
+				if(M1>0) SM2=cons([M1,0],SM2);
+			}else M1+=car(SM1[Mx1]);
+			if((Mx0=anal2sp(SM1,["max",1,0])[0])<0){
+				if(M0>0) SM2=cons([M0,RT],SM2);
+			}else M0+=car(SM1[Mx0]);
+			for(J=0;SM1!=[];J++,SM1=cdr(SM1)){
+				if(J==Mx0){
+					if(M0>0) SM2=cons([M0,-RT],SM2);
+				}else if(J==Mx1){
+					if(M1>0) SM2=cons([M1,0],SM2);
+				}else SM2=cons([car(SM1)[0],car(SM1)[1]+RT],SM2);
+			}
+			SM1=reverse(SM2);
+		}
 		G = cutgrs(GN);
 	}
-	return G;
+	return SM0?[G,SM1]:G;
 }
 
+def spslm(M,TT)
+{
+	R=getbygrs(M,1|mat=1);
+	if(type(R)!=4||type(R[0])!=4||type(S=R[0][1])!=4){
+		errno(0);return0;
+	}
+	if(S[1]!=[[1,0]]){
+		print("Not rigid!");return0;
+	}
+	if((F=S[0][0][1])!=0){
+		for(V=vars(F);V!=[];V=cdr(V)){
+			if(mydeg(F,car(V))==1){
+				T=lsol(F,car(V));
+				break;
+			}
+		}
+		if(V==[]){
+			print("Violate Fuchs condition!");
+			return0;
+		}
+	}
+	for(P=[];R!=[];R=cdr(R))
+		P=cons(car(R)[0],P);
+	if(F!=0){
+		S=mysubst(S,[car(V),T]);P=mysubst(P,[car(V),T]);
+	}
+	return mcgrs(S,P|mat=1,slm=[TT,[[1,0]]]);
+}
+
 /*
   F=0 : unify
   F=["add",S] : 
@@ -8334,6 +8942,8 @@ def mcgrs(G, R)
   F=["put",F,V] : 
   F=["get1",F,V] : 
   F=["put1",F,V] : 
+  F=["max"] : 
+  F=["max",F.V] : 
   F=["put1"] : 
   F=["val",F];
   F=["swap"];
@@ -8378,6 +8988,18 @@ def anal2sp(R,F)
 		return G;
 	}
 	if(F[0]=="add") return append(R,F[1]);
+	if(F[0]=="max"){
+		if(length(F)==3) C=1;
+		else C=0;
+		M=-10^10;K=[-1];
+		for(I=0;R!=[];R=cdr(R),I++){
+			if(C>0&&car(R)[F[1]]!=F[2]) continue;
+			if(M<car(R)[0]){
+				M=car(R)[0];K=[I,car(R)];
+			}
+		}
+		return K;
+	}
 	R=reverse(R);
 	if(F[0]=="sub"){
 		for(S=F[1];S!=[];S=cdr(S))
@@ -8390,13 +9012,19 @@ def anal2sp(R,F)
 		return G;
 	}
 	if(F[0]=="+"){
-		for(G=[];R!=[];R=cdr(R))
-			G=cons([car(R)[0],car(R)[1]+F[1],car(R)[2]+F[2]],G);
+		L=length(F);
+		for(G=[];R!=[];R=cdr(R)){
+			for(S=[],I=L-1;I>0;I--) S=cons(car(R)[I]+F[I],S);
+			G=cons(cons(car(R)[0],S),G);
+		}
 		return G;
 	}
 	if(F[0]=="*"){
-		for(G=[];R!=[];R=cdr(R))
-			G=cons([car(R)[0],car(R)[1]*F[1]+car(R)[2]*F[2]],G);
+		L=length(F);
+		for(G=[];R!=[];R=cdr(R)){
+			for(S=0,I=1;I<L;I++) S+=car(R)[I]*F[I];
+			G=cons([car(R)[0],S],G);
+		}
 		return G;
 	}
 	if(F[0]=="mult"){
@@ -8454,8 +9082,11 @@ def anal2sp(R,F)
  P=["get",L]
     L=n        for variable x_n
     L=[m,n]    for residue [m,n]
+    L=[m,n,l]  for residue [m,n,l]
     L=[[m,n],[m',n']] for common spct
+ P=["eigen",I]   decomposition of A_I
  P=["get0",[m,n],[m',n']] for the sum of residues
+ P=["rest",[m,n]] restriction 
  P=["swap",[m,n]] for symmetry
  P=["perm",[...]] for symmetry
  P=["deg"]
@@ -8525,7 +9156,9 @@ def mc2grs(G,P)
 	}
 	if(type(P)<2) return G;
 	F=0;
-	if(type(P)==7||(type(P)==4&&type(P[0])<4)) P=[P];
+	if(type(P)==7||(type(P)==4&&
+		(type(P[0])<4||(type(P[0])==4&&length(P[0])==2&&type(P[0][0])<4&&type(P[1])<4))
+	  )) P=[P];
 	if((Dvi=getopt(dviout))!=1&&Dvi!=2&&Dvi!=-1) Dvi=0;
 	Keep=(Dvi==2)?1:0;
 	if(type(P)==4&&type(F=car(P))==7){
@@ -8555,6 +9188,56 @@ def mc2grs(G,P)
 			return R;
 		}
 		if(F=="show0"){
+			if(type(Fig=getopt(fig))>0){
+				PP=[[-1.24747,-5.86889],[1.24747,-5.86889],[3.52671,-4.8541],[5.19615,-3],
+				  [5.96713,-0.627171],[5.70634,1.8541],[4.45887,4.01478],[2.44042,5.48127],
+				  [0,6],[-2.44042,5.48127],[-4.45887,4.01478],[-5.70634,1.8541],
+				  [-5.96713,-0.627171],[-5.19615,-3],[-3.52671,-4.8541]];
+				PL=[[1.8,-5.2],[5.7,-1.7],[3.2,5],[-3.6,4.7],[2.2,3],[-2.8,2.8],
+				  [-1.5,-1.4],[-3.2,-2.5],[0.76,-1.4],[-2,0.2]];
+				PC=["black,dashed","green,dashed","red,dashed","blue,dashed",
+					"black","cyan","green","blue","red","magenta"];
+				N=["1","2","3","4","5","6","7","8","9","a","b","c","d","e","f"];
+				LL=[[1,2,3],[4,5,6],[7,8,9],[10,11,12],[7,10,13],[4,11,14],[5,8,15],[1,12,15],
+				  [2,9,14],[3,6,13]];
+				TB=str_tb("\\draw\n",TB);
+				if(type(Fig)==4){
+					if(type(car(Fig))==1){
+						PP=ptaffine(car(Fig)/12,PP);PL=ptaffine(car(Fig)/12,PL);
+						Fig=cdr(Fig);
+					}
+					if(Fig!=[]&&length(Fig)==10) PC=Fig;
+				}
+				for(R=mc2grs(G,"show0"|dviout=-1),I=0;R!="";I++){	/* 頂点 */
+					J=str_chr(R,0,",");
+					if(J>0){
+						S=str_cut(R,0,J-1);
+						R=str_cut(R,J+1,1000);
+					}else{
+						S=R;R="";
+					}
+					T=(str_chr(S,0,"1")==0)?"":"[red]";
+					str_tb(["node",T,"(",N[I],") at ",xypos(PP[I]),"{$",S,"$}\n"],TB);
+				}
+				for(S=PC,P=PL,I=0;I<4;I++){
+					for(J=I+1;J<5;J++,S=cdr(S),P=cdr(P)){			/* 線の番号 */
+						SS=car(S);
+						if((K=str_chr(SS,0,","))>0) SS=sub_str(SS,0,K-1);
+						str_tb(["node[",SS,"] at ",xypos(car(P)),
+							"{$[",rtostr(I),rtostr(J),"]$}\n"],TB);
+					}
+				}
+				str_tb(";\n",TB);
+				for(I=0;I<10;I++){		/* 線 */
+					S=car(PC);P0=car(PC);L0=car(LL);PC=cdr(PC);LL=cdr(LL);
+					C=[N[L0[0]-1],N[L0[1]-1],N[L0[2]-1]];
+					str_tb(["\\draw[",S,"] (", C[0],")--(",C[1],") (",
+						C[0],")--(",C[2],") (",C[1],")--(",C[2],");\n"],TB);
+				}
+				R=str_tb(0,TB);
+				if(TikZ==1&&Dvi!=-1) dviout(xyproc(R)|dviout=1,keep=Keep);
+				return R;
+			}
 			for(S="",L=[];G!=[];G=cdr(G)){
 				for(TL=[],TG=cdr(car(G));TG!=[];TG=cdr(TG)) TL=cons(car(TG)[0],TL);
 				TL=msort(TL,[-1,0]);
@@ -8632,6 +9315,7 @@ def mc2grs(G,P)
 						else S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}&"+S;
 					}
 					L=ltotex(R|opt="GRS",pre=S);
+					if(type(D=getopt(div))==1 || type(D)==4) L=divmattex(L,D);
 					if(Dvi>0) dviout(L|eq=0,keep=Keep);
 				}
 				return L; /* get all spct */
@@ -8643,14 +9327,14 @@ def mc2grs(G,P)
 					if(I[0]>I[0]){S=I;I=J;J=S;};
 					K=lsort(I,J,0);
 					if(length(K)==4){
-						S=sp2grs(G,["get0",[I,J]]);
+						S=mc2grs(G,["get0",[I,J]]);
 						return anal2sp(S,[["*",1,1],0]);
 					}
 					I=lsort(K,lsort(I,J,2),1);
 					S=lsort([0,1,2,3,4],K,1);
-					D=sp2grs(G,"deg");
+					D=mc2grs(G,"deg");
 					if(findin(4,S)<0) D=-D;
-					J=sp2grs(G,["get0",[I,S]]);
+					J=mc2grs(G,["get0",[I,S]]);
 					if(I[0]>S[0]) J=sp2grs(J,"swap");
 					return anal2sp(J,[["+",0,D],["*",-1,1]]);
 				}
@@ -8662,6 +9346,10 @@ def mc2grs(G,P)
 						if(car(PG)[0]==T) return (F=="get")?car(PG):cdr(car(PG));
 					return [];	/* get common spct */
 				}
+				if(length(T)==3){
+					T0=T;T=lsort([0,1,2,3,4],T,1);
+					if(length(T)!=2) return [];
+				}else T0=0;
 				if(T[0]>T[1]) T=[T[1],T[0]];
 				for(FT=0,PG=G;PG!=[];PG=cdr(PG)){
 					if(car(PG)[0][0]==T){
@@ -8673,9 +9361,118 @@ def mc2grs(G,P)
 				}
 				if(!FT) return [];
 				L=anal2sp(cdr(car(PG)),[["get1",FT],0]);
+				if(T0!=0){
+					if((K=mc2grs(G,"deg"))!=0){
+						if(T[1]!=4) K=-K;
+						R=reverse(L);
+						for(L=[];R!=[];R=cdr(R)) L=cons([car(R)[0],car(R)[1]+K],L);
+					}
+					T=T0;
+				}
 				return (F=="get")?cons(T,L):L;
 			}
 		}
+		if(F=="rest"||F=="eigen"||F=="rest0"||F=="rest1"){
+			if(F!="eigen") G=mc2grs(G,"homog");
+			if(length(P)==1){
+				for(R=[],I=0;I<4;I++){
+					for(J=I+1;J<5;J++){
+						S=mc2grs(G,[F,[I,J]]);
+						if(S!=[]) R=cons(cons([I,J],S),R);
+					}
+				}
+				R=reverse(R);
+				if(Dvi){
+					TB=str_tb(0,0);
+					if(F=="rest0"||F=="rest1"){
+						for(T=R;;){
+							TT=car(T);
+							S=rtostr(car(TT)[0])+rtostr(car(TT)[1]);
+							str_tb(["[",S,"]","&: "],TB);
+							for(TR=[],TT=cdr(TT);TT!=[];TT=cdr(TT))
+								TR=cons(car(TT)[1],TR);
+							for(TR=qsort(TR);TR!=[];TR=cdr(TR))
+								str_tb([s2sp(car(TR)|short=1,std=-1),"\\ \\ "],TB);
+							if((T=cdr(T))==[]) break;
+							str_tb("\\\\\n",TB);
+						}
+					}else{
+						TB=str_tb(0,0);
+						for(T=R;;){
+							TT=car(T);
+							S=rtostr(car(TT)[0])+rtostr(car(TT)[1]);
+							str_tb(["[",S,"]",":\\ "],TB);
+							for(TR=[],TT=cdr(TT);;){
+								T0=car(TT);
+								str_tb(["&",my_tex_form(car(T0)),"&&\\to\\ \n",
+									ltotex(cdr(T0)|opt="GRS")],TB);
+								if((TT=cdr(TT))==[]) break;
+								str_tb("\\\\\n",TB);
+							}
+							if((T=cdr(T))==[]) break;
+							str_tb("\\allowdisplaybreaks\\\\\n",TB);
+						}
+					}
+					R=texbegin("align*",str_tb(0,TB));
+					if(Dvi!=-1) dviout(R|keep=Keep);
+				}
+				return R;
+			}
+			I=P[1];
+			if(I[0]>I[1]) I=[I[1],I[0]];
+			L=lsort([0,1,2,3,4],I,1);
+			if(F=="rest"&&length(P)==3){
+				J=P[2];if(J[0]>J[1]) J=[J[1],J[0]];
+				L=lsort(L,J,1);
+				if(length(L)!=1) return 0;
+				return [mc2grs(G,["get0",I]),mc2grs(G,["get0",[I[0],J[0]],[I[1],J[1]]]),
+					mc2grs(G,["get0",[I[0],J[1]],[I[1],J[0]]]),mc2grs(G,["get0",[I[0],I[1],L[0]]])];
+			}
+			L=[[L[0],L[1]],[L[0],L[2]],[L[1],L[2]]];
+			if(F!="eigen"){
+				if(I==[0,4]) L=reverse(L);
+				else{
+					for(V=[],J=2;J>=0;J--){
+						if(L[J][0]==0) V=cons([L[J][1],J],V);
+						else{
+							for(K=4;K>=0;K--){
+								if(findin(K,L[J])<0){
+									V=cons([K,J],V);break;
+								} 
+							}
+						}
+					}
+					V=qsort(V);
+					L=[L[V[0][1]],L[V[1][1]],L[V[2][1]]];
+				}
+			}
+			for(LL=[],T=L;T!=[];T=cdr(T))
+				LL=cons(mc2grs(G,["get0",[I,car(T)]]),LL);
+			LL=reverse(LL);
+			for(R=[],Q=mc2grs(G,["get0",I]);Q!=[];Q=cdr(Q)){
+				for(T=[],J=2;J>=0;J--){
+					V=anal2sp(LL[J],["get1",(I[0]<L[J][0])?1:2,car(Q)[1]]);
+					if(F=="rest"){
+						if(I[0]==0){
+							if(I[1]!=4){
+								if(L[J][1]!=4) V=anal2sp(V,["+",-car(Q)[1]]);
+							}else if (L[J][0]!=2) V=anal2sp(V,["+",-car(Q)[1]]);
+						}else if(L[J][0]!=0) V=anal2sp(V,["+",-car(Q)[1]]);
+					}
+					T=cons(V,T);
+				}
+				R=cons(cons(car(Q)[1],T),R);
+			}
+			if(F=="rest0"||F=="rest1"){
+				for(L=[];R!=[];R=cdr(R)){
+					TR=cdr(car(R));
+					if(F=="rest1"&&chkspt(TR|opt="idx")==2) continue;
+					L=cons([car(R)[0],s2sp(chkspt(TR|opt=6))],L);
+				}
+				R=reverse(L);
+			}
+			return R;
+		}
 		if(F=="deg"){
 			for(S=I=0;I<3;I++){
 				for(J=I+1;J<4;J++){
@@ -8686,9 +9483,10 @@ def mc2grs(G,P)
 			}
 			return S/L[0];
 		}
-		if(F=="spct"){
+		if(F=="spct"||F=="spct1"){
+			K=(F=="spct")?5:6;
 			G=mc2grs(G,"get");
-			M=newmat(5,5);
+			M=newmat(5,K);
 			for(;G!=[];G=cdr(G)){
 				GT=car(G);I=GT[0][0];J=GT[0][1];
 				for(S=0,L=[],GT=cdr(GT);GT!=[];GT=cdr(GT)){
@@ -8705,19 +9503,29 @@ def mc2grs(G,P)
 					for(L=M[I][J];L!=[];L=cdr(L)) S+=car(L)^2;
 				}
 				M[I][I]=S;
+				if(K==6){
+					for(S=[],J=4;J>=0;J--)
+						if(I!=J) S=cons(M[I][J],S);
+					R=chkspt(S|opt=2);
+					M[I][5]=((L=length(R))>1)?s2sp(R[L-2]|short=1):"";
+				}
 			}
 			if(Dvi){
 				S=[];
 				for(I=4;I>=0;I--){
-					L=[M[I][I]];
+					L=(K==6)?[M[I][5]]:[];
+					L=cons(M[I][I],L);
 					for(J=4;J>=0;J--){
 						if(I==J) L=cons("",L);
 						else L=cons(s2sp([M[I][J]]),L);
 					}
 					S=cons(L,S);
 				}
-				S=cons([x0,x1,x2,x3,x4,"idx"],S);
-				M=ltotex(S|opt="tab",hline=[0,1,z],vline=[0,1,z-1,z],left=["","$x_0$","$x_1$","$x_2$","$x_3$","$x_4$"]);
+				T=(K==6)?["reduction"]:[];
+				S=cons(append([x0,x1,x2,x3,x4,"idx"],T),S);
+				M=ltotex(S|opt="tab",hline=[0,1,z],
+					vline=(K==6)?[0,1,z-2,z-1,z]:[0,1,z-1,z],
+					left=["","$x_0$","$x_1$","$x_2$","$x_3$","$x_4$"]);
 				if(Dvi>0) dviout(M|keep=Keep);
 			}
 			return M;
@@ -8980,7 +9788,7 @@ def mcmgrs(G,P)
 	Keep=(Dvi==2)?1:0;
 	if(type(P)==4 && type(F=car(P))==7){
 		if(F=="mult"){
-			for(P=cdr(P);P!=[];P=cdr(P)) G=os_md.mc2grs(G,car(P)|option_list=getopt());
+			for(P=cdr(P);P!=[];P=cdr(P)) G=mc2grs(G,car(P)|option_list=getopt());
 			return G;
 		}
 		if(F=="get"||F=="get0"){
@@ -9093,7 +9901,7 @@ def mcmgrs(G,P)
 				L=cons(TL,L);
 			}
 			if(Dvi){
-				if(Dvi!=-1) dviout(S|eq=0);
+				if(Dvi!=-1) dviout(S|eq=0,keep=Keep);
 				return S;
 			}
 			return reverse(L);
@@ -10161,6 +10969,7 @@ def divmattex(S,T)
 	if(length(L0)>0) L=cons(reverse(L0),L);
 	L=lv2m(reverse(L));	/* get matrix */
 	if(T==0) return L;
+	if(type(T)==1) T=[T];
 	Size=size(L);S0=Size[0];
 	if(type(T[0])!=4){
 		S1=Size[1];
@@ -14209,6 +15018,38 @@ def draw_bezier(ID,IDX,B)
 	return 0;
 }
 
+
+/*
+def redbezier(L)
+{
+	V=newvect(4);ST=0;
+	for(R=[],I=0,T=L;T=[];T=cdr(T){
+		if(type(car(T))<4){
+			F=0;
+			if(I==3)
+			if(car(T)==0){
+			}else if(car(T)==1){
+			}else if(car(T)==-1){
+				if(I<3) V[I++]=ST;
+			}
+		}else if(I==3){
+			if(R==[] || car(R)!=1){
+				R=cons(V[0],R);
+				if(ST==0) ST=V[0];
+			}
+			for(J=1;J<3;J++) R=cons(V[J],R);
+			while((T=cdr(T))!=[]){
+				R=cons(car(T),R);
+				if(type(car(R))<4)
+			}
+		}else{
+			if(ST==0) ST=car(T);
+			V[I++]= car(T);
+		}
+	}
+}
+*/
+
 def lbezier(L)
 {
 	if((In=getopt(inv))==1||In==2||In==3){
@@ -14597,6 +15438,39 @@ def xycirc(P,R)
     return S+"}};\n";
 }
 
+def xypoch(W,H,R1,R2)
+{
+ 	if(H>R1||2*H>R2){
+		errno(0);
+		return;
+ 	}
+	if(type(Ar=getopt(ar))!=1) Ar=TikZ?0.25:2.5;
+	T1=dasin(H/R1);S1=R1*dcos(T1); 
+	T2=dasin(H/R2);S2=R2*dcos(T2);
+	T3=dasin(2*H/R2);S3=R2*dcos(T3);
+	S=xyline([R1,0],[W-R1,0]);
+	S+=xyang(R1,[W,0],-@pi,@pi-T1);
+	S+=xyline([S2,H],[W-S1,H]);
+	S+=xyang(R2,[0,0],T2,2*@pi-T3);
+	S+=xylines([[S3,-2*H],[W-H-R2,-2*H],[W-H-R2,2*H],[W-S3,2*H]]); 
+	S+=xyang(R2,[W,0],-@pi+T2,@pi-T3);
+	S+=xyline([W-T2,-H],[W-T2,-H]);
+	S+=xyang(R1,[0,0],0,2*@pi-T1);
+	S+=xyline([W-S2,-H],[S1,-H]);
+	if(Ar>0){
+		S+=xyang(Ar,[W/2,0],[0,0],8);
+		S+=xyang(Ar,[W/2,-2*H],[0,-2*H],8);
+		S+=xyang(Ar,[W/2-Ar,-H],[W,-H],8);
+		S+=xyang(Ar,[W/2-Ar,H],[W,H],8);
+		S+=xyang(Ar,[W-S3,2*H],[W-H-R2,2*H],8);
+	}
+	S+=xyput([R1,0,"$\\bullet$"]);
+	S+=xyput([0,0,"$\\times$"]);
+	S+=xyput([W,0,"$\\times$"]);
+	if(TikZ) S=str_subst(S,";\n\\draw","\n");
+	return S;
+}
+
 def ptaffine(M,L)
 {
 	if(type(L)!=4&&type(L)!=5){
@@ -14885,16 +15759,27 @@ def ptcopy(L,V)
 
 def	average(L)
 {
-	L=os_md.m2l(L|flat=1);
-	M0=M1=car(L);
-	for(I=SS=0, LT=L; LT!=[]; LT=cdr(LT), I++){
-		S+=(V=car(LT));
-		SS+=V^2;
-		if(V<M0)		M0=V;
-		else if(V>M1)	M1=V; 
+	if(getopt(opt)=="co"){
+		S0=average(L[0]);V0=car(S0);
+		S1=average(L[1]);V1=car(S1);
+		L0=os_md.m2l(L[0]|flat=1);
+		L1=os_md.m2l(L[1]|flat=1);
+		for(S=0;L0!=[];L0=cdr(L0),L1=cdr(L1))
+			S+=(car(L0)-V0)*(car(L1)-V1);
+		S/=S0[1]*S1[1]*S0[2];
+		S=[S,S0,S1];
+	}else{
+		L=os_md.m2l(L|flat=1);
+		M0=M1=car(L);
+		for(I=SS=0, LT=L; LT!=[]; LT=cdr(LT), I++){
+			S+=(V=car(LT));
+			SS+=V^2;
+			if(V<M0)		M0=V;
+			else if(V>M1)	M1=V; 
+		}
+		SS=dsqrt(SS/I-S^2/I^2);
+		S=[deval(S/I),SS,I,M0,M1];
 	}
-	SS=dsqrt(SS/I-S^2/I^2);
-	S=[deval(S/I),SS,I,M0,M1];
 	if(isint(N=getopt(sint))) S=sint(S,N);
 	return S;
 }
@@ -16631,6 +17516,292 @@ def conf1sp(M)
 	return P;
 }
 
+/* ((1)(1)) ((1))   111|11|21  [[ [2,[ [1,[1]],[1,[1]] ]], [1,[[1,[1]]]] ]]  */
+/* (11)(1),111  111|21,111 [[[2,[1,1]],[1,[1]]],[1,1,1]]  */
+def s2csp(S)
+{
+	if(type(S)!=7){
+		U="";
+		if(type(N=getopt(n))>0){
+			for(D=0,S=reverse(S);S!=[];S=cdr(S),D++){
+				if(D) U=","+U;
+				T=str_subst(rtostr(car(S)),","," ");
+				U=str_cut(T,1,str_len(T)-2)+U;
+			}
+			V=strtoascii(U);
+			for(R=[];V!=[];V=cdr(V)){
+				if((CC=car(V))==91){ 	/* [ */
+					if(length(V)>1 && V[1]==91) V=cdr(V);
+					for(I=1;(CC=V[I])!=91&&CC!=93;I++);
+					if(CC==91){
+						R=cons(40,R);	/* ( */
+						while(I--) V=cdr(V);
+					}else{
+						V=cdr(V);
+						while(--I) R=cons(car(V),R);
+					}
+				}else if(CC==93){		/* ] */
+					R=cons(41,R);
+					if(length(V)>1 && V[1]==93) V=cdr(V);
+				}else R=cons(CC,R);
+			}
+			return asciitostr(reverse(R));
+		}
+		for(;S!=[];S=cdr(S)){
+			if(U!="") U=U+",";
+			for(D=0,TU="",T=car(S);T!=[];D++){
+				if(type(car(T))==4){
+					R=lpair(T,0);
+					T=R[0];R1=m2l(R[1]|flat=1);
+				}else R1=[];
+				if(D) TU="|"+TU;
+				TU=s2sp([T])+TU;
+				T=R1;
+			}
+				U=U+TU;
+		}
+		return U;
+	}
+	S=strtoascii(S);
+	if(type(N=getopt(n))>0){
+		S=ltov(S);
+		L=length(S);
+		R="";
+		for(I=J=N=0, V=[];J<L;J++){
+			if(S[J]==72) I=J;			/* ( */
+			else if(S[J]>47&&S[J]<58) N=N*10+S[J]-48;
+			else{
+				if(N>0){
+					V=cons(N,V);
+					N=0;
+				}
+				if(S[J]==41){	/* ) */ 
+					
+				}else if(S[J]==44){		/* , */
+
+				}
+			}
+		}
+	}
+	for(P=TS=[],I=D=0; S!=[]; S=cdr(S)){
+		if((C=car(S))==44){			/* , */
+			P=cons(D,P);D=0;
+		}else if(C==124){	/* | */
+			D++;C=44;
+		}
+		TS=cons(C,TS);
+	}
+	S=reverse(TS);
+	P=reverse(cons(D,P));
+	U=s2sp(asciitostr(S));
+
+	for(R=[];P!=[];P=cdr(P),U=cdr(U)){
+		D=car(P);R0=car(U);
+		while(D--){
+			U=cdr(U);
+			for(U0=car(U),R2=[];U0!=[];U0=cdr(U0)){
+				for(R1=[],N=car(U0);N>0;R0=cdr(R0)){
+					R1=cons(car(R0),R1);
+					if(type(car(R0))==4) N-=car(R0)[0];
+					else N-=car(R0);
+				}
+				R2=cons([car(U0),reverse(R1)],R2);
+			}
+			R0=reverse(R2);
+		}
+		R=cons(R0,R);
+	}
+	return reverse(R);
+}
+
+
+def partspt(S,T)
+{
+	if(length(S)>length(T)) return [];
+	if(type(Op=getopt(opt))!=1) Op=0;
+	else{
+	 	VS=ltov(S);
+	  	L=length(S)-1;
+	  	VT=ltov(qsort(T));
+	}
+	if(length(S)==length(T)){
+		if(S==T||qsort(S)==qsort(T)) R=S;
+		else return [];
+	}else if(getopt(sort)==1){
+		S0=S1=[];
+		for(;S!=[]&&car(S)==car(T);S=cdr(S),T=cdr(T))
+			S0=cons(car(S),S0);
+		if(S!=[]&&car(S)<car(T)) return [];
+		S0=reverse(S0);
+		for(S=reverse(S),T=reverse(T);S!=[],car(S)==car(T);S=cdr(S),T=cdr(T))
+			S1=cons(car(S),S1);
+		if(car(S)!=[]&&car(S)<cat(T)) return [];
+		R=partspt(reverse(S),reverse(T));
+		if(S1!=[]){
+			for(R0=[];R!=[];R=cdr(R))
+				R0=cons(append(car(R),S1),R0);
+			R=reverse(R0);
+		}
+		if(S0!=[]){
+			for(R0=[];R!=[];R=cdr(R))
+				R0=cons(append(S0,car(R)),R0);
+			R=reverse(R0);
+		}
+	}else{
+	  for(R=[];;){
+		for(I=J=P=0;I<L;I++){
+			P=VS[I];
+			X=100000;
+			while((P-=(Y=VT[J++]))>0){
+				if(X<Y) break;
+				X=Y;
+			}
+			if(X<Y||P<0) break;
+		}
+		if(!P&&X>=Y) R=cons(vtol(VT),R);
+		if(!vnext(VT)) break;
+	  }
+	}
+	if(Op){
+		for(W=[];R!=[];R=cdr(R)){
+			for(I=0,S=VS[0],K=U=[],TR=car(R);TR!=[];TR=cdr(TR)){
+				K=cons(car(TR),K);
+				if(!(S-=car(K))){
+					U=cons([VS[I],reverse(K)],U);
+					K=[];
+					S=VS[++I];
+					if(I==L){
+						U=cons([S,cdr(TR)],U);
+						break;
+					}
+				}
+			}
+			W=cons(reverse(U),W);
+		}
+		R=W;
+		if(iand(Op,1)){
+			for(R=[];W!=[];W=cdr(W))
+				R=cons(reverse(qsort(car(W))),R);
+			R=lsort(R,[],1);
+		}
+		if(Op==3){
+			for(W=[];R!=[];R=cdr(R)){
+				for(S=[],TR=car(R);TR!=[];TR=cdr(TR))
+					S=append(S,car(TR)[1]);
+				W=cons(S,W);
+			}
+			R=reverse(W);
+		}
+	}
+	return R;
+}
+
+#if 0
+def confspt(S,T)
+{
+	R=[];
+	LS=length(S);LT=length(T);
+	if(LS<LT)  return R;
+	if(LS==LT){
+		return(S==T)? return [[S,T]]:R;
+	}
+	R=[];
+	for(ST=S,S0=T0=[],TT=T;ST!=[];ST=cdr(ST),TT=cdr(TT)){
+		if(car(ST)>car(TT)) return R;
+		if(car(ST)==car(TT){
+			S0=cons(car(ST));T0=cons(car(TT));
+			LS--;LT--;continue;
+		}
+		V=car(TT);D=LS-LT;
+		for(P=[ST],DD=D;DD>0;){
+			VD=V-car(car(ST));
+		}
+	}
+}
+#endif
+
+def mcvm(N)
+{
+  X=getopt(var);
+  if((Z=getopt(z))!=1) Z=0;
+  if(type(N)==4){
+    if((K=length(N))==1&&isvar(X)) X=[X];
+    if(type(X)!=4){
+      for(X=[],I=0;I<K;I++) X=cons(asciitostr([97+I]),X);
+      X=reverse(X);
+    }
+	if(getopt(e)==1){
+	  if(length(N)==4){
+		N=ltov(N);
+		if(N[1]<N[3]){
+			I=N[1];N[1]=N[3];N[3]=I;
+		}
+		if(N[2]<N[3]||N[2]>=N[1]+N[3]) return 0;
+		X=X[0];
+		for(R=[],I=1;I<N[3];I++) R=cons(makev([X[0],I]),R);
+		for(L=[],I=N[1];I<=N[2];I++) L=cons(makev([X[0],I]),L);
+		for(S=0,I=N[1];I<=N[2];I++){
+		  V=makev([X[0],I]);
+          S+=polbyroot(R,V)/polbyroot(lsort(L,V,1),V);
+		  S=red(S);
+		}
+		return S;
+      }
+	}
+	for(M=[],I=S=0;I<K;Z=0,I++){
+		M=cons(mcvm(N[I]|var=X[I],z=Z),M);
+		S+=N[I];
+	}
+	M=newbmat(K,K,reverse(M));
+	N=S;
+  }else{
+	if(type(X)==7) X=strtov(X);
+	if(!isvar(X)) X=a;
+    M=newmat(N,N);
+    for(I=0;I<N;I++){
+      V=makev([X,I+1]);
+      for(J=0;J<=I;J++){
+        R=polbyroot([1,J],V|var=X);
+        if(Z==1) R*=V;
+        M[I][J]=R;
+      }
+    }
+  }
+  if(getopt(get)==1){
+    for(R=[],I=0;I<N;I++){
+      U=newmat(N,N);
+      for(J=0;J<N;J++) U[J][J]=M[J][I];
+      R=cons(map(red,myinv(M)*U*M),R);
+    }
+    return reverse(R);
+  }
+  return M;
+}
+
+def confexp(S)
+{
+	if(type(S[0])==4){
+		for(E=[];S!=[];S=cdr(S))
+			E=cons(confexp(car(S),E));
+		return reverse(E);
+	}
+	V=x;E=[];
+	for(P=0,Q=[],ST=S;ST!=[];ST=cdr(ST)){
+		Q=cons(car(ST)[0],Q);
+		P+=car(ST)[1]/(V-car(ST)[0]);
+		P=red(P);
+	}
+	P=red(P*polbyroot(Q,V));
+	Q=cdr(reverse(Q));
+	for(I=(length(W=Q));I>=0;I--){
+		C=mycoef(P,I,V);
+		P-=C*polbyroot(W,V);
+		W=cdr(W);
+		E=cons(red(C),E);
+	}
+	return reverse(E);
+}
+
 def pgen(L,VV)
 {
 	if(type(L[0])<4) L=[L];
@@ -16751,6 +17922,13 @@ def newbmat(M,N,R)
 	S  = newvect(M);
 	T  = newvect(N);
 	IM = length(R);
+	if(type(car(R))!=4 && M==N && M==IM){
+		for(RR=TR=[],I=0;I<M;I++){
+			for(TR=[R[I]],J=0;J<I;J++) TR=cons(0,TR);
+			RR=cons(TR,RR);
+		}
+		R=reverse(RR);
+	}
 	for(I = 0; I < IM; I++){
 		RI = R[I];
 		JM = length(RI);
@@ -19301,7 +20479,7 @@ def distpoint(L)
 
 def keyin(S)
 {
-	print(S,2);
+	mycat0(S,0);
 	purge_stdin();
 	S=get_line();
 	L=length(S=strtoascii(S));