=================================================================== RCS file: /home/cvs/OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v retrieving revision 1.8 retrieving revision 1.47 diff -u -p -r1.8 -r1.47 --- OpenXM/src/asir-contrib/packages/src/os_muldif.rr 2017/05/10 02:37:37 1.8 +++ OpenXM/src/asir-contrib/packages/src/os_muldif.rr 2019/03/05 01:52:51 1.47 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.7 2017/05/04 11:12:16 takayama Exp $ */ +/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.46 2019/03/04 02:02:04 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 - Apr. 2017) + * Toshio Oshima (Nov. 2007 - Feb. 2019) * * For polynomials and differential operators with coefficients * in rational funtions (See os_muldif.pdf) @@ -22,6 +22,7 @@ static Muldif.rr$ static TeXEq$ static TeXLim$ static DIROUT$ +static DIROUTD$ static DVIOUTL$ static DVIOUTA$ static DVIOUTB$ @@ -42,6 +43,7 @@ static Canvas$ static ID_PLOT$ static Rand$ static LQS$ +static SVORG$ localf spType2$ localf erno$ localf chkfun$ @@ -51,6 +53,7 @@ localf makenewv$ localf vweyl$ localf mycat$ localf mycat0$ +localf fcat$ localf findin$ localf countin$ localf mycoef$ @@ -114,6 +117,8 @@ localf lchange$ localf llsize$ localf llbase$ localf lsort$ +localf rsort$ +localf lpair$ localf lmax$ localf lmin$ localf lgcd$ @@ -167,6 +172,7 @@ localf myacos$ localf myatan$ localf mylog$ localf mypow$ +localf scale$ localf arg$ localf sqrt$ localf gamma$ @@ -178,6 +184,8 @@ localf eta$ localf jell$ localf frac$ localf erfc$ +localf orthpoly$ +localf schurpoly$ localf fouriers$ localf todf$ localf f2df$ @@ -235,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$ @@ -269,6 +281,7 @@ localf okuboetos$ localf heun$ localf fspt$ localf abs$ +localf sgn$ localf calc$ localf isint$ localf israt$ @@ -293,6 +306,7 @@ localf cutgrs$ localf mcgrs$ localf mc2grs$ localf mcmgrs$ +localf spslm$ localf anal2sp$ localf delopt$ localf str_char$ @@ -339,6 +353,10 @@ localf getbygrs$ localf mcop$ localf shiftop$ localf conf1sp$ +localf confexp$ +localf confspt$ +localf s2csp$ +localf partspt$ localf pgen$ localf diagm$ localf mgen$ @@ -355,6 +373,7 @@ localf fimag$ localf trig2exp$ localf intpoly$ localf integrate$ +localf rungeKutta$ localf simplog$ localf fshorter$ localf isshortneg$ @@ -372,6 +391,7 @@ localf varargs$ localf ptype$ localf pfargs$ localf average$ +localf tobig$ localf sint$ localf frac2n$ localf xyproc$ @@ -396,10 +416,14 @@ localf areabezier$ localf saveproc$ localf xygraph$ localf xy2graph$ +localf addIL$ +localf xy2curve$ +localf xygrid$ localf xyarrow$ localf xyarrows$ localf xyang$ localf xyoval$ +localf xypoch$ localf ptcommon$ localf ptcopy$ localf ptaffine$ @@ -423,6 +447,7 @@ extern Muldif.rr$ extern TeXEq$ extern TeXLim$ extern DIROUT$ +extern DIROUTD$ extern DVIOUTL$ extern DVIOUTA$ extern DVIOUTB$ @@ -444,11 +469,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; +static S_FDot$ extern AMSTeX$ -Muldif.rr="00170510"$ +Muldif.rr="00190301"$ AMSTeX=1$ TeXEq=5$ TeXLim=80$ @@ -467,6 +493,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]]$ @@ -547,9 +574,7 @@ def makenewv(L) if((V=getopt(var))<2) V="z_"; else if(isvar(V)) V=rtostr(V); if(type(N=getopt(num))!=1) N=0; - Var=vars(L); - for(Va=Var;Va!=[];Va=cdr(Va)) - if(vtype(car(Va))==2) Var=append(vars(args(car(Va))),Var); + Var=varargs(L|all=2); for(XX=[],I=J=0;;I++){ X=strtov(V+rtostr(I)); if(findin(X,Var)<0){ @@ -608,12 +633,37 @@ def mycat(L) Do = 1; } if(CR) print(""); + else print("",2); } +def fcat(S,X) +{ + if(type(S)!=7){ + if(type(DIROUTD)!=7){ + DIROUTD=str_subst(DIROUT,["%HOME%","%ASIRROOT%","\\"], + [getenv("HOME"),get_rootdir(),"/"])+"/"; + if(isMs()) DIROUTD=str_subst(DIROUTD,"/","\\"|sjis=1); + } + if(S==-1) return; + T="fcat"; + if(S>=2&&S<=9) T+=rtostr(S); + T=DIROUTD+T+".txt"; + if(S==-1) return T; + if(S!=0&&access(T)) remove_file(T); + S=T; + } + R=output(S); + print(X); + output(); + if(getopt(exe)==1) shell("\""+S+"\""); + return R; +} + def mycat0(L,T) { Opt = getopt(delim); Del = (type(Opt) >= 0)?Opt:""; + if(type(L)!=4) L=[L]; while(L != []){ if(Do==1) print(Del,0); @@ -622,6 +672,7 @@ def mycat0(L,T) Do = 1; } if(T) print(""); + else print("",2); } def findin(M,L) @@ -639,20 +690,24 @@ def findin(M,L) def countin(S,M,L) { - if(((Step=getopt(step))==1)||Step==-1){ + Step=getopt(step); + if(type(Step)==1){ + N=(Step>0)?Step:-Step; if(type(L)==5) L=vtol(L); L=qsort(L); while(car(L)0&&car(L)==S)){ C++; L=cdr(L); }else{ R=cons(C,R);C=0;S+=M; + if(N>1&&++I>=N) break; } } if(C>0) R=cons(C,R); + if(N>1&&(N-=length(R))>0) while(N-->0) R=cons(0,R); return reverse(R); } if(type(L)==4){ @@ -705,7 +760,7 @@ def mydiff(P,X) for(;X!=[];X=cdr(X)) P=mydiff(P,car(X)); return P; } - if(deg(dn(P),X) == 0) + if(ptype(dn(P),X)<2) return red(diff(nm(P),X)/dn(P)); return red(diff(P,X)); } @@ -845,6 +900,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); @@ -1219,6 +1275,255 @@ def mulseries(V1,V2) return VV; } +def scale(L) +{ + T=F=0;LS=1; + Pr=getopt(prec); + 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==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;M2=[[1,10,1],[10,100,10]]; + }else if(L==3){ + 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]], + [[1,2,1/2],[2,10,1], [10,20,5],[20,100,10], [100,200,50],[200,1000,100]]]: + [[[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;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{ + 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]; + if(length(L)!=3||L[0]+L[2]>L[1]) T=L; + } + if(T==0){ + if(type(L[0][0])!=4) L=[L]; + for(R=[];L!=[];L=cdr(L)){ + for(RR=[],LT=car(L);LT!=[];LT=cdr(LT)) + for(I=car(LT)[0];I<=car(LT)[1];I+=car(LT)[2]) RR=cons(I,RR); + RR=lsort(RR,[],1); + R=cons(RR,R); + } + R=reverse(R); + for(T=[];R!=[];R=cdr(R)){ + if(length(R)>1) T=cons(lsort(R[0],R[1],"setminus"),T); + else T=cons(R[0],T); + } + } + V0=dlog(10); + S0=S1=1;D0=D1=0; + SC=getopt(scale); + if(type(SC)==4){ + S0=SC[0];S1=SC[1]; + }else if(type(SC)==1){ + S0=SC;S1=0; + }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(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)){ + 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,((length(SC)>2)?SC[I]:(I*S1))+D1],M); + M=cons(0,M); + }else M0=cons(V+D0,M0); + } + if(S1==0) M=cons(reverse(M0),M); + } + if(S1!=0) M=cdr(M); + if(S1==0||getopt(TeX)!=1) return M; + M=reverse(M); + 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],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)){ + 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; +} + def pluspower(P,V,N,M) { RR = 1; @@ -1393,6 +1698,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}"; @@ -1423,6 +1729,13 @@ def mtoupper(MM, F) Top+=(TeX)?"\\ ":" "; } PC=IF=1; + if(Opt>3){ + for(P=[1],K=0;K4 && length(Var=vars(nm(M[J][K])))==1){ J0=J;Jv=mydeg(nm(M[J0][K]),car(Var)); for(I=JJ;I1) continue; if(mydeg(MIK,T[0])0){ QF=1;Q0*=T; continue; } @@ -1563,10 +1880,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); } } } @@ -1583,11 +1900,13 @@ def mtoupper(MM, F) KRC=-red((T[2]*dn(M[J0][K]))/(T[1]*dn(M[I][K]))); for(II=K;II0||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); if(type(T)==4){ K=T; - T=K[0]; - K=cdr(K); + if(length(T)>0){ + T=K[0]; + K=cdr(K); + }else T=0; }else K=0; - if(type(T)==7) - T = findin(T,["cup","setminus","cap","reduce"]); - if(K){ - C1=getopt(c1);C2=getopt(c2); - KN=K[0]; - if(L2==[]){ /* sort or deduce duplication */ - if((T!=0&&T!=1)||length(K)!=1) return L1; + if(type(TT=T)==7) + T = findin(T,["cup","setminus","cap","reduce","sum","subst"]); + if(type(L2)==7&&T<0) + T=findin(TT,["put","get","sub"]); + if(K){ /* [[..],..] */ + if(K!=[]) KN=K[0]; + if(L2==[]||L2=="sort"){ /* sort or deduce duplication */ + if((T!=0&&T!=3)||length(K)!=1) return L1; if(KN<0){ KN=-KN-1; F=-1; }else F=1; L1=msort(L1,[F,0,KN]); - if(T==1){ + if(T==3){ R=[car(L1)];L1=cdr(L1); for(;L1!=[];L1=cdr(L1)){ if(car(L1)[KN]!=car(R)[KN]) R=cons(car(L1),R); @@ -3067,21 +3400,18 @@ def lsort(L1,L2,T) L1=reverse(R); } return L1; - }else if(L2==0&&type(C1)==4){ + }else if((L2==0||L2=="col")&&type(C1)==4){ if(T==0||T==1){ /* extract or delete columns */ for(R=[];L1!=[];L1=cdr(L1)){ - if(T==1&&L=[0]){ /* delete top column */ + if(T==1&&C1==[0]){ /* delete top column */ R=cons(cdr(car(L1)),R); continue; } - LT=car(L1); + LT=car(L1);RT=[]; if(T==0){ - for(CT=C1;CT!=[];CT=cdr(CT)){ - for(RT=[],CT=C1;CT!=[];CT=cdr(CT)) - RT=cons(LT[car(CT)],R); - } + for(CT=C1;CT!=[];CT=cdr(CT)) RT=cons(LT[car(CT)],RT); }else{ - for(I=0,RT=[];LT!=[];I++,LT=cdr(LT)) + for(I=0;LT!=[];I++,LT=cdr(LT)) if(findin(I,C1)<0) RT=cons(car(LT),RT); RT=reverse(RT); } @@ -3089,61 +3419,144 @@ def lsort(L1,L2,T) } return reverse(R); } - }else{ + }else if(type(L2)==1||type(L2)==7){ + if(L2==1||L2=="num"){ + if(T==4) T=3; + I=(length(K)<2)?(-1):K[1]; + if(T==0||T==1||T==2||T==3){ + S=F=CT=0;R=[]; + if(K==[] || type((S=K[0]))==1 || S==0){ + if(T==0||T==1||T==2){ + for(J;L1!=[];L1=cdr(L1),J++){ + if(T==0) R=cons(cons(J+S,car(L1)),R); + else if(T==1){ + for( ;C1!=[]; C1=cdr(C1)) + R=cons(L1[car(C1)],R); + }else{ + if(findin(J,C1)<0) R=cons(car(L1),R); + } + } + return reverse(R); + }else if(T==3) return length(L1); + }else{ + if(type(S)==2&&vtype(S)>2) F=1; + else if(type(S)==4) F=2; + else if(S=="+") F=3; + else return L1; + } + for(R=[];L1!=[];L1=cdr(L1)){ + L1T=car(L1); + if(F==1) V=call(S,(I<0)?L1T:L1T[I]); + else if(F==2) V=calc((I<0)?L1T:L1T[I],S); + else if(F==3){ + for(C=C1,V=0;C!=[];C=cdr(C)) + if(type(X=L1T[car(C)])==1) V+=X; + } + if(T==0) R=cons(cons(V,L1T),R); + else if(T==1){ + if(V) R=cons(L1T,R); + }else if(T==2){ + if(!V) R=cons(L1T,R); + }else if(T==3){ + if(F==3) CT+=V; + else if(V) CT++; + } + } + return (T==3)?CT:reverse(R); + }else if(TT=="col"){ + J=(length(K)>0)?car(K):0; + I=length(car(L1))+J; + for(V=[];I>J;) + V=cons(--I,V); + return cons(V,L1); + } + }else if(L2=="transpose") return mtranspose(L1); + else if(L2=="subst"||L2=="adjust"){ + Null=(!K)?"":car(K); + if(L2=="adjust") C1=[]; + R=lv2m(L1|null=""); + for(;C1!=[];C1=cdr(C1)) R[car(C1)[0]][car(C1)[1]]=car(C1)[2]; + return m2ll(R); + } + return L1; + }else{ /* [[..],..], [[..],..] */ + if(type(L2[0])<4){ + for(R=[];L2!=[];L2=cdr(L2)) R=cons([car(L2)],R); + L2=reverse(R); + } + if(TT=="sum") T=3; + if(TT=="over") T=4; + if(findin(T,[0,1,2,3,4,5])<0) return L1; + if(T==4||T==5){ + if(type(C1)<2) C1=[C1]; + if(type(C2)<2) C2=[C2]; + } if(type(car(L2))!=4){ for(R=[];L2!=[];L2=cdr(L2)) R=cons([car(L2)],R); R=reverse(R); if(length(K)==1) K=[K[0],0]; - } - for(R=[],I=0;L1!=[];I++,L1=cdr(L1)) - R=cons(cons(I,car(L1)),R); - KN++; - KR=K[1]; - K0=K[0];K1=K[1]; - L1=msort(R,[],[1,0,K0]); - if(type(C2)==4){ - L2=msort(L2,0,0|c1=cons(K1,C2)); /* extract columns */ C2=0; - K1=0; } - L2=msort(L2,[],[1,0,K1]); - S=size(L2); - for(R0=[];S>0;S--) R0=cons("",R0); - R0=[R0]; - if(T==0||T==1||T==3){ /* cup or setminus or cap */ - for(R=[];L1!=[];L1=cdr(L1)){ - while(L2!=[]&&car(L1)[K0]>car(L2)[K1]) L2=cdr(L2); - if(L2==[]||car(L1)[K0]0)?K[0]+1:1; + K1=(length(K)>1)?K1=K[1]:0; + L1=lsort(L1,"sort",[0,K0]); + if(T<4&&type(C2)==4&&length(L2[0])>1){ + L2=lsort(L2,"col",["put"]|c1=cons(K1,C2)); /* add key and extract columns */ + C2=0;K1=0; + } + L2=lsort(L2,"sort",[0,K1]); + for(R0=[],S=S1=length(L1[0]);S>0;S--) R0=cons("",R0); + for(R1=[],S=length(L2[0]);S>0;S--) R1=cons("",R1); + if(!K1&&T!=3) R1=cdr(R1); + for(R=[];L1!=[];L1=cdr(L1)){ + while(L2!=[]&&car(L1)[K0]>car(L2)[K1]){ + if(T==3) R=cons(append(R0,car(L2)),R); + L2=cdr(L2); } + if(L2==[]||car(L1)[K0]3||R1==[])?car(L1):append(car(L1),R1),R); + }else if(T==0||T==2||T==3){ + if(R0==[]) R=append(car(L1),R); + else R=cons(append(car(L1),(!K1&&T!=3)?cdr(car(L2)):car(L2)),R); + L2=cdr(L2); + }else if(T==4||T==5){ + V1=ltov(car(L1));V2=ltov(car(L2)); + for(D1=C1,D2=C2;D1!=[];D1=cdr(D1),D2=cdr(D2)) + if((I=V2[car(D2)])!=""||T==4) V1[car(D1)+1]=I; + R=cons(vtol(V1),R); + } } - R=msort(R,[],[1,0,K0]); - R=msort(R,0,[1]|c1=(T1!=0&&T!=3)?[0]:[0,length(L1)+K[1]]); - if(type(C1)!=4&&type(C2)!=4) return R; - C=[];S0=size(L1); - if(type(C1)==4) - for(;C1!=[];C1=cdr(C1)) C=cons(car(C1),C); - else for(I=0;IK1)?S0:(S0-1); - C=cons(car(C1)+F,C); + if(T==3){ + while(L2!=[]){ + R=cons(append(R0,car(L2)),R); + L2=cdr(L2); } - }else -*/ - for(I=0;I1) L2=cdr(L2); + } + return reverse(R); + } + if(T==10||TT=="cmp"){ + if(length(L1)!=length(L2)){ + mycat("Different length!"); + return 1; + } + R=[]; + if(type(car(L1))==4){ + for(U=[],I=0;L1!=[];I++,L1=cdr(L1),L2=cdr(L2)){ + if(length(S=car(L1))!=length(T=car(L2))){ + mycat(["Different size : line ",I]); + return 0; + } + for(J=0;S!=[];S=cdr(S),T=cdr(T),J++) + if(car(S)!=car(T)) U=cons([[I,J],car(S),car(T)],U); + } + if(U!=[]) R=cons(reverse(U),R); + }else{ + for(I=0;L1!=[];L1=cdr(L1),L2=cdr(L2),I++) + if(car(L1)!=car(L2)) R=cons([I,car(L1),car(L2)],R); + } + return reverse(R); + } + if(T==11||TT=="append"){ + if(type(car(L1))!=4) return append(L1,L2); + for(R=[];L1!=[];L1=cdr(L1),L2=cdr(L2)) + R=cons(append(car(L1),car(L2)),R); + return reverse(R); + } if(T == 1 || T == 2){ L1 = lsort(L1,[],1); L2 = lsort(L2,[],1); @@ -3260,6 +3718,20 @@ def msort(L,S) return qsort(L,os_md.mqsub); } +def lpair(A,B) +{ + if(B==0){ + for(S=T=[];A!=[];A=cdr(A)){ + S=cons(car(A)[0],S);T=cons(car(A)[1],T); + } + return [reverse(S),reverse(T)]; + }else{ + for(R=[];A!=[];A=cdr(A),B=cdr(B)) + R=cons([car(A),car(B)],R); + return reverse(R); + } +} + def lmax(L) { if(type(L)==4){ @@ -3393,16 +3865,34 @@ def lnsol(VV,L) def ladd(X,Y,M) { - if(type(X)==4) X=ltov(X); if(type(Y)==4) Y=ltov(Y); + if(type(X)==4) X=ltov(X); return vtol(X+M*Y); } def mrot(X) { + if(type(X)==4){ + if(getopt(deg)==1) + X=[deval(@pi*X[0]/180),deval(@pi*X[1]/180),deval(@pi*X[2]/180)]; + if(getopt(conj)==1) + return mrot([-X[2],-X[1],0])*mrot([X[0],X[1],X[2]]); + if(X[1]==0){ + X=[X[0]+X[2],0,0]; + if(X[0]==0) return diagm(3,[1]); + } + if(X[0]!=0){ + M=mat([dcos(X[0]),-dsin(X[0]),0],[dsin(X[0]),dcos(X[0]),0],[0,0,1]); + if(X[1]==0) return M; + } + N=mat([dcos(X[1]),0,-dsin(X[1])],[0,1,0],[dsin(X[1]),0,dcos(X[1])]); + if(X[0]!=0) N=M*N; + if(X[2]==0) return N; + return N*mrot([X[2],0,0]); + } if(getopt(deg)==1) X=@pi*X/180; X=deval(X); - return mat([dcos(X),dsin(X)],[-dsin(X),dcos(X)]); + return mat([dcos(X),-dsin(X)],[dsin(X),dcos(X)]); } def m2v(M) @@ -4496,6 +4986,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))!=[]){ @@ -4691,11 +5182,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;I0;N--,P-=1) S*=P/N; return red(S); } @@ -5564,6 +6056,7 @@ def expower(P,R,N) def seriesHG(A,B,X,N) { + if(N==0) return 1; if(type(N)!=1 || N<0) return 0; if(type(X)<4){ for(K=0,S=S0=1;K2||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;I3){ + 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=cons(red(To),cdr(Var)); + 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 -7; + 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=0;I--){ + P=IL[I];Q=mydiff(P,t); + for(J=0;J=0;I--) L=cons(num(TL[I]),L); + } + } + } + if(F==-3) return [Var,L]; + for(I=0;I=0 && IT=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;I30) 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=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=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;I0)?1:-1; + } + if(type(X)==5) X=vtol(X); + if(type(X)==4){ + for(W=0,Y=X;Y!=[];Y=cdr(Y)) + for(Z=cdr(Y);Z!=[];Z=cdr(Z)) + if(car(Y)>car(Z)) W++; + if(getopt(val)==1) return W; + return (iand(W,1))?-1:1; + } +} + def calc(X,L) { - if(type(X)<4){ - if(type(L)==4){ + if(type(X)<4||type(X)==7){ + if(type(L)==4||type(L)==7){ V=L[1]; - if((L0=L[0])=="+") X+=V; - else if(L0=="-") X-=V; - else if(L0=="*") X*=V; - else if(L0=="/") X/=V; - else if(L0=="^") X^=V; - else if(L0==">") X=(X>V); - else if(L0=="<") X=(X") X=(X>V); + else if(L0=="<") X=(X=") X=(X>=V); else if(L0=="<=") X=(X<=V); else if(L0=="!=") X=(X!=V); - }else if(type(L)==7){ + }else if(type(L)==7&&type(X)<4){ if(L=="neg") X=-X; else if(L=="abs") X=abs(X); else if(L=="neg") X=-X; @@ -7198,6 +8016,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; @@ -7443,6 +8267,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; } @@ -7467,6 +8293,7 @@ def spgen(MO) B=cons(sub_str(S,P0,P1-1),B); } } + close_file(Id); }else{ MO/=2; if(L1<=1) L1=MO+4; @@ -7732,7 +8559,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){ @@ -7741,7 +8568,6 @@ def chkspt(M) } return fspt(M,Opt); } - MR = fspt(M,1); P = length(M); OD = -1; XM = newvect(P); @@ -7764,8 +8590,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; } @@ -7782,13 +8608,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) @@ -7903,7 +8730,7 @@ def redgrs(M) } L = cons([VM,EV], L); /* - if(R[2] >= 2){ */ /* digid */ + if(R[2] >= 2){ */ /* rigid */ /* P = dx^(R[1]); } */ } @@ -7930,62 +8757,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 = newvec(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] : @@ -7997,6 +8902,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"]; @@ -8041,6 +8948,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(M0;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;I0){ + 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]); @@ -8295,6 +9275,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 */ @@ -8306,14 +9287,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]]); } @@ -8325,6 +9306,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){ @@ -8336,9 +9321,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]=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; @@ -8643,7 +9748,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"){ @@ -8756,7 +9861,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); @@ -9824,6 +10929,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]; @@ -10095,7 +11201,17 @@ def tocsv(L) } str_tb("\n",Tb); } - return str_tb(0,Tb); + S=str_tb(0,Tb); + if(type(EXE=getopt(exe))!=1&&EXE!=0&&type(EXE)!=7) return S; + if(type(F)!=7){ + fcat(-1,0); + F="risaout"; + if(EXE>=2&&EXE<=9) F+=rtostr(EXE); + F=DIROUTD+F+".csv"; + }else F=S; + if(EXE!=0 && access(F)) remove_file(F); + fcat(F,S|exe=1); + return 1; } def readcsv(F) @@ -10108,10 +11224,11 @@ def readcsv(F) else if(type(V)==1) V=[V]; else V=[]; } + Eq=getopt(eq); Sp=getopt(sp); if(type(T=getopt(col))!=1) T=0; Null=getopt(null); - if(type(Null)<0) Null=""; + if(type(Null)<0) Null=(Eq==1)?0:""; while((S=get_line(ID))!=0){ S=strtoascii(S); N=length(S); @@ -10139,21 +11256,28 @@ def readcsv(F) LT=cons(C,LT);continue; } LS=asciitostr(reverse(LT)); - if(V==1||findin(++J,V)>=0) LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); + if(V==1||findin(++J,V)>=0){ + if(Eq==1) LS=(LS=="")?Null:eval_str(LS); + else LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); + } if(!T || T==J) LL=cons(LS,LL); if(F==-2) while(++I0)){ /* lastline */ LS=asciitostr(reverse(LT)); - if(findin(++J,V)>=0) LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); + if(V==1||findin(++J,V)>=0){ + if(Eq==1) LS=(LS=="")?Null:eval_str(LS); + else LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); + } if(!T || T==J) LL=cons(LS,LL); } L=cons(reverse(LL),L); } close_file(ID); if(T) L=m2l(L|flat=1); - return reverse(L); + L=reverse(L); + return L; } def showbyshell(S) @@ -10175,7 +11299,7 @@ def getbyshell(S) Tmp=str_subst(DIROUT,["%HOME%","%ASIRROOT%"],[Home,get_rootdir()]); Sep=isMs()?"\\":"/"; F=Tmp+Sep+"muldif.tmp"; - if(type(S)<=1 && S>=0) close_file(Id); + if(type(S)<=1 && S>=0) close_file(S); remove_file(F); if(type(S)<=1) return -1; shell(S+" > \""+F+"\""); @@ -10622,11 +11746,11 @@ def mtotex(M) def sint(N,P) { - if( type(N)==1 ) { + if( type(N)==1 || N==0 ) { NT=ntype(N); if((type(Opt=getopt(str))==1 || Opt==0) && Opt>=0 && P>=0){ if(Opt==2 || Opt==4 || Opt==0){ - if(N==0) return "0"; + if(N==0) return (Opt>0)?"0":0; Pw=0; if(NT==4){ NN=abs(real(N));N1=abs(imag(N)); @@ -10670,16 +11794,18 @@ def sint(N,P) N=-N; Neg="-"; }else Neg=""; + N=rint(N*10^P)/10^P; NN=floor(N); + NV=(N-NN+1)*10^P; NS=rtostr(NN); if(P<=0) return Neg+NS; if(NN==0 && getopt(zero)==0) NS=""; - return Neg+NS+"."+str_cut(rtostr(rint((N-NN+1)*10^P)),1,P); + return Neg+NS+"."+str_cut(rtostr(NV),1,P); } if(NT==4) return sint(real(N),P)+sint(imag(N),P)*@i; X = rint( N*10^P ); - return ((X+1.0)-1.0)/10^P; + return deval(X/10^P); } if( (type(N)==2) || (type(N)==3) ){ NN = eval(N); @@ -10701,9 +11827,9 @@ def frac2n(N) if((T=type(N))<0) return N; E=(getopt(big)==1)?eval(@e):0.1; if(T==1){ - if(ntype(N)==0) return (E+N)-E; + if(ntype(N)==0) return (E*N)/E; else if(ntype(N)!=4) return N; - else return (E*(1+@i)+N)-E*(1+@i); + else return (E*(1+@i)*N)/(E*(1+@i)); } if(T==3||T==2){ N=red(N); @@ -10711,7 +11837,7 @@ def frac2n(N) for(S=0,I=mydeg(Nm,V);I>=0;I--) S+=frac2n(mycoef(Nm,I,V))*V^I; return S/dn(N); } - if(T<4) return (N+E)-E; + if(T<4) return (E*N)/E; #ifdef USEMODULE return mtransbys(os_md.frac2n,N,[]|option_list=getopt()); #else @@ -10830,7 +11956,6 @@ def xyline(P,Q) def xylines(P) { -/* mycat([P,getopt()]); */ Lf=getopt(curve); if(type(Lf)!=1) Lf=0; SS=getopt(opt); @@ -10989,9 +12114,357 @@ def saveproc(S,Out) } } +def xygrid(X,Y) +{ + for(RR=[],I=0,Z=X;I<2;I++){ + U=Z[2];L=LL=[];M=Z[3]; + if(Z[1]==1||Z[1]==-1){ + if(type(M)==4) L=M; + else{ + if(U*(-dlog(1-1/20)/dlog(10))>=M){ + L=cons([1,2,1/10],L); + LL=cons([1,2,1/2],LL); + }else if(U*(-dlog(1-1/10)/dlog(10))>=M) + L=cons([1,2,1/5],L); + else if(U*(-dlog(1-1/4)/dlog(10))>=M) + L=cons([1,2,1/2],L); + if(U*(-dlog(1-1/50)/dlog(10))>=M){ + L=cons([2,5,1/10],L); + LL=cons([2,5,1/2],LL); + }else if(U*(-dlog(1-1/25)/dlog(10))>=M) + L=cons([2,5,1/5],L); + else if(U*(-dlog(1-1/10)/dlog(10))>=M) + L=cons([2,5,1/2],L); + if(U*(-dlog(1-1/100)/dlog(10))>=M){ + L=cons([5,10,1/10],L); + LL=cons([5,10,1/2],LL); + } + else if(U*(-dlog(1-1/50)/dlog(10))>=M) + L=cons([5,10,1/5],L); + else if(U*(-dlog(1-1/20)/dlog(10))>=M) + L=cons([5,10,1/2],L); + L=cons(L,cons(LL,[[[1,10,1]]])); + } + R=scale(L|scale=U); + if(Z[1]==-1){ + for(LL=[];R!=[];R=cdr(R)){ + for(L=[],T=car(R);T!=[];T=cdr(T)) L=cons(U-car(T),L); + LL=cons(reverse(L),LL); + } + R=reverse(LL); + } + }else if(Z[1]==0){ + if(type(M)==4){ + R=scale(M|f=x,scale=U); + }else{ + V=0; + if(U/10>=M) V=1/10; + else if(U/5>=M) V=1/5; + else if(U/2>=M) V=1/2; + R=[]; + if(V>0){ + UU=U*V; + for(R=[],J=UU;J0;J--){ + U=lsort(S[J],U,0);S[J-1]=lsort(S[J-1],U,1); + } + RR=cons(vtol(S),RR); + Z=Y; + } + if((Raw=getopt(raw))==1) return RR; + SS=[]; + if(type(Sf=getopt(shift))==7){ + Sx=Sf[0];Sy=Sf[1]; + }else Sx=Sy=0; + for(I=0;I<2;I++){ + for(S0=[],L=RR[I];L!=[];L=cdr(L)){ + for(S=[],T=car(L);T!=[];T=cdr(T)){ + if(S!=[]) S=cons(0,S); + if(I==0){ + S=cons([X[0]+Sx,car(T)+Sy],S); + S=cons([Sx,car(T)+Sy],S); + }else{ + S=cons([car(T)+Sx,Y[0]+Sy],S); + S=cons([car(T)+Sx,Sy],S); + } + } + S0=cons(S,S0); + } + SS=cons(reverse(S0),SS); + } + SS=reverse(SS); + if(Raw==2) return SS; + if(length(Y)<5) T=[["",""]]; + else if(type(Y[4])==4) T=[Y[4]]; + else T=[Y[4],Y[4]]; + if(length(X[4])==4) T=cons([""],T); + else if(type(X[4])==4) T=cons(X[4],T); + else T=cons([X[4]],T); + for(Sx=Sy=[],I=0;I<2;I++){ + TT=T[I]; + for(V=SS[I];V!=[];V=cdr(V)){ + Op=car(TT); + if(length(TT)>1) TT=cdr(TT); + if(car(V)==[]) continue; + if(Op=="") S=xylines(car(V)); + else S=xylines(car(V)|opt=Op); + if(I==0) Sx=cons(S,Sx); + else Sy=cons(S,Sy); + } + } + for(S="",Sx=reverse(Sx), Sy=reverse(Sy);Sx!=[]&&Sy!=[];){ + if(Sx!=[]){ + S+=car(Sx);Sx=cdr(Sx); + } + if(Sy!=[]){ + S+=car(Sy);Sy=cdr(Sy); + } + } + return S; +} + + +def addIL(I,L) +{ + if(I==0){ + for(R=[];L!=[];L=cdr(L)) R=addIL(car(L),R); + return reverse(R); + } + if(type(In=getopt(in))==1){ + if(In==-1){ + J=JJ=I[1];I=I[0]; + for(R=[];L!=[];L=cdr(L)){ + J=lmin([car(L)[0],JJ]); + if(J>I) R=cons([I,J],R); + I=lmax([car(L)[1],I]); + } + if(II) return 0; + if(car(L)[1]>=I){ + if(In==3) return car(L); + if(In==1||(I!=car(L)[0]&&I!=car(L)[1])) return 1; + return 2; + } + } + return 0; + } + } + I0=car(I);I1=I[1]; + for(F=0,R=[];L!=[];L=cdr(L)){ + if(I0>car(L)[1]){ + R=cons(car(L),R); + continue; + } + if(I0<=car(L)[1]){ + I0=lmin([I0,car(L)[0]]); + if(I10) Db[I-1]=addIL([P-W+1,1],Db[I-1]); + if(P+W>1 && I+11) OL=[["opt",Opt[0]],["cmd",Opt[1]]]; + else OL=[["opt",Opt]]; + }else OL=[]; + S=xybezier(lbezier(Bf|inv=1)|option_list=OL); + if(Raw==1||!Dvi) return S; + return xyproc(S|dviout=Dvi); +} + +def rungeKutta(F,N,Lx,Y,IY) +{ + if((Pr=getopt(prec))==1){ + One=eval(exp(0)); + }else{ + One=1;Pr=0; + } + if((FL=getopt(last))!=1) FL=0; + if(length(Lx)>2){ + V=car(Lx);Lx=cdr(Lx); + }else V=x; + if(Pr==0) Lx=[deval(Lx[0]),deval(Lx[1])]; + else Lx=[eval(Lx[0]),eval(Lx[1])]; + if(type(Y)==4){ + if((Sing=getopt(single))==1||type(F)!=4) + F=append(cdr(Y),[F]); + L=length(Y); + for(TF=[];F!=[];F=cdr(F)) + TF=cons(f2df(car(F)),TF); + F=reverse(TF); + }else{ + L=1; + F=f2df(F); + } + if(getopt(val)==1) V1=1; + else V1=0; + H=(Lx[1]-Lx[0])/N;H2=H/2; + FV=findin(V,vars(F)); + K=newvect(4); + if(L==1){ + R=[[T=Lx[0],S=IY]]; + if(!H) return R; + for(;;){ + for(I=0;I<4;I++){ + if(I==0) W=[[V,T],[Y,S]]; + else if(I==3) W=[[V,T+H],[Y,S+H*K[2]]]; + else W=[[V,T+H2],[Y,S+H2*K[I-1]]]; + if(FV<0) W=cdr(W); + K[I]=Pr?myfeval(F,W)*One:myfdeval(F,W); + } + S+=(K[0]+2*K[1]+2*K[2]+K[3])*H/6;T+=H; + if(!FL) R=cons([deval(T),S],R); + if((T+H-Lx[1])*H>0) break; + } + }else{ + T=Lx[0]; + R=[cons(T,V1?[car(IY)]:IY)]; + S=ltov(IY); + if(!H) return R; + for(;;){ + for(I=0;I<4;I++){ + if(I==0) W=cons([V,T ],lpair(Y,vtol(S))); + else if(I==3) W=cons([V,T+H ],lpair(Y,vtol(S+H*K[2]))); + else W=cons([V,T+H2],lpair(Y,vtol(S+H2*K[I-1]))); + if(FV<0) W=cdr(W); + for(TK=[],TF=F;TF!=[];TF=cdr(TF)){ + TK=cons(Pr?myfeval(car(TF),W)*One:myfdeval(car(TF),W),TK); + } + K[I]=ltov(reverse(TK)); + } + S+=(K[0]+2*K[1]+2*K[2]+K[3])*H/6;T+=H; + TS=vtol(S); + if(V1) TS=[car(TS)]; + if(!FL) R=cons(cons(deval(T),TS),R); + if((T+H-Lx[1])*H>0) break; + } + } + return FL?(V1?S[0]:S):reverse(R); +} + def xy2graph(F0,N,Lx,Ly,Lz,A,B) { - /* (x,y,z) -> ( -x sin A + y cos A, z cos B - x cos A sin B - y sin A sin B) */ + /* (x,y,z) -> (z sin B + x cos A cos B + y sin A cos B, + -x sin A + y cos A, z cos B - x cos A sin B - y sin A sin B) */ if((Proc=getopt(proc))==1||Proc==2){ OPT0=[["proc",3]]; }else{ @@ -11425,22 +12898,100 @@ def xy2graph(F0,N,Lx,Ly,Lz,A,B) if(Dvi<0) return Lout; } +def orthpoly(N) +{ + F=0; + if(type(P=getopt(pol))==7){ + for(L=["Le","Ge","Tc","2T","Ja","He","La","Se"];L!=[];L=cdr(L),F++) + if(str_str(P,car(L)|end=2)==0) break; + }else P=0; + if(type(D=N)==4) D=N[0]; + if(!isint(D)||D<0) return 0; + if(F==0) return seriesHG([-D,D+1],[1],(1-x)/2,D); + if(F==1) return red(seriesHG([-D,D+2*N[1]],[N[1]+1/2],(1-x)/2,D)*binom(D+2*N[1]-1,D)); + if(F==2) return seriesHG([-D,D],[1/2],(1-x)/2,D); + if(F==3){ + if(D==0) return 0; + return orthpoly([D-1,1]|pol="Ge"); + } + if(F==4) return red(seriesHG([-D,D+N[1]],[N[2]],x,D)); + if(F==5){ + for(S=I=1;I<=D;I+=2) S*=I; + if(iand(D,1)) return seriesHG([-(D-1)/2],[3/2],x^2/2,D-1)*x*S*(-1)^((D-1)/2); + else return seriesHG([-D/2],[1/2],x^2/2,D)*S*(-1)^(D/2); + } + if(F==6){ + NN=(type(N)==4)?N[1]:0; + return red(seriesHG([-D],[NN+1],x,D)*binom(D+NN,D)); + } + if(F==7){ + NN=N[1]; + for(S=1,I=1;I<=D;I++) S+=(-1)^I*binom(D,I)*binom(D+I,I)*sftpow(x,I)/sftpow(NN,I); + return S; + } + return 0; +} + +def schurpoly(L) +{ + N=length(L); + for(R=[],I=1;L!=[];L=cdr(L),I++) R=cons(car(L)+N-I,R); + L=reverse(R); + if(type(X=getopt(var))!=4){ + V=(type(X)>1)?X:"x"; + for(X=[],I=0;I0) Y=deval(Y); + else Y=0; + if((V=getopt(const))==0||type(V)>0){ + V=myfeval(V,Y); + K=1; + }else K=0; if(A!=[]&&type(car(A))>1){ - for(C=[],I=A[1];I>=0;I--) C=cons(myfeval(car(A),I),C); + for(C=[],I=A[1];I>=K;I--) C=cons(myf2eval(car(A),I,Y),C); + if(K) C=cons(0,C); A=C; } + if(K){ + if(A!=[]) A=cdr(A); + A=cons(V,A); + } if(B!=[]&&type(car(B))>1){ - for(C=[],I=B[1];I>0;I--) C=cons(myfeval(car(B),I),C); + for(C=[],I=B[1];I>0;I--) C=cons(myf2eval(car(B),I,Y),C); B=C; } - R=0; + L=length(B)+1; + if(length(A)>=L) L=length(A)+1; + if(type(Sum=getopt(sum))>0){ + if(Sum==1) Sum=1-x; + else if(Sum==2) Sum=[(z__)/(3.1416*x),[z__,os_md.mysin,3.1416*x]]; + else Sum=f2df(Sum); + C=[]; + if(A!=[]){ + C=cons(car(A),C); + A=cdr(A); + } + for(I=1;A!=[];A=cdr(A),I++) C=cons(car(A)*myf2eval(Sum,I/L,L),C); + A=reverse(C); + for(C=[],I=1;B!=[];B=cdr(B),I++) C=cons(car(B)*myf2eval(Sum,I/L,L),C); + B=reverse(C); + } if(getopt(cpx)==1){ - if(type(X=eval(X))>1) return todf([os_md.fouriers,[["cpx",1]]],[[A],[B],[X]]); + if(type(X=eval(X))>1) return todf([os_md.fouriers,[["cpx",1]]],[[A],[B],[X]]); V=dexp(@i*X); for(C=A,P=1,I=0;C!=[];C=cdr(C),I++){ - R+=car(C)*P; + R+=S*car(C)*P; P*=V; } V=dexp(-@i*X); @@ -11485,7 +13036,7 @@ def mysin(Z) def mytan(Z) { if(type(Z=eval(Z))>1) return todf(os_md.mytan,[Z]); - if((Im=imag(Z))==0) return dsin(Z); + if((Im=imag(Z))==0) return dtan(Z); V=myexp(2*Z*@i); return @i*(1-V)/(1+V); } @@ -11956,10 +13507,6 @@ def compdf(F,V,G) { FL=["abs","floor","rint","zeta","gamma","arg","real","imag","conj"]; FS=[os_md.abs,floor,rint,os_md.zeta,os_md.gamma,os_md.myarg,real,imag,conj]; - if(type(V)==4){ - for(;V!=[];V=cdr(V),G=cdr(G)) F=compdf(F,car(V),car(G)); - return F; - } if(type(F)==7){ if(str_str(F,"|")==0){ F="abs("+str_cut(F,1,str_len(F)-2)+")"; @@ -11980,7 +13527,20 @@ def compdf(F,V,G) } if(type(F)!=4) F=f2df(F); if(type(G)!=4) G=f2df(G); + if(V==G) return F; /* subst(F(V),V,G) */ VF=vars(F);VG=vars(G); + if(type(V)==4){ + for(VT=[],VV=V;VV!=[];VV=cdr(VV)){ + if(findin(car(VV),VF)>=0){ + X=makenewv(append(VF,VG)); + VF=cons(X,VF); + F=mysubst(F,[car(VV),X]); + VT=cons(X,VT); + }else VT=cons(car(VV),VT); + } + for(V=reverse(VT);V!=[];V=cdr(V),G=cdr(G)) F=compdf(F,car(V),car(G)); + return F; + } for(E=I=0;I<30;I++){ for(J=0;J<30;J++){ X=makev(["z__",I,J]); @@ -11991,7 +13551,6 @@ def compdf(F,V,G) if(E) break; } if(!E) return 0; - if(V==G) return F; /* subst(F(V),V,G) */ if(type(G)<4) return mysubst(F,[V,G]); if(type(F)<4) F=[F]; /* return compdf([X,[X,0,F]],V,G); */ F=mysubst(F,[V,X]); @@ -12439,7 +13998,8 @@ def xygraph(F,N,LT,LX,LY) } V=reverse(NV); } - if(getopt(raw)==1) return V; + if((Raw=getopt(raw))==1) return V; + if(Raw==2) return [V,LT]; OL=[["curve",1]];OLP=[]; if(type(C=getopt(ratio))==1){ OL=cons(["ratio",C],OL);OLP=cons(["ratio",C],OLP); @@ -12697,7 +14257,11 @@ def polroots(L,V) Lim=Lim2=[]; if(type(L)<4){ if(type(Lim=getopt(lim))==4){ - if(type(Lim[0])!=4) Lim=[Lim]; + if(type(Lim[0])!=4){ + if(!isvar(Lim[0])) Lim=cons(V,[Lim]); + Lim=[Lim]; + } + if(!isvar(Lim[0][0])) Lim=[cons(V,Lim)]; Lim=delopt(Lim,V|inv=1); if(Lim!=[]){ Lim=Lim[0]; @@ -12759,7 +14323,7 @@ def polroots(L,V) if(SS==0&&INIT==1){ SS=polroots(L,V|option_list=OL); if(SS!=0) return SS; - for(C=0;SS==0&&C<4;C++){ + for(C=0;SS==0&&C<5;C++){ I=(C==0)?1:(iand(random(),0xff)-0x80); for(LL=[],K=length(L)-1;K>=0;K--){ for(Q=0,J=length(L)-1;J>=0;J--) @@ -12785,6 +14349,7 @@ def polroots(L,V) for(SS=[];R!=[];R=cdr(R)){ RS=(N==2)?[car(R)]:car(R); for(I=0,L0=L[0];Icar(V)[0]) continue; + if(car(V)==[]||X>car(V)[0]) continue; if(X==car(V)[0]) return car(V)[1]; return myfeval(F,Y); } } -def fsum(F,L,X) +def fsum(F,L) { + if(getopt(df)==1){ + F=f2df(F); + }else Sub=getopt(subst); if(type(L[0])==2){ X=L[0]; L=cdr(L); @@ -12992,7 +14560,7 @@ def fsum(F,L,X) V=(length(L)>2)?L[2]:1; for(R=0,I=L[0];;I+=V){ if(V==0||(I-L[1])*V>0) return R; - R+=os_md.myfeval(F,X?[X,I]:I); + R+=(Sub==1)?subst(F,X?X:x,I):os_md.myfeval(F,X?[X,I]:I); } } @@ -13001,19 +14569,19 @@ def periodicf(F,L,X) if(type(L)==4) L=[eval(L[0]),eval(L[1])]; else L=eval(L); if(isvar(X)){ - Y=makenewv([X,V]); - if(type(F)==5) return [Y,[Y,os_md.periodicf,[F],L,X]]; - Z=makenewv([X,Y,V]); - return [Z,[Z,os_md.periodicf,[mysubst(F,[x,Y])],[L],[[Y,X]]]]; + Y=makenewv([X,F]); + Z=makenewv([X,Y,F]); + return [Z,[Z,os_md.periodicf,[mysubst(F,[x,Y])],(type(L)==4)?[L]:L,[[Y,X]]]]; } - X=eval(X); - if(type(F)==5) - return myfeval(F[floor(X/L)%length(F)],X-floor(X/L)*L); + if(type(X)==4){ + V=X[0]; + X=X[1]; + }else V=x; + if(type(F)==5){ + X=eval(X); + return myfeval(F[floor(X/L)%length(F)],[V,X-floor(X/L)*L]); + } if(type(L)==4){ - if(type(X)==4){ - V=X[0]; - X=X[1]; - }else V=x; X-=floor((X-L[0])/(L[1]-L[0]))*(L[1]-L[0]); return myfeval(F,[V,X]); } @@ -13410,6 +14978,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){ @@ -13798,6 +15398,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){ @@ -14086,16 +15719,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(VM1) 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(VM1) 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; } @@ -14410,7 +16054,7 @@ def ltotex(L) else Hline=subst(Hline,z,S); for(VV=[],VT=Hline;VT!=[];VT=cdr(VT)){ if(type(T=car(VT))==4 && T[1]>0){ - for(I=T[0];I<=CS;I+=T[1]) VV=cons(I,VV); + for(I=T[0];I<=S;I+=T[1]) VV=cons(I,VV); }else VV=cons(T,VV); } Hline=qsort(VV); @@ -14465,20 +16109,79 @@ def ltotex(L) } str_tb("\\end{tabular}\n",Out); }else if(Op==11){ /* graph */ - Width=8; Hight=3; WRet=1/2; HMerg=0.2; + if(type(Strip=getopt(strip))!=1) Strip=0; + if(type(MX=getopt(max))!=1) MX=0; + if(type(ML=getopt(mult))!=1) ML=0; + if((REL=getopt(relative))!=1) REL=0; + CL=getopt(color); + OL=delopt(getopt(),["color","strip","mult"]); + if(ML==1&&type(CL)==4){ + LL=L[1];L=L[0];K=length(L);S=T=""; + if(!MX){ + MX=vector(length(L[0])); + for(LT=L;LT!=[];LT=cdr(LT)){ + for(I=0,LTT=car(LT);LTT!=[];I++,LTT=cdr(LTT)){ + if(REL==1) MX[I]+=car(LTT); + else if(MX[I]=0;){ + if(REL==1){ + R=cons([MX[J],V=MX[J]+L[I][J]],R); + MX[J]=V; + }else R=cons([(!I)?0:L[I-1][J],L[I][J]],R); + } + OP=cons(["color",CL[I]],OL); + S+=ltotex([R,LL]|option_list=cons(["value",0],cons(["strip",(!I)?1:2],OP))); + T+=ltotex([R,LL]|option_list=cons(["strip",3],OP)); + } + return(!Strip)?xyproc(S+T):(S+T); + }else if(!TikZ) CL=0; + if(type(Line=getopt(line))!=1){ + if(type(Line)==4){ + if(type(Line[0])==1 && (type(Line[1])==7 || type(Line[1])==1)){ + Opt=Line[1]; Line=Line[0]; + }else if(ML==1){ + OL=delopt(OL,"line"); + LL=L[1];L=L[0];K=length(L);S=""; + if(!MX){ + MX=newvect(length(L[0])); + for(LT=L;LT!=[];LT=cdr(LT)){ + for(I=0,LTT=car(LT);LTT!=[];I++,LTT=cdr(LTT)){ + if(REL==1) MX[I]+=car(LTT); + else if(MX[I]2) WRet=V[2]; - if(length(V)>3) HMerg=V[3]; + if(length(V)>3) VMerg=VMerg=V[3]; + if(length(V)>4) HMerg=V[4]; } Val=getopt(value); if(!isint(Val)) Val=-1; - if(type(Shift=getopt(shift))!=1) - Shift=0; if(type(Line=getopt(line))!=1){ if(type(Line)==4 && type(Line[0])==1 && (type(Line[1])==7 || type(Line[1])==1)){ Opt=Line[1]; Line=Line[0]; @@ -14492,26 +16195,27 @@ def ltotex(L) if((S=car(LT))<=0) return 0; Sum+=S; } - for(R=[],LT=L;LT!=[];LT=cdr(LT)) - R=cons(car(LT)/Sum,R); + for(R=[],LT=L;LT!=[];LT=cdr(LT)) R=cons(car(LT)/Sum,R); R=reverse(R); Opt0=Opt*2/3; - Out=str_tb(xyproc(1),0); - str_tb(xylines(ptpolygon(6,Opt)|close=1,curve=1),Out); + Out=str_tb((Strip>0)?0:xyproc(1),0); + if(type(CL)!=4) str_tb(xylines(ptpolygon(6,Opt)|close=1,curve=1),Out); for(S=0,RT=R,LT=LL;RT!=[];RT=cdr(RT)){ - str_tb(xyline([0,0],[Opt*dsin(S*6.2832),Opt*dcos(S*6.2832)]),Out); - T=S+RT[0]/2; - S+=RT[0]; + SS=S+RT[0]; + if(type(CL)==4){ + str_tb(xyang(Opt,[0,0],(0.25-SS)*6.2832,(0.25-S)*6.2832|ar=1,opt=car(CL)),Out); + if(length(CL)>0) CL=cdr(CL); + }else str_tb(xyline([0,0],[Opt*dsin(S*6.2832),Opt*dcos(S*6.2832)]),Out); + T=(S+SS)/2; + S=SS; if(LT!=[]){ - str_tb(xyput([Opt0*dsin(T*6.2832),Opt0*dcos(T*6.2832),SS]),Out); + str_tb(xyput([Opt0*dsin(T*6.2832),Opt0*dcos(T*6.2832),car(LT)]),Out); LT=cdr(LT); } } - str_tb(xyproc(0),Out); + if(!Strip) str_tb(xyproc(0),Out); return str_tb(0,Out); } - if(type(MX=getopt(max))!=1) - MX=0; if(MX==0){ for(MX=0,LT=L; LT!=[]; LT=cdr(LT)) if(car(LT)>MX) MX=car(LT); @@ -14520,33 +16224,61 @@ def ltotex(L) S=length(L); WStep=Width/S; WWStep=WStep*WRet; - HStep=Hight/MX; + HStep=(Hight<0)?-Hight:Hight/MX; if(LL!=[]&&length(LL)==S-1) WS2=WStep/2; else WS2=0; - Out=str_tb(xyproc(1),0); - str_tb(xyline([0,0],[Width-WStep+WWStep,0]),Out); - if(TikZ) CL=getopt(color); - else CL=0; + Out=str_tb((Strip>0)?0:xyproc(1),0); + Hori=getopt(horiz); + if(Strip<2){ + if(Hori==1) str_tb(xyline([0,0],[0,Width-WStep+WWStep]),Out); + else str_tb(xyline([0,0],[Width-WStep+WWStep,0]),Out); + } for(I=0,LT=L;LT!=[]; LT=cdr(LT),I++){ - XP=WStep*I; XPM=XP+WWStep/2; YP=(car(LT)-Shift)*HStep; - if(Line!=0){ - if(I>0) - str_tb(xyarrow([XPM-WStep,YPP],[XPM,YP]|opt=Opt),Out); - if(Val!=0) - str_tb(xyput([XPM,YP+HMerg,car(LT)]),Out); - if(Line==2) - str_tb(xyput([XPM,YP,"$\\bullet$"]),Out); - YPP=YP; - }else if(YP!=0 || Val==1){ - if(CL) str_tb(xybox([[XP,0],[XP+WWStep,YP]]|color=CL),Out); - else str_tb(xybox([[XP,0],[XP+WWStep,YP]]),Out); - if(Val!=0){ - str_tb(xyput([XPM,(YP<0)?(YP-HMerg):(YP+HMerg),car(LT)]),Out); + XP=WStep*I; XPM=XP+WWStep/2; + if(type(LTT=car(LT))==4){ + YP0=(car(LTT)-Shift)*HStep;YP=(LTT[1]-Shift)*HStep; + VL=LTT[1]; + if(REL) VL-=LTT[0]; + }else{ + YP0=0;YP=(LTT-Shift)*HStep;VL=LTT; + } + if(Hori==1){ + if(Line!=0){ + if(I>0) + str_tb(xyarrow([XPM,YP],[XPM-WStep,YPP]|opt=Opt),Out); + if(Val!=0) + str_tb(xyput([YP+HMerg, XPM,car(LT)]),Out); + if(Line==2) + str_tb(xyput([YP,XPM,"$\\bullet$"]),Out); + YPP=YP; + }else if(YP!=0 || Val==1){ + if(Strip!=3){ + if(CL) str_tb(xybox([[YP,XP+WWStep], [YP0,XP]]|color=CL),Out); + else str_tb(xybox([[YP,XP+WWStep],[YP0,XP]]),Out); + } + if(Val!=0) str_tb(xyput([(YP<0||REL==1)?(YP-HMerg):(YP+HMerg),XPM,VL]),Out); } + if(LL!=[]&&I0) + str_tb(xyarrow([XPM-WStep,YPP],[XPM,YP]|opt=Opt),Out); + if(Val!=0) + str_tb(xyput([XPM,YP+HMerg,car(LT)]),Out); + if(Line==2) + str_tb(xyput([XPM,YP,"$\\bullet$"]),Out); + YPP=YP; + }else if(YP!=0 || Val==1){ + if(Strip!=3){ + if(CL) str_tb(xybox([[XP,YP0],[XP+WWStep,YP]]|color=CL),Out); + else str_tb(xybox([[XP,YP0],[XP+WWStep,YP]]),Out); + } + if(Val!=0) str_tb(xyput([XPM,(YP<0||REL==1)?(YP-HMerg):(YP+HMerg),VL]),Out); + } + if(LL!=[]&&I0){ + 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=[];J47&&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)0){ + if(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(LScar(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 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]; @@ -16869,7 +18830,7 @@ def integrate(P,X) if(S!=RR) R=cons([[1,RR=S]],R); for(V=FR=[];R!=[];R=cdr(R)) if(car(R)!=FR) V=cons(FR=car(R),V); - Var=varargs(V|all=1)[1]; + Var=varargs(V|all=2); for(S0=[x0,x1,x2,x3],S=[t,s,u,v,w];S0!=[]&&S!=[];){ if(findin(car(S0),Var)<0){ S0=cdr(S0); continue; @@ -18000,10 +19961,10 @@ def linfrac01(X) def varargs(P) { - if((All=getopt(all))!=1) All=0; + if((All=getopt(all))!=1&&All!=2) All=0; V=vars(P); for(Arg=FC=[];V!=[];V=cdr(V)){ - if(vtype(CV=car(V))==0&&All==1){ + if(vtype(CV=car(V))==0&&All!=0){ Arg=lsort([CV],Arg,0); } if(vtype(CV)!=2) continue; @@ -18020,7 +19981,8 @@ def varargs(P) } } } - return [FC,Arg]; + Arg=reverse(Arg); + return (All==2)?Arg:[reverse(FC),Arg]; } def pfargs(P,X) @@ -18235,9 +20197,83 @@ def ntable(F,II,D) { F=f2df(F|opt=-1); Df=getopt(dif); - if(Df!=1) Df=0; Str=getopt(str); - L=[];T=II[1]-II[0]; + if(Df!=1) Df=0; + L=[]; + if(type(D)==4){ + if(type(II[0])==4){ + T1=II[0][1]-II[0][0];T2=II[1][1]-II[1][0]; + for(L0=[],I=0;I=0){ + if(J==0) VV=str_cut(VV,1,10000); + else VV=str_cut(VV,0,J-1)+str_cut(VV,J+1,10000); + } + V1=eval_str(VV); + if(I++) LT=cons(V1-V0,LT); + V0=V1; + } + DT=cons(LT,DT); + if((RT=cdr(RT))==[]){ + VE=rint(myfdeval(F,II[1])*10^Str[1]); + DT=cons([VE-V0],DT); + } + } + for(I=0,D=[],TT=DT;TT!=[];TT=cdr(TT)){ + if(!I++) V=car(TT)[0]; + else{ + T1=reverse(cons(V,car(TT))); + V=car(T1); + if(length(TT)>1) T1=cdr(T1); + D=cons(T1,D); + } + } + for(DD=[],TT=D;TT!=[];TT=cdr(TT)) + DD=cons([os_md.lmin(car(TT)),os_md.lmax(car(TT))],DD); + DD=reverse(DD); + L=lsort(L,DD,"append"); + } + } + L=lsort(L,L0,"cons"); + if(type(Top=getopt(top))==4||getopt(TeX)==1){ + if(type(Top)==4){ + K=length(L[0])-length(Top); + if(K>0&&K<4){ + if(K>1){ + Top=append(Top,["",""]); + K-=2; + } + if(K) Top=cons("",Top); + } + L=cons(Top,L); + } + if(type(H=getopt(hline))!=4) H=[0,1,z]; + if(type(V=getopt(vline))!=4) V=[0,1,(DF)?z-2:z]; + if(type(T=getopt(title))!=7) Out=ltotex(L|opt="tab",hline=H,vline=V); + else Out=ltotex(L|opt="tab",hline=H,vline=V,title=T); + if(Df) Out=str_subst(Out,"\\hline","\\cline{1-"+rtostr(length(L[0])-2)+"}"); + return Out; + } + return L; + } for(L=[],I=0;I<=D;I++){ X=II[0]+I*T/D; L=cons([X,myfdeval(F,X)],L); @@ -18249,9 +20285,9 @@ def ntable(F,II,D) } L=reverse(LD); } - if(type(Str=getopt(str))==4){ + if(type(Str)==4){ if(length(Str)==1) Str=[Str[0],Str[0]]; - if(Df==1 && length(Str)==2) Str=[Str[0],Str[1],Str[2]]; + if(Df==1 && length(Str)==2) Str=[Str[0],Str[1],Str[1]]; for(S=Str,Str=[];S!=[];S=cdr(S)){ if(type(car(S))!=4) Str=cons([car(S),3],Str); else Str=cons(car(S),Str); @@ -18339,7 +20375,7 @@ def distpoint(L) def keyin(S) { - print(S,2); + mycat0(S,0); purge_stdin(); S=get_line(); L=length(S=strtoascii(S)); @@ -18372,7 +20408,7 @@ def init() { } if(Id>=0){ while((S=get_line(Id))!=0){ - if(type(P=str_str(S,LS))==4 && (P0=str_char(S,P[1]+5,"="))>0){ + if(type(P=str_str(S,LS))==4 && (P0=str_char(S,P[1]+4,"="))>0){ if(P[0]<5){ P0=str_chr(S,P0+1,"\""); if(P0>0){ @@ -18396,7 +20432,7 @@ def init() { else if(P[0]==7) TikZ=SV; else if(P[0]==8) XYPrec=SV; else if(P[0]==9) XYcm=SV; - else if(P[0]==10) XYcm=Canvas; + else if(P[0]==10) Canvas=SV; } } }