=================================================================== RCS file: /home/cvs/OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v retrieving revision 1.9 retrieving revision 1.78 diff -u -p -r1.9 -r1.78 --- OpenXM/src/asir-contrib/packages/src/os_muldif.rr 2017/05/11 04:55:18 1.9 +++ OpenXM/src/asir-contrib/packages/src/os_muldif.rr 2020/11/07 06:01:26 1.78 @@ -1,12 +1,12 @@ -/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.8 2017/05/10 02:37:37 takayama Exp $ */ -/* The latest version will be at ftp://akagi.ms.u-tokyo.ac.jp/pub/math/muldif +/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.77 2020/11/06 00:01:40 takayama Exp $ */ +/* The latest version will be at https://www.ms.u-tokyo.ac.jp/~oshima/index-j.html scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs */ #define USEMODULE 1 /* #undef USEMODULE */ /* os_muldif.rr (Library for Risa/Asir) - * Toshio Oshima (Nov. 2007 - Apr. 2017) + * Toshio Oshima (Nov. 2007 - Nov. 2020) * * For polynomials and differential operators with coefficients * in rational funtions (See os_muldif.pdf) @@ -21,13 +21,14 @@ module os_md; static Muldif.rr$ static TeXEq$ static TeXLim$ +static TeXPages$ static DIROUT$ +static DIROUTD$ static DVIOUTL$ static DVIOUTA$ static DVIOUTB$ static DVIOUTH$ static DVIOUTF$ -static FCAT$ static LCOPT$ static COLOPT$ static LPOPT$ @@ -43,6 +44,7 @@ static Canvas$ static ID_PLOT$ static Rand$ static LQS$ +static SVORG$ localf spType2$ localf erno$ localf chkfun$ @@ -58,6 +60,9 @@ localf countin$ localf mycoef$ localf mydiff$ localf myediff$ +localf mypdiff$ +localf pTaylor$ +localf pwTaylor$ localf m2l$ localf m2ll$ localf mydeg$ @@ -80,11 +85,13 @@ localf trpos$ localf sprod$ localf sinv$ localf slen$ +localf sexps$ localf sord$ localf vprod$ localf dvangle$ localf dvprod$ localf dnorm$ +localf dext$ localf mulseries$ localf pluspower$ localf vtozv$ @@ -92,6 +99,7 @@ localf dupmat$ localf matrtop$ localf mytrace$ localf mydet$ +localf permanent$ localf mperm$ localf mtranspose$ localf mtoupper$ @@ -112,10 +120,14 @@ localf myimage$ localf mymod$ localf mmod$ localf ladd$ +localf lsub$ localf lchange$ localf llsize$ localf llbase$ +localf llget$ localf lsort$ +localf rsort$ +localf lpair$ localf lmax$ localf lmin$ localf lgcd$ @@ -136,6 +148,7 @@ localf mpower$ localf mrot$ localf texlen$ localf isdif$ +localf isfctr$ localf fctrtos$ localf texlim$ localf fmult$ @@ -144,6 +157,8 @@ localf getel$ localf ptol$ localf rmul$ localf mtransbys$ +localf trcolor$ +localf mcolor$ localf drawopt$ localf execdraw$ localf execproc$ @@ -168,7 +183,10 @@ localf myasin$ localf myacos$ localf myatan$ localf mylog$ +localf nlog$ localf mypow$ +localf scale$ +localf iceil$ localf arg$ localf sqrt$ localf gamma$ @@ -180,6 +198,8 @@ localf eta$ localf jell$ localf frac$ localf erfc$ +localf orthpoly$ +localf schurpoly$ localf fouriers$ localf todf$ localf f2df$ @@ -231,12 +251,23 @@ localf sftpowext$ localf polinsft$ localf pol2sft$ localf polroots$ +localf sgnstrum$ +localf polstrum$ +localf polrealroots$ +localf polradiusroot$ localf fctri$ localf binom$ localf expower$ localf seriesHG$ localf seriesMc$ localf seriesTaylor$ +localf mulpolyMod$ +localf solveEq$ +localf res0$ +localf eqs2tex$ +localf baseODE$ +localf baseODE0$ +localf taylorODE$ localf evalred$ localf toeul$ localf fromeul$ @@ -250,6 +281,7 @@ localf expat$ localf polbyroot$ localf polbyvalue$ localf pcoef$ +localf pmaj$ localf prehombf$ localf prehombfold$ localf sub3e$ @@ -271,6 +303,7 @@ localf okuboetos$ localf heun$ localf fspt$ localf abs$ +localf sgn$ localf calc$ localf isint$ localf israt$ @@ -286,6 +319,7 @@ localf iscoef$ localf iscombox$ localf sproot$ localf spgen$ +localf spbasic$ localf chkspt$ localf cterm$ localf terms$ @@ -295,6 +329,7 @@ localf cutgrs$ localf mcgrs$ localf mc2grs$ localf mcmgrs$ +localf spslm$ localf anal2sp$ localf delopt$ localf str_char$ @@ -315,6 +350,8 @@ localf s2euc$ localf s2sjis$ localf r2ma$ localf evalma$ +localf evalcoord$ +localf readTikZ$ localf ssubgrs$ localf verb_tex_form$ localf tex_cuteq$ @@ -325,6 +362,7 @@ localf divmattex$ localf dviout0$ localf myhelp$ localf isMs$ +localf getline$ localf showbyshell$ localf readcsv$ localf tocsv$ @@ -340,7 +378,14 @@ localf texsp$ localf getbygrs$ localf mcop$ localf shiftop$ +localf shiftPfaff; localf conf1sp$ +localf confexp$ +localf confspt$ +localf vConv$ +localf mcvm$ +localf s2csp$ +localf partspt$ localf pgen$ localf diagm$ localf mgen$ @@ -357,6 +402,7 @@ localf fimag$ localf trig2exp$ localf intpoly$ localf integrate$ +localf rungeKutta$ localf simplog$ localf fshorter$ localf isshortneg$ @@ -373,9 +419,12 @@ localf primroot$ localf varargs$ localf ptype$ localf pfargs$ +localf regress$ localf average$ +localf tobig$ localf sint$ localf frac2n$ +localf openGlib$ localf xyproc$ localf xypos$ localf xyput$ @@ -396,19 +445,31 @@ localf periodicf$ localf cmpf$ localf areabezier$ localf saveproc$ +localf xyplot$ +localf xyaxis$ localf xygraph$ localf xy2graph$ +localf addIL$ +localf xy2curve$ +localf xygrid$ localf xyarrow$ localf xyarrows$ localf xyang$ localf xyoval$ +localf xypoch$ +localf xycircuit$ +localf ptline$ localf ptcommon$ +localf ptcontain$ localf ptcopy$ localf ptaffine$ localf ptlattice$ localf ptpolygon$ localf ptwindow$ +localf ptconvex$ localf ptbbox$ +localf darg$ +localf dwinding$ localf lninbox$ localf ptcombezier$ localf ptcombz$ @@ -424,13 +485,14 @@ localf msort$ extern Muldif.rr$ extern TeXEq$ extern TeXLim$ +extern TeXPages$ extern DIROUT$ +extern DIROUTD$ extern DVIOUTL$ extern DVIOUTA$ extern DVIOUTB$ extern DVIOUTH$ extern DVIOUTF$ -extern FCAT$ static LCOPT$ static COLOPT$ static LPOPT$ @@ -443,18 +505,24 @@ extern XYPrec$ extern XYcm$ extern TikZ$ extern XYLim$ +extern TeXPages$ 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"$ +extern Glib_math_coordinate$ +extern Glib_canvas_x$ +extern Glib_canvas_y$ +Muldif.rr="00201103"$ AMSTeX=1$ TeXEq=5$ TeXLim=80$ +TeXPages=20$ TikZ=0$ XYcm=0$ XYPrec=3$ @@ -465,12 +533,12 @@ DVIOUTL="%ASIRROOT%\\bin\\risatex0.bat"$ DVIOUTA="%ASIRROOT%\\bin\\risatex.bat"$ DVIOUTB="%ASIRROOT%\\bin\\risatex1%TikZ%.bat"$ DVIOUTH="start dviout -2 -hyper=0x90 \"%ASIRROOT%\\help\\os_muldif.dvi\" #%LABEL%"$ -FCAT="%TEMP%\\fcat.txt"$ DVIOUTF=0$ LCOPT=["red","green","blue","yellow","cyan","magenta","black","white","gray"]$ 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]]$ @@ -551,9 +619,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){ @@ -612,24 +678,36 @@ def mycat(L) Do = 1; } if(CR) print(""); + else print("",2); } def fcat(S,X) { if(type(S)!=7){ - if(S==-1) return FCAT; - if(S==0&&access(FCAT)) remove(FCAT); - S=FCAT; + if(type(DIROUTD)!=7){ + DIROUTD=str_subst(DIROUT,["%HOME%","%ASIRROOT%","\\"], + [getenv("HOME"),get_rootdir(),"/"])+"/"; + if(isMs()) DIROUTD=str_subst(DIROUTD,"/","\\"|sjis=1); + } + 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; } - output(S); + 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); @@ -638,6 +716,7 @@ def mycat0(L,T) Do = 1; } if(T) print(""); + else print("",2); } def findin(M,L) @@ -655,20 +734,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){ @@ -721,7 +804,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)); } @@ -743,6 +826,61 @@ def myediff(P,X) return red(X*diff(P,X)); } +def mypdiff(P,L) +{ + if(type(P)>3) return map(os_md.mypdiff,P,L); + for(Q=0;L!=[];L=cdr(L)){ + Q+=mydiff(P,car(L))*L[1]; + L=cdr(L); + } + return red(Q); +} + +def pTaylor(S,X,N) +{ + if(!isvar(T=getopt(time))) T=t; + if(type(S)<4) S=[S]; + if(type(X)<4) X=[X]; + if(findin(T,varargs(S|all=2))>=0){ + S=cons(z_z,S);X=cons(z_z,X);FT=1; + }else FT=0; + LS=length(S); + FR=(getopt(raw)==1)?1:0; + if(!FR) R=newvect(LS); + else R=R1=[]; + for(L=[],I=0,TS=S,TX=X;I1;N--){ + S=mypdiff(S,L); + K*=++M; + for(TS=S,I=0,R1=[];TS!=[];TS=cdr(TS),I++){ + if(!FR) R[I]+=car(TS)*t^M/K; + else R1=cons(car(TS)/K,R1); + } + if(FR) R=cons(reverse(R1),R); + } + if(FT){ + if(!FR){ + S=newvect(LS-1); + for(I=1;I= 4){ S=(type(P) == 6)?size(P)[0]:0; P = m2l(P); - for(I = 0, Deg = -3; P != []; P = cdr(P), I++){ - if( (DT = mydeg(car(P),X)) == -2) + for(I = 0, Deg = -100000; P != []; P = cdr(P), I++){ + if( (DT = mydeg(car(P),X)) == -2&&type(X)!=4) return -2; if(DT > Deg){ Deg = DT; @@ -783,8 +921,19 @@ def mydeg(P,X) return (Opt==1)?([Deg,(S==0)?II:[idiv(II,S),irem(II,S)]]):Deg; } P = red(P); - if(deg(dn(P),X) == 0) - return deg(nm(P),X); + if(type(X)==2){ + if(deg(dn(P),X) == 0) + return deg(nm(P),X); + }else{ + P=nm(red(P)); + for(D=-100000,I=deg(P,X[1]);I>=0;I--){ + if(TP=mycoef(P,I,X[1])){ + TD=mydeg(TP,X[0])-I; + if(D2)) 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); @@ -1136,6 +1286,18 @@ def slen(S) return V; } +def sexps(S) +{ + K=length(S);S=ltov(S); + for(R=[],I=0;I=0&&S[J]>S[J+1];J--){ + T=S[J];S[J]=S[J+1];S[J+1]=T; + R=cons(J,R); + } + } + return R; +} + def sord(W,V) { L = length(W); @@ -1169,6 +1331,7 @@ def sord(W,V) def vprod(V1,V2) { + V1=lsub(V1);V2=lsub(V2); for(R = 0, I = length(V1)-1; I >= 0; I--) R = radd(R, rmul(V1[I], V2[I])); return R; @@ -1176,24 +1339,36 @@ def vprod(V1,V2) def dnorm(V) { - if(type(V)<2) return dabs(V); + if(type(V)<2) return ctrl("bigfloat")?abs(V):dabs(V); + if((M=getopt(max))==1||M==2){ + if(type(V)==5) V=vtol(V); + for(S=0;V!=[];V=cdr(V)){ + if(M==2) S+=ctrl("bigfloat")?abs(car(V)):dabs(car(V)); + else{ + if((T=ctrl("bigfloat")?abs(car(V)):dabs(car(V)))>S) S=T; + } + } + return S; + } R=0; if(type(V)!=4) - for (I = length(V)-1; I >= 0; I--) R+= V[I]^2; + for (I = length(V)-1; I >= 0; I--) R+= real(V[I])^2+imag(V[I])^2; else{ if(type(V[0])>3){ V=ltov(V[0])-ltov(V[1]); return dnorm(V); } - for(;V!=[]; V=cdr(V)) R+=car(V)^2; + for(;V!=[]; V=cdr(V)) R+=real(car(V))^2+imag(car(V))^2; } - return dsqrt(R); + return ctrl("bigfloat")?pari(sqrt,R):dsqrt(R); } def dvprod(V1,V2) { if(type(V1)<2) return V1*V2; R=0; + V1=lsub(V1); + V2=lsub(V2); if(type(V1)!=4) for(I = length(V1)-1; I >= 0; I--) R += V1[I]*V2[I]; @@ -1204,6 +1379,13 @@ def dvprod(V1,V2) return R; } +def ptline(L,R) +{ + P=L[0];Q=L[1]; + return (Q[1]-P[1])*(R[0]-P[0])-(Q[0]-P[0])*(R[1]-P[1]); +} + + def dvangle(V1,V2) { if(V2==0 && type(V1)==4 && length(V1)==3 && @@ -1235,6 +1417,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; @@ -1325,6 +1756,30 @@ def mydet(M) } } +def permanent(M) +{ + SS=size(M); + if((S=SS[0]) != SS[1] || S==0) return 0; + if((Red=getopt(red))!=1){ + MM = matrtop(M); + for(Dn = 1, I = 0; I < S; I++) + Dn *= MM[1][I]; + return (!Dn)?0:red(permanent(MM[0]|red=1)/Dn); + } + if(S<3){ + if(S==1) return M[0][0]; + else return M[0][0]*M[1][1]+M[0][1]*M[1][0]; + } + LL=m2ll(M); + for(V=I=0;I3){ + 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; } @@ -1579,10 +2046,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); } } } @@ -1599,11 +2066,13 @@ def mtoupper(MM, F) KRC=-red((T[2]*dn(M[J0][K]))/(T[1]*dn(M[I][K]))); for(II=K;II GRS */ G=s2sp(M|std=1); L=length(G); @@ -3056,26 +3529,78 @@ 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 llget(L,LL,LC) +{ + if(type(LL)==4){ + LM=length(L); + for(R=[];LL!=[];LL=cdr(LL)){ + if(isint(TL=car(LL))) R=cons(TL,R); + else{ + IM=(length(TL)==1)?(LM-1):TL[1]; + for(I=car(TL);I<=IM;I++) R=cons(I,R); + } + } + LL=reverse(R); + if(LC==-1){ + LL=lsort(LL,[],1); + return lsort(L,"num",["sub"]|c1=LL); + } + L=lsort(L,"num",["get"]|c1=LL); + } + if(type(LC)==4){ + LM=length(L[0]); + for(R=[];LC!=[];LC=cdr(LC)){ + if(isint(TL=car(LC))) R=cons(TL,R); + else{ + IM=(length(TL)==1)?(LM-1):TL[1]; + for(I>=car(TL);I<=IM;I++) R=cons(I,R); + } + } + LC=reverse(R); + if(LL==-1){ + LC=lsort(LC,[],1); + return lsort(L,"col",["setminus"]|c1=LC); + } + L=lsort(L,"col",["put"]|c1=LC); + } + if(getopt(flat)==1) L=m2l(L|flat=1); + return L; +} + + 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); @@ -3083,83 +3608,162 @@ 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); } - R=cons(RT,R); + R=cons(reverse(RT),R); } 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); @@ -3276,6 +3925,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){ @@ -3315,24 +3978,49 @@ def lgcd(L) return []; } -def llcm(L) +def llcm(R) { - if(type(L)==4){ - F=getopt(poly); - V=car(L); - while((L=cdr(L))!=[]){ - if(V!=0){ - if((V0=car(L))!=0) - V=(F==1)?red(V*V0/gcd(V,V0)):ilcm(V,V0); + if(type(R)==5||type(R)==6) R=m2l(R); + if(type(R)<4) R=[R]; + if(type(R)!=4) return 0; + V=getopt(poly); + if(type(V)<1){ + for(L=R;L!=[];L=cdr(L)){ + if(type(car(L))>1){ + V=1; break; } - else V=car(L); } - if(F!=1&&V<0) V=-V; - return V; } - else if(type(L)==5||type(L)==6) - return llcm(m2l(L)|option_list=getopt()); - return []; + if(getopt(dn)!=1){ + for(L=[];R!=[];R=cdr(R)) if(R!=0) L=cons(1/car(R),L); + R=L; + } + P=1; + if(type(V)<1){ + for(;R!=[];R=cdr(R)){ + if(!(TL=car(R))) continue; + else P=ilcm(P,dn(TL)); + } + return P; + } + for(;R!=[];R=cdr(R)){ + if(!car(R)) continue; + D=dn(red(car(R))); + N=red(P/D); + if(type(V)<2){ + if(type(N)!=3) continue; + P*=dn(N); + continue; + } + if(ptype(N,V)>2){ + L=fctr(dn(N)); + for(;L!=[];L=cdr(L)){ + if(ptype(car(L)[0],V)<2) continue; + P*=car(L)[0]^car(L)[1]; + } + } + } + return P; } def ldev(L,S) @@ -3409,16 +4097,37 @@ def lnsol(VV,L) def ladd(X,Y,M) { - if(type(X)==4) X=ltov(X); + if(Y==0){ + Y=X[1];X=X[0]; + } 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) @@ -3677,21 +4386,21 @@ def texsp(P) def fctrtos(P) { /* extern TeXLim; */ - if(!chkfun("write_to_tb", "names.rr")) return 0; TeX = getopt(TeX); if(TeX != 1 && TeX != 2 && TeX != 3) TeX = 0; - if((Dvi=getopt(dviout)==1) && TeX<2) TeX=3; + if((Dvi=getopt(dviout)==1) && TeX<2) TeX=3; if(TeX>0){ Lim=getopt(lim); if(Lim!=0 && TeX>1 && (type(Lim)!=1||Lim<30)) Lim=TeXLim; else if(type(Lim)!=1) Lim=0; CR=(TeX==2)?"\\\\\n":"\\\\\n&"; - if(TeX==1 || Lim==0) CR=""; - else if((Pages=getopt(pages))==1) CR="\\allowdisplaybreaks"+CR; + CR2="\\allowdisplaybreaks"+CR; + if(TeX==1 || Lim==0) CR=CR2=""; + else if((Pages=getopt(pages))==1) CR2=CR; if(!chkfun("print_tex_form", "names.rr")) return 0; Small=getopt(small); @@ -3768,7 +4477,10 @@ def fctrtos(P) } VV=reverse(VV);VD=reverse(VD); Rev=(getopt(rev)==1)?1:0; - Dic=(getopt(dic)==1)?1:0; + Rdic=0; + if((Dic=getopt(dic))==2){ + Dic=Rdic=1; + }else if(Dic!=1) Dic=0; TT=terms(P,VV|rev=Rev,dic=Dic); if(TeX==0){ Pre="("; Post=")"; @@ -3776,7 +4488,7 @@ def fctrtos(P) Pre="{"; Post="}"; } Out = string_to_tb(""); - for(L=C=0,Tm=TT;Tm!=[];C++,Tm=cdr(Tm)){ + for(L=C=CC=0,Tm=TT;Tm!=[];C++,Tm=cdr(Tm)){ for(I=0,PC=P,T=cdr(car(Tm)),PW="";T!=[];T=cdr(T),I++){ PC=mycoef(PC,D=car(T),VV[I]); if(PC==0) continue; @@ -3788,7 +4500,8 @@ def fctrtos(P) else PT="^"+rtostr(D); } if(Dif>0) PW+=(Dif==1)?"d":"\\partial "; - PW+=VD[I]+PT; + if(Rdic) PW=VD[I]+PT+PW; + else PW+=VD[I]+PT; } } D=car(Tm)[0]; @@ -3797,10 +4510,12 @@ def fctrtos(P) if(D>1) Op+="^"+((D>9)?(Pre+rtostr(D)+Post):rtostr(D)); PW=Op+Add+"}{"+PW+"}"; }else if(Add!=0) PW=PW+Add; + CD=0; if(TeX>=1){ if(type(PC)==1 && ntype(PC)==0 && PC<0) OC="-"+my_tex_form(-PC); else OC=fctrtos(PC|TeX=1,br=1); + if(isint(PC)&&(PC<-1||PC>1)) CD=1; }else OC=fctrtos(PC|br=1); if(PW!=""){ if(OC == "1") OC = ""; @@ -3822,16 +4537,28 @@ def fctrtos(P) } } if(Lim>0){ + CC++; LL=texlen(OC)+texlen(PW); if(LL+L>=Lim){ if(L>0) str_tb(CR,Out); if(LL>Lim){ - if(TOC==7) OC=texlim(OC,Lim|cut=CR); - PW+=CR; L=0; + if(TOC==7) OC=texlim(OC,Lim|cut=[CR,CR2]); + if(length(Tm)!=1) PW+=CR; + L=0; }else L=LL; }else L+=LL; - }else if(length(Tm)!=1) PW += CR; /* not final term */ - if(TeX) OC=texsp(OC); + }else if(length(Tm)!=1){ + CC++; + PW += CR; /* not final term */ + } + if(CC>TeXPages) CR=CR2; + if(TeX){ + OC=texsp(OC); + if(CD){ /* 2*3^x */ + CD=strtoascii(str_cut(PW,0,1)); + if(length(CD)==2&&car(CD)==123&&isnum(CD[1])) OC+="\\cdots"; + } + } if(str_chr(OC,0,"-") == 0 || C==0) str_tb([OC,PW], Out); else{ str_tb(["+",OC,PW],Out); @@ -3861,14 +4588,14 @@ def fctrtos(P) if(imag(P)==0) P = fctr(P); /* usual polynomial */ else P=[[P,1]]; S = str_tb(0,0); - for(J = N = 0; J < length(P); J++){ - if(type(P[J][0]) <= 1){ - if(P[J][0] == -1){ + for(J = N = CD = 0; J < length(P); J++){ + if(type(V=P[J][0]) <= 1){ + if(V == -1){ write_to_tb("-",S); if(length(P) == 1) str_tb("1", S); - }else if(P[J][0] != 1){ - str_tb((TeX>=1)?my_tex_form(P[J][0]):rtostr(P[J][0]), S); + }else if(V != 1){ + str_tb((TeX>=1)?my_tex_form(V):rtostr(V), S); N++; }else if(length(P) == 1) str_tb("1", S); @@ -3876,6 +4603,7 @@ def fctrtos(P) str_tb((TeX>=1)?my_tex_form(P[1][0]):rtostr(P[1][0]), S); J++; } + if(J==0&&isint(V=P[J][0])&&(V<-1||V>1)) CD=1; continue; } if(N > 0 && TeX != 1 && TeX != 2 && TeX != 3) @@ -3886,19 +4614,23 @@ def fctrtos(P) if(nmono(P[J][0])>1|| (!isvar(P[J][0])||vtype(P[J][0]))&&str_len(SS)>1) SS="("+SS+")"; write_to_tb(SS,S); - str_tb(["^", (TeX>1)?rtotex(P[J][1]):monotos(P[J][1])],S); + str_tb(["^", (TeX>=1)?rtotex(P[J][1]):monotos(P[J][1])],S); }else{ - if(nmono(P[J][0])>1) SS="("+SS+")"; + if(nmono(P[J][0])>1&&length(P)>1) SS="("+SS+")"; + else if(CD&&J==1){ /* 2*3^x */ + CD=strtoascii(str_cut(SS,0,1)); + if(length(CD)==2&&car(CD)==123&&isnum(CD[1])) SS="\\cdot"+SS; + } write_to_tb(SS,S); } } S = str_tb(0,S); - if((Lim>0 || TP!=2) && CR!="") S=texlim(S,Lim|cut=CR); + if((Lim>0 || TP!=2) && CR!="") S=texlim(S,Lim|cut=[CR,CR2]); } if(TeX>0){ if(Small==1) S=str_subst(S,"\\frac{","\\tfrac{"); if(Dvi==1){ - dviout(strip(S,"(",")")|eq=(Pages==1)?6:0); S=1; + dviout(strip(S,"(",")")|eq=(Pages==1||Pages==2)?6:0); S=1; } } return S; @@ -3922,7 +4654,12 @@ def texlim(S,Lim) mycat(["Set TeXLim =",Lim]); return 1; } - if(type(Out=getopt(cut))!=7) Out="\\\\\n&"; + if(type(Out=getopt(cut))!=7){ + if(type(Out)!=4) Out=Out2="\\\\\n&"; + else{ + Out2=Out[1];Out=Out[0]; + } + } if(type(Del=getopt(del))!=7) Del=Out; if(Lim<30) Lim=TeXLim; S=ltov(strtoascii(S)); @@ -3953,6 +4690,7 @@ def texlim(S,Lim) SS=str_tb(0,0); L=cons(length(S),L); L=reverse(L); + if(length(L)>TeXPages) Out=Out2; for(I=0; L!=[]; I=J,L=cdr(L)){ str_tb((I==0)?"":Out,SS); J=car(L); @@ -4100,6 +4838,35 @@ def mtransbys(FN,F,LL) return call(FN, cons(F,LL)|option_list=Opt); } +def trcolor(S) +{ + if(type(S)!=7) return S; + return ((I=findin(S,LCOPT))>=0)?COLOPT[I]:0; +} + +def mcolor(L,P) +{ + if(type(L)!=4) return L; + if(!P||(S=length(L))==1){ + if(type(V=car(L))!=7) return V; + return trcolor(V); + } + P-=ceil(P)-1; + if(P==1){ + if(type(V=L[S-1])!=7) return V; + return trcolor(V); + } + for(S=P*(S-1);S>1;S--,L=cdr(L)); + if(getopt(disc)==1) S=0; + if(type(L0=L[0])==7) L0=trcolor(L0); + if(type(L1=L[1])==7) L1=trcolor(L1); + T=rint(iand(L0,0xff)*(1-S)+iand(L1,0xff)*S); + TT=iand(L0,0xff00)*(1-S)+iand(L1,0xff00)*S; + T+=rint(TT/0x100)*0x100; + TT=iand(L0,0xff0000)*(1-S)+iand(L1,0xff0000)*S; + return T+rint(TT/0x10000)*0x10000; +} + def drawopt(S,T) { if(type(S)!=7) return -1; @@ -4131,6 +4898,24 @@ def drawopt(S,T) return -1; } +def openGlib(W) +{ + extern Glib_canvas_x; + extern Glib_canvas_y; + extern Glib_math_coordinate; + + if(W==0){ + glib_clear(); + return; + } + if(type(W)==4&&length(W)==2){ + Glib_canvas_x=W[0]; + Glib_canvas_y=W[1]; + } + Glib_math_coordinate=1; + if(getopt(null)!=1) return glib_open(); +} + def execdraw(L,P) { if((Proc=getopt(proc))!=1) Proc=0; @@ -4383,6 +5168,12 @@ def execdraw(L,P) LOut=cons(T[2],Out); } } + }else if(T[0]==6){ /* plot */ + F++; + if((T1=findin(T[1],LCOPT))>-1) T1=COLOPT(T1); + else if(type(T1)!=1 && T1!=0) T1=0xffffff; + for(T2=ptaffine(M,T[2]|option_list=Org);T2!=[];T2=cdr(T2)) + draw_obj(Id,Ind,[rint(car(T2)[0]),rint(car(T2)[1])],T1); }else if(Proc==1&&type(T[0])==2){ if(length(T)<3) call(T[0],T[1]); else call(T[0],T[1]|option_list=T[2]); @@ -4432,7 +5223,10 @@ def execdraw(L,P) } } if(MM) V=ptaffine(MM,V|option_list=Org); - if(length(T)>3) V=append(V,T[3]); + if(length(T)>3){ + if(type(T2=T[3])==7) T2=[T2]; + V=append(V,T2); + } str_tb(xyput(V),Out); }else if(T[0]==3){ F++; @@ -4462,9 +5256,15 @@ def execdraw(L,P) if(P[0]==2) dviout(T[2]|option_list=T[1]); else LOut=cons(T[2],Out); } + }else if(T[0]==6){ /* plot */ + F++; + if(type(T[1])==7) T1=[T[1],"."]; + else T1="."; + for(T2=ptaffine(M,T[2]|option_list=Org);T2!=[];T2=cdr(T2)) + str_tb(xypos([car(T2)[0],car(T2)[1],T1]),Out); }else if(T[0]==-2) str_tb(["%",T[1],"\n"],Out); - else if(Proc==1&&type(T[0])==2){ + else if(Proc==1&&type(T[0])==2){ if(length(T)<3) call(T[0],T[1]); else call(T[0],T[1]|option_list=T[2]); } @@ -4512,6 +5312,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))!=[]){ @@ -4630,6 +5431,15 @@ def mmulbys(FN,P,F,L) def appldo(P,F,L) { + if(getopt(Pfaff)==1){ + L = vweyl(L); + X = L[0]; DX = L[1]; + for(I=mydeg(P,DX);I>0;I--){ + if(!(TP=mycoef(P,I,DX))) continue; + P=red(P-TP*DX^I+TP*muldo(DX^(I-1),F,L)); + } + return P; + } if(type(F) <= 3){ if(type(L) == 4 && type(L[0]) == 4) return applpdo(P,F,L); @@ -4707,11 +5517,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;I3) 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; @@ -5002,12 +5818,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]); @@ -5016,10 +5831,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); @@ -5072,7 +5902,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) @@ -5402,7 +6233,7 @@ def divdo(P,Q,L) } P -= muldo(SR*(DX)^(J-I),Q,L); S += SR*(DX)^(J-I); - } + } return [S,P,M]; } @@ -5564,7 +6395,7 @@ def pol2sft(F,A) def binom(P,N) { - if(type(N)!=1 || N<0) return 1; + if(type(N)!=1 || N<=0) return 1; for(S=1;N>0;N--,P-=1) S*=P/N; return red(S); } @@ -5580,6 +6411,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(L0=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; + if(Ord<0){ /* cancell y1, z1,... by baseODE0() */ + if(Ord==-1) Ord=2; + if(type(To)==4||!isvar(To)){ + L=L0=baseODE(L0|to=To,f=-3)[1]; + To=0; + } + R=baseODE0(L|option_list= + delopt(getopt(),[["var",Var],["ord",Ord]]|inv=1)); + if(TeX){ + if(type(R)==4&&length(R)>1&&type(R[1])==4) R=R[1]; + if(type(To)==2 && !isvar(To)){ + S0=baseODE(L0|TeX=1,f=-1,to=To); + V=baseODE0(L|step=-1,to=To); + }else{ + S0=baseODE(L0|TeX=1,f=-1); + V=baseODE0(L|step=-1,to=To); + } + T=eqs2tex(R,[V,2,Pages]); + S=((F==1)?(Tt+"\n"):S0)+texbegin("align*",T); + if(TeX==2) dviout(S); + return S; + } + return R; + } + if(To&&!isvar(To)){ + if(type(To)!=4){ + To=red(To); + for(K=0;K0&&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=0;I--){ + P=IL[I];Q=mydiff(P,t); + for(J=0;J=0;I--) L=cons(num(TL[I]),L); + } + } + } + if(F==-3&&!TeX) 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;I1 && isvar(L[1])) L=[L]; + R=car(L);L=cdr(L);Sgn=1; + }else R=[]; + if(type(R)==4&&car(R)==0){ + Sgn=0;R=cdr(R); + } + if(L!=[]){ + Dic=car(L);L=cdr(L); + } + if(L!=[]){ + Pages=car(L);L=cdr(L); + } + if(L!=[]) Cont=car(L); + if(type(P)==4){ + for(S="";P!=[];P=cdr(P)){ + S+=eqs2tex(car(P),[R,Dic,Pages,Cont]); + if(!Cont) Cont=1; + } +/* S=str_subst(S,"\\\\&,\\\\",",\\\\&"); */ + if(getopt(dviout)==1) dviout(S|eq=6); + return S; + } + if(type(R)==2) R=[R]; + if(Sgn){ + for(;R!=[];R=cdr(R)) + if((Deg=mydeg(P,car(R)))>0) break; + if(Deg>0){ + CP=mycoef(P,Deg,car(R)); + if(cmpsimple(-CP,CP)<0) P=-P; + } + } + S="&\\!\\!\\!"; + if(Cont) + S=(Pages?",\\allowdisplaybreaks":",")+"\\\\\n"+S; + S+=fctrtos(P|var=R,dic=Dic,TeX=3,pages=Pages); + if(getopt(dviout)==1) dviout(S|eq=6); + return S; +} + +/* Opt: var, opt, dbg */ +def res0(P,Q,X) +{ + if(!isvar(X)){ + if(!isvar(P)) return -1; + Y=P;P=Q;Q=X;X=Y; + } + if(isvar(Var=getopt(var))) Var=[Var]; + else if(type(Var)!=4) Var=0; + if(type(W=getopt(w))!=4) W=[]; + if(!isint(Opt=getopt(opt))&&type(Opt)!=4) Opt=0; + if(type(Dbg=getopt(dbg))==4){ + Fct=Dbg[1];Dbg=Dbg[0]; + } + if(!isint(Dbg)) Dbg=0; + P=nm(P);Q=nm(Q); + Fctr=isfctr(P)*isfctr(Q); + DP=deg(P,X);DQ=deg(Q,X); + if(DP==DQ&&nmono(coef(P,DP,X))0){ + if(DP=2) mycat([DP,"(",nmono(P), nmono(coef(P,DP,X)),") :", + DQ, "(",nmono(Q),nmono(coef(Q,DQ,X)), ")"]); + else mycat0([DP,":",DQ,","],0); + } + TQ=coef(Q,DQ,X);TP=coef(P,DP,X); + if(Fctr){ + T=gcd(TP,TQ);M=red(TQ/T); + if(Var&&M!=car(W)&&type(TV=vars(M))==4&&lsort(TV,Var,2)!=[]) W=cons(M,W); + P=M*(P-coef(P,DP,X)*X^DP)-red(TP/T)*X^(DP-DQ)*(Q-coef(Q,DQ,X)*X^DQ); + if(Var){ +#if 1 + if(Dbg>2) mycat0(">",0); + for(S=SS=fctr(P),P=1,C=0;S!=[];S=cdr(S)){ + TV=vars(S0=car(S)[0]); + if(type(TV)==4&&lsort(TV,Var,2)!=[]){ + for(TW=W;TW!=[];TW=cdr(TW)){ + if(gcd(car(TW),S0)!=1){ + S0=1;break; + } + } + if(Dbg>1){ + if(S0==1) mycat(["Reduced by :",nmono(car(TW))]); + else if(C++>0){ + mycat(["Product :", nmono(P), nmono(S0)]); + if(Dbg==3){ + if(!Fct||Fct==[]){ + if(C>1) P=1; + }else{ + if(car(Fct)==C){ + C=10000;Fct=cdr(Fct);P=1; + }else S0=1; + } + }else if(Dbg==4) return [SS,Q,DP,DQ,W]; + } + } + P*=S0; + } + } +#else + for(TW=W;TW!=[];TW=cdr(TW)){ + if((C=gcd(P,car(TW)))!=1){ + P=red(P/C); + if(Dbg>=2&&nmono(Q)>1) mycat(["Reduce :",nmono(C)]); + } + } +#endif + } + }else{ + if(type(TQ)==1){ + Q/=TQ; + P=P-TP*X^(DP-DQ)*Q; + }else P=TQ*P-TP*X^(DP-DQ); + if(deg(P,X)==DP) P-=coef(P,DP,X)*X^DP; + } + DP=deg(P,X); + if(Opt==-2||(type(Opt)==4&&Opt[0]==DP&&Opt[1]==DQ)) return [P,Q,DP,DQ,W]; + } + if(Dbg){ + if(Dbg>1) mycat([DP,"(",nmono(P), nmono(coef(P,DP,X)),") :", + DQ, "(",nmono(Q), nmono(coef(Q,DQ,X)), ")"]); + else mycat0([DP,":",DQ," "],0); + } + if(Opt==1) Q=[P,Q,DP,DQ,W]; + return (DQ==0)?Q:0; +} + +/* Opt : f, var, ord, ord, step, f, to */ +def baseODE0(L) +{ + if(!isint(Ord=getopt(ord))) Ord=-1; + if(Ord==-1) Ord=2; + if(Ord0&&Ord>0) Ord=-1; + N=length(L); + if(type(To=getopt(to))==4&&length(To)==N){ + V=cdr(To);To=car(To); + } + if(!isvar(To)) To=V=0; + if(type(SV=Var=getopt(var))!=4){ + SV=SVORG; + if(N>10){ + R=[]; + for(K=N-1;K>9;K++) R=cons(SV[floor(K/10)-1]+SV[K%10],R); + SV=append(SV,R); + } + for(Var=[],I=N-1;I>=0;I--) Var=cons(makev([SV[I]]),Var); + } + if((J=findin(To,Var))>0){ + TV=TL=[]; + for(I=N-1;I>=0;I--){ + if(I!=J){ + TV=cons(Var[I],TV);TL=cons(L[I],TL); + } + } + Var=cons(Var[J],TV);L=cons(L[J],TL); + } + if(!To) To=car(SV); + Q=car(L); + V0=makev([To,1]); + R=[V0-Q];V0=[V0]; + for(I=2;I<=N;I++){ + P=diff(t,Q); + if(type(P)==3) P=red(P); + for(TV=Var,TL=L;TV!=[];TV=cdr(TV),TL=cdr(TL)){ + P+=diff(Q,car(TV))*car(TL); + if(type(P)==3) P=red(P); + } + Q=P; + TV=makev([To,I]); + R=cons(nm(TV-Q),R); + V0=cons(TV,V0); + } + if(Step==-1) return V0; + if(!V) V=cdr(Var); + if(Ord<0){ + for(C=1,R0=[];V!=[];V=cdr(V),C++){ + TR=R=reverse(R); + if(length(R)>1){ /* reduce common factor */ + P=car(TR);TR=cdr(TR); + for(;TR!=[]&&P!=1;TR=cdr(TR)) + P=gcd(P,car(TR)); + if(P!=1){ + for(TR=[];R!=[];R=cdr(R)) TR=cons(red(car(R)/P),TR); + R=reverse(TR); + } + } + TR=[]; + TV=car(V); + if(length(V)==1) V0=[car(V0)]; + if(C==Step) return [append(V,V0),R]; + while(R!=[]&&findin(TV,vars(car(R)))<0){ + TR=cons(car(R),TR); + R=cdr(R); + } + R0=(F==2)?append(R,R0):cons(car(R),R0); + if(R!=[]){ + for(W=[],P=car(R),R=cdr(R); R!=[]; R=cdr(R)){ + if(Dbg) mycat0(["\nStep ",C,"-",length(R)," ",TV, + (type(Dbg)==4||Dbg>=2)?"\n":" "],0); + if(findin(TV,vars(car(R)))<0){ + TR=cons(car(R),TR); + continue; + } + if(Ord>-3){ + if(Dstep&&Dstep[0]==C&&Dstep[1]==length(R)) + return res0(P,car(R),TV|var=V0,opt=cdr(cdr(Dstep)),dbg=Dbg); + else TQ=res0(P,car(R),TV|var=V0,opt=1,dbg=Dbg,w=W); + if(Dbg==4&&type(car(TQ))==4) return TQ; + if(Ord==-2) P=car(TQ); + W=TQ[4];TQ=TQ[1]; + }else{ + TQ=res(TV,P,car(R)); + Q=fctr(TQ); /* irreducible one */ + for(TQ=1;Q!=[];Q=cdr(Q)) + if(lsort(V0,vars(car(Q)[0]),2)!=[]) TQ*=car(Q)[0]; + } + TR=cons(TQ,TR); + } + } + R=TR; + } + if(Dbg==1) mycat([]); + return (F==1)?car(R):(F==2?append(R,R0):cons(car(R),R0)); + } + V=append(V,[makev([To,N])]); + if(Step==1) return [R,V]; + R=gr(R,V,Ord); + return (F==1)?car(R):R; /* hgr(R,V,Ord); */ +} + + +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=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;I=0; II--){ - J = mydeg(P=mycoef(F,I,DX),X); + J = mydeg(P=mycoef(F,II,DX),X); if(II==I) S=II-J; else if(P!=0 && II-J>S) S=II-J; } F *= X^S; - R = 0; - for( ; I >= 0; I--) + } + if(V == "infty"){ + for(R=0; I >= 0; I--) R += red((mysubst(mycoef(F,I,DX),[X,1/X])*(x*DX)^I)); return(subst(pol2sft(R,DX),DX,-DX)); } - F = subst(F,X,X+V); - for(II=I; II>=0; II--){ - J = mymindeg(P=mycoef(F,II,DX),X); - if(II==I) S=II-J; - else if(P!=0 && II-J>S) S=II-J; - } - F *= X^S; - R = 0; - for( ; I >= 0; I--) + for(R=0; I >= 0; I--) R += (red(mycoef(F,I,DX)/X^I))*DX^I; return pol2sft(R,DX); } @@ -5757,8 +7207,10 @@ def fromeul(P,L,V) S = DX*(S*X + mydiff(S,DX)); R += mycoef(P,J,DX)*S; } - while(mycoef(R,0,X) == 0) - R = tdiv(R,X); + if(getopt(raw)!=1){ + while(mycoef(R,0,X) == 0) + R = tdiv(R,X); + } if(V != "infty" && V != 0) R = mysubst(R,[X,X-V]); return R; @@ -5767,8 +7219,8 @@ def fromeul(P,L,V) def sftexp(P,L,V,N) { L = vweyl(L); DX = L[1]; - P = mysubst(toeul(P,L,V),[DX,DX+N]); - return fromeul(P,L,V); + P = mysubst(toeul(P,L,V|opt_list=getpt()),[DX,DX+N]); + return fromeul(P,L,V|option_list=getopt()); } @@ -6163,6 +7615,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); @@ -6351,6 +7807,30 @@ def pcoef(P,L,Q) return Coef; } +def pmaj(P) +{ + if(type(P)==4){ + Opt=getopt(var); + Opt=(isvar(Opt))?[["var",Opt]]:[]; + for(Q=[];P!=[];P=cdr(P)) Q=cons(pmaj(car(P)|option_list=Opt),Q); + if(Opt==[]) return reverse(Q); + X=Opt[0][1]; + D=mydeg(Q,X); + for(S=0;D>=0;D--) S+=lmax(mycoef(Q,D,X))*X^D; + return S; + } + V=vars(P); + Y=getopt(var); + Abs=(Y==1)?1:0; + if(!(K=length(V))) return Y==1?1:abs(P); + for(R=0,D=deg(P,X=V[0]);D>=0;D--){ + Q=coef(P,D,X); + if(Q!=0) R+=((type(Q)>1)?pmaj(Q|var=Abs):(Y==1?1:abs(Q)))*X^D; + } + if(isvar(Y)) for(;V!=[];V=cdr(V)) R=subst(R,car(V),Y); + return R; +} + def prehombf(P,Q) { if((Mem=getopt(mem))!=1 && Mem!=-1) @@ -7183,23 +8663,41 @@ def abs(X) return X; } +def sgn(X) +{ + if(X==0) return 0; + if(type(X)==1){ + return (X>0)?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; @@ -7214,6 +8712,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; @@ -7459,158 +8963,20 @@ 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; } - if(MO<=0){ + if(M0<=0){ MO=-MO; if(iand(MO,1)==1) return []; - if(MO>1){ - if(isMs()==0) return []; - Cmd="okubo "+rtostr(-MO); - MO/=2; - if(L1>0) Cmd=Cmd+"+"+rtostr(L0)+"-"+rtostr(L1); - else L1=MO+4; - Cmd=Cmd+" B"; - Id=getbyshell(Cmd); - if(Id<0) return []; - B=[]; - while((S=get_line(Id)) !=0){ - P0=str_chr(S,1,":")+1; - if(P0>1){ - P1=str_chr(S,P,"\n"); - if(P1<0) P1=str_len(S); - B=cons(sub_str(S,P0,P1-1),B); - } - } - }else{ - MO/=2; - if(L1<=1) L1=MO+4; -BB=[ -["11,11,11,11","111,111,111","1^4,1^4,22","1^6,222,33"], -["11,11,11,11,11","1^4,1^4,211","211,22,22,22","1^6,2211,33", -"2211,222,222","22211,2^4,44","2^511,444,66","1^4,22,22,31", -"2^5,3331,55","1^5,1^5,32","1^8,332,44","111,111,21,21","1^5,221,221"], -["11,11,11,11,11,11","1^4,1^4,1^4","1^4,22,22,22","111,111,111,21", -"1^6,21^4,33","21^4,222,222","221^4,2^4,44","2^41^4,444,66", -"1^5,1^5,311","1^8,3311,44","1^6,222,321","321,33,33,33", -"3321,333,333","33321,3^4,66","3^721,666,99","2^5,3322,55", -"1^6,1^6,42","222,33,33,42","1^a,442,55","1^6,33,33,51", -"222,222,33,51","1^9,333,54","2^7,554,77","1^5,2111,221", -"2^41,333,441","1^7,2221,43","211,211,22,22","2211,2211,222", -"22211,22211,44","1^4,211,22,31","2^411,3331,55","1^4,1^4,31,31", -"22,22,22,31,31","1^7,331,331","2221,2221,331","111,21,21,21,21"], -["11,11,11,11,11,11,11","111,111,111,111","1^6,1^6,33", -"1^6,222,222","222,33,33,33","1^5,1^5,221", -"1^4,211,22,22","1^4,1^4,22,31","22,22,22,22,31", -"111,111,21,21,21","21^6,2^4,44","2221^6,444,66", -"1^6,222,3111","3111,33,33,33","33111,333,333", -"333111,3^4,66","3^5111,666,99","2^5,33211,55", -"1^8,3221,44","3222,333,333","33222,3^4,66", -"3^4222,666,99","1^6,1^6,411","222,33,33,411", -"1^a,4411,55","2^4,2^4,431","431,44,44,44", -"2^6,4431,66","4431,444,444","44431,4^4,88", -"4^531,888,cc","1^a,433,55","1^7,1^7,52", -"1^c,552,66","3^4,444,552","1^8,2^4,53", -"1^8,44,44,71","3^5,555,771","21^4,2211,222", -"221^4,22211,44","2221^4,3331,55","1^6,2211,321", -"2^411,3322,55","1^7,322,331","2211,33,33,42", -"3^42,4442,77","2211,222,33,51","3^51,5551,88", -"2^611,554,77","2221,2221,322","2^41,2^41,54", -"1^5,2111,2111","222111,333,441","1^7,22111,43", -"1^5,1^5,41,41","1^9,441,441","22111,2221,331", -"1^5,221,32,41","221,221,221,41","211,211,211,22", -"2211,2211,2211","1^4,211,211,31","211,22,22,31,31", -"1^4,22,31,31,31","1^5,32,32,32","221,221,32,32","21,21,21,21,21,21"], -["11,11,11,11,11,11,11,11","1^4,1^4,22,22","1^8,2^4,44", -"1^6,2211,222","2211,33,33,33","111,111,111,21,21", -"1^5,1^5,2111","1^4,211,211,22","1^4,1^4,211,31", -"211,22,22,22,31","1^4,22,22,31,31","111,21,21,21,21,21", -"221^8,444,66","2^5,331^4,55","1^8,32111,44", -"32211,333,333","332211,3^4,66","3^42211,666,99", -"2^5,32221,55","1^7,1^7,511","1^c,5511,66", -"3^4,444,5511","541,55,55,55","5541,555,555", -"55541,5^4,aa","5^541,aaa,ff","1^8,1^8,62", -"1^a1^4,662,77","1^a,55,55,91","2^71,555,87", -"21^6,22211,44","221^6,3331,55","1^6,2211,3111", -"2^411,33211,55","1^7,3211,331","2211,33,33,411", -"3^42,44411,77","22211,2^4,431","2^511,4431,66", -"1^8,332,431","3^42,4433,77","1^8,22211,53", -"2221,2221,3211","221^5,333,441","1^7,21^5,43", -"1^b,443,65","21^5,2221,331","2^51,3332,65", -"21^4,21^4,222","221^4,221^4,44","1^6,21^4,321", -"2221^4,3322,55","21^4,33,33,42","21^4,222,33,51", -"2^51^4,554,77","2^4,3311,3311","3^411,4442,77", -"321,321,33,33","3321,3321,333","33321,33321,66", -"222,321,33,42","1^6,321,33,51","222,222,321,51", -"1^9,3321,54","1^7,322,322","3^422,5551,88", -"1^6,33,42,42","1^6,222,42,51","33,33,33,42,51", -"1^6,1^6,51,51","222,33,33,51,51","1^b,551,551", -"1^5,221,311,41","2^41,3321,441","22111,2221,322", -"2^51,443,551","222111,2^41,54","21^4,2211,2211", -"1^5,311,32,32","3331,3331,442","2211,2211,33,51", -"221,221,311,32","22111,22111,331","1^5,2111,32,41", -"2111,221,221,41","2111,221,32,32","211,211,211,211", -"211,211,22,31,31","1^4,211,31,31,31","22,22,31,31,31,31"], -["11,11,11,11,11,11,11,11,11","1^5,1^5,1^5","2^5,2^5,55", -"111,111,111,111,21","2^41,333,333","1^4,1^4,211,22", -"211,22,22,22,22","1^8,22211,44","1^4,1^4,1^4,31", -"1^4,22,22,22,31","1^7,1^7,43","1^7,2221,331", -"2221,2221,2221","1^6,21^4,222","21^4,33,33,33", -"1^6,1^6,321","222,321,33,33","1^6,33,33,42", -"222,222,33,42","1^6,222,33,51","222,222,222,51", -"33,33,33,33,51","1^6,2211,2211","111,111,21,21,21,21", -"1^5,1^5,32,41","1^5,221,221,41","1^5,221,32,32", -"221,221,221,32","1^4,211,211,211","211,211,22,22,31", -"1^4,211,22,31,31","1^4,1^4,31,31,31","22,22,22,31,31,31", -"21,21,21,21,21,21,21","21^a,444,66","1^8,31^5,44", -"321^4,333,333","3321^4,3^4,66","3^421^4,666,99", -"2^5,322111,55","32^41,3^4,66","3332^41,666,99", -"1^8,1^8,611","2^4,44,44,611","1^d,6611,77", -"4^5,66611,aa","2^6,444,651","3^4,3^4,651", -"651,66,66,66","3^6,6651,99","6651,666,666", -"66651,6^4,cc","6^551,ccc,ii","2^8,655,88", -"1^9,1^9,72","1^g,772,88","1^c,444,75", -"2^6,3^4,75","1^c,66,66,b1","3^4,444,66,b1", -"3^7,777,ba","1^7,2221,4111","2^41,333,4311", -"1^9,2^41,63","21^8,3331,55","2^411,331^4,55", -"1^7,31^4,331","2^411,32221,55","22211,2^4,422", -"2^511,4422,66","1^8,332,422","2^5,3331,541", -"22211,44,44,62","2^411,2^5,64","2^711,664,88", -"1^a,3331,64","2221,2221,31^4","21^7,333,441", -"333,333,441,81","2^6111,555,87","21^6,221^4,44", -"221^6,3322,55","2^41^6,554,77","1^6,21^4,3111", -"3111,321,33,33","33111,3321,333","333111,33321,66", -"222,3111,33,42","1^6,3111,33,51","222,222,3111,51", -"1^9,33111,54","2221^4,33211,55","1^7,3211,322", -"3^4211,5551,88","2^4,3221,3311","333221,4442,77", -"3222,3321,333","33222,33321,66","1^9,3222,54", -"21^4,33,33,411","3^411,44411,77","222,321,33,411", -"1^6,33,411,42","1^6,222,411,51","33,33,33,411,51", -"221^4,2^4,431","2^41^4,4431,66","1^8,3311,431", -"3^411,4433,77","33321,444,552","1^8,221^4,53", -"3311,44,44,53","4^42,5553,99","2^4,3311,44,71", -"3^421,555,771","4^52,7771,bb","3^611,776,aa", -"2^41,33111,441","22111,2221,3211","2^41,3222,441", -"2^61,4441,76","3331,3331,4411","22211,22211,431", -"3331,3331,433","3^41,3^41,76","1^7,1^7,61,61", -"1^d,661,661","21^5,2221,322","221^5,2^41,54", -"2^51,33311,65","21^5,22111,331","3^41,4441,661", -"1^7,331,43,61","2221,2221,43,61","2221,331,331,61", -"21^4,21^4,2211","21^4,2211,33,51","22211,3311,3311", -"1^5,311,311,32","2211,321,33,42","2211,222,321,51", -"3322,3331,442","2211,222,42,42","2^411,442,442", -"1^6,2211,42,51","2211,33,33,51,51","221,221,311,311", -"1^5,2111,311,41","222111,3321,441","22111,22111,322", -"222111,222111,54","2111,221,311,32","2111,2111,221,41", -"1^5,221,41,41,41","2221,43,43,43","1^5,32,32,41,41", -"331,331,43,43","221,221,32,41,41","221,32,32,32,41", -"211,211,211,31,31","211,22,31,31,31,31","1^4,31,31,31,31,31"]]; - B=BB[MO]; - } + MO=MO/2; + B=spbasic(-2*MO,0|str=1); + if(L1<3) L1=MO+4; if(St!=1){ for(R=[]; B!=[]; B=cdr(B)){ - RT=F?s2sp(car(B)|std=F):s2sp(car(B)); + RT= F?s2sp(car(B)|std=F): s2sp(car(B)); if(length(RT)L1) continue; R=cons(RT,R); } @@ -7712,6 +9078,198 @@ BB=[ return LL; } +def spbasic(Idx,D) +{ +/* + D<=3|Idx|+6, D<=|Idx|+2 (p>3), p<=|Idx|/2+4 + Idx=2*D^2-(D^2-\sum m_{j,\nu}^2); \sum(D-m_{j,1})>=2*D; + \sum (m_{j,1)-m_{j,\nu})*m_{j,\nu) + 0<=(2*D-\sum(D-m_{j,1})})*D=\sum_(m_{j,1}-m_{j,\mu})*m_{j,\nu} -|Idx| + (-2,0) 13個 (9+3+?) + (-4,0) 37個 (25+9+?) + (-6,0) : 8.5sec ?sec 0.05sec 69個 (46+17+?) + (-8,0) : 97 sec 1sec 0.13sec 113個 (73+29+?) <- (-2,0) + (-10,0): 4sec 0.27sec 198個 (127+50+?) +　(-12,0) 28sec 4.2sec 0.64sec 291個 (182+76+?) + (-14,0) 27sec 10.2sec 1.31sec 415個 (249+115+?) + (-16,0) 34.0sec 2.47sec 647個 (395+172+?) <- (-4,0) + (-18,0) 4.42sec 883個 (521+243+?) <- (-2,0) + (-20,0) 8.17sec 1186個 (680+345+?) +*/ + Idx=-Idx; + if((Str=getopt(str))!=1) Str=0; + if(!isint(Idx)||!isint(Idx/2)||Idx<0||!isint(D)||D<0||D==1||D>3*Idx+6) return []; + if(D==0){ + for(R=[],D=3*Idx+6;D>=2;D--) R=append(spbasic(-Idx,D|str=Str),R); + return R; + } + if(!Idx){ + R=0; + if(D==2) R="11,11,11,11"; + if(D==3) R="111,111,111"; + if(D==4) R="22,1111,1111"; + if(D==6) R="33,222,111111"; + if(!R) return []; + return [(Str==1)?R:s2sp(R)]; + } + if(D>Idx+2){ + L=3; + if(D==3*Idx+6){ + R=[[D/2,D/2],[D/3,D/3,D/3],[D/6,D/6,D/6,D/6,D/6,D/6-1,1]]; + return [(Str==1)?s2sp(R):R]; + } + if(iand(D,1)&&(D-3)/2>Idx) return []; + }else L=Idx/2+4; + V=newvect(L);SV=newvect(L); + for(S1=[],I=0;I1;T--){ + K=D%T; + if((T-K)*K<=Idx) break; + } + J=(T-K)*K;SJ=K^2+(D-K)*T; + TV=K?[K]:[]; + for(I=(D-K)/T;I>0;I--) TV=cons(T,TV); + for(I=0;I0) return []; + if(D>Idx+2 && V[0][0]+V[1][0]>=D && V[1][0]>1){ + T=V[1][0]-1;K=D%T;TV=K?[K]:[]; + for(I=(D-K)/T;I>0;I--) TV=cons(T,TV); + V[1]=V[2]=TV; + } + for(R=[];;){ + if(D>Idx+2){ + if(3*V[0][0]=D && (T=D-V[0][0]-1)>0){ + K=D%T;TV=K?[K]:[]; + for(I=(D-K)/T;I>0;I--) TV=cons(T,TV); + V[1]=V[2]=TV; + } + S2=V[0][0]+V[1][0]+V[2][0]-D; + if(V[0][0]+2*V[1][0]0){ + J=D%T; + K=J?[J]:[]; + for(J=(D-J)/T;J>0;J--) K=cons(T,K); + V[2]=K; + } + continue; + } + if(S2<0||V[2][0]<=S2){ + V[1]=V[2]=nextpart(V[1]); + continue; + }else if(S2>0){ + T=V[2][0]-S2;J=D%T; + K=J?[J]:[]; + for(J=(D-J)/T;J>0;J--) K=cons(T,K); + V[2]=K; + } + } + for(S=-2*D,IL=0;IL=0) break; + } + if((I=IL)==L){ /* reducible i.e. IL=L && S<0 */ + for(LL=L-1;LL>=0;LL--){ + if((K=car(V[LL]))+S>0){ + K+=S; + for(TV=[],TD=D;TD>=K;TD-=K) TV=cons(K,TV); + if(TD>0) V[LL]=append(TV,[TD]); + else V[LL]=TV; + break; + }else{ + S+=K-1; + V[LL]=S1; + } + } + if(LL<0) break; + continue; + } + for(S0=K=0;K<=IL;K++){ + ST=car(V[K]);J=V[K][length(V[K])-1];S0+=(ST-J)*J; + if(S0>Idx) break; + } + if(S0>Idx && car(V[K])!=1){ + ST=car(V[K]); + S0-=(ST-J)*J; + for(ST--;ST>0;ST--){ + J=D%ST; + if(S0+(ST-J)*J <= Idx) break; + } + V[K]=J?[J]:[]; + for(J=D-J;J>0;J-=ST) V[K]=cons(ST,V[K]); + for(J=K+1;JIdx && K<=IL && K!=L){ + SS0=Idx-SS+S0; + for(TV=car(V[K]);TV>1;TV--){ + U=D%TV; + if((D-U)*U<=SS0) break; + } + if(TV==car(V[K])){ + K=K-1; + V[K]=nextpart(V[K]); /* to be improves */ + }else{ + V[K]=U?[U]:[]; /* to be improved */ + for(J=D-U;J>0;J-=TV) V[K]=cons(TV,V[K]); + } + for(J=K+1;J=I||IL==2)){ + for(TR=[],K=J;K>=0;K--) TR=cons(V[K],TR); + R=cons((Str==1)?s2sp(TR):TR,R); + } + if(J>=0 && J1&& IxF-D^2+S0<0){ + for(V[J]=[],K=D-I;K>0;K--) V[J]=cons(1,V[J]); + V[J]=cons(I,V[J]); + V[J]=nextpart(V[J]); + for(I=J+1;I=0 && J(U=V[J][length(V[J])-1])+1){ + TV=reverse(V[J]); + for(S0=0,K=[];TV!=[];TV=cdr(TV),S0++){ + if((I=car(TV))1&&S0<2)){ + while(I-->0) K=cons(1,K); + }else K=cons(car(TV),K); + } + V[I=J]=K; + }else{ + if(J>=L) J=L-1; + for(I=J;I>=0&&length(V[I])==D;I--); + if(I<0) break; + } + V[I]=nextpart(V[I]); /* to be improved */ + for(J=I+1;J= 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){ @@ -7757,7 +9315,6 @@ def chkspt(M) } return fspt(M,Opt); } - MR = fspt(M,1); P = length(M); OD = -1; XM = newvect(P); @@ -7780,8 +9337,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; } @@ -7798,13 +9355,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) @@ -7919,7 +9477,7 @@ def redgrs(M) } L = cons([VM,EV], L); /* - if(R[2] >= 2){ */ /* digid */ + if(R[2] >= 2){ */ /* rigid */ /* P = dx^(R[1]); } */ } @@ -7946,62 +9504,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] : @@ -8013,6 +9649,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"]; @@ -8057,6 +9695,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]); @@ -8311,6 +10022,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 */ @@ -8322,14 +10034,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]]); } @@ -8341,6 +10053,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){ @@ -8352,9 +10068,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; @@ -8659,7 +10495,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"){ @@ -8772,7 +10608,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); @@ -9033,7 +10869,24 @@ def mcmgrs(G,P) def delopt(L,S) { - if((Inv=getopt(inv))!=1) Inv=0; + if((Inv=getopt(inv))!=1&&Inv!=2) Inv=0; + if(Inv&&type(S)==4&&type(car(S))==4){ + for(R=[];L!=[];L=cdr(L)){ + L0=car(L)[0]; + for(F=0,TS=[];S!=[];S=cdr(S)){ + if(!F&&L0==car(S)[0]){ + R=cons(car(S),R); + F++; + continue; + } + TS=cons(car(S),TS); + } + if(!F) R=cons(car(L),R); + S=reverse(TS); + } + R=reverse(R); + return Inv==1?append(S,R):append(R,S); + } for(R=[];L!=[];L=cdr(L)){ if(type(car(L))!=4) F=0; else if(type(S)==4) F=(findin(car(L)[0],S)<0)?0:1; @@ -9183,8 +11036,10 @@ def str_str(S,T) }else if(type(S)==4){ for(; J<=LE; S=cdr(S),J++){ if(car(S) != LP){ - if(SJIS && (V=S[J])>128){ - if(V<160 || (V>223 && V<240)) J++; + if(SJIS && (V=car(S))>128){ + if((V<160 || (V>223 && V<240))&&S!=[]) { + J++;S=cdr(S); + } } continue; } @@ -9489,6 +11344,132 @@ def evalma(S) return S; } +def evalcoord(L) +{ + if(type(L)==7) L=strtoascii(L); + I=str_str(L,"("); + if(I>=0) J=str_pair(L,I+1,"(",")"); + if(I<0 || J32&&(C<40||C>58)){F=0;break;} + } + S0=str_cut(L,I+1,J-1); + for(;J>=0;J--) L=cdr(L); + while(L!=[]&&car(L)<33) L=cdr(L); + if(F){ + S="["+S0+"]"; + return [eval_str(S),L]; + }else return [[S0],L]; +} + +def readTikZ(L) +{ + if(type(L)!=4) L=strtoascii(L); + R=[]; + CMD=["draw","fill","filldraw","shade","shadedraw","clip","pattern","node","begin"]; + while(L!=0&&L!=[]){ + while(L!=[]&&car(L)<33) L=cdr(L); + if(L==[]) break; + if(car(L)==34){ /* % */ + while(L!=[]&&car(L)!=10) L=cdr(L); + continue; + } + if(car(L)!=92) {L=0;break;} /* \ */ + for(DF=0;DF<9;DF++) if(str_str(L,CMD[DF]|top=1,end=1)==1) break; + if(DF<7){ + S=T=0; + I=str_str(L,"(");J=str_str(L,"["); + if(J>0&&I>J){ + K=str_str(L,"]"); + S=str_cut(L,J+1,K-1); + } + F0=F=0;C=[]; + while(L!=0&&L!=[]){ + V=evalcoord(L); + L=V[1]; + if(L==[]) break; + if(F0){ + if (!F) C=cons(0,C); + else if(F0!=3) C=cons(1,C); + } + C=cons(V[0],C); + F0=F;F=0; + if(L[0]==34){ /* % */ + while(L!=[]&&car(L)!=10) L=cdr(L); + continue; + } + if(!str_str(L,"..")){ /* .. */ + L=cdr(L);L=cdr(L); + F=1; + }else if(!str_str(L,"--")){ /* -- */ + L=cdr(L);L=cdr(L); + F=2; + } + while(L!=[]&&car(L)<33) L=cdr(L); + if(L==[]){L=0; break;} + if(!str_str(L,"cycle")){ + if(F==2) C=cons(1,C); + C=cons(-1,C); + F0=F=0; + continue; + } + if(!str_str(L,"and")||!str_str(L,"control")) + F=3; /* control, and */ + else if(car(L)==59){ /* ; */ + L=cdr(L); + break; + }else if(isalpha(car(L))){ + T=[]; + while(car(L)!=40 && car(L)!=59){ /* ( ; */ + T=cons(car(L),T); + if((L=cdr(L))==[]){L=0;break;} + } + T=asciitostr(reverse(T)); + if(car(L)==59){ /* ; */ + L=cdr(L); + break; + } + F0=0;continue; + }else if(F!=1&&F!=2){ + L=0;break; + } + } + if(T){ + if(length(C)==1||length(C)==2) S=(!S)?["",T]:[S,T]; + else{ + L=0;break; + } + } + S=(!S)? []:[["opt",S]]; + if(DF) S=S=cons(["cmd",CMD[DF]],S); + if(T&&length(C)) R=cons((length(C)==1)?[3,S,C[0],DF]:[3,S,C[1],C[0]],R); + else R=cons([1,S,reverse(C)],R); + }else{ /* \node */ + U=0; + I=str_str(L,"(");J=str_str(L,"["); + if(J>0&&I>J){ + K=str_str(L,"]"); + U=str_cut(L,J+1,K-1); + } + V=evalcoord(L); + C=V[0];L=V[1]; + J=str_str(L,"{");K=str_pair(L,J+1,"{","}"); + S=str_cut(L,J+1,K-1); + if(U) S=[U,S]; + R=cons([2,[],C,[S]],R); + for(;K>=0;K--) L=cdr(L); + K=str_str(L,";"); + for(;K>=0;K--) L=cdr(L); + }; + } + if(!L){ + mycat("Can't understand!"); + return -1; + } + return reverse(R); +} + def i2hex(N) { Opt=getopt(); @@ -9687,6 +11668,7 @@ def my_tex_form(S) } SS = cons(S[I], SS); } + SS=str_subst(SS,"\n\\\\\n\\end{pmatrix}","\n\\end{pmatrix}"|raw=1); SS=str_subst(SS,"\\\\\n\\end{pmatrix}","\n\\end{pmatrix}"|raw=1); Subst=getopt(subst); Sub0=["{asin}","{acos}","{atan}"]; @@ -9761,7 +11743,7 @@ def my_tex_form(S) S=cons(123,S); if(F==2) SS=cdr(SS); else if(F==0) S=cons(car(SS),S); - }else if(F==2&&P-Q==3){ /* (2)^x -> 2^x*/ + }else if(F==2&&P-Q==3){ /* (2)^x -> 2^x */ SS=cdr(SS);SS=cdr(SS); S=cons(123,S);S=cons(car(SS),S);S=cons(125,S); SS=cdr(SS);SS=cdr(SS); @@ -9782,7 +11764,16 @@ def my_tex_form(S) SS=reverse(S); Top=P; } - S=asciitostr(SS); + for(F=G=0,S=[];SS!=[];SS=cdr(SS)){ /* 22^x -> 2\cdot 2^x */ + if(F==1&&G!=-1&&car(SS)==123 && length(SS)>1 && isnum(SS[1])) + S=append([116,111,100,99,92],S); + G=F; + if(car(SS)==125||car(SS)==95) F=-1; + else F=isnum(car(SS)); + S=cons(car(SS),S); + } + S=asciitostr(reverse(S)); +/* S=asciitostr(SS); */ if((K=getopt(ket))==1) S=texket(S); else if(K==2) S=texket(S|all=1); return S; @@ -9840,6 +11831,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]; @@ -9938,7 +11930,7 @@ def str_subst(S, L0, L1) def dviout0(L) { - Cmd=["TikZ","TeXLim","TeXEq","DVIOUT","XYPrec","XYcm","XYLim","Canvas"]; + Cmd=["TikZ","TeXLim","TeXEq","DVIOUT","XYPrec","XYcm","XYLim","Canvas","TeXPages"]; if(type(Opt=getopt(opt))==7){ if((F=findin(Opt,Cmd)) < 0) return -1; if(L==-1){ @@ -9951,7 +11943,8 @@ def dviout0(L) if(F==4) V=XYPrec; else if(F==5) V=XYcm; else if(F==6) V=XYLim; - else V=Canvas; + else if(F==7) V=Canvas; + else if(F==8) V=TeXPages; } return V; } @@ -9969,6 +11962,7 @@ def dviout0(L) else if(F==4) XYPrec=L; else if(F==5) XYcm=L; else if(F==6) XYLim=L; + else if(F==8) TeXPages=L; } mycat0([Cmd[F],"=",L],1); return 1; @@ -10001,9 +11995,9 @@ def dviout0(L) mycat0(["DVIOUTA=\"", DVIOUTA,"\""],1); mycat0(["DVIOUTB=\"", DVIOUTB,"\""],1); mycat0(["DVIOUTL=\"", DVIOUTL,"\""],1); - mycat0(["FCAT =\"", FCAT,"\""],1); mycat(["Canvas =", Canvas]); mycat(["TeXLim =", TeXLim]); + mycat(["TeXPages =", TeXPages]); mycat(["TeXEq =", TeXEq]); mycat(["AMSTeX =", AMSTeX]); mycat(["TikZ =", TikZ]); @@ -10101,7 +12095,7 @@ def tocsv(L) if(type(LT)==5) LT=vtol(LT); if(type(LT)<4) LT=[LT]; for(N=0; LT!=[]; LT=cdr(LT),N++){ - if(N) str_tb(", ",Tb); + if(N) str_tb(",",Tb); if((T=car(LT))==Null) continue; if(type(T)==7){ K=str_len(T); @@ -10112,7 +12106,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) @@ -10177,9 +12181,26 @@ def readcsv(F) } close_file(ID); if(T) L=m2l(L|flat=1); - return reverse(L); + L=reverse(L); + return L; } +def getline(ID) +{ + if(isint(Maxlen=getopt(Max))>0) Maxlen=1024; + if(type(CR=getopt(CR))!=4) CR=[13]; + if(type(LF=getopt(LF))!=4) LF=[10]; + S=[]; + for(I=0; I<1023; I++){ + C=get_byte(ID); + if(C<0) return 0; + if(findin(C,CR)>=0) continue; + if(findin(C,LF)>=0) break; + S=cons(C,S); + } + return asciitostr(reverse(S)); +} + def showbyshell(S) { Id = getbyshell(S); @@ -10199,21 +12220,34 @@ 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+"\""); return open_file(F); } +def isfctr(P) +{ + if(type(P)>3) return 0; + if(type(P)==3) return (!isfctr(nm(P))||!isfctr(dn(P)))?0:1; + V=ptol(P,vars(P)|opt=0); + for(;V!=[];V=cdr(V)){ + if(type(car(V))>1||ntype(car(V))>0) return 0; + } + return 1; +} + def show(P) { T=type(P); S=P; Var=getopt(opt); + if((Raw=getopt(raw))!=1) Raw=0; if(Var=="verb"){ - dviout("{\\tt"+verb_tex_form(T)+"}\n\n"); - return; + S="{\\tt"+verb_tex_form(T)+"}\n\n"; + if(Raw) return S; + dviout(S);return; } if(type(Var)<0) Var=getopt(var); if(T==6){ @@ -10231,23 +12265,51 @@ def show(P) if(Var=="pfrac") X=var(P); else X=getopt(pfrac); if(isvar(X)){ - pfrac(P,X|dviout=1); - return; + if(Raw) return pfrac(P,X|TeX=1); + pfrac(P,X|dviout=1);return; } - Opt=cons(["dviout",1],getopt()); - if(type(Var)==2||type(Var)==4||type(Var)==7) fctrtos(P|option_list=Opt); - else{ + Opt=getopt(); + if(type(Var)!=2&&type(Var)!=4&&type(Var)!=7){ if(isdif(P)!=0) Opt=cons(["var","dif"],Opt); else Opt=cons(["br",1],Opt); - fctrtos(P|option_list=Opt); } - return; + if(!isfctr(P)){ + if(Raw) return my_tex_form(P); + else{ + dviout(P); return; + } + } + if(Raw) return fctrtos(P|option_list=cons(["TeX",3],Opt)); + fctrtos(P|option_list=cons(["pages",2],cons(["dviout",1],Opt)));return; }else if(T==4){ + F=0;N=length(getopt()); + if(Raw) N--; + if(N==1){ + if(type(Var=getopt(var))>1){ + if(isvar(Var)) Var=[0,Var]; + else if(type(Var)==4&&Var[0]!=0) Var=cons(0,Var); + else Var=0; + }else if(type(Var=getopt(eqs))!=4) Var=0; + }else if(N==0) Var=[]; + else Var=0; + if(type(Var)==4){ + for(F=0,L=P;L!=[];L=cdr(L)){ /* */ + if(type(car(L))==2) F+=nmono(car(L)); + else{ + F=0;break; + } + } + } + if(F>50){ + S=texbegin("align*",eqs2tex(P,Var)); + if(Raw) return S; + dviout(S);return; + } if(type(Var)==4 || type(Var)==7){ S=ltotex(P|option_list=getopt()); if(Var=="text"){ - dviout(S); - return; + if(Raw) return S; + dviout(S);return; } }else{ for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ @@ -10275,8 +12337,8 @@ def show(P) if(F==1) S=ltotex(P|opt="spt"); else if(F==2){ M=mtranspose(lv2m(S)); - show(M|sp=1); /* GRS */ - return; + if(Raw) return show(M|sp=1,raw=1); /* GRS */ + show(M|sp=1);return; }else if(F==7) S=ltotex(P|opt="spts"); else{ for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ @@ -10308,14 +12370,23 @@ def show(P) } } }else if(T==7){ - if(Var=="raw" || - (Var !="eq" && str_chr(P,0,"\\")<0 && str_char(P,0,"^")<0 && str_char(P,0,"_")<0 - && str_char(P,0,"&")<0)){ - dviout(P+"\n\n"); - return; + if(Var=="raw") S=P+"\n\n"; + else if(Var != "eq" &&str_str(P,"\\begin"|end=128)<0){ + if((TikZ&&str_str(P,"\\draw"|end=128)>=0)||(!TikZ&&str_str(P,"\\ar@"|end=128)>=0)) + S=xyproc(P); + }else if(Var !="eq"){ + if(str_str(P,"\\begin{align")>=0 || str_str(P,"\\[")>=0 + || str_str(P,"\\begin{equation")>=0 + || (str_char(P,0,"^")<0 && str_char(P,0,"_")<0 && str_char(P,0,"&")<0)) + S=P+"\n\n"; } + if(P!=S){ + if(Raw) return S; + dviout(S); return; + } } - dviout(S|eq=5); + if(Raw) return "\\begin{align}\\begin{split}\n &"+S+"\\end{split}\\end{align}"; + else dviout(S|eq=5); } @@ -10646,11 +12717,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)); @@ -10694,16 +12765,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); @@ -10725,9 +12798,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); @@ -10735,7 +12808,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 @@ -10743,6 +12816,86 @@ def frac2n(N) #endif } +/* Option : opt */ +def ptconvex(L) +{ + if(!(isint(Opt=getopt(opt)))) Opt=0; + L0=car(L);X=L0[0];Y=L0[1]; + for(TL=cdr(L);TL!=[];TL=cdr(TL)){ /* find the most left pt L0 */ + if(X0?Y^2:-Y^2)/S,S],L0); + R=cons(L0,R); + } + L=qsort(R); + if(Opt==2) return L; + + for(R=[],TL=L;TL!=[];TL=cdr(TL)){ + if(Opt==4){ + L0=car(TL); + V=car(L0); + L0=append(cdr(cdr(L0)),[V]); + }else L0=cdr(cdr(car(TL))); + R=cons(L0,R); + } + L=reverse(R); + if(Opt==1) return L; + R=[cons(V0=-8,L0=car(L))]; + for(TL=cdr(L);TL!=[];TL=cdr(TL)){ + V=darg(L0,L1=car(TL)); + if(V<-4) continue; + while(V2){ + if((V-=4)>4) return -4; + }else if(V<=-2) V+=4; + return V; + } + X=Q[0]-P[0];Y=Q[1]-P[1]; + if(!(S=X^2+Y^2)) return -8; + V=Y^2/S; + if(Y<0) V=-V; + return X<=0?2-V:V; +} + +def dwinding(P,Q) +{ + V=V0=V1=darg(P,Q0=car(Q)); + Q=cons(Q0,reverse(Q)); + for(Q=cdr(Q);Q!=[];Q=cdr(Q)){ + if((V2=darg(P,car(Q)))<-4) return 1/3; + V1=V2-V1; + if(V1==2||V1==-2) return 1/2; + if(V1<-2) V1+=4; + else if(V1>2) V1-=4; + V+=V1; + V1=V2; + } + return floor((V0-V+1/2)/4); +} + def xyproc(F) { if(type(Opt=getopt(opt))!=7) Opt=""; @@ -10854,7 +13007,6 @@ def xyline(P,Q) def xylines(P) { -/* mycat([P,getopt()]); */ Lf=getopt(curve); if(type(Lf)!=1) Lf=0; SS=getopt(opt); @@ -11013,9 +13165,560 @@ 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=deval(exp(0));Pr=0; + } + if(!isint(FL=getopt(mul))||!FL) FL=1; + if(length(Lx)>2){ + V=car(Lx);Lx=cdr(Lx); + }else V=x; + if(Pr==1) Lx=[eval(Lx[0]),eval(Lx[1])]; + else Lx=[deval(Lx[0]),deval(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; + if(FL>0) N*=FL; + H=(Lx[1]-Lx[0])/N*One;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(C=0;C0&&!((C+1)%FL)) R=cons([deval(T),S],R); + } + }else{ + T=Lx[0]; + R=[cons(T,V1?[car(IY)]:IY)]; + S=ltov(IY); + if(!H) return R; + for(C=0;C2){ + V=car(Lx);Lx=cdr(Lx); + }else V=t; + if(!isvar(T=getopt(var))) V=t; + if(isint(Pr=getopt(prec))&&Pr>0){ + One=eval(exp(0)); + if(Pr>9){ + setprec(Pr); + ctrl("bigfloat",1); + } + Pr=1; + }else{ + One=deval(exp(0));Pr=0; + } + if(Pr==1) Lx=[eval(Lx[0]),eval(Lx[1])]; + else Lx=[deval(Lx[0]),deval(Lx[1])]; + Sf=(type(F)!=4)?1:0; + if(type(Y)==4){ + if(type(F)!=4) F=append(cdr(Y),[F]); + }else Y=[Y]; + if(type(Ly)!=4) Ly=[Ly]; + if(findin(V,vars(F))>=0){ + if(type(F)!=4) F=[F]; + Tf=1;F=cons(1,subst(F,V,z_z));Y=cons(z_z,Y);Ly=cons(car(Lx),Ly); + }else Tf=0; /* Tf: autonomous */ + ErF=0; + if(type(Er=getopt(err))==4){ + if(length(Er)==2) ErF=Er[1]; /* ErF&1: Raw, ErF&2: relative, ErF&4: add Sol */ + Er=car(Er); + }; + if(!isint(Er)||Er<0) Er=0; /* 基準解を返す */ + if(FL>0) N*=FL; + S=vtol(pTaylor(F,Y,M|time=V)); + FM=pmaj(F|var=x); + LS=length(S); + + if(type(Vw=getopt(view))==4){ /* Dislay on Canvas */ + Glib_math_coordinate=1; + glib_window(car(Vw)[0], car(Vw)[2],car(Vw)[1],car(Vw)[3]); + if(length(car(Vw))==6) Vr=[car(Vw)[4],car(Vw)[5]]; + else Vr=0; + if(length(Vw)>1){ + if(type(Cl=Vw[1])==4) Cl=map(os_md.trcolor,Cl); + else Cl=trcolor(Cl); + }else Cl=0; + if(length(Vw)>2){ + Mt=Vw[2]; + if(LS==1){ + if(type(Mt)>1) Mt=0; + }else{ + if(type(Mt)!=6||((Ms=size(Mt)[0])!=2&&Ms!=3)) Mt=0; + if(Ms!=3) Vr=0; + } + if(Tf&&type(Mt)==6) Mt=newbmat(2,2,[[1,0],[0,Mt]]); + }else Mt=0; + if(!Mt){ + if(LS>1+Tf){ + if(Vr){ + Mt=newmat(3,LS);Mt[2+Tf][2+Tf]=1; + } + else Mt=newmat(2,LS); + Mt[Tf][Tf]=Mt[Tf+1][Tf+1]=1; + }else Mt=1; + if(LS==1+Tf||Sf) glib_putpixel(Lx[0],Mt*Ly[Tf]|color=mcolor(Cl,0)); + else{ + YT=Mt*ltov(Ly); + glib_putpixel(YT[0],YT[1]|color=mcolor(Cl,0)); + } + } + }else Vw=0; + + T=Lx[0]; + RE=R=(Tf)?[Ly]:[cons(T,Ly)]; + H=(Lx[1]-Lx[0])/N*One; + + Ck=N+1;CB=10;Ckm=2;MM=2;C1=1; + if(Ck<5) Ck=100; + if(type(Inf=getopt(Inf))==4&&length(Inf)>1&&Inf[0]>4){ /* explosion */ + Ck=Inf[0];Ckm=Inf[1]; + if(length(Inf)>2) MM=Inf[2]; + if(!isint(MM)||MM<1) MM=2; + if(length(Inf)>3) C1=Inf[3]; + if(type(C1)!=1||C1<0) C1=1; + if(length(Inf)>4) CB=Inf[4]; + }else if(isint(Inf)&&Inf>0&&Inf<100){ + MM=Inf+1;Ck=100; + }else Inf=0; + Ckm*=Ck; + + SS=subst(S,V,H);N0=N; + if(Er>0){ + HE=H/(Er+1);SSE=subst(S,V,HE);LyE=Ly; + } + for(C=CC=CF=0;C=Ck){ /* check explosion */ + CC=0; + D0=dnorm(Ly|max=1); + if(Er&&CF){ + DE=dnorm(ladd(LyE,Ly,-1)|max=1); + if(CB*DE>D0) break; + } + for(Dy=F,TY=Y,TL=Ly;TY!=[];TY=cdr(TY),TL=cdr(TL)) + Dy=subst(Dy,car(TY),One*car(TL)); + D1=dnorm(Dy|max=1);D2=subst(FM,x,2*D0+C1);D3=D1+D2; + HH=2*(D0+C1)/Ckm; + if(HHHH) H/=2; + if(H*7/51) N*=MM; + MM=0; + } + CC=0; + } + + T+=H; + for(Dy=SS,TY=Y,TL=Ly;TY!=[];TY=cdr(TY),TL=cdr(TL)) + Dy=subst(Dy,car(TY),One*car(TL)); + Ly=Dy; + + if(Er>0){ /* estimate error */ + for(CE=0;CE<=Er;CE++){ + for(Dy=SSE,TY=Y,TL=LyE;TY!=[];TY=cdr(TY),TL=cdr(TL)) + Dy=subst(Dy,car(TY),One*car(TL)); + LyE=Dy; + } + } + if(FL<0||(C+1)%FL) continue; + if(Vw){ + if(LS==1+Tf||Sf) CR=CC/N0; + else{ + YT=Mt*ltov(Ly); + CR=(!Vr)?CC/N0:(YT[2]-Vr[0])/(Vr[1]-Vr[0]); + } + if(LS==1+Tf||Sf) glib_putpixel(deval(T),Mt*Ly[Tf]|color=mcolor(Cl,CR)); + else glib_putpixel(YT[0],YT[1]|color=mcolor(Cl,CR)); + continue; + } + TR=(V1)?[car(Ly)]:Ly; + if(!Tf) TR=cons((Inf)?eval(T):deval(T),TR); + R=cons(TR,R); + if(Er){ + TRE=(V1)?[car(LyE)]:LyE; + if(!Tf) TRE=cons((Inf)?eval(T):deval(T),TRE); + RE=cons(TRE,RE); + } + } + if(Vw) return 1; + L=(FL<0)?((V1)?car(Ly):Ly):reverse(R); + if(Er){ /* Estimate error */ + LE=(FL<0)?((V1)?car(LyE):LyE):reverse(RE); + if(FL>0){ + for(S=L,T=LE,D=[];S!=[];S=cdr(S),T=cdr(T)) D=cons(os_md.ladd(car(S),car(T),-1),D); + F=map(os_md.dnorm,reverse(D)); + if(iand(ErF,2)){ /* relative error */ + G=llget(LE,-1,[0]); + G=map(os_md.dnorm,G); + for(R=[];G!=[];G=cdr(G),F=cdr(F)){ + if(car(G)) R=cons(car(F)/car(G),R); + else R=cons(0,R); + } + F=reverse(R); + } + if(!iand(ErF,1)) F=map(os_md.nlog,F); + if(!iand(ErF,8)) F=map(deval,F); + }else if(V1){ + D=ladd(L,LE,-1);F=dnorm(D); + if(iand(ErF,2)){ + G=dnorm(cdr(L)); + if(!G) D/=G; + else D=1; + } + F=(!iand(ErF,1))?nlog(D):D; + if(!iand(ErF,8)) F=deval(F); + }else{ + D=abs(L-LE); + if(iand(ErF,2)){ + G=abs(L); + if(!G) D/=G; + else D=1; + } + F=(!iand(ErF,1))?nlog(D):D; + if(!iand(ErF,8)) F=deval(F); + } + return iand(ErF,4)?[L,F,LE]:[L,F]; + } + return L; +} + 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{ @@ -11449,22 +14152,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); @@ -11509,7 +14290,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); } @@ -11517,10 +14298,15 @@ def mytan(Z) def mylog(Z) { if(type(Z=eval(Z))>1) return todf(os_md.mylog,[Z]); - if((Im=imag(Z))==0) return dlog(Z); + if(imag(Z)==0&&Z>=0) return dlog(Z); return dlog(dabs(Z))+@i*myarg(Z); } +def nlog(X) +{ + return mylog(X)/dlog(10); +} + def mypow(Z,R) { if(type(Z=eval(Z))>1||type(R=eval(R))>1) return todf(os_md.mypow,[Z,R]); @@ -11980,10 +14766,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)+")"; @@ -12004,7 +14786,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]); @@ -12015,7 +14810,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]); @@ -12279,6 +15073,126 @@ def fcont(F,LX) return reverse(L); } +def xyplot(L,LX,LY) +{ + Vw=getopt(view); + if(type(Vw)!=1 && type(Vw)!=7 && Vw!=0) Vw=-1; + if(!LX){ + L0=llget(L,1,[0]|flat=1); + LX=[lmin(L0),LXm=lmax(L0)]; + S=SX=LX[1]-LX[0]; + if(S>0){ + if(Vw) LX=[LX[0]-S/32,LX[1]+S/32]; + }else LX=[LX[0]-1,LX[0]+1]; + } + LX=map(deval,LX); + if(!LY){ + L0=llget(L,1,[1]|flat=1); + LY=[lmin(L0),LYm=lmax(L0)]; + S=SY=LY[1]-LY[0]; + if(S>0){ + if(Vw) LY=[LY[0]-S/32,LY[1]+S/32]; + }else LY=[LY[0]-1,LY[0]+1]; + } + LY=map(deval,LY); + if(getopt(raw)==1) mycat([LX,LY]); + if(Vw!=-1){ + if(Vw!=1){ + if(type(Vw)==7) Vw=trcolor(Vw); + Opt=[["color",Vw]]; + }else Opt=[]; + Glib_math_coordinate=1; + glib_window(LX[0],LY[0],LX[1],LY[1]); + for(; L!=[];L=cdr(L)) + glib_putpixel(car(L)[0],car(L)[1]|option_list=Opt); + if((AX=getopt(ax))==1||AX==2){ + if(LY[0]<0&&LY[1]>0){ + glib_line(LX[0],0,LX[1],0); + if(AX==2&&LXm>0){ + E=floor(dlog(LXm)/dlog(10)); + V=floor(LXm*10^(-E)+1/128)*10^E; + glib_line(V,0,V,SY/64); + glib_print(V,-SY/128,rtostr(V)); + } + } + if(LX[0]<0&&LX[1]>0){ + glib_line(0,LY[0],0,LY[1]); + if(AX==2&&LYm>0){ + E=floor(dlog(LYm)/dlog(10)+1/64); + V=floor(LYm*10^(-E)+1/128)*10^E; + glib_line(0,V,SX/64,V); + glib_print(SX/96,V,rtostr(V)); + } + + } + } + return [LX,LY]; + } + Opt=getopt();Opt0=delopt(Opt,["dviout","proc"]); + if(type(R=getopt(to))!=4) To=[12,8]; + R=[To[0]/(LX[1]-LX[0]),RY=To[1]/(LY[1]-LY[0])]; + R=[sint(R[0],4|str=0),sint(R[1],4|str=0)]; + S="% "; + if(type(C=getopt(scale))!=1&&type(C)!=4){ + Opt0=cons(["scale",R],Opt0); + S+="scale="+rtostr(R)+", "; + } + S+=rtostr(LX)+", "+rtostr(LY)+"\n"; + for(L0=[],TL=L;TL!=[];TL=cdr(TL)){ + TTL=map(deval,car(TL)); + if(TTL[0]LX[1]||TTL[1]LY[1]){ + S+=xylines(reverse(L0)|option_list=Opt0); + L0=[]; + }else{ + L0=cons(TTL,L0); + } + } + if(length(L0)>1) S+=xylines(reverse(L0)|option_list=Opt0); + AX=getopt(ax);Opt=delopt(Opt0,"opt"); + if(type(AX)==4) S+="% axis\n"+xygraph([0,0],0,LX,LX,LY|option_list=Opt); + else if((LX[0]<=0&&LX[1]>=0)||(LY[0]<=0&&LY[1]>=0)) + S+="% axis\n"+xygraph([0,0],0,LX,LX,LY|option_list=cons(["ax",[0,0]],Opt)); + if(getopt(dviout)!=1) return S; + xyproc(S|dviout=1); + return [LX,LY]; +} + +def xyaxis(A,X,Y) +{ + if(isint(Vw=getopt(view))&&Vw!=0){ + CL=getopt(opt); + if(type(CL)==7) CL=trcolor(CL); + if(type(CL)!=0) CL=0; + if(CL) Opt=[[color,CL]]; + else Opt=[]; + Glib_math_coordinate=1; + UX=(X[1]-X[0])/50;UY=(Y[1]-Y[0])/50; + glib_window(X[0],Y[0],X[1],Y[1]); + glib_line(A[0],Y[0],A[0],Y[1]|option_list=Opt); + glib_line(X[0],A[1],X[1],A[1]|otpion_list=Opt); + if(length(A)>2&&A[2]){ + I0=-floor((A[0]-X[0])/A[2]);I1=floor((X[1]-A[0])/A[2]); + for(I=I0;I<=I1;I++){ + IX=A[0]+A[2]*I; + if(iand(Vw,2)) glib_print(IX-UX,A[1]-UY/2,rtostr(IX)); + glib_line(IX,A[1],IX,A[1]+UY); + } + } + if(length(A)>3&&A[3]){ + I0=-floor((A[1]-Y[0])/A[3]);I1=floor((Y[1]-A[1])/A[3]); + for(I=I0;I<=I1;I++){ + IY=A[1]+A[3]*I; + if(iand(Vw,4)) glib_print(A[0]-UX*2,IY+UY,rtostr(IY)); + glib_line(A[0],IY,A[0]+UX,IY); + } + } + return; + } + Opt=getopt(); + Opt=cons(["ax",A],Opt); + return xygraph([0,0],0,[0,1],X,Y|option_list=Opt); +} + def xygraph(F,N,LT,LX,LY) { if((Proc=getopt(proc))!=1&&Proc!=2&&Proc!=3) Proc=0; @@ -12463,7 +15377,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); @@ -12590,7 +15505,7 @@ def xygraph(F,N,LT,LX,LY) if(length(Ax)>3){ D=Ax[3]; if(type(D)==1 && D>0){ - I0=ceil((LY[0]-Ax[1])/D); I1=floor((LY[1]-Ax[0])/D); + I0=ceil((LY[0]-Ax[1])/D); I1=floor((LY[1]-Ax[1])/D); for(DD=[],I=I0; I<=I1; I++){ if(length(Ax)<5) DD=cons(I*D,DD); else if(I!=0){ @@ -12721,7 +15636,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]; @@ -12783,7 +15702,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--) @@ -12809,6 +15728,7 @@ def polroots(L,V) for(SS=[];R!=[];R=cdr(R)){ RS=(N==2)?[car(R)]:car(R); for(I=0,L0=L[0];I=0;L--) R[L]=Q[L]-P[L]; + return R; + } + return P; +} + +def dext(P,Q) +{ + P=lsub(P);Q=lsub(Q); + return P[0]*Q[1]-P[1]*Q[0]; +} + def ptcommon(X,Y) { if(length(X)!=2 || length(Y)!=2) return 0; @@ -12865,19 +15806,29 @@ def ptcommon(X,Y) T=[Y[0][0]+(Y[1][0]-Y[0][0])*y_-S[0], Y[0][1]+(Y[1][1]-Y[0][1])*y_-S[1]]; R=lsol(T,[x_,y_]); - if(type(R[0])==4&&type(R[1])==4&&R[0][0]==x_&&R[1][0]==y_){ - if(!In || (R[0][1]>=0&&R[0][1]<=1&&R[1][1]>=0&&R[1][1]<=1) ) - return subst(S,x_,R[0][1],y_,R[1][1]); + if(type(R[0])==4&&type(R[1])==4&&R[0][0]==x_&&R[1][0]==y_){ + /* unique sol of parameters */ + if(In && (R[0][1]<0||R[0][1]>1||R[1][1]<0||R[1][1]>1) ) return 0; + return subst(S,x_,R[0][1],y_,R[1][1]); } - if((type(R[0])>0&&type(R[0])<4)||(type(R[1])>0&&type(R[1])<4)) return 0; - if(!In) return 1; - I=(X[0][0]==X[1][0]&&Y[0][0]==Y[1][0]&&X[0][0]==Y[0][0])?1:0; - if(X[0][I]<=X[1][I]){ - X0=X[0][I];X1=X[1][I]; - }else{ - X1=X[0][I];X0=X[1][I]; + if((type(R[0])>0&&type(R[0])<4)||(type(R[1])>0&&type(R[1])<4)) return 0; /* no solution */ + F=0; + if(X[0]==X[1]) F=1; + else if(Y[0]==Y[1]) F=2; + if(!In){ + if(!F) return 1; + else if(F==1) return X[0]; + else if(F==2) return Y[0]; } - return ((Y[0][I]X1&&Y[1][I]>X1))?0:1; + X0=X[0];X1=X[1]; + if(X0>X1){R=X0;X0=X1;X1=R;} + Y0=Y[0];Y1=Y[1]; + if(Y0>Y1){R=Y0;Y0=Y1;Y1=R;} + if(X0Y1) X1=Y1; + if(X0>X1) return 0; + if(X01 && R[0]==R[1]) R=cdr(R); + return R; + } + if(dext([L[0],L[1]],[L[0],L[2]])<0) L=[L[0],L[2],L[1]]; + L=cons(L[2],L); + for(I=F=1;I<4;I++,L=cdr(L)){ + if((V=dext([L[0],L[1]],[L[0],P])) < 0) return 0; + if(!V) F++; + } + return F; +} + def tobezier(L) { if((Div=getopt(div))==1||Div==2){ @@ -13001,14 +15985,17 @@ def cutf(F,X,VV) if(car(V)!=[] && car(V)[0]car(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); @@ -13016,7 +16003,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); } } @@ -13025,19 +16012,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]); } @@ -13267,6 +16254,213 @@ def ptbezier(V,L) return [subst(B,t,L[1]),subst(BB,t,L[1])]; } +/* +def isroot(P,Q,I) +{ + if(subst(P,X,X0=I[0])*subst(P,X,I[1])<=0) return 1; + XM=(I[1]+I[0])/2;W=XM-X0; + if(W<0) W=-W; + X=var(P); + if(!Q) Q=diff(P,X); + Q=subst(Q,X,X+I2);D=deg(Q,X); + for(M=0,P=1,I=deg(Q,X);I<=D;I++){ + V=coef(Q,I,X); + M+=(V<0?-V:V)*P; + P*=W; + } + V=subst(P,X,X0); + if(V<0) V=-V; + return (V-M<=0) 2:0; +} +*/ + +def sgnstrum(L,V) +{ + X=var(car(L)); + if(X==0) X=var(L[1]); + for(F=N=0;L!=[];L=cdr(L)){ + P=car(L); + if(type(V)==7){ + C=coef(P,D=deg(P,X),X); + if(V=="-"&&iand(D,1)) C=-C; + }else C=subst(P,X,V); + if(!C) continue; + if(C*F<0) N++; + F=C; + } + return N; +} + +def polstrum(P) +{ + X=vars(P0=P); + if(!length(X)) return []; + X=car(X); + if(isfctr(P)){ + D=gcd(P,Q=diff(P,X)); + P=sdiv(P,D); + if(getopt(mul)==1&&type(getopt(num))<0) + return append(polstrum(D|mul=1),[P]); + } + D=deg(P,X); + P=P/coef(P,deg(P,X),X); + Q=diff(P,X)/D; + for(L=[Q,P];D>0;){ + R=urem(P,Q); + if((D=deg(R,X))<0) break; + C=coef(R,D,X); + if(C>0) C=-C; + R/=C; + L=cons(R,L); + P=Q;Q=R; + } + if(type(N=getopt(num))>0){ + if(getopt(mul)!=1){ + if(type(N)==1) N=["-","+"]; + return sgnstrum(L,N[0])-sgnstrum(L,N[1]); + } + if(!isfctr(P0)) return -1; + R=polstrum(P0|mul=1); + for(C=0;R!=[];R=cdr(R)) C+=polstrum(car(R)|num=N); + return C; + } + return reverse(L); +} + +def iceil(X) +{ + S=(X>0)?1:-1; + X*=S; + if(X>1) X=ceil(X); + else if(X>1/2) X=1; + else if(X) X=1/floor(1/X); + return S*X; +} + +def polradiusroot(P) +{ + X=var(P);D=deg(P,X); + if(D<1) return -1; + C=coef(P,D,X); + P/=-C; + Int=getopt(int); + if(getopt(comp)==1){ + for(ND=0,TD=0;TD0){ + N2++; + if(!iand(D-TD,1)) N1++; + }else if(iand(D-TD,1)) N1++; + } + for(V1=V2=0,TD=0;TD0){ + TV=eval((C*N2)^(1/(D-TD))); + if(V20){ + TV=eval((C*N1)^(1/(D-TD))); + if(V11&&MC<10001) MC1=MC; + else MC1=MC=32; + if(type(I=getopt(in))!=4){ + I=polradiusroot(P); + W=(I[1]-I[0])/1024; + I=[I[0]-W,I[1]+W]; + } + if(type(L=type(getopt(strum)))!=4) L=polstrum(P); + N0=sgnstrum(L,I[0]);N1=sgnstrum(L,I[1]); + P=car(L);X=var(P); + if(N0<=N1) return []; /* [L,I,N0,N1]; */ + LT=[[0,I[0],I[1],N0,N1]];R=[]; + Z=eval(exp(0)); + while(LT!=[]){ + T=car(LT);LT=cdr(LT); + C=T[0];X0=T[1];X1=T[2];N0=T[3];N1=T[4]; + if(N0<=N1)continue; + if(N0==N1+1){ + V0=subst(P,X,X0); + V1=subst(P,X,X1); + while(C++0&&V2>0)||(V0<0&&V2<0)) X0=X2; + else X1=X2; + } + R=cons([X0,X1,1],R); + continue; + } + while(++CN2){ + if(N2>N1) LT=cons([C,X2,X1,N2,N1],LT); + X1=X2; + N1=N2; + if(N0==N1+1){ + LT=cons([C,X0,X1,N0,N1],LT); + C=MC+1; + } + }else{ + X0=X2; + N0=N2; + } + } + if(C!=MC+2) R=cons([X0,X1,N0-N1],R); + } + if(isint(Nt=getopt(nt)) && Nt>0){ + if(Nt>256) Nt=256; + Q=diff(P,X); + for(S=[],TR=R;TR!=[];TR=cdr(TR)){ + if(car(TR)[2]>1) continue; + V0=subst(P,X,car(TR)[0]); + V1=subst(P,X,car(TR)[1]); + if(abs(V0)0;Tn--){ + X1=X0-V0/subst(Q,X,X0); + V1=subst(P,X,X1); + if(abs(V1)>=abs(V0)) break; + X0=X1;V0=V1; + } + S=cons(X0,S); + } + for(TR=R;TR!=[];TR=cdr(TR)) + if(car(TR)[2]>1) S=cons(car(TR),S); + return reverse(S); + } + return reverse(cons(P,R)); +} + +/* +def ptcombezier0(P,Q) +{ + PB=subst(tobezier(P|div=1),t,s); + QB=tobezier(Q|Div=1); + Z=res(PB[0]-QB[0],PB[1]-QB[1],s); + D=pmaj(diff(Z,t)|val=t); +} +*/ + def ptcombezier(P,Q,T) { if(type(T)<2){ @@ -13434,6 +16628,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){ @@ -13443,7 +16669,7 @@ def lbezier(L) else{ if(R!=[]&&F!=0) R=cons(0,R); R=cons(G=car(LT),R); - if(In==3) In==2; + if(In==3) In=2; } for(LT=cdr(LT);LT!=[];LT=cdr(LT)) R=cons(car(LT),R); @@ -13462,7 +16688,7 @@ def lbezier(L) } RT=cons(T,RT); }else if(T==0){ - if(RT==[]) R=cons(reverse(RT),R); + if(RT!=[]) R=cons(reverse(RT),R); RT=[];F=0; }else if(T==1){ if(RT!=[]){ @@ -13484,6 +16710,7 @@ def lbezier(L) def xybezier(L) { + if(type(L)==4&&type(car(L))==4&&type(car(L)[0])==4) L=lbezier(L|inv=1); if(L==0 || (LS=length(L))==0) return ""; Out=str_tb(0,0); if(type(VF=getopt(verb))==4){ @@ -13651,25 +16878,34 @@ def xybox(L) def xyang(S,P,Q,R) { - Opt=getopt(); + Opt=delopt(getopt(),"ar"); if(type(Prec=getopt(prec))!=1) Prec=0; if(type(Q)>2){ + if(type(Ar=getopt(ar))!=1) Ar=0; if(R==1||R==-1){ /* 直角 */ P1=ptcommon([Q,P],[-S,0]); S*=R; P2=ptcommon([P,P1],[S,@pi/2]); P3=ptcommon([P1,P2],[S,@pi/2]); return xylines([P1,P2,P3]|option_list=Opt); - }else if((AR=abs(R))==0||AR==2||AR==3||AR==4){ /* 矢印 */ + }else if((AR=abs(R))==0||AR==2||AR==3||AR==4||AR>=10){ /* 矢印 */ Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); if(R<0) Ang+=3.14159; - ANG=[0.7854,0.5236,1.0472]; - X=(AR==0)?1.5708:ANG[AR-2]; + if(AR>10) X=deval(@pi/180*AR); + else{ + ANG=[0.7854,0.5236,1.0472]; + X=(AR==0)?1.5708:ANG[AR-2]; + } U=[P[0]+S*dcos(Ang+X),P[1]+S*dsin(Ang+X)]; V=[P[0]+S*dcos(Ang-X),P[1]+S*dsin(Ang-X)]; /* 矢先 */ - V=(X==0)?[U,V]:[U,P,V]; - if(getopt(ar)==1) V=append([Q,P,0],V); /* 心棒 */ - return xylines(V|option_list=Opt); + L=(X==0)?[U,V]:[U,P,V]; + if(X&&iand(Ar,2)){ + L=append([V],L); + if((X=ptcommon([P,Q],[U,V]|in=1))!=0) P=X; + } + if(iand(Ar,1)) + L=append([Q,P,0],L); /* 心棒 */ + return xylines(L|option_list=Opt); }else if(AR>4&&AR<9){ Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); ANG=[0.7854,0.5236,0.3927,0.2618]; @@ -13679,19 +16915,20 @@ def xyang(S,P,Q,R) W=ptcommon([P,U],[P,Q]|in=-2); W1=[(U[0]+P[0]+W[0])/3,(U[1]+P[1]+W[1])/3]; W2=[(V[0]+P[0]+W[0])/3,(V[1]+P[1]+W[1])/3]; - L=[U,W1,P,1,W2,V]; - if(getopt(ar)==1) L=append([Q,P,0],L); + L=iand(Ar,2)?[V,U,1,W1,P,1,W2,V]:[U,W1,P,1,W2,V]; + if(iand(Ar,1)){ + if(iand(Ar,2)) P=ptcommon([P,Q],[U,V]); + L=append([Q,P,0],L); + }; if(type(Sc=getopt(scale))>0){ if(type(Sc)==1) Sc=[Sc,Sc]; L=ptaffine(diagm(2,Sc),L); } - Opt=getopt(opt); - if(type(Opt)>0) OL=[["opt",Opt]]; - else OL=[]; - if(getopt(proc)==1) return append([2,OL],L); - S=xybezier(L|optilon_list=OL); + Opt=delopt(Opt,"proc"); + if(getopt(proc)==1) return append([2,Opt],L); + S=xybezier(L|option_list=Opt); if(getopt(dviout)!=1) return S; - dviout(S); + dviout(xyproc(S)); return 1; } } @@ -13822,6 +17059,211 @@ 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 xycircuit(P,S) +{ + if(type(Sc=getopt(scale))!=1) Sc=1; + if(type(Opt0=getopt(opt))!=7) Opt0=""; + if(type(At=getopt(at))!=1) At=(S=="E"||S=="EE")?1:1/2; + Rev=(getopt(rev)==1)?-1:1; + if(type(P)==4&&type(car(P))==4&&P[0][0]==P[1][0]) Rev=-Rev; + W=R=B2=B3=0;Opt=Opt2=Opt3=""; + if(S=="L"||S=="VL"||S=="LT"){ + G=[1/8*x-2/5*cos(x)+2/5,1/2*sin(x)+1/2]; + B=xygraph(G,-21,[0,7*@pi],[-1,10],[-2,2]|scale=0.3/1.06466,opt=0); + B=append(B,[1,[1,0]]); + B=append([[0,0],car(B),1],cdr(B)); + W=1;Opt="thick"; + if(S=="VL"){ + B2=xyang(0.2,[0.5+0.4*Rev,0.45],[0.5-0.435*Rev,-0.3],3|ar=3,opt=0); + Opt2="thick,fill"; + }else if(S=="LT"){ + B2=[[0.5+0.4*Rev,0.45],[0.5-0.435*Rev,-0.3],0,[0.45+0.4*Rev,0.394],[0.55+0.4*Rev,0.506]]; + Opt2="thick"; + } + }else if(S=="C"||S=="VC"||S=="C+"||S=="C-"||S=="CT"){ + B=[[0,-0.2],[0,0.2],0,[0.15,-0.2],[0.15,0.2]]; + W=0.15;Opt="very thick"; + if(S=="VC"){ + B2=xyang(0.2,[1/3+0.075,0.3*Rev],[-1/3+0.075,-0.3*Rev],3|ar=3,opt=0); + Opt2="thick,fill"; + }else if(S=="CT"){ + B2=[[1/3+0.075,0.3*Rev],[-1/3+0.075,-0.3*Rev],0,[1/3+0.125,0.244*Rev], + [1/3+0.025,0.356*Rev]]; + Opt2="thick"; + }else if(S=="C+") + B2=[[0,0.05],[0.15,-0.05],0,[0,0.15],[0.15,0.05],0,[0,-0.05],[0.15,-0.15], + 0,[0.29,0.04*Rev],[0.29,0.24*Rev],0,[0.19,0.14*Rev],[0.39,0.14*Rev]]; + else if(S=="C-") + B2=[[0,0.05],[0.15,-0.05],0,[0,0.15],[0.15,0.05],0,[0,-0.05],[0.15,-0.15]]; + }else if(S=="R"||S=="VR"||S=="VR3"||S=="RT"){ + for(I=0,B=[[0,0]];I<12;I++) + if(iand(I,1)) B=cons([I,(-1)^((I+1)/2)],B); + B=reverse(cons([12,0],B)); + B=xylines(B|scale=[1/18,0.15],opt=0); + W=2/3;Opt="thick"; + if(S=="VR"){ + B2=xyang(0.2,[2/3,0.3*Rev],[0,-0.3*Rev],3|ar=3,opt=0); + Opt2="thick,fill"; + }else if(S=="RT"){ + B2=[[2/3,0.3*Rev],[0,-0.3*Rev],0,[0.717,0.244*Rev],[0.617,0.357*Rev]]; + Opt2="thick"; + }else if(S=="RN3"){ + B2=xyang(0.2,[1/3,0.2*Rev],[1/3,0.5*Rev],3|ar=3,opt=0); + Opt2="thick,fill"; + } + }else if(S=="RN"||S=="VRN"||S=="RN3"||S=="NRT"){ + B=xylines([[0,0.1],[2/3,0.1],[2/3,-0.1],[0,-0.1],[0,0.1]]|opt=0); + W=2/3;Opt="thick"; + if(S=="VRN"){ + B2=xyang(0.2,[2/3,0.3*Rev],[0,-0.3*Rev],3|ar=3,opt=0); + Opt2="thick,fill"; + }else if(S=="RN3"){ + B2=xyang(0.2,[1/3,0.2*Rev],[1/3,0.5*Rev],3|ar=3,opt=0); + Opt2="thick,fill"; + }else if(S=="NRT"){ + B2=[[2/3,0.3*Rev],[0,-0.3*Rev],0,[0.717,0.244*Rev],[0.617,0.357*Rev]]; + Opt2="thick"; + } + }else if(S=="circle"){ + W=1; + B=xyang(0.5,[0.5,0],0,0|opt=0); + }else if(S=="gap"){ + W=0.3; + B=xyang(0.15,[0.15,0],0,3.1416|opt=0); + }else if(S=="E"){ + W=0.1; + B=[[0,0.2],[0,-0.2],0,[0,0.05],[0.1,-0.05],0,[0,0.15],[0.1,0.05],0,[0,-0.05],[0.1,-0.15]]; + }else if(S=="EE"){ + W=0.15; + B=[[0,0.2],[0,-0.2],0,[0.075,0.13],[0.075,-0.13],0,[0.15,-0.06],[0.15,0.06]]; + }else if(S=="Cell"){ + W=0.1; + B=[[0,-0.2],[0,0.2]]; + B2=[[0.1,-0.1],[0.1,0.1]];Opt2="very thick"; + }else if(S=="Cell2"){ + W=0.3; + B=[[0,-0.2],[0,0.2],0,[0.2,-0.2],[0.2,0.2]]; + B2=[[0.1,-0.1],[0.1,0.1],0,[0.3,-0.1],[0.3,0.1]];Opt2="very thick"; + }else if(S=="Cells"){ + W=0.6; + B=[[0,-0.2],[0,0.2],0,[0.5,-0.2],[0.5,0.2],0,[0.1,0],[0.18,0],0, + [0.24,0],[0.34,0],0,[0.40,0],[0.5,0]]; + B2=[[0.1,-0.1],[0.1,0.1],0,[0.6,-0.1],[0.6,0.1]];Opt2="very thick"; + }else if (S=="Sw"){ + W=0.5; + B=xyang(0.05,[0.05,0],0,0|opt=0); + B0=ptaffine(1,B|shift=[0.4,0]); + B=ptaffine("union",[B,B0]); + B=ptaffine("union",[B,[[0.0908,0.025*Rev],[0.45,0.17*Rev]]]); + }else if(S=="D"){ + W=0.3;Opt="thick"; + B=[[0,0],[0.3,0.173],0,[0.3,0.173],[0.3,-0.173],0,[0.3,-0.173],[0,0],0, + [0,0.173],[0,-0.173]]; + }else if(S=="NPN"||S=="PNP"||S=="NPN0"||S=="PNP0"){ + W=0.6; + C=[[0.6,0],[0.37,0.23],[0,0],[0.23,0.23]]; + if(Rev==-1) C=[C[2],C[3],C[0],C[1]]; + if(S=="PNP"||S=="PNP0") C=[C[1],C[0],C[2],C[3]]; + B=[[0,0],[0.23,0.23],0,[0.6,0],[0.37,0.23],0,[0.3,0.23],[0.3,0.6]]; + B=ptaffine("union",[xyang(0.15,C[0],C[1],18|ar=1,opt=0),B]); + if(S=="PNP"||S=="NPN") B=ptaffine("union",[xyang(0.3354,[0.3,0.15],0,0|opt=0),B]); + B2=[[0.07,0.23],[0.53,0.23]]; + Opt2="very thick"; + }else if(S=="JN"||S=="JP"){ + W=0.6; + B=[[0,0],[0.2,0],1,[0.2,0.23],0,[0.6,0],[0.4,0],1,[0.4,0.23],0,[0.3,0.23],[0.3,0.6]]; + C=[[0.3,0.23],[0.3,0.4854]]; + if(S=="JP") C=reverse(C); + B=ptaffine("union",[B,xyang(0.15,C[0],C[1],18|opt=0)]); + B=ptaffine("union",[B,xyang(0.3354,[0.3,0.15],0,0|opt=0)]); + B2=[[0.07,0.23],[0.53,0.23]]; + Opt2="very thick"; + }else if(S=="") R=(Opt0=="")?xyline(P[0],P[1]):xyline(P[0],P[1]|opt=Opt0); + else if(S=="arrow") R=xyang(0.2*Sc,P[1],P[0],3|ar=1,opt=Opt0); + else if(type(S)==4&&type(car(S))==7){ + if(type(car(P))!=4) P=[P]; + for(R="";P!=[];P=cdr(P)) R+=xyput([car(P)[0],car(P)[1],car(S)]); + } + if(W){ + R=""; + if(type(P)==4){ + if(type(car(P))==4){ + T=ptcommon([[0,0],[1,0]],P|in=2); + L=dnorm(P); + W*=Sc; + L1=L*At-W/2;L2=L*(1-At)-W/2; + if(L1>0){ + P1=[P[0][0]+L1*dcos(T),P[0][1]+L1*dsin(T)]; + R+=xyline(P[0],P1); + } + if(L2>0){ + P2=[P[1][0]-L2*dcos(T),P[1][1]-L2*dsin(T)]; + R+=xyline(P2,P[1]); + } + B=ptaffine(Sc,B|shift=P1,arg=T); + if(B2) B2=ptaffine(Sc,B2|shift=P1,arg=T); + if(B3) B3=ptaffine(Sc,B3|shift=P1,arg=T); + }else{ + B=ptaffine(Sc,B|shift=P1); + if(B2) B2=ptaffine(Sc,B2|shift=P1); + if(B3) B3=ptaffine(Sc,B3|shift=P1); + } + }else{ + B=ptaffine(Sc,B); + if(B2) B2=ptaffine(Sc,B2); + if(B3) B3=ptaffine(Sc,B3); + } + if(Opt=="") Opt=Opt0; + else if(Opt0!="") Opt=Opt+","+Opt0; + R+=(Opt=="")?xybezier(B):xybezier(B|opt=Opt); + if(B2){ + if(Opt2=="") Opt2=Opt0; + else if(Opt0!="") Opt2=Opt2+","+Opt0; + R+=(Opt2=="")?xybezier(B2):xybezier(B2|opt=Opt2); + } + if(B3){ + if(Opt3=="") Opt3=Opt0; + else if(Opt0!="") Opt3=Opt3+","+Opt0; + R+=(Opt3=="")?xybezier(B3):xybezier(B3|opt=Opt3); + } + } + return R; +} + + def ptaffine(M,L) { if(type(L)!=4&&type(L)!=5){ @@ -14108,18 +17550,50 @@ def ptcopy(L,V) } } +def regress(L) +{ + E=deval(exp(0)); + for(S0=T0=0,S=L;S!=[];S=cdr(S)){ + S0+=car(S)[0]*E;T0+=car(S)[1]*E; + } + K=length(L);S0/=K;T0/=K; + for(SS=TT=0,S=L;S!=[];S=cdr(S)){ + SS+=(car(S)[0]-S0)^2*E;TT+=(car(S)[1]-T0)^2*E; + ST+=(car(S)[0]-S0)*(car(S)[1]-T0)*E; + } + if(!SS||!TT) return []; + A=ST/SS; + L=[A,A*S0-T0,ST/dsqrt(SS*TT),S0,dsqrt(SS/K),T0,dsqrt(TT/K)]; + if(isint(N=getopt(sint))){ + R=reverse(L); + for(L=[];R!=[];R=cdr(R)) L=cons(sint(car(R),N|str=0),L); + } + return L; +} + 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; } @@ -14434,7 +17908,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); @@ -14489,20 +17963,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]; @@ -14516,26 +18049,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); @@ -14544,33 +18078,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!=[]&&I=0){ + D=(D1-M1>D0)?D1-M1:D0; + G0=muldo(X[1]^D,G0,X);G1=muldo(X[1]^(D+M1),G1,X); + }else{ + D=(D0+M1>D1)?D0+M1:D1; + G0=muldo(X[1]^(D-M1),G0,X);G1==muldo(X[1]^D,G1,X); + } + G0=map(mc,G0,X,M0);G1=map(mc,G1,X,M0+M1); + G0=appldo(G0,A,X|Pfaff=1); + G1=sppldo(G1,B,X|Pfaff=1); + return rmul(myinv(G0),G1); +} + def conf1sp(M) { if(type(M)==7) M=s2sp(M); @@ -15768,6 +19363,347 @@ 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=[];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 vConv(K,I,J) +{ + if(type(X=getopt(var))!=7) X="a"; + if(getopt(e)==2) return subst(vConv(K,I+1,J+1),makev([X,1]),0); + if(J>K){L=J;J=K;K=L;} + if(K>I||J<1||K+J0;I--) V=cons(makev(["a0",I]),V); + MI=myinv(M); + V=ltov(V)*MI; + for(R=[],I=0;I0;I--) V1=cons(os_md.makev([X[0],I]),V1); + for(V2=[],I=NR[1];I>0;I--) V2=cons(os_md.makev([X[1],I]),V2); + R=subst(R,car(V1),0,car(V2),0); + V1=subst(V1,car(V1),0); + V2=subst(V2,car(V2),0); + for(V=[],S=V1;S!=[];S=cdr(S)) for(T=V2;T!=[];T=cdr(T)) V=cons(car(T)-car(S),V); + V=reverse(V); + Mx=length(V); + for(A0=[],I=J=NR[0]-1;J>=0;I+=--J) for(K=0;K=0;I--) F0=cons(1/(x-V[I]), F0); + MV=confexp([F0,V]|sym=3); + RR=newvect(Mx); + for(K=0;K3) M=map(red,M); + else M=red(M); + R=cons(M,R); + } + R=reverse(R); + if(Sym==2) return R; + M=length(R);N=length(S[1]); + E=newmat(M,N); + for(I=0;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]; @@ -15888,6 +19824,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=1) D=1; } - if(type(X)==5){ - K=length(X); - for(J=5, F=K-10; F>0; F-=J++); - if(F==0) D=2; - } if(D==0) return 0; - if(T==0){ /* x <-> y */ - if(D==1){ - R=cdr(X); R=cdr(R); - R=cons(X[0],R); - return cons(X[1],R); + if(type(T)==4&&(length(T)==K+3||length(T)==2)){ + for(U=[],I=K+2;I>=0;I--) U=cons(I,U); + if(length(T)==2) T=mperm(U,[T],0); + L=sexps(T); + for(R=[X,S];L!=[];L=cdr(L)){ + if(!(I=car(L))) I=4; + /* else if(I==1) I=1; */ + else if(I==2) I=5; + else if(I==K+1) I=6; + else if(I>2) I=2-I; + R=lft01(R,I); } - R=newvect(K,[X[3],X[1],X[4],X[0],X[2],X[6],X[5]]); - for(I=7;I=0;I--) S=cons(I,S); + else S=0; + if(T<=0){ /* y_i <-> y_{i+1}, y_0=x=x_0, y_i=x_{i+2} */ + R=mperm(X,[[-T,1-T]],0); + if(S){ + if(!T) S=mperm(S,[[0,3]],0); + else S=mperm(S,[[2-T,3-T]],0); /* : J J=3,...,K; */ + R=[R,S]; } - R=newvect(K,[X[2],X[1],X[0],X[4],X[3],X[5],X[6],X[8],X[7],X[9]]); - for(I=11;I1;X=cdr(X)) R=cons(red(car(X)*(1-T)/(car(X)-T)),R); + R=cons(1-T,R); + if(S) S=mperm(S,[[K+1,K+2]],0); + }else if(T==7){ /* x_2=1 <-> x_{K+2}=infty */ + for(R=[];X!=[];X=cdr(X)) R=cons(red(car(X)/(car(X)-1)),R); + if(S) S=mperm(S,[[2,K+2]],0); + }else return 0; + R=reverse(R); + return S?[R,S]:R; } def linfrac01(X) { - if(type(X)==4) K=length(X)-2; - else if(type(X)==5){ - L=length(X); - for(K=0,I=10,J=5; I=0;I--) U=cons(I,U); + X=[car(X),U]; + }else U=0; } if(K>3 && getopt(over)!=1) return(-1); II=(K==-1)?3:4; @@ -18018,16 +21924,16 @@ def linfrac01(X) } } } - return L; + return reverse(L); } 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; @@ -18044,7 +21950,8 @@ def varargs(P) } } } - return [FC,Arg]; + Arg=reverse(Arg); + return (All==2)?Arg:[reverse(FC),Arg]; } def pfargs(P,X) @@ -18259,9 +22166,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); @@ -18273,9 +22254,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); @@ -18363,7 +22344,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 +22353,7 @@ def keyin(S) } def init() { - LS=["DIROUT","DVIOUTA","DVIOUTB","DVIOUTH","DVIOUTL","FCAT","TeXLim","TeXEq","TikZ", + LS=["DIROUT","DVIOUTA","DVIOUTB","DVIOUTH","DVIOUTL","TeXLim","TeXEq","TikZ", "XYPrec","XYcm","Canvas"]; if(!access(get_rootdir()+"/help/os_muldif.dvi")||!access(get_rootdir()+"/help/os_muldif.pdf")) mycat(["Put os_muldif.dvi and os_muldif.pdf in", get_rootdir()+(isMs()?"\\help.":"/help.")]); @@ -18382,7 +22363,6 @@ def init() { DVIOUTB=str_subst(DVIOUTB,[["\\","/"],[".bat",".sh"]],0); DVIOUTL=str_subst(DVIOUTL,[["\\","/"],[".bat",".sh"]],0); DVIOUTH="%ASIRROOT%/help/os_muldif.pdf"; - FCAT=str_subst(DVIOUTB,"\\","/"); } Home=getenv("HOME"); if(type(Home)!=7) Home=""; @@ -18397,7 +22377,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){ @@ -18410,27 +22390,23 @@ def init() { else if(P[0]==2) DVIOUTB=SS; else if(P[0]==3) DVIOUTH=SS; else if(P[0]==4) DVIOUTL=SS; - else if(P[0]==5) CATF=SS; } } if(P0<0 || P1