/* The latest version will be at ftp://akagi.ms.u-tokyo.ac.jp/pub/math/muldif scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs */ #define USEMODULE 1 /* #undef USEMODULE */ /* os_muldif.rr (Library for Risa/Asir) * Toshio Oshima (Nov. 2007 - Aug. 2017) * * For polynomials and differential operators with coefficients * in rational funtions (See os_muldif.pdf) * * "Tab = 4 column" is best */ ord([zz,dz,dy,dx])$ #ifdef USEMODULE module os_md; static Muldif.rr$ static TeXEq$ static TeXLim$ static DIROUT$ static DIROUTD$ static DVIOUTL$ static DVIOUTA$ static DVIOUTB$ static DVIOUTH$ static DVIOUTF$ static LCOPT$ static COLOPT$ static LPOPT$ static LFOPT$ static ErMsg$ static FLIST$ static IsYes$ static XYPrec$ static XYcm$ static TikZ$ static XYLim$ static Canvas$ static ID_PLOT$ static Rand$ static LQS$ localf spType2$ localf erno$ localf chkfun$ localf makev$ localf shortv$ localf makenewv$ localf vweyl$ localf mycat$ localf mycat0$ localf fcat$ localf findin$ localf countin$ localf mycoef$ localf mydiff$ localf myediff$ localf m2l$ localf m2ll$ localf mydeg$ localf pfctr$ localf mymindeg$ localf m1div$ localf mulsubst$ localf cmpsimple$ localf simplify$ localf monotos$ localf minustos$ localf monototex$ localf vnext$ localf ldict$ localf ndict$ localf nextsub$ localf nextpart$ localf transpart$ localf trpos$ localf sprod$ localf sinv$ localf slen$ localf sord$ localf vprod$ localf dvangle$ localf dvprod$ localf dnorm$ localf mulseries$ localf pluspower$ localf vtozv$ localf dupmat$ localf matrtop$ localf mytrace$ localf mydet$ localf mperm$ localf mtranspose$ localf mtoupper$ localf mydet2$ localf myrank$ localf meigen$ localf transm$ localf vgen$ localf mmc$ localf lpgcd$ localf mdivisor$ localf mdsimplify$ localf m2mc$ localf easierpol$ localf paracmpl$ localf mykernel$ localf myimage$ localf mymod$ localf mmod$ localf ladd$ localf lchange$ localf llsize$ localf llbase$ localf lsort$ localf lmax$ localf lmin$ localf lgcd$ localf llcm$ localf ldev$ localf lsol$ localf lnsol$ localf l2p$ localf m2v$ localf lv2m$ localf m2lv$ localf s2m$ localf c2m$ localf m2diag$ localf myinv$ localf madjust$ localf mpower$ localf mrot$ localf texlen$ localf isdif$ localf fctrtos$ localf texlim$ localf fmult$ localf radd$ localf getel$ localf ptol$ localf rmul$ localf mtransbys$ localf drawopt$ localf execdraw$ localf execproc$ localf myswap$ localf mysubst$ localf evals$ localf myval$ localf myeval$ localf mydeval$ localf myfeval$ localf myf2eval$ localf myf3eval$ localf myfdeval$ localf myf2deval$ localf myf3deval$ localf myexp$ localf mycos$ localf mysin$ localf mytan$ localf myarg$ localf myasin$ localf myacos$ localf myatan$ localf mylog$ localf mypow$ localf scale$ localf arg$ localf sqrt$ localf gamma$ localf lngamma$ localf digamma$ localf dilog$ localf zeta$ localf eta$ localf jell$ localf frac$ localf erfc$ localf orthpoly$ localf schurpoly$ localf fouriers$ localf todf$ localf f2df$ localf df2big$ localf compdf$ localf fzero$ localf fmmx$ localf flim$ localf fcont$ localf fresidue$ localf mmulbys$ localf appldo$ localf appledo$ localf muldo$ localf jacobian$ localf hessian$ localf wronskian$ localf adj$ localf laplace1$ localf laplace$ localf mce$ localf mc$ localf rede$ localf ad$ localf add$ localf vadd$ localf addl$ localf cotr$ localf rcotr$ localf muledo$ localf mulpdo$ localf transpdosub$ localf transpdo$ localf translpdo$ localf rpdiv$ localf mygcd$ localf mylcm$ localf sftpexp$ localf applpdo$ localf tranlpdo$ localf divdo$ localf qdo$ localf sqrtdo$ localf ghg$ localf ev4s$ localf b2e$ localf sftpow$ localf sftpowext$ localf polinsft$ localf pol2sft$ localf polroots$ localf fctri$ localf binom$ localf expower$ localf seriesHG$ localf seriesMc$ localf seriesTaylor$ localf evalred$ localf toeul$ localf fromeul$ localf sftexp$ localf fractrans$ localf soldif$ localf chkexp$ localf sqrtrat$ localf getroot$ localf expat$ localf polbyroot$ localf polbyvalue$ localf pcoef$ localf prehombf$ localf prehombfold$ localf sub3e$ localf fuchs3e$ localf okubo3e$ localf eosub$ localf even4e$ localf odd5e$ localf extra6e$ localf rigid211$ localf solpokuboe$ localf stoe$ localf dform$ localf polinvsym$ localf polinsym$ localf tohomog$ localf substblock$ localf okuboetos$ localf heun$ localf fspt$ localf abs$ localf sgn$ localf calc$ localf isint$ localf israt$ localf iscrat$ localf isalpha$ localf isnum$ localf isalphanum$ localf isdecimal$ localf isvar$ localf isyes$ localf isall$ localf iscoef$ localf iscombox$ localf sproot$ localf spgen$ localf chkspt$ localf cterm$ localf terms$ localf polcut$ localf redgrs$ localf cutgrs$ localf mcgrs$ localf mc2grs$ localf mcmgrs$ localf anal2sp$ localf delopt$ localf str_char$ localf str_pair$ localf str_cut$ localf str_str$ localf str_subst$ localf str_times$ localf str_tb$ localf strip$ localf i2hex$ localf sjis2jis$ localf jis2sjis$ localf s2os$ localf l2os$ localf r2os$ localf s2euc$ localf s2sjis$ localf r2ma$ localf evalma$ localf ssubgrs$ localf verb_tex_form$ localf tex_cuteq$ localf my_tex_form$ localf texket$ localf smallmattex$ localf divmattex$ localf dviout0$ localf myhelp$ localf isMs$ localf showbyshell$ localf readcsv$ localf tocsv$ localf getbyshell$ localf show$ localf dviout$ localf rtotex$ localf mtotex$ localf ltotex$ localf texbegin$ localf texcr$ localf texsp$ localf getbygrs$ localf mcop$ localf shiftop$ localf conf1sp$ localf pgen$ localf diagm$ localf mgen$ localf madj$ localf newbmat$ localf unim$ localf pfrac$ localf cfrac$ localf cfrac2n$ localf sqrt2rat$ localf s2sp$ localf sp2grs$ localf fimag$ localf trig2exp$ localf intpoly$ localf integrate$ localf simplog$ localf fshorter$ localf isshortneg$ localf intrat$ localf powsum$ localf bernoulli$ localf lft01$ localf linfrac01$ localf nthmodp$ localf issquaremodp$ localf rootmodp$ localf rabin$ localf primroot$ localf varargs$ localf ptype$ localf pfargs$ localf average$ localf sint$ localf frac2n$ localf xyproc$ localf xypos$ localf xyput$ localf xybox$ localf xyline$ localf xylines$ localf xycirc$ localf xybezier$ localf lbezier$ localf draw_bezier$ localf tobezier$ localf velbezier$ localf ptbezier$ localf cutf$ localf fsum$ localf fint$ localf periodicf$ localf cmpf$ localf areabezier$ localf saveproc$ localf xygraph$ localf xy2graph$ localf addIL$ localf xy2curve$ localf xygrid$ localf xyarrow$ localf xyarrows$ localf xyang$ localf xyoval$ localf ptcommon$ localf ptcopy$ localf ptaffine$ localf ptlattice$ localf ptpolygon$ localf ptwindow$ localf ptbbox$ localf lninbox$ localf ptcombezier$ localf ptcombz$ localf lchange$ localf init$ localf powprimroot$ localf distpoint$ localf ntable$ localf keyin$ localf mqsub$ localf msort$ #else extern Muldif.rr$ extern TeXEq$ extern TeXLim$ extern DIROUT$ extern DIROUTD$ extern DVIOUTL$ extern DVIOUTA$ extern DVIOUTB$ extern DVIOUTH$ extern DVIOUTF$ static LCOPT$ static COLOPT$ static LPOPT$ static LFOPT$ extern TikZ$ extern ErMsg$ extern FLIST$ extern IsYes$ extern XYPrec$ extern XYcm$ extern TikZ$ extern XYLim$ extern Canvas$ extern ID_PLOT$ extern Rand$ extern LQS$ #endif static S_Fc,S_Dc,S_Ic,S_Ec,S_EC,S_Lc$ static S_FDot$ extern AMSTeX$ Muldif.rr="00170825"$ AMSTeX=1$ TeXEq=5$ TeXLim=80$ TikZ=0$ XYcm=0$ XYPrec=3$ XYLim=4$ Rand=0$ DIROUT="%HOME%\\tex"$ 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%"$ 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"]$ Canvas=[400,400]$ LQS=[[1,0]]$ ErMsg = newvect(3,[ "irregal argument", /* 0 */ "too big size", /* 1 */ "irregal option" /* 2 */ ])$ FLIST=0$ IsYes=[]$ ID_PLOT=-1$ def erno(N) { /* extern ErMsg; */ print(ErMsg[N]); } def chkfun(Fu, Fi) { /* extern FLIST; */ /* extern Muldif.rr; */ if(type(Fu) <= 1){ if(Fu==1) mycat(["Loaded os_muldif Ver.", Muldif.rr, "(Toshio Oshima)"]); else mycat(["Risa/Asir Ver.", version()]); return 1; } if(type(FLIST) < 4) FLIST = flist(); if(type(Fu) == 4){ for(; Fu != [] ;Fu = cdr(Fu)) if(chkfun(car(Fu),Fi) == 0) return 0; return 1; } if(findin(Fu, FLIST) >= 0) return 1; FLIST = flist(); if(findin(Fu, FLIST) >= 0) return 1; if(type(Fi)==7){ mycat0(["load(\"", Fi,"\") -> try again!\n"],1); load(Fi); } return 0; /* if(type(Fi) == 7) Fi = [Fi]; for( ; Fi != []; Fi = cdr(Fi)) load(car(Fi)); FLIST = flist(); return (findin(Fu,FLIST)>=0)?1:0; */ } def makev(L) { S = ""; Num=getopt(num); while(length(L) > 0){ VL = car(L); L = cdr(L); if(type(VL) == 7) S = S+VL; else if(type(VL) == 2 || VL < 10) S = S+rtostr(VL); else if(VL<46 && Num!=1) S = S+asciitostr([VL+87]); else S = S+rtostr(VL); } return strtov(S); } 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=varargs(L|all=2); for(XX=[],I=J=0;;I++){ X=strtov(V+rtostr(I)); if(findin(X,Var)<0){ XX=cons(X,XX); if(++J>N) return X; else if(J==N) return reverse(XX); } } } def shortv(P,L) { V=vars(P); if(type(T=getopt(top))==2) T=strtoascii(rtostr(T))[0]-87; else T=10; for(;L!=[];L=cdr(L)){ for(J=0;J<36;J++){ if(findin(X=makev([car(L),J]|num=1),V)>=0){ while(findin(Y=makev([T]),V)>=0) T++; if(T>35) return P; P=subst(P,X,Y); T++; }else if(J>0) break; } } return P; } def vweyl(L) { if(type(L) == 4){ if(length(L) == 2) return L; else return [L[0],makev(["d",L[0]])]; } /* else if(type(L)<2) return L; */ return [L,makev(["d", L])]; } def mycat(L) { if(type(L) != 4){ print(L); return; } Opt = getopt(delim); Del = (type(Opt) >= 0)?Opt:" "; Opt = getopt(cr); CR = (type(Opt) >= 0)?0:1; while(L != []){ if(Do==1) print(Del,0); print(car(L),0); L=cdr(L); Do = 1; } if(CR) print(""); } def fcat(S,X) { if(type(S)!=7){ if(type(DIROUTD)!=7){ DIROUTD=str_subst(DIROUT,["%HOME%","%ASIRROOT%","\\"], [getenv("HOME"),get_rootdir(),"/"])+"/"; if(isMs()) DIROUTD=str_subst(DIROUTD,"/","\\"|sjis=1); } if(S==-1) return; T="fcat"; if(S>=2&&S<=9) T+=rtostr(S); T=DIROUTD+T+".txt"; if(S==-1) return T; if(S!=0&&access(T)) remove_file(T); S=T; } R=output(S); print(X); output(); if(getopt(exe)==1) shell("\""+S+"\""); return R; } def mycat0(L,T) { Opt = getopt(delim); Del = (type(Opt) >= 0)?Opt:""; if(type(L)!=4) L=[L]; while(L != []){ if(Do==1) print(Del,0); print(car(L),0); L=cdr(L); Do = 1; } if(T) print(""); } def findin(M,L) { if(type(L)==4){ for(I = 0; L != []; L = cdr(L), I++) if(car(L) == M) return I; }else if(type(L)==5){ K=length(L); for(I = 0; I < K; I++) if(L[I] == M) return I; }else return -2; return -1; } def countin(S,M,L) { 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){ for(N=0; L!=[]; L=cdr(L)) if(car(L)>=S && car(L)<=M) N++; }else if(type(L)==5){ K=length(L); for(I = 0; I < K; I++) if(L[I]>=S && L[I]<=M) N++; }else return -2; return N; } def mycoef(P,N,X) { if(type(P)<3 && type(N)<3) return coef(P,N,X); if(type(P) >= 4) #ifdef USEMODULE return map(os_md.mycoef,P,N,X); #else return map(mycoef,P,N,X); #endif if(type(N)==4){ for(;N!=[];N=cdr(N),X=cdr(X)) P=mycoef(P,car(N),car(X)); return P; } if(deg(dn(P), X) > 0){ P = red(P); if(deg(dn(P), X) > 0) return 0; } return red(coef(nm(P),N,X)/dn(P)); } def mydiff(P,X) { if(X == 0) return 0; if(type(P)<3 && type(X)<3) return diff(P,X); if(type(P) >= 4) #ifdef USEMODULE return map(os_md.mydiff,P,X); #else return map(mydiff,P,X); #endif if(type(X)==4){ for(;X!=[];X=cdr(X)) P=mydiff(P,car(X)); return P; } if(ptype(dn(P),X)<2) return red(diff(nm(P),X)/dn(P)); return red(diff(P,X)); } def myediff(P,X) { if(X == 0) return 0; if(type(P) < 3) return ediff(P,X); if(type(P) >= 4) #ifdef USEMODULE return map(os_md.myediff,P,X); #else return map(myediff,P,X); #endif if(deg(dn(P),X) == 0) return red(ediff(nm(P),X)/dn(P)); return red(X*diff(P,X)); } def m2l(M) { if(type(M) < 4) return [M]; if(type(M) == 4){ if(type(car(M))==4 && getopt(flat)==1){ for(MM = []; M!=[]; M=cdr(M)) MM = append(MM,car(M)); return MM; } return M; } if(type(M) == 5) return vtol(M); S = size(M); for(MM = [], I = S[0]-1; I >= 0; I--) MM = append(vtol(M[I]), MM); return MM; } def mydeg(P,X) { if(type(P) < 3) return deg(P,X); II = -1; Opt = getopt(opt); if(type(P) >= 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) return -2; if(DT > Deg){ Deg = DT; II = I; } } 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); return -2; } def pfctr(P,X) { P=red(P); if((T=ptype(P,X))>3) return []; if(T==3){ G=pfctr(dn(P),X); F=pfctr(nm(P),X); R=[[car(F)[0]/car(G)[0],1]]; for(F=cdr(F);F!=[];F=cdr(F)) R=cons(car(F),R); for(G=cdr(G);G!=[];G=cdr(G)) R=cons([car(G)[0],-car(G)[1]],R); return reverse(R); } F=fctr(nm(P)); for(R=[],C=1/dn(P);F!=[];F=cdr(F)) if(mydeg(car(F)[0],X)>0) R=cons(car(F),R); else C*=car(F)[0]^car(F)[1]; return cons([C,1],reverse(R)); } def mymindeg(P,X) { if(type(P) < 3) return mindeg(P,X); II = -1;T=60; Opt = getopt(opt); if(type(P) >= 4){ S=(type(P) == 6)?size(P)[0]:0; P = m2l(P); for(I = 0, Deg = -3; P != []; P = cdr(P), I++){ if(car(P) == 0) continue; if( (DT = mydeg(car(P),X)) == -2) return -2; if(DT < Deg || Deg == -3){ if(DT==0){ if(type(car(P))>=T) continue; T=type(car(P)); } Deg = DT; II = I; } } return (Opt==1)?([Deg,(S==0)?II:[idiv(II,S),irem(II,S)]]):Deg; } P = red(P); if(deg(dn(P),X) == 0) return mindeg(nm(P),X); return -2; } def m1div(M,N,L) { L = (type(L) <= 3)?[0,L]:vweyl[L]; DX = L[1]; X = L[0]; if(mydeg(N,DX) != 0) return 0; DD = mydeg(M,DX); MM = M; while( (Deg=mydeg(MM,DX)) > 0){ MC = mycoef(MM,Deg,DX)*DX^(Deg-1); MS = radd(MC, MS); MM = radd(MM, muldo(MC,radd(-DX,N),L)); } return [MM, MS]; } def mulsubst(F,L) { N = length(L); if(N == 0) return F; if(type(L[0])!=4) L=[L]; if(getopt(inv)==1){ for(R=[];L!=[];L=cdr(L)) R=cons([car(L)[1],car(L)[0]],R); L=reverse(R); } if(length(L)==1) return mysubst(F,L); L1 = newvect(N); for(J = 0; J < N ; J++) L1[J] = uc(); L2 = newvect(N); for(J = 0; J < N; J++){ S = L[J][1]; for(I = 0; I < N; I++) S = mysubst(S,[L[I][0],L1[I]]); L2[J] = S; } for(J = 0; J < N; J++) F = mysubst(F, [L[J][0],L2[J]]); for(J = 0; J < N; J++) F = mysubst(F, [L1[J],L[J][0]]); return F; } def cmpsimple(P,Q) { T = getopt(comp); if(P == Q) return 0; D = 0; if(type(T) < 0) T = 7; if(iand(T,1)) D = length(vars(P)) - length(vars(Q)); if(!D && iand(T,2)) D = nmono(P) - nmono(Q); if(!D && iand(T,4)) D = str_len(rtostr(P)) - str_len(rtostr(Q)); if(!D){ if(P > Q) D++; else D--; } return D; } def simplify(P,L,T) { if(type(P) > 3) #ifdef USEMODULE return map(os_md.simplify,P,L,T); #else return map(simplify,P,L,T); #endif if(type(L[0]) == 4){ if(length(L[0]) > 1) #if USEMODULE return fmult(os_md.simplify,P,L,[T]); #else return fmult(simplify,P,L,[T]); #endif L = L[0]; } if(type(Var=getopt(var)) == 4 && Var!=[]){ if(type(P) == 3) return simplify(nm(P),P,L,T|var=Var)/simplify(dn(P),P,L,T|var=Var); V = car(Var); if((I = mydeg(P,V)) > 0){ Var = cdr(Var); for(Q=0; I>=0 ; I--) Q += simplify(mycoef(P,I,V), L, T|var=Var)*V^I; return Q; } } if(length(L) == 1){ L = car(L); for(V = vars(L); V != []; V = cdr(V)){ VT = car(V); if(deg(L,VT) != 1) continue; P = simplify(P, [VT, -red(coef(L,0,VT)/coef(L,1,VT))], T); } return P; } Q = mysubst(P,[L[0],L[1]]); return (cmpsimple(P,Q|comp=T) <= 0)?P:Q; } def monotos(P) { if(nmono(P) <= 1) return rtostr(P); return "("+rtostr(P)+")"; } def monototex(P) { Q=my_tex_form(P); if(nmono(P)<2 && (getopt(minus)!=1 || str_str(Q,"-"|top=0,end=0)<0)) return Q; return "("+Q+")"; } def minustos(S) { if(str_str(S,"-"|top=0,end=0)<0) return S; return "("+S+")"; } def vnext(V) { S = length(V); for(I = S-1; I > 0; I--){ if(V[I-1] < V[I]){ V0 = V[I-1]; for(J = I+1; J < S; J++) if(V0 >= V[J]) break; V[I-1] = V[--J]; V[J] = V0; for(J = S-1; I < J; I++, J--){ V0 = V[I]; V[I] = V[J]; V[J] = V0; } return 1; } } return 0; } def ldict(N, M) { Opt = getopt(opt); R = S = []; for(I = 2; N > 0; I++){ R = cons(irem(N,I), R); N = idiv(N,I); } L = LL = length(R); T=newvect(LL+1); while(L-- > 0){ V = car(R); R = cdr(R); for(I = J = 0; J <= V ; I++){ if(T[I] == 0) J++; } T[I-1] = 1; S = cons(LL-I+1, S); } for(I = 0; I <= LL; I++){ if(T[I] == 0){ S = cons(LL-I, S); break; } } if(M == 0) return S; if(M <= LL){ print("too small size"); return 0; } T = []; for(I = --M; I > LL; I--) T = cons(I,T); S = append(S,T); if(Opt == 2 || Opt == 3) S = reverse(S); if(Opt != 1 && Opt != 3) return S; for(T = []; S != []; S = cdr(S)) T = cons(M-car(S),T); return T; } def ndict(L) { Opt = getopt(opt); R = []; if(Opt != 1 && Opt != 2) L = reverse(L); T = (Opt == 1 || Opt == 3)?1:0; for( ; L != []; L = cdr(L)){ for(I = 0, V = car(L), LT = cdr(L); LT != []; LT = cdr(LT)) if(T == 0){ if(V < car(LT)) I++; }else if (V > car(LT)) I++; R = cons(I, R); } R = reverse(R); for(V = 0, I = length(R); I > 0; R = cdr(R), I--) V = V*I + car(R); return V; } def nextsub(L,N) { if(type(L) == 1){ for(LL = [], I = L-1; I >= 0; I--) LL = cons(I,LL); return LL; } M = length(L = ltov(L)); K = N-M; for(I = M-1; I >= 0; I--) if(L[I] < I+K) break; if(I < 0) return 0; for(J = L[I]+1; I < M; I++, J++) L[I] = J; return vtol(L); } def nextpart(L) { if(car(L) <= 1) return 0; for(I = 0, L = reverse(L); car(L) == 1; L=cdr(L)) I++; I += (K = car(L)); R = irem(I,--K); R = (R==0)?[]:[R]; for(J = idiv(I,K); J > 0; J--) R = cons(K,R); L = cdr(L); while(L!=[]){ R = cons(car(L), R); L = cdr(L); } return R; } def transpart(L) { L = reverse(L); for(I=1, R=[]; L!= []; I++){ R = cons(length(L), R); while(L != [] && car(L) <= I) L = cdr(L); } return reverse(R); } def trpos(A,B,N) { S = newvect(N); for(I = 0; I < N; I++) S[I]=(I==A)?B:((I==B)?A:I); return S; } def sprod(S,T) { L = length(S); V = newvect(L); while(--L >= 0) V[L] = S[T[L]]; return V; } def sinv(S) { L = length(S); V = newvect(L); while(--L >= 0) V[S[L]] = L; return V; } def slen(S) { L = length(S); for(V = 0, J = 2; J < L; i++){ for(I = 0; I < J; I++) if(S[I] > S[J]) V++; } return V; } def sord(W,V) { L = length(W); W0 = nevect(L); V0 = newvect(L); for(I = F = C = 0; I < L; I++){ C = 0; if( (W1 = W[I]) > (V1 = V[I]) ){ if(F < 0) C = 1; else if(F==0) F = 1; }else if(W1 < V1){ if(F > 0) C = 1; else if(F==0) F = -1; } for(J = I;--J >= 0 && W0[J] > W1; ) W0[J+1] = W0[J]; W0[J+1] = W1; for(J = I;--J >= 0 && V0[J] > V1; ) V0[J+1] = V0[J]; V0[J+1] = V1; if(C){ for(J = I; J >= 0; J--){ if((W1=W0[J]) == (V1=V0[J])) continue; if(W1 > V1){ if(F < 0) return 2; } else if(F > 0) return 2; } } } return F; } def vprod(V1,V2) { for(R = 0, I = length(V1)-1; I >= 0; I--) R = radd(R, rmul(V1[I], V2[I])); return R; } def dnorm(V) { if(type(V)<2) return dabs(V); R=0; if(type(V)!=4) for (I = length(V)-1; I >= 0; I--) R+= 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; } return dsqrt(R); } def dvprod(V1,V2) { if(type(V1)<2) return V1*V2; R=0; if(type(V1)!=4) for(I = length(V1)-1; I >= 0; I--) R += V1[I]*V2[I]; else{ for(; V1!=[]; V1=cdr(V1),V2=cdr(V2)) R+=car(V1)*car(V2); } return R; } def dvangle(V1,V2) { if(V2==0 && type(V1)==4 && length(V1)==3 && (type(V1[0])==4 || type(V1[0])==5 || type(V1[1])==4 || type(V1[1])==5 || type(V1[2])==4 || type(V1[2])==5) ){ if(V1[0]==0 || V1[1]==0 || V1[2]==0) return 1; PV2=V1[1]; if(type(PV2)==4){ PV2=ltov(PV2); return dvangle(PV2-ltov(V1[0]),ltov(V1[2])-PV2); }else return dvangle(PV2-V1[0],V1[2]-PV2); } if((L1=dnorm(V1))==0 || (L2=dnorm(V2))==0) return 1; return dvprod(V1,V2)/(L1*L2); } def mulseries(V1,V2) { L = length(V1); if(size(V2) < L) L = size(V2); VV = newvect(L); for(J = 0; J < L; J++){ for(K = R = 0; K <= J; K++) R = radd(R,rmul(V1[K],V2[J-K])); VV[J] = R; } return VV; } def scale(L) { T=0;LS=1; Pr=getopt(prec); if(type(L)!=4){ if(L==2){ L=(Pr!=1)? [[[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; }else if(L==3){ L=(Pr!=1)? [[[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; }else{ L=(Pr!=1)? [[[1,2,1/50],[2,5,1/20],[5,10,1/10]], [[1,5,1/10],[5,10,1/2]], [[1,5,1/2],[5,10,1]]]: [[[1,2,1/100],[2,5,1/50],[5,10,1/20]], [[1,2,1/20],[2,10,1/10]], [[1,2,1/10],[2,10,1/2]]]; } }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]; } if(type(F=getopt(f))>1) F=f2df(F); else F=0; for(M=M0=[],I=length(T);T!=[];T=cdr(T),I--){ for(S=car(T);S!=[];S=cdr(S)){ V=((!F)?dlog(car(S))/dlog(10)/LS:myfdeval(F,car(S)))*S0; if(S1!=0){ M=cons([V+D0,D1],M); M=cons([V+D0,I*((length(SC)>2)?SC[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) M=cons([U[0]+D0,D1],cons([U[1]+D0,D1],cons(0,M))); if(type(Col=getopt(col))<1) S=xylines(M); else S=xylines(M|opt=Col); if(type(Mes=getopt(mes))==4){ 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]); else Mes=scale(cdr(Mes)|f=F,scale=[S0,0],shift=[D0,D1]); for(M=car(Mes);M!=[];M=cdr(M),V=cdr(V)){ VT=deval(car(V)); if(Col!=0) VT=[Col,VT]; S+=xyput([car(M),S3,VT]); } } return S; } def pluspower(P,V,N,M) { RR = 1; for(K = R = 1; K < M-1; I++){ R = R*(N-K+1)*P/K; RR = radd(RR,R); } VV = newvect(M); for(K = 0; K < M-1; K++) VV[K] = red(mycoef(RR,K,V)); } def vtozv(V) { if(type(V)<4) V=newvect(1,[V]); S = length(V); VV = newvect(S); Lcm = 1; for(K = 0; K < S; K++){ VV[K] = red(V[K]); Lcm = lcm(Lcm,dn(VV[K])); C = ptozp(nm(VV[K])|factor=0); if(K == 0){ Dn = dn(C[1]); Nm = nm(C[1]); PNm = nm(C[0]); }else{ Dn = ilcm(Dn,dn(C[1])); Nm = igcd(Nm,nm(C[1])); PNm = gcd(PNm,nm(C[0])); } } if(!(M=Nm*PNm)) return [VV,0]; Mul = (Lcm*Dn)/M; for(K = 0; K < S; K++) VV[K] = rmul(VV[K],Mul); return [VV,Mul]; } def dupmat(M) { if(type(M) == 6){ Size = size(M); MM = newmat(Size[0],Size[1]); for(I = 0; I < Size[0]; I++){ for(J = 0; J < Size[1]; J++) MM[I][J] = M[I][J]; } return MM; } if(type(M) == 5) return ltov(vtol(M)); return M; } def matrtop(M) { S = size(M); MM = dupmat(M); Lcm = newvect(S[0]); for(J = 0; J < S[0]; J++){ U = vtozv(M[J]); for(K = -1, I = 0; I < S[1]; I++) MM[J][I] = U[0][I]; Lcm[J] = U[1]; } return [MM,Lcm]; } def mytrace(M) { S=size(M); if(S[0]!=S[1]) return 0; for(I=V=0; I 3 && type(P[0]) >= 4) P = trpos(P[0][0],P[0][1],S[0]); else if(type(P) == 4){ if(length(P)==2 && type(P[1])==4){ P0=P[0];P1=car(P[1]);P=newvect(P1); for(I=0;I 3 && type(Q[0]) >= 4) Q = trpos(Q[0][0],Q[0][1],S[1]); if(type(Q) == 4){ if(length(Q)==2 && type(Q[1])==4){ P0=Q[0];P1=car(Q[1]);Q=newvect(P1); for(I=0;I= 4){ if(length(P) == 1 && type(car(P)) == 4) P = trpos(car(P)[0],car(P)[1],length(M)); MM = newvect(S = length(P)); for(I = 0; I < S; I++) MM[I] = M[P[I]]; if(type(M) == 4) MM = vtol(MM); return MM; } return M; } def mtranspose(M) { if(type(M)==4){ MV=ltov(M); II=length(MV); for(I=L=0; IJ){ F=1; T=cons(MV[I][J],T); } } if(F==0) return reverse(R); if(F==1) R=cons(reverse(T),R); } } if(type(M) != 6) return M; S = size(M); MM = newmat(S[1],S[0]); for(I = 0; I < S[0]; I++){ for(J = 0; J < S[1]; J++) MM[J][I] = M[I][J]; } return MM; } def mtoupper(MM, F) { TeXs=["\\ -=\\ ","\\ +=\\ "]; Lins=[" -= line"," += line"]; Assume=["If","Assume"]; if(type(St = getopt(step))!=1) St=0; Opt = getopt(opt); if(type(Opt)!=1) Opt=0; TeX=getopt(dviout); if(type(Tab=getopt(tab))!=1 && Tab!=0) Tab=2; Line="\\text{line}"; if(type(TeX)!=1 || !St) TeX=0; Size = size(MM); if(F==-1){ M = newmat(Size[0], Size[1]+1); for(I = 0; I < Size[0]; I++){ for(J = 0; J < Size[1]; J++) M[I][J] = MM[I][J]; M[I][Size[1]] = zz^I; } Size = size(M); F = 1; }else if(F<0){ F=Size[0]; M = newbmat(1,2,[[MM,mgen(F,0,[1],0)]]); Size=[Size[0],F+Size[1]]; }else M = dupmat(MM); if(St){ if(TeX) Lout=[[dupmat(M)]]; else mycat0([M,"\n\n"],0); } Top=""; if(Opt>3){ for(I=Opt; I>4; I--) Top+=(TeX)?"\\ ":" "; } PC=IF=1; for(K = JJ = 0; K < Size[1] - F; K++){ for(J = JJ; J < Size[0]; J++){ if(M[J][K] != 0){ /* search simpler element */ if(Opt>2 && (Mul=M[J][K])!=1){ for(FF=0,JT=J; JTtype(Mul)) continue; if(type(Val)3){ if(isint(Val)==1){ /* integer elememt */ if(isint(Mul)!=1){ Mul=Val; J=JT; /* integer */ } if(FF<3||(FF==3&&Val>0)){ for(JK=K+1;;){ if(JK>=Size[1]-F){ J=JT; FF=((Mul=Val)>0)?4:3; break; /* divisible int => 4: pos_int 3: neg_int */ } if(isint(M[JT][JK++]/Val)!=1) break; } } }else if(!FF){ for(JK=K+1; JK 1: non integer */ } } } } if(FF==0 && Opt>3 && Mul!=1 && Mul!=-1){ /* FF > 0 => divisible */ for(FF=0,J0=J; J00){ for(I=K;I4 && 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; } if(subst(PC,Var,T)==0) continue; Q0*=(Var-(T=QR[0][1])); if(type(T)<2){ M0=subst(M,Var,T); 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); }else{ mycat([str_times(" ",St-1)+"If",Var,"=",T,","]); mtoupper(M0,F|step=St+1,opt=Opt); } } } if(Q0!=1){ if(TeX) Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{"+Assume[QF]+" }", Q0/=fctr(Q0)[0][0],"\\ne0,"],Lout); else mycat([str_times(" ",St-1)+Assume[QF],Q0,"!=0,"]); PC*=Q0; } IF=0;St++; }else{ KRC=-red((T[2]*dn(M[J0][K]))/(T[1]*dn(M[I][K]))); for(II=K;II=2)?Temp:-Temp; } if(St){ if(TeX) Lout=cons([Top+"\\xrightarrow{",Line,JJ+1,"\\ \\leftrightarrow\\ ", Line,J+1,"}",dupmat(M)],Lout); else mycat0([Top+"line",JJ+1," <-> line",J+1,"\n",M,"\n\n"],0); } } /* Assume PC != 0 */ if(Opt>1){ Mul = M[JJ][K]; if(Opt > 5 && St && IF && (Var=vars(MIK=nm(Mul)))!=[]){ TF=fctr(MIK); for(FF=0,Q0=1,TP=cdr(TF);TP!=[];TP=cdr(TP)){ if(type(dn(red(PC/(TP0=car(car(TP))))))<2) continue; /* divisible */ Q0*=TP0; for(Var=vars(TP0);Var!=[];Var=cdr(Var)){ if(mydeg(TP0,X=car(Var))==1 && type(dn(red(PC/mycoef(TP0,1,X))))<2){ /* TP0=A*X+B with non-vanishing A */ T=red(-mycoef(TP0,0,X)/mycoef(TP0,1,X)); M0=mysubst(M,[X,T]); if(TeX){ Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", X,"=",T,","] ,Lout); Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab), Lout); }else{ mycat([str_times(" ",St-1)+"If",X,"=",T,","]); mtoupper(M0,F|step=St+1,opt=Opt); } break; } } if(Var==[] && Opt>6){ for(Var=vars(TP0);Var!=[];Var=cdr(Var)){ if(mydeg(TP0,X=car(Var))==1){ /* TP0=A*X+B, A is a poly of X0 with rational funct */ T=nm(mycoef(TP0,1,X)); for(Var0=vars(T);Var0!=[]; Var0=cdr(Var0)){ X0=car(Var0); if(type(dn(red(PC/type(mycoef(T,mydeg(T,X0),X0)))))>1) continue; TR=getroot(T,X0|mult=1); if(findin(X0,vars(TR))<0) break; } if(Var0==[]) continue; for(;TR!=[0];TR=cdr(TR)){ if(TR==[]){ TR=[0,0]; T0=-mycoef(TP0,0,X)/mycoef(TP0,1,X); X0=X; }else T0=car(TR)[1]; M0=mysubst(M,[X0,T0]); if(TeX){ Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", X0,"=",T0,","] ,Lout); Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab), Lout); }else{ mycat([str_times(" ",St-1)+"If",X0,"=",T0,","]); mtoupper(M0,F|step=St+1,opt=Opt); } } } break; } } if(Var==[]){ FF=1; } } if(Q0!=1){ if(FF) FF=1; if(TeX) Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{"+Assume[FF]+" }",Q0/=fctr(Q0)[0][0],"\\ne0,"], Lout); else mycat([str_times(" ",St-1)+Assume[FF],Q0,"!=0,"]); PC*=Q0;St++; } } IF=M[JJ][K]=1; if(Mul!=1){ for(L=K+1; L0)?0:(JJ+1); J < Size[0]; J++){ if(J == JJ) continue; Mul = -M[J][K]; if(Mul!=0){ if(Opt!=2) Mul=rmul(Mul,1/M[JJ][K]); for(I = K+1; I < Size[1]; I++) M[J][I] = radd(M[J][I],rmul(M[JJ][I],Mul)); M[J][K] = 0; if(St){ if(Mul<0){ Mul=-Mul;Sgn=0; }else Sgn=1; if(TeX){ if(Mul==1) Lout=cons([Top+"\\xrightarrow{", Line,J+1,TeXs[Sgn],Line,JJ+1, "}",dupmat(M)],Lout); else Lout=cons([Top+"\\xrightarrow{", Line,J+1,TeXs[Sgn],Line,JJ+1, "\\times\\left(",Mul,"\\right)}",dupmat(M)],Lout); }else{ if(Mul==1) mycat0([Top+"line",J+1, Lins[Sgn],JJ+1,"\n",M,"\n\n"],0); else mycat0([Top+"line",J+1, Lins[Sgn],JJ+1," * (",Mul,")\n",M,"\n\n"],0); } } } } JJ++; } } } if(TeX){ if(TeX==-2) return Lout; Lout=reverse(Lout); Br="\\allowdisplaybreaks"; Cr="\\\\\n &"; if(getopt(pages)==1) Cr=Br+Cr; if(type(S=getopt(cr))==7) Cr=S; if(type(Lim=getopt(lim))==1){ if(Lim>0){ if(Lim<30) Lim=TeXLim; Lim*=2; } }else Lim=0; Out = ltotex(Lout|opt=["cr","spts0"],str=1,cr=Cr,lim=Lim); if(TeX<0) return Out; dviout(Out|eq=(str_str(Cr,Br)>=0)?6:5,keep=(TeX==1)?0:1); } return M; } def mydet2(M) { S = size(M); Det = 1; MM = mtoupper(M,0); for(I = 0; I < S[0]; I++) Det = rmul(Det,MM[I][I]); return Det; } def myrank(MM) { S = size(MM); M = dupmat(MM); M = mtoupper(M,0); C = 0; for(I = K = 0; I < S[0]; I++){ for(J = K; J < S[1]; J++){ if(M[I][J] != 0){ C++; K++; break; } } } return C; } def meigen(M) { F = getopt(mult); if(type(M)==4 || type(M)==5){ II=length(M); for(R=[],I=II-1; I>=0; I--){ if(F==1) R=cons(meigen(M[I]|mult=1),R); else R=cons(meigen(M[I]),R); } return R; } S = size(M)[0]; P = mydet2(mgen(S,0,[zz],0)-M); return (F==1)?getroot(P,zz|mult=1):getroot(P,zz); } def transm(M) { if(type(M)!=6) M=s2m(M); if(type(M)!=6){ errno(0); return 0; } L=[M];TeX=""; Line=["\\text{line}","\\text{col}"]; if((DVI=getopt(dviout)) !=1) DVI=0; else dviout(M); for(;;){ print(L0=dupmat(car(L))); Sz=size(L0); S=keyin("? "); N=0; if(str_len(S)<=1){ if(S=="q") return L; if(S=="t"){ N=mtranspose(L0); TeX=["\\text{transpose}"]; } else if(S=="f"){ if(length(L)>1){ if(LF!=0) TeX=""; L=cdr(L);LF=L0; if(DVI){ dviout0(-1); dviout(" "); } } }else if(S=="g"){ if(LF!=0) N=LF; }else if(S=="0"){ N=M;L=[];TeX=[]; }else if(S=="a"||S=="A"){ if(DVI&&S=="A") mtoupper(L0,0|step=1,opt=10,dviout=1); else mtoupper(L0,0|step=1,opt=10); }else{ mycat0([ "2,5 : line2 <-> line5", "2,5,-2 ; line2 += (-2)*line5", "2,2,-2 : line2 *= -2", "2,5,0 : line2 += (?)*line5 for reduction", "r,2,5 : raw2 <-> raw5 (r,2,5,-2 etc.)", "s,x,2 : subst(*,x,2)", "t : transpose", "0 : first matrix", "f : previous matrix", "g : next matrix (only after f)", "A : auto (a : without TeX)", "q : quit" ],1|delim="\n"); } }else{ FR=0; S=evals(S|del=","); if(S[0]==r){ FR=1; S=cdr(S); } if((LL=length(S))>=2){ S0=S[0]-1;S1=S[1]-1; if(S[0]==s){ if(length(S)==3) N=subst(L0,S[1],S[2]); if(DVI) TeX=[S[1],"\\mapsto",S[2]]; }else if(FR==0){ if(S0<0 || S0>=Sz[0] || S1<0 || S1>=Sz[0]) continue; if(LL==2){ N=rowx(L0,S0,S1); if(DVI) TeX=[Line[0],S[0],"\\ \\leftrightarrow\\ ",Line[0],S[1]]; }else{ S2=S[2]; if(S0==S1){ N=rowm(L0,S0,S2); if(DVI) TeX=[Line[0],S[0],"\\ \\times=\\ ",S2]; }else{ if(S2==0){ for(J=0;J=Sz[1] || S1<0 && S1>=Sz[1]) continue; if(LL==2){ N=colx(L0,S0,S1); if(DVI) TeX=[Line[1],S[0],"\\ \\leftrightarrow\\ ",Line[1],S[1]]; }else{ S2=S[2]; if(S0==S1){ N=colm(L0,S0,S2); if(DVI) TeX=[Line[1],S[0],"\\ \\times=\\ ",S[2]]; }else{ if(S2!=0){ for(J=0; I10) return -1; return(I==IM)?0:I; } def mmc(M,X) { Mt=getopt(mult); if(type(M)==7) M=os_md.s2sp(M); if(type(M)!=4||type(M[0])!=6) return 0; if(type(M[0])!=6){ /* spectre type -> GRS */ G=s2sp(M|std=1); L=length(G); for(V=[],I=L-2;I>=0;I--) V=cons(makev([I+10]),V); V=cons(makev([L+9]),V); G=sp2grs(G,V,[1,length(G[0]),-1]|mat=1); if(getopt(short)!=0){ V=append(cdr(V),[V[0]]); G=shortv(G,V); } R=chkspt(G|mat=1); if(Mt!=1) Mt=0; if(R[2]!=2 || R[3]!=0 || !(R=getbygrs(G,1|mat=1))) return 0; MZ=newmat(1,1); SS=length(G); if(Mt==1) SS=SS*(SS-1)/2; for(M=[],I=0;I=6 && Mt!=0)||(L==3&&Mt==1)){ for(SS=2,I=3; ISS){ /* addition */ for(I=0;I=0; I--){ if(I==J){ for(RR=[],K=SS-1; K>=0; K--) RR=cons((K==I)?N[K]+diagm(S,[X]):N[K],RR); R=cons(RR,R); }else R=cons([MZ],R); } MM[J]=newbmat(SS,SS,R); if(J==0) M1=MM[0]; else M1=radd(M1,MM[J]); } /* middle convolution */ for(P=0,Q=1;J=0; I--){ for(RR=[],K=SS-1;K>=0;K--){ MT=MZ; if(I==K){ MT=N[J]; if(I==P) MT-=N[Q]; else if(I==Q) MT-=N[P]; }else if(I==P && K==Q) MT=N[Q]; else if(I==Q && K==P) MT=N[P]; RR=cons(MT,RR); } R=cons(RR,R); } MM[J]=newbmat(SS,SS,R); if(++Q==SS){ P++;Q=P+1; } } for(R=[],I=SS-1; I>=0; I--){ for(RR=[N[I]],J=0; J0){ Q *= V[I]; M[I]--; } } return Q; } def mdivisor(M,X) { S=size(M=dupmat(M)); XX=(type(X)==4||X==0)?X:[0,X]; S0=S[0]; S1=S[1]; if((Tr=getopt(trans))==1||Tr==2){ Tr0=1; GR=mgen(S0,0,1,0); GC=mgen(S1,0,1,0); }else Tr=Tr0=0; /* 0,a,b : (a,b)->(1,1) 1 : (1,1) invertible 2,i,M : line 0,i by M 3,j,M : col 0,j by M 4,j : col 1 += col j 5,j,T : line j by T 6,j,T : col 1 += col j by T (non-com) 7,j : line 2<->j (non-com) */ if(type(V=getopt(dviout))==1){ if(type(XX)==4 && type(XX[0])>1) Var=[XX[1],"\\partial"]; else Var=0; Tr=(abs(V)==3)?0:1; MM=dupmat(M); II=((S[0]>S[1])?S[1]:S[0])+1; if(abs(V)>1){ Is1=Js1=S[0]+S[1]; Is=Js=[0,[Is1]]; }else{ Is=[0,[Is1=S[0]]];Js=[0,[Js1=S[1]]]; } VV=V; V=newvect(II); for(I=0;I",I,")"],Out); NN=mperm(N,Is1,Js1); for(K=S[0];K",I,")"],Out); else continue; }else if(C==2){ C=mat(N[I0],N[R[1]+I0]);C=muldo(R[2],C,XX); for(J=0;J0){ dviout(Out|eq=6); return NN; } return Out; }else if(type(V)!=5) V=0; if(type(St=getopt(step))!=1) St=0; for(FF=": start";;){ if(St && V==0){ if(Tr){ mycat0([St,FF,"\n"],0); mycat([GR,"\n"]);mycat([M,"\n"]);mycat([GC,"\n"]); } else mycat0([St,FF,"\n",M,"\n"],0); } if(X==0||X==[0,0]){ /* search minimal non-zero element */ for(K=F=I=0; IP || K==0)){ K=P; R=[I,J]; } } } R=cons(K-1,[R]); } else R=mymindeg(M,XX[1]|opt=1); if(R[0]<0){ /*zero matrix */ if(Tr) return [[],mgen(S0,0,1,0),mgen(S1,0,1,0)]; return []; } R0=R[1][0];R1=R[1][1]; if(R0!=0){ M=rowx(M,0,R0); if(Tr) GR=rowx(GR,0,R0); } if(R1!=0){ M=colx(M,0,R1); if(Tr) GC=colx(GC,0,R1); } if(St>0 && (R0!=0 || R1!=0)) if(type(V)==5) V[St]=cons([0,R0,R1],V[St]); else if(Tr){ mycat0([St,": (",R0+1,",",R1+1,") -> (1,1)\n"],0); mycat([GR,"\n"]);mycat([M,"\n"]);mycat([GC,"\n"]); }else mycat0([St,": (",R0+1,",",R1+1,") -> (1,1)\n",M,"\n"],0); if(R[0]==0){ /* (1,1) : invertible */ if(type(V)==5) V[St]=cons([1],V[St]); P=M[0][0]; M[0][0]=1; for(J=0;J 1 */ if(J>0) M[0][J]= red(M[0][J]/P); if(Tr) GR[0][J]=red(GR[0][J]/P); } if(S0>1 && S1>1) N=newmat(S0-1,S1-1); else N=0; for(I=1;I0 && V==0){ if(Tr){ mycat0([St,": unit\n"],0); mycat([GR,"\n"]);mycat([M,"\n"]);mycat([GC,"\n"]); } else mycat0([St,": unit\n",M,"\n"],0); } if(N==0){ if(!Tr) return [1]; if(Tr==2){ GR0=mdivisor(GR,X|trans=1)[1]; GC0=mdivisor(GC,X|trans=1)[1]; return [[1],GR,GC,GR0,GC0]; } return [[1],GR,GC]; } R=mdivisor(N,XX|dviout=V,trans=Tr0,step=(St>0)?St+1:St); if(!Tr) return cons(1,R); GR=muldo(newbmat(2,2,[[1],[0,R[1]]]),GR,XX); GC=muldo(GC,newbmat(2,2,[[1],[0,R[2]]]),XX); if(S0==S1 && countin(1,1,R[0])==S0-1){ GR=muldo(GC,GR,XX); GC=mgen(S0,0,1,0); } if(Tr==2){ GR0=mdivisor(GR,X|trans=1)[1]; GC0=mdivisor(GC,X|trans=1)[1]; return [cons(1,R[0]),GR,GC,GR0,GC0]; } return [cons(1,R[0]),GR,GC]; } for(I=1;IS0) continue; for(J=1;JS1) continue; if(S0==1 || S1==1){ P=M[0][0]; if(X==0){ if(P<0){ P=-P; if(Tr) for(J=0;J0)?St+1:St); RT=(Tr)?R[0]:R; for(RR=[],L=reverse(RT);L!=[];L=cdr(L)) RR=cons(red(P*car(L)),RR); RR=cons(P,RR); if(!Tr) return RR; GR=muldo(newbmat(2,2,[[1],[0,R[1]]]),GR,XX); GC=muldo(GC,newbmat(2,2,[[1],[0,R[2]]]),XX); if(S0==S1 && countin(1,1,RR)==S0){ GR=muldo(GC,GR,XX); GC=mgen(S0,0,1,0); } if(Tr==2){ GR0=mdivisor(GR,X|trans=1)[1]; GC0=mdivisor(GC,X|trans=1)[1]; return [RR,GR,GC,GR0,GC0]; } return [RR,GR,GC]; } /* End of commutative case */ for(I=1; I1){ M=rowx(M,1,I); if(Tr) GR=rowx(GR,1,I); if(type(V)==5) V[St]=cons([7,I],V[St]); FF+=", line 2<->"+rtostr(I+1); } for(I=1;IS0) break; } if(I==S0) return []; /* zero matrix : never happen */ } } def mdsimplify(L) { T=getopt(type); SS=0; if(type(L)==6){ L=[L]; SS=1; } if(type(L)==5){ SS=2; L = vtol(L); } M=car(L); S=size(M)[0]; #if 0 MN=newmat(S,S); MD=newmat(S,S); for(I=0;I2) continue; } } } #endif DD=newvect(S); for(I=0; I1) XX=[1,length(M[0])]; M=sp2grs(M,[d,a,b,c],[XX[0],XX[1],-2]|mat=1); if(XX[0]>1 && XX[1]<2) XX=[XX[0],2]; if(getopt(int)!=0){ T=M[XX[0]-1][XX[1]-1][1]; for(V=vars(T);V!=[];V=cdr(V)){ F=coef(T,1,car(V)); if(type(F)==1 && dn(F)>1) M = subst(M,car(V),dn(F)*car(V)); } } V=vars(M); if(findin(d1,V)>=0 && findin(d2,V)<0 && findin(d3,V)<0) M=subst(M,d1,d); } RC=chkspt(M|mat=1); if(RC[2] != 2 || RC[3] != 0){ /* rigidity idx and Fuchs cond */ erno(0);return 0; } R=getbygrs(M,1|mat=1); if(getopt(anal)==1) return R; /* called by mc2grs() */ Z=newmat(1,1,[[0]]); N=[Z,Z,Z,Z,Z]; for(RR=R; RR!=[]; RR=cdr(RR)){ RT=car(RR)[0]; if(type(RT)==4){ if(RT[0]!=0) N=m2mc(N,RT[0]|simplify=Simp); N=m2mc(N,[RT[1],RT[2],RT[3]]|simplify=Simp); } } if(type(X)==4 && type(X[0])==7) return m2mc(N,X|keep=Keep,small=Small); return N; } if(type(X)==4 && type(X[0])==7){ Keep=(getopt(keep)==1)?1:0; if(X[0]=="All"){ dviout("Riemann scheme"|keep=1); m2mc(M,[(findin("GRSC",X)>=0)?"GRSC":"GRS","dviout"]|keep=1); dviout("Spectral types : "|keep=1); m2mc(M,["sp","dviout"]|keep=1); dviout("\\\\\nBy the decompositions"|keep=1); R=m2mc(M,["pairs","dviout"]|keep=1); for(R0=R1=[],I=1; R!=[]; I++, R=cdr(R)){ for(S=0,RR=car(R)[1][0];RR!=[]; RR=cdr(RR)) S+=RR[0]; if(S==0) R0=cons(I,R0); else if(S<0) R1=cons(I,R1); } S="irreducibility\\ $"+((length(R0)==0)?"\\Leftrightarrow":"\\Leftarrow") +"\\ \\emptyset=\\mathbb Z\\cap$"; dviout(S|keep=1); m2mc(M,["irreducible","dviout"]|keep=1); if(R0!=[]) dviout(ltotex(reverse(R0))|eq=0,keep=1, title="The following conditions may not be necessary for the irreducibility."); if(R1!=[]) dviout(ltotex(reverse(R1))|eq=0,keep=1,title="The following conditions can be omitted."); if(getopt(operator)!=0){ dviout("The equation in a Pfaff form is"|keep=1); m2mc(M,["Pfaff","dviout"]|keep=Keep,small=Small); } else if(Keep!=1) dviout(" "); return M; } Show=0; if(length(X)>1){ if(X[1]=="dviout") Show=2; if(X[1]=="TeX") Show=1; } if(X[0]=="GRS"||X[0]=="GRSC"||X[0]=="sp"){ Y=radd(-M[0],-M[1]-M[2]); if(X[0]!="GRSC"){ L=meigen([M[0],M[1],M[2],M[3],M[4],Y,radd(-M[1],-M[3]-M[4]),radd(Y,-M[3]-M[4])]|mult=1); if(X[0]=="sp"){ L=chkspt(L|opt="sp"); V=[L[1],L[0],L[2],L[5]]; W=[L[1],L[3],L[4],L[6]]; if(Show==2) dviout(s2sp(V)+" : "+s2sp(W)|keep=Keep); return [V,W]; } S="x=0&x=y&x=1&y=0&y=1&x=\\infty&y=\\infty&x=y=\\infty\\\\\n"; }else{ L=meigen([M[0],M[1],M[2],M[3],M[4],Y,radd(-M[1],-M[3]-M[4]),radd(Y,-M[3]-M[4]), radd(M[0],M[1]+M[3]),radd(M[1],M[2]+M[4])]|mult=1); S="x=0&x=y&x=1&y=0&y=1&x=\\infty&y=\\infty&x=y=\\infty&x=y=0&x=y=1\\\\\n"; } T=ltotex(L|opt="GRS",pre=S,small=Small); if(Show==2) dviout(T|eq=0,keep=Keep); if(Show==1) L=T; return L; } if(X[0]=="Pfaff"){ S=ltotex(M|opt=["Pfaff",u,x,x-y,x-1,y,y-1],small=Small); if(Show==2) dviout(S|eq=0,keep=Keep); return S; } if(X[0]=="irreducible"){ L=meigen([M[0],M[1],M[2],radd(-M[0],-M[1]-M[2])]|mult=1); S=getbygrs(L,10|mat=1); if(Show==2) dviout(ltotex(S)|eq=0,keep=Keep); return S; } if(X[0]=="pairs"||X[0]=="pair"){ L=meigen([M[0],M[1],M[2],radd(-M[0],-M[1]-M[2])]|mult=1); S=chkspt(L|opt=0); V=(Show==2)?1:0; S=sproot(L,X[0]|dviout=V,keep=Keep); return S; } if(X[0]=="swap"){ Swap=getopt(swap); if(type(Swap)<1 || Swap==1) return newvect(5,[M[3],M[1],M[4],M[0],M[2]]); if(Swap==2) return newvect(5,[radd(M[0],M[1]+M[3]),M[4],M[2],radd(-M[1],-M[3]-M[4]),M[1]]); if(type(Swap)==4 && length(Swap)==3){ MX=radd(-M[0],-M[1]-M[2]); MY=radd(-M[3],-M[1]-M[4]); if(Swap[0]==1){ MX0=M[2];MY0=M[4]; } else if(Swap[0]==2){ MX0=MX;MY0=MY; }else{ MX0=M[0];MY0=M[3]; } if(Swap[1]==1){ MX1=M[2];MY1=M[4]; } else if(Swap[1]==2){ MX1=MX;MY1=MY; }else{ MX1=M[0];MY1=M[3]; } return newvect(5,MX0,M[1],MX1,MY0,MY1); } } return 0; } if(getopt(swap)==1) return m2mc(m2mc(m2mc(M,"swap"),X),"swap"); N=newvect(5); for(I=0;I<5;I++) N[I]=M[I]; S=size(N[0])[0]; if(type(X)==4){ for(I=0;I<3;I++){ if(X[I] != 0) N[I] = radd(N[I],X[I]); } if(length(X)==3) return N; X=X[3]; } MZ = newmat(S,S); ME = mgen(S,0,[X],0); MM = newvect(5); MM[0] = newbmat(3,3, [[N[0]+ME,N[1],N[2]], [MZ], [MZ]]); MM[1] = newbmat(3,3, [[MZ], [N[0],N[1]+ME,N[2]], [MZ]]); MM[2] = newbmat(3,3, [[MZ], [MZ], [N[0],N[1],N[2]+ME]]); MM[3] = newbmat(3,3, [[N[3]+N[1],-N[1]], [-N[0],radd(N[0],N[3])], [MZ,MZ,N[3]]]); MM[4] = newbmat(3,3, [[N[4]], [MZ,N[4]+N[2],-N[2]], [MZ,-N[1],radd(N[4],N[1])]]); M0 = newbmat(3,3, [[N[0]], [MZ,N[1]], [MZ,MZ,N[2]]]); M1 = radd(MM[0],MM[1]+MM[2]); KE = append(mykernel(M0|opt=1),mykernel(M1|opt=1)); if(length(KE) == 0) return MM; KK = mtoupper(lv2m(KE),0); for(I=0;I<5;I++) MM[I] = mmod(MM[I],KK); if(Simp!=0) MM = mdsimplify(MM|type=Simp); return MM; } def easierpol(P,X) { if(type(X) == 4){ for( Y = [] ; X != []; X = cdr(X) ) Y = cons([0,car(X)], Y); }else Y = [0,X]; return rede(P,Y); } def l2p(L,V) { if(type(L)==4){ for(S=I=0;L!=[];L=cdr(L),I++) S+=car(L)*V^I; return S; }else if(type(L)==5){ for(S=0,I=size(L)-1;I>=0;I--) S+=L[I]*V^I; return S; }else{ if(type(D=getopt(size))==1) D--; else D=mydeg(L,V); for(S=[];D>=0;D--) S=cons(mycoef(L,D,V),S); return S; } } def paracmpl(L,V) { if(type(L)==4) L=ltov(L); S=length(L); Lim=getopt(lim);Low=getopt(low); if((F=type(L[0]))>3){ SV=length(L[0]); V0=makenewv(L); for(LL=[];S>0;S--) LL=cons(l2p(L[S-1],V0),LL); G=paracmpl(LL,V|option_list=getopt()); H=(Lim==1)?G:G[0]; for(HH=[];H!=[];H=cdr(H)){ HT=l2p(car(H),V0|size=SV); if(F==5) HT=ltov(HT); HH=cons(HT,HH); } H=reverse(HH); return (Lim==1)?H:[H,G[1]]; } H=newvect(S);D=newvect(S); for(Dn=1,I=0;I0){ P=red(P/V^K); G=colm(G,I,1/V^K); } for(DT=[],VT=VV;VT!=[];VT=cdr(VT)){ K=(Low==1)?mymindeg(C,car(VT)):mydeg(C,car(VT)); C=mycoef(C,K,car(VT)); DT=cons(K,DT); } D[I]=DT=reverse(DT); for(C=P,VT=VV;VT!=[];VT=cdr(VT),DT=cdr(DT)) C=mycoef(C,car(DT),car(VT)); H[I]=P=red(P/C); G=colm(G,I,1/C); } if(Dn!=1){ for(I=0;I= 0; I--){ for(J = S[1]-1; J >= 0; J--){ if(MM[I][J] != 0) return R; } P = easierpol(MM[I][S[1]],zz); RR = newvect(S[0]); for(J = 0; J < S[0]; J++) RR[J] = mycoef(P,J,zz); R = cons(RR,R); } return R; } def myimage(M) { if(getopt(opt) == 1) M = mtranspose(M); S = size(M); V = []; M0 = newvect(S[1]); M = mtoupper(M,0|opt=1); for(I = S[0]-1; I >= 0; I--) if(M0 != M[I]) V = cons(vtozv(M[I])[0], V); return V; } def mymod(V,L) { Opt = getopt(opt); S = length(V); VP = newvect(S); if(type(L)==6) L=m2lv(L); CT = length(L); for(LT = L; LT != []; LT = cdr(LT)){ for(VT = car(LT), I = 0; I < S; I++) if(VT[I] != 0) break; if(I >= S){ CT--; continue; } VP[I] = 1; MI = -red(V[I]/VT[I]); if(MI != 0) V = radd(V,rmul(MI,VT)); } if(Opt==1){ for(I = 0; I < S; I++) if(V[I] != 0) return 1; return 0; } if(Opt==2){ W=newvect(S-CT); for(CC = I = 0; I < S; I++){ if(VP[I]==0) W[CC++] =V[I]; } return W; } return V; } def mmod(M,L) { S=size(M)[1]; MM=mtranspose(M); VP = newvect(S); if(type(L)==6) L=m2lv(L); for(CT = 0, LT = L; LT != []; LT = cdr(LT)){ for(VT = car(LT), I = 0; I < S; I++){ if(VT[I] != 0){ VP[I] = 1; break; } } } if(getopt(opt)==1) NE=1; for(D=I=0; IJ) J=length(car(V)); return [I,J]; } def llbase(VV,L) { S = length(VV); V = dupmat(VV); if(type(V) == 4) V = ltov(V); T = length(L); for(I = 0; I < S; I++) V[I] = nm(red(V[I])); LV = 0; for(J = 0; J < T; J++){ X = var(L[J]); N = deg(L[J],X); for(I = LV; I < S; I++){ if((C2=coef(V[I],N,X)) != 0){ if(I > LV){ Temp = V[I]; V[I] = V[LV]; V[LV] = Temp; } for(I = 0; I < S; I++){ if(I == LV || (C1 = coef(V[I],N,X)) == 0) continue; Gcd = gcd(C1,C2); V[I] = V[I]*tdiv(C2,Gcd)-V[LV]*tdiv(C1,Gcd); } LV++; } } } return V; } def lsort(L1,L2,T) { C1=getopt(c1);C2=getopt(c2); if(type(T)==4){ K=T; if(length(T)>0){ T=K[0]; K=cdr(K); }else T=0; }else K=0; 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==3){ R=[car(L1)];L1=cdr(L1); for(;L1!=[];L1=cdr(L1)){ if(car(L1)[KN]!=car(R)[KN]) R=cons(car(L1),R); } L1=reverse(R); } return L1; }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&&C1==[0]){ /* delete top column */ R=cons(cdr(car(L1)),R); continue; } LT=car(L1);RT=[]; if(T==0){ for(CT=C1;CT!=[];CT=cdr(CT)) RT=cons(LT[car(CT)],RT); }else{ 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); } return reverse(R); } }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]; C2=0; } L1=lsort(L1,"num",["put",0]); /* insert number */ K0=(length(K)>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); } } if(T==3){ while(L2!=[]){ R=cons(append(R0,car(L2)),R); L2=cdr(L2); } } R=lsort(R,"sort",["put",0]); /* original order */ D=(((T==0||T==2)&&!K1)||T==3)?[0]:[0,S1+K1]; R=lsort(R,0,[1]|c1=D); /* delete */ if(type(C1)!=4||T==1||T==4||T==5) return R; C=[];S0=size(L1[0]); for(;C1!=[];C1=cdr(C1)) C=cons(car(C1),C); for(I=0;I= 0; I--){ if(I > 0 && L1[I] == L1[I-1]) continue; L3 = cons(L1[I], L3); } return L3; } if(T==8||TT=="count"){ K=length(lsort(L1,L2,3)[0]); R=[length(L2),length(L1)]; L1 = lsort(L1,[],1); L2 = lsort(L2,[],1); R=append([length(L2),length(L1)],R); R=cons(length(lsort(L1,L2,2)),R); return reverse(cons(K,R)); } if((T==9||TT=="cons")&&type(car(L1))==4){ if(type(L2)!=4) L2=[L2]; for(R=[];L1!=[];L1=cdr(L1)){ R=cons(cons(car(L2),car(L1)),R); if(length(L2)>1) 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); L3 = []; if(T == 1){ while(L1 != []){ if(L2 == [] || car(L1) < car(L2)){ L3 = cons(car(L1), L3); L1 = cdr(L1); continue; } if(car(L1) > car(L2)){ L2 = cdr(L2); continue; } L1 = cdr(L1); L2 = cdr(L2); } return reverse(L3); } if(T==2){ while(L1 != [] && L2 != []){ if(car(L1) != car(L2)){ if(car(L1) <= car(L2)) L1 = cdr(L1); else L2 = cdr(L2); continue; } while(car(L1) == car(L2)) L1 = cdr(L1); L3 = cons(car(L2), L3); } return reverse(L3); } } if(T==3){ L1 = qsort(L1); L2 = qsort(L2); L3 = L4 = []; while(L1 != [] && L2 != []){ if(car(L1) == car(L2)){ L1 = cdr(L1); L2 = cdr(L2); }else if(car(L1) < car(L2)){ L3 = cons(car(L1),L3); L1 = cdr(L1); }else{ L4 = cons(car(L2), L4); L2 = cdr(L2); } } L4 = append(reverse(L4),L2); L3 = append(reverse(L3),L1); return [L3,L4]; } L1 = append(L1,L2); return lsort(L1,[],1); } def mqsub(X,Y) { for(L=LQS;L!=[];L=cdr(L)){ F=(T=car(L))[0];M=(T=cdr(T))[0]; X0=X;Y0=Y; for(T=cdr(T);T!=[];T=cdr(T)){ X0=X0[car(T)];Y0=Y0[car(T)]; } if(type(M)==1){ if(M==3){ X0=type(X0);Y0=type(Y0); }else if(M==4&&type(X0)<2&&type(Y0)<2){ X0=abs(X0);Y0=abs(Y0); }else if(M==5){ X0=str_len(rtostr(X0));Y0=str_len(rtostr(Y0)); }else if(type(X0)==type(Y0)&&type(X0)>3&&type(X0)<7){ if(M==1){ X0=length(X0);Y0=length(Y0); }else if(M==2){ LX=length(X0);LY=length(Y0); L0=(LX car(L)) V=car(L); return V; }else if(type(L)==5||type(L)==6) return lmin(m2l(L)); return []; } def lgcd(L) { if(type(L)==4){ F=getopt(poly); V=car(L); while((L=cdr(L))!=[]&&V!=1){ if(V!=0) V=(F==1)?gcd(V,car(L)):igcd(V,car(L)); } return V; }else if(type(L)==5||type(L)==6) return lgcd(m2l(L)|option_list=getopt()); return []; } def llcm(L) { 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); } 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 []; } def ldev(L,S) { M=abs(lmax(L));N=abs(lmin(L)); if(M=M) break; M=MT; } if(!C){ for(C=0,LT=L;;C--){ LT=ladd(LT,S,-1); MT=abs(lmax(LT));NT=abs(lmin(LT)); if(MT=M) break; M=MT; } } return [C,ladd(L,S,C)]; } def lchange(L,P,V) { if(getopt(flat)==1&&type(P)==4){ for(L=ltov(L);P!=[];P=cdr(P),V=cdr(V)) L[car(P)]=car(V); return vtol(L); } if(type(P)==4){ IP=car(P); P=cdr(P); }else{ IP=P; P=[]; } for(I=0, LL=[], LT=L; LT!=[]; I++,LT=cdr(LT)){ if(I==IP){ LL=cons((P==[])?V:lchange(car(LT),P,V),LL); }else LL=cons(car(LT),LL); } return reverse(LL); } def lsol(VV,L) { if(type(VV)<4 && type(L)==2) return red(L-VV/mycoef(VV,1,L)); S = length(VV); T = length(L); V = llbase(VV,L); for(J = K = 0; J < T; J++){ X = var(L[J]); N = deg(L[J],X); for(I = K; I < S; I++){ if((C=mycoef(V[I], N, X)) != 0){ V[I] = [L[J],red(X^N-V[I]/C)]; K++; break; } } } return V; } def lnsol(VV,L) { LL=lsort(vars(VV),L,1); VV=ptol(VV,LL|opt=0); return lsol(VV,L); } def ladd(X,Y,M) { if(type(X)==4) X=ltov(X); if(type(Y)==4) Y=ltov(Y); 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)]); } def m2v(M) { S = size(M); V = newvect(S[0]*S[1]); for(I = C = 0; I < S[0]; I++){ MI = M[I]; for(J = 0; J < S[1]; J++) V[C++] = MI[J]; } return V; } def lv2m(L) { if(type(L)==5) L=vtol(L); II=length(L); for(J=1,T=L; T!=[]; T=cdr(T)) if(length(car(T))>JJ) JJ=length(car(T)); M = newmat(II,JJ); N = getopt(null); if(type(N)<0) N=0; for(I=0; I=0;) M[I][J] = V[J]; if(N!=0){ for(J=length(V); J0;) N=cons(M[I],N); return N; } def s2m(S) { if(type(S)==6) return S; if(type(S)==7){ if(str_chr(S,0,"[")!=0) S=s2sp(S); else if(str_chr(S,0,",")>=0) return eval_str(S); else{ for(L=LL=[],I=0; ; ){ II=str_chr(S,I+2,"]"); if(II<0) return 0; J=str_chr(S,I+2," "); while(str_chr(S,J+1," ")==J+1) J++; if(J>II-2 || J<0) J=II; V=eval_str(sub_str(S,I+1,J-1)); L=cons(V,L); I=J; if(J==II){ LL=cons(ltov(reverse(L)),LL); L=[]; if((I=str_chr(S,II+1,"["))<0) return lv2m(reverse(LL)); } } } } if(type(S)==5) S=vtol(S); if(type(S[0])==5) return lv2m(S); I=length(S); for(J=1,T=S; T!=[]; T=cdr(T)) if(length(car(T))>J) J=length(car(T)); return newmat(I,J,S); } def c2m(L,V) { if(type(Pow=getopt(pow))!=1){ if(isvar(V)==1){ for(Pow=0,LT=L;LT!=[];LT=cdr(LT)){ if(mydeg(car(LT),V)>JJ) Pow=mydeg(car(LT),V); } JJ=Pow+1; }else{ Pow=-1; JJ=length(V); } }else JJ=Pow+1; M=newmat(length(L),JJ); for(I=0;L!=[];L=cdr(L),I++){ for(J=0;J=0)?mycoef(LT,J,V):mycoef(LT,1,V[J]); } } return M; } #if 0 def m2diag(M,N) { S = size(M); MM = mtoupper(M,N); for(I = S[0]-1; I >= 0; I--){ for(J = 0; I < S[1]-N; I++){ if(MM[I][J] != 0){ P = MM[I][J]; for(K = 0; K < I; K++){ Q = -rmul(MM[K][J],1/P); MM[K][J] = 0; if(Q != 0){ for(L = J+1; L < S[1]; L++){ if(MM[I][L] != 0) MM[K][L] = radd(MM[K][L], rmul(MM[I][L],Q)); } } } } } } return MM; } #endif def myinv(M) { S = size(M); if((T=S[0]) != S[1]) return 0; MM = mtoupper(M,-T|opt=2); if(MM[T-1][T-1] != 1) return 0; return mperm(MM,0,[T,[T]]); } def madj(G,M) { H=myinv(G); if(type(M)==6) return rmul(rmul(G,M),H); if(type(M)==4||type(M)==5){ L=length(M); N=newvect(L); for(I=0;I=0){ if(I>J) LF+=texlen(str_cut(S,J,I-1)); I+=6; for(F=L=0,J=I;F<2 && J0 && JL) L=LL; } LF+=L; } if(J>0) S=str_cut(S,J,str_len(S)-1); if(S==0) return LF; S=ltov(strtoascii(S)); L=LL=length(S); for(I=F=0; I96 && S[I]<123)||(S[I]>64 && S[I]<91)) LL--; else F=0; } if(S[I]<=32||S[I]==123||S[I]==125||S[I]==94||S[I]==38) LL--; /* {}^& */ else if(S[I]==95){ LL--; if(I+23) return 0; for(Var=[],R=vars(P);R!=[];R=cdr(R)){ V0=rtostr(car(R)); if(V0>"d" && V0<"e"){ V=sub_str(V0,1,str_len(V0)-1); if(V>="a" && V<"{") Var=cons([strtov(V),strtov(V0)],Var); } } if(Var==[]) return 0; for(V=Var; V!=[]; V=cdr(V)) if(ptype(P,car(V)[1])==3) return 0; return Var; } def texsp(P) { Q=strtoascii(P); if((J=str_char(Q,0,92))<0 || (C=Q[L=str_len(P)-1])==32||C==41||C==125) return P; for(;;){ if((I=str_char(Q,J+1,92))<0) break; J=I; }; for(I=J+1;I0){ 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; if(!chkfun("print_tex_form", "names.rr")) return 0; Small=getopt(small); } Dif=getopt(dif); Var=getopt(var); if(Lim>0 && type(Var)<2 && TeX!=1) Var=[strtov("0"),""]; Dif=0; if(Var=="dif"){ Dif=DV=1; }else if (Var=="dif0") Dif=1; else if(Var=="dif1") Dif=2; else if(Var=="dif2") Dif=3; if(Dif>0){ for(Var=[],R=vars(P);R!=[];R=cdr(R)){ V=rtostr(car(R)); if(V>"d" && V<"e"){ V=sub_str(V,1,str_len(V)-1); if(V>="a" && V<"{"){ if(TeX>0){ V=my_tex_form(strtov(V)); if(Dif>=1){ if(Dif==1){ if(str_len(V)==1) V="\\partial_"+V; else V="\\partial_{"+V+"}"; } Var=cons([car(R),V],Var); } else Var=cons([car(R)],Var); }else Var=cons([car(R)],Var); } } } if(TeX>0){ if(length(Var)==1){ if(DV==1 && str_len(Var[0][1])==10) Var=[[Var[0][0],"\\partial"]]; }else if(DV==1){ for(V=Var;V!=[];V=cdr(V)){ VV=rtostr(car(V)[0]); if(VV<"dx0" || VV>= "dx:" || str_len(VV)>4) break; } if(V==[]){ for(VT=[],V=Var;V!=[];V=cdr(V)){ VV=str_cut(rtostr(car(V)[0]),2,3); if(str_len(VV)==1) VT=cons([car(V)[0],"\\partial_"+VV],VT); else VT=cons([car(V)[0],"\\partial_{"+VV+"}"],VT); } Var=reverse(VT); } }else if(Dif==2 && length(Var)>1) Dif=3; } if(Dif>0) Dif--; } if(type(Var)>1 && Var!=[]){ /* as a polynomial of Var */ Add=getopt(add); if(type(Add)>0){ if(type(Add)!=7){ Add=my_tex_form(Add); if(str_char(Add,0,"-")>=0 || str_char(Add,0,"+")>=0) Add="("+Add+")"; } if(str_char(Add,0,"(")!=0) Add = " "+Add; }else Add=0; if(type(Var)!=4) Var=[Var]; if(length(Var)==2 && type(Var[1]) == 7) Var = [Var]; for(VV=VD=[]; Var!=[];Var=cdr(Var)){ VT=(type(car(Var))==4)?car(Var):[car(Var)]; VT0=var(car(VT)); VV=cons(VT0,VV); if(length(VT)==1){ VD=cons((TeX>=1)?my_tex_form(VT0):rtostr(VT0),VD); }else VD=cons(VT[1],VD); } VV=reverse(VV);VD=reverse(VD); Rev=(getopt(rev)==1)?1:0; Dic=(getopt(dic)==1)?1:0; TT=terms(P,VV|rev=Rev,dic=Dic); if(TeX==0){ Pre="("; Post=")"; }else{ Pre="{"; Post="}"; } Out = string_to_tb(""); for(L=C=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; PT=""; if(D!=0 && VD[I]!=""){ if(TeX==0 && PW!="") PW+="*"; if(D>1){ if(D>9) PT="^"+Pre+rtostr(D)+Post; else PT="^"+rtostr(D); } if(Dif>0) PW+=(Dif==1)?"d":"\\partial "; PW+=VD[I]+PT; } } D=car(Tm)[0]; if(Dif>0 && D>0){ Op=(Dif==1)?"\\frac{d":"\\frac{\\partial"; if(D>1) Op+="^"+((D>9)?(Pre+rtostr(D)+Post):rtostr(D)); PW=Op+Add+"}{"+PW+"}"; }else if(Add!=0) PW=PW+Add; 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); }else OC=fctrtos(PC|br=1); if(PW!=""){ if(OC == "1") OC = ""; else if(OC == "-1") OC = "-"; } if(TeX==0 && D!=0 && OC!="" && OC!="-") PW= "*"+PW; if((TOC=type(OC)) == 4){ /* rational coef. */ if(Lim>0 && (texlen(OC[0])>Lim || texlen(OC[0])>Lim)){ OC = (Small==1)?"("+OC[0]+")/("+OC[1]+")" :"\\Bigl("+OC[0]+"\\Bigr)\\Bigm/\\Bigl("+OC[1]+"\\Bigr)"; TOC = 7; }else{ if(str_char(OC[0],0,"-")==0){ OC = fctrtos(-PC|TeX=1,br=1); OC = "-\\frac{"+OC[0]+"}{"+OC[1]+"}"; } else OC = "\\frac{"+OC[0]+"}{"+OC[1]+"}"; } } if(Lim>0){ 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; }else L=LL; }else L+=LL; }else if(length(Tm)!=1) PW += CR; /* not final term */ if(TeX) OC=texsp(OC); if(str_chr(OC,0,"-") == 0 || C==0) str_tb([OC,PW], Out); else{ str_tb(["+",OC,PW],Out); if(LL<=Lim) L++; } } S=str_tb(0,Out); if(S=="") S="0"; }else{ /* Var is not specified */ if((TP=type(P)) == 3){ /* rational function */ P = red(P); Nm=nm(P); Dn=dn(P); Q=dn(ptozp(Nm|factor=1)[1]); if(Q>1){ Nm*=Q;Dn*=Q; } if(TeX>0){ return (TeX==2)? "\\frac\{"+fctrtos(Nm|TeX=1)+"\}\{"+fctrtos(Dn|TeX=1)+"\}" :[fctrtos(Nm|TeX=1),fctrtos(Dn|TeX=1)]; } else{ S=fctrtos(Nm); if(nmono(Nm)>1) S="("+S+")"; return S+"/("+fctrtos(Dn)+")"; } } 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){ 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); N++; }else if(length(P) == 1) str_tb("1", S); else if(getopt(br)!=1 && length(P) == 2 && P[1][1] == 1){ str_tb((TeX>=1)?my_tex_form(P[1][0]):rtostr(P[1][0]), S); J++; } continue; } if(N > 0 && TeX != 1 && TeX != 2 && TeX != 3) write_to_tb("*", S); SS=(TeX>=1)?my_tex_form(P[J][0]):rtostr(P[J][0]); N++; if(P[J][1] != 1){ /* (log(x))^2 */ 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); }else{ if(nmono(P[J][0])>1) SS="("+SS+")"; write_to_tb(SS,S); } } S = str_tb(0,S); if((Lim>0 || TP!=2) && CR!="") S=texlim(S,Lim|cut=CR); } 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; } } return S; } def strip(S,S0,S1) { SS=strtoascii(S); if(length(SS)>1){ if(SS[0]==40&&SS[length(SS)-1]==41&&str_pair(SS,1,S0,S1)==length(SS)-1) S=str_cut(SS,1,length(SS)-2); } return S; } def texlim(S,Lim) { /* extern TeXLim; */ if(S==1 && Lim>10){ TeXLim=Lim; mycat(["Set TeXLim =",Lim]); return 1; } if(type(Out=getopt(cut))!=7) Out="\\\\\n&"; if(type(Del=getopt(del))!=7) Del=Out; if(Lim<30) Lim=TeXLim; S=ltov(strtoascii(S)); for(L=[0],I=F=0;F==0; ){ II=str_str(S,Del|top=I)+2; if(II<2){ F++;II=/* str_len(S) */ length(S)-1; } for(J=JJ=I+1;;JJ=K+1){ K=str_char(S,JJ,43); /* + */ if((K1=str_char(S,JJ,45))>2 && K10 && K1-JJ>6 && K10 || str_str(S,"Big"|top=T+1,end=T+1)>0)) K=T; else if(K1>0 && K1II) break; if(K-J>Lim && texlen(str_cut(S,J,K-1))>=Lim){ J=K+1; L=cons(JJ-1,L); SL=0; } } I=II; } SS=str_tb(0,0); L=cons(length(S),L); L=reverse(L); for(I=0; L!=[]; I=J,L=cdr(L)){ str_tb((I==0)?"":Out,SS); J=car(L); str_tb(str_cut(S,I,J-1),SS); } return str_tb(0,SS); } def fmult(FN,M,L,N) { Opt=getopt(); for(I = 0; I < length(M); I++) M = call(FN, cons(M,cons(L[I],N))|option_list=Opt); return M; } def radd(P,Q) { if(type(P) <= 3 || type(Q) <= 3){ if(type(P) >= 5) return radd(Q,P); if(type(Q) >= 5){ R = dupmat(Q); if(P == 0) return R; if(type(Q) == 6){ S = size(Q); if(S[0] != S[1]) return 0; for(I = 0; I < S[0]; I++) R[I][I] = radd(R[I][I], P); }else{ for(I = length(R)-1; I >= 0; I--) R[I] = radd(R[I],P); } return R; } /* P=red(P);Q=red(Q); */ if((P1=dn(P)) == (Q1=dn(Q))){ if(P1==1) return P+Q; return red((nm(P)+nm(Q))/P1); } R=gcd(P1,Q1);S=tdiv(P1,R); return red((nm(P)*tdiv(Q1,R)+nm(Q)*S)/(S*Q1)); } if(type(P) == 5){ S = length(P); R = newvect(S); for(I = 0; I < S; I++) R[I] = radd(P[I],Q[I]); return R; } if(type(P) == 6){ S = size(P); R = newmat(S[0],S[1]); for(I = 0; I < S[0]; I++){ for(J = 0; J < S[1]; J++) R[I][J] = radd(P[I][J],Q[I][J]); } return R; } erno(0); } def getel(M,I) { if(type(M) >= 4 && type(M) <= 6 && type(I) <= 1) return M[I]; if(type(M) == 6 && type(I) == 5) return M[I][J]; return M; } def ptol(P,X) { F=(getopt(opt)==0)?0:1; if(type(P) <= 3) P = [P]; if(type(X) == 4){ for( ; X != []; X = cdr(X)) P=ptol(P,car(X)|opt=F); return P; } P = reverse(P); for(R=[]; P != []; P = cdr(P)){ Q = car(P); for(I = mydeg(Q,X); I >= 0; I--){ S=mycoef(Q,I,X); if(F==1 || S!=0) R = cons(S,R); } } return R; } def rmul(P,Q) { if(type(P) <= 3 && type(Q) <= 3){ P=red(P);Q=red(Q); P1=dn(P);P2=nm(P);Q1=dn(Q);Q2=nm(Q); if(P1==1 && Q1==1) return P*Q; if((R=gcd(P1,Q2)) != 1){ P1=tdiv(P1,R);Q2=tdiv(Q2,R); } if((R=gcd(Q1,P2)) != 1){ Q1=tdiv(Q1,R);P2=tdiv(P2,R); } return P2*Q2/(P1*Q1); } #ifdef USEMODULE return mmulbys(os_md.rmul,P,Q,[]); #else return mmulbys(rmul,P,Q,[]); #endif } def mtransbys(FN,F,LL) { Opt=getopt(); if(type(F) == 4){ F = ltov(F); S = length(F); R = newvect(S); for(I = 0; I < S; I++) R[I] = mtransbys(FN,F[I],LL|option_list=Opt); return vtol(R); } if(type(F) == 5){ S = length(F); R = newvect(S); for(I = 0; I < S; I++) R[I] = mtransbys(FN,F[I],LL|option_list=Opt); return R; } if(type(F) == 6){ S = size(F); R = newmat(S[0],S[1]); for(I = 0; I < S[0]; I++){ for(J = 0; J < S[1]; J++) R[I][J] = mtransbys(FN,F[I][J],LL|option_list=Opt); } return R; } if(type(F) == 7) return F; return call(FN, cons(F,LL)|option_list=Opt); } def drawopt(S,T) { if(type(S)!=7) return -1; if(T==0||T==1){ for(I=0,R=LCOPT;I<7;I++,R=cdr(R)) if(str_str(S,car(R))>=0) return(T==0)?COLOPT[I]:car(R); return -1; } if(T==2){ V0=V1=0; for(I=0,R=LPOPT;R!=[];I++,R=cdr(R)){ if(str_str(S,car(R))>=0){ if(I==0) V1++; else if(I==1) V1--; else if(I==2) V0--; else V0++; } } if(V0==0&&V1==0) return -1; return [V0,V1]; } if(T==3){ V=0; for(I=1,R=LFOPT;R!=[];R=cdr(R),I*=2){ if(str_str(S,car(R))>=0) V+=I; } return (V==0)?-1:V; } return -1; } def execdraw(L,P) { if((Proc=getopt(proc))!=1) Proc=0; if(type(P)<2) P=[P]; if(L!=[]&&type(L[0])!=4) L=[L]; /* special command */ if(P[0]<0){ if(length(P)==1&&(P[0]==-1||P[0]==-2||P[0]==-3)){ /* Bounding Box */ W=WS=N=LS=0; for(LL=L;LL!=[];LL=cdr(LL)){ T=car(LL); if(P[0]!=-3 && T[0]==0){ if(length(T)>3) S=" by "+rtostr(T[3])+" cm"; else S=""; if(P[0]==-1){ mycat(["Windows : ",T[1][0],"< x <",T[1][1],", ", T[2][0],"< y <",T[2][1],S]); if(length(T)>4 && type(T[4])==4) mycat(["ext :",T[4]]); if(length(T)>5) mycat(["shift :",T[5]]); } return cdr(T); } if(type(T[0])==1){ if(T[0]==1){ for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ D=car(TT); if(type(D[0][0])==4){ for(DT=D;DT!=[];DT=cdr(DT)){ if(N++==0) W=ptbbox(car(DT)); else W=ptbbox(car(DT)|box=W); } }else{ if(N++==0) W=ptbbox(D); else W=ptbbox(D|box=W); } } }else if(T[0]==2){ V=T[2]; if(type(V[0])>1||type(V[1])>1) continue; /* not supported */ if((Sc=delopt(T[1],"scale"|inv=1))!=[]){ Sc=car(Sc)[1]; if(type(Sc)==1) V=[Sc*V[0],Sc*V[1]]; else V=[Sc[0]*V[0],Sc[1]*V[1]]; } if(LS==0) WS=ptbbox([V]); else WS=ptbbox([V]|box=WS); if(length(T)>4) S=T[4]; else if(type(S=T[3])==4){ S=S[0]; if(type(S)==4) S=S[length(S)-1]; S=rtostr(S); } if(str_len(S)>LS) LS=str_len(S); }else if(T[0]==3||T[0]==4){ if(N++==0) W=ptbbox(cdr(cdr(T))); else W=ptbbox(cdr(cdr(T))|box=W); } } } if(W!=0&&WS!=0) W=ptbbox([W,WS]|box=1); return (P[0]==-3)?[W,LS,WS]:W; }else if(length(P)>1&&P[0]==-1){ /* set Bounding Box */ P=cons(0,cdr(P)); Ex=Sft=[0,0]; if(type(X=getopt(ext))==4) Ex=X; if(type(X=getopt(shift))==4) Sft=X; if(Ex!=Sft||Ex!=[0,0]){ if(Sft==[0,0]) Sft=[Ex]; else Sft=[Ex,Sft]; if(length(P)==3) Sft=cons(1,Sft); if(length(P)==3||length(P)==4) P=append(P,Sft); } return cons(P,delopt(L,0)); } if(P[0]==-4){ for(N=0,LT=L;LT!=[];LT=cdr(LT)){ /* count coord. */ T=car(LT); if(T[0]==1){ for(T=cdr(cdr(T));T!=[];T=cdr(T)){ if(type((S=car(T))[0][0])==4) N+=length(S); else for(;S!=[];S=cdr(S)) if(type(car(S))==4) N++; } }else if(T[0]==2) N++; else if(T[0]==3||T[0]==4) N+=2; } return N; } if(P[0]==-5){ /* functions */ for(N=0,R=[],LT=L;LT!=[];LT=cdr(LT)){ T=car(LT); if(T[0]==0) N=ior(N,1); else if(type(T[0])==1){ if(T[0]>0) N=ior(N,2^T[0]); } else if(Type(T[0])==2){ if(findin(T[0],R)<0) R=cons(T[0],R); } } for(I=5;I>=0;I--) if(iand(N,2^I)) R=cons(I,R); return R; } return 0; } if(length(P)>1){ if(type(P[1])==6||(type(P[1])<2&&P[1]>0)) M=P[1]; else if(type(P[1])==4&&length(P[1])==2) M=diagm(2,P[1]); } if(length(P)>2&&type(P[2])==4){ Org=[["shift",P[2]]]; if(M==0) M=1; }else Org=[]; if(P[0]==0||(type(P[0])==4&&P[0][0]==0)){ /* Risa/Asir */ PP=car(P);PPP=0; if(type(PP)!=4) PP=[PP]; if(length(PP)<3){ if(length(PP)==1 || type(PP[1])==4){ if(ID_PLOT<0) ID_PLOT=ox_launch_nox(0,"ox_plot"); Id=ID_PLOT; if(length(PP)==1&&type(Canvas)==4&&length(Canvas)==2) PP=cons(PP[0],[Canvas]); if(length(PP)>1){ PPP=PP[1][0]; PPQ=(length(PP[1])==2)?PP[1][1]:PPP; open_canvas(Id,[PPP,PPQ]); }else open_canvas(Id); Ind=ox_pop_cmo(Id); }else{ Ind=PP[1]; if(getopt(cl)==1) clear_canvas(Id,Ind); } }else{ Id=PP[1];Ind=PP[2]; if(length(PP)>3 && type(PP[3])==1) PPP=PP[3]; if(length(PP)>4 && type(PP[4])==1) PPQ=PP[4]; if(getopt(cl)==1) clear_canvas(Id,Ind); } if(L==[]) return (PPP>0)? [0,Id,Ind,PPP,PPQ]:[0,Id,Ind]; Ex0=Ex0;Sft=[0,0]; if(length(P)>1&&P[1]==0&&length(P)<4){ R=execdraw(L,-3); Ex0=Ex1=Ex2=10; if((U=R[1])>0){ /* string */ if(U>20) U=16; /* adj 16,8,2,7,15 */ if(R[0][0][0]>R[2][0][0]-(R[0][0][1]-R[0][0][0])/256) Ex0+=8*U; /* adj 256 */ else Ex0+=2*U; if(R[0][0][1]2 && P[2]==1) mycat0(["Box:",[R[0],R[1]], ", ext=",R[3],", shift=",R[4]],1); }else R=execdraw((length(P)>3)?P[3]:L,-2); /* Windows */ XW=R[0];YW=R[1]; if(length(R)>3){ if(R[3]!=0 && R[3]!=[0,0]) Ex=R[3]; if(length(R)>4) Sft=R[4]; } if(type(X=getopt(ext))==4) Ex=(Ex0)?[X[0]+Ex[0],X[1]+Ex[1]]:X; if(type(M)<2){ if(length(P)>1&&type(P[1])==1) M=P[1]; else if((length(P)==1||P[1]==0||P[1]==1)&& PPP>0) M=PPP; if(M<2) M=400; if(Ex!=0 && type(Ex)==4){ M-=Ex[0]+Ex[1]; } M=(M/(XW[1]-XW[0]))*diagm(2,[1,-1]); } if(type(X=getopt(shift))==4) Sft=(Ex0)?[Sft[0]+X[0],Sft[1]+X[1]]:X; if(type(Sft)==4) Sft=[Sft[0],-Sft[1]]; if(Ex!=0) Sft=[Sft[0]+Ex[0],Sft[1]]; Org=[["shift",ptaffine(M,[-XW[0],-YW[1]]|shift=Sft)]]; for(CT=0;CT<2;CT++){ for(LT=L;LT!=[];LT=cdr(LT)){ T=car(LT); if(!CT && T[0]!=2) continue; if(CT && T[0]==2) continue; if(T[0]==1){ for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ D=car(TT); if(type(D[0][0])==4){ for(DT=D;DT!=[];DT=cdr(DT)){ V=car(DT); if(M) V=ptaffine(M,V|option_list=Org); draw_bezier(Id,Ind,V|option_list=T[1]); } }else{ if(M) D=ptaffine(M,D|option_list=Org); draw_bezier(Id,Ind,D|option_list=T[1]); } } }else if(T[0]==2){ /* put */ if(length(T)<4) continue; V=T[2]; if(type(VLB)==4&&V[0]=="_") V=VLB; else if(type(V[0])>1||type(V[1])>1) continue; /* not supported */ if(length(T)>3&&type(T[3])==4&&length(T[3])>1&&T[3][1]==1) VLB=V; F++;MM=M; if((Sc=delopt(T[1],"scale"|inv=1))!=[]){ if(!MM) MM=1; Sc=car(Sc)[1]; if(type(Sc)==1) MM=MM*Sc; else if(type(Sc)==6) MM=MM*diagm(2,Sc); } if(MM) V=ptaffine(MM,V|option_list=Org); if(type(S=S0=T[3])==4) S=S0[0]; if(length(T)>4) S=T[4]; /* subst. string */ if(type(S0)==4&&type(S0[0])==4){ if((Col=drawopt(S0[0][0],0))<0) Col=0; /* attrib. */ if(type(S)!=7) S=rtostr(S0[0][1]); S=str_subst(S,[["$\\bullet$","*"],["$\\times$","x"],["$",""]],0); if(type(Pos=drawopt(S0[0][0],2))==4) V=[V[0]+4*str_len(S)*Pos[0],V[1]-10*Pos[1]]; /* adjustable */ }else S=str_subst(rtostr(S),[["$\\bullet$","*"],["$\\times$","x"],["$",""]],0); V=[V[0]-str_len(S)*4,V[1]-8]; /* adjustable */ draw_string(Id,Ind,V,S,Col); }else if(T[0]==3){ /* arrow */ F++; T1=T[2];T2=T[3]; if(M){ T1=ptaffine(M,T1|option_list=Org); T2=ptaffine(M,T2|option_list=Org); } draw_bezier(Id,Ind,[T1,T2]|option_list=T[1]); }else if(T[0]==4){ /* line */ F++; T1=T[2];T2=T[3]; if(M){ T1=ptaffine(M,T1|option_list=Org); T2=ptaffine(M,T2|option_list=Org); } V=delopt(T1=T[1],"opt"|inv=1); if(V!=[]&&str_str(V[1],".")>=0) T1=cons(["opt",cons("dotted,",V[1])],delopt(T1,"opt")); draw_bezier(Id,Ind,[T1,T2]|option_list=T1); }else if(T[0]==5){ /* TeX */ mycat(rtostr(T[2])); if(F){ S=str_tb(0,Out); Out=str_tb(0,0); F=0; if(S!=""){ if(P[0]==2) dviout(xyproc(S)|keep=1); else LOut=cons(xyproc(S),LOut); } if(P[0]==2) dviout(T[2]|option_list=T[1]); else{ LOut=cons(T[2],Out); } } }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]); } } } S=(PPP>0)? [0,Id,Ind,PPP,PPQ]:[0,Id,Ind]; if(Ex==0&&Sft!=[0,0]) Ex=[0,0]; return (Ex!=0&&length(P)>2&&P[2]==-1)? [S,0,0,[0,R[0],R[1],0,Ex,[Sft[0]-Ex[0],-Sft[1]]]]:S; } if(P[0]==1||P[0]==2){ /* TeX */ Out=str_tb(0,0);LOut=[];F=0; if(getopt(cl)==1) dviout0(0); for(;L!=[];L=cdr(L)){ T=car(L);Opt=T[1]; if(type(T[0])>=2) continue; if(T[0]==0){ XW=T[1];YW=T[2]; if(length(P)>1&&type(P[1])==1&&P[1]<0) M=-P[1]/(XW[0]-XW[1]); }else if(T[0]==1){ F++; for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ D=car(TT); if(type(D[0][0])==4){ for(DT=D;DT!=[];DT=cdr(DT)){ V=car(DT); if(M) V=ptaffine(M,V|option_list=Org); str_tb(xybezier(V|option_list=Opt),Out); } }else{ if(M) D=ptaffine(M,D|option_list=Org); str_tb(xybezier(D|option_list=Opt),Out); } } }else if(T[0]==2){ F++;V=T[2]; Opt=delopt(Opt,"scale"|inv=1); MM=M; if(Opt!=[]){ Opt=car(Opt)[1]; if(type(Opt)==1) Opt=[Opt,Opt]; if(Opt!=[1,1]){ if(!MM) MM=1; MM=MM*diagm(2,[Opt[0],Opt[1]]); } } if(MM) V=ptaffine(MM,V|option_list=Org); if(length(T)>3) V=append(V,T[3]); str_tb(xyput(V),Out); }else if(T[0]==3){ F++; T1=T[2];T2=T[3]; if(M){ T1=ptaffine(M,T1|option_list=Org); T2=ptaffine(M,T2|option_list=Org); } str_tb(xyarrow(T1,T2|option_list=Opt),Out); }else if(T[0]==4){ F++; T1=T[2];T2=T[3]; if(M){ T1=ptaffine(M,T1|option_list=Org); T2=ptaffine(M,T2|option_list=Org); } str_tb(xyline(T1,T2|option_list=Opt),Out); }else if(T[0]==5){ if(F){ S=str_tb(0,Out); Out=str_tb(0,0); F=0; if(S!=""){ if(P[0]==2) dviout(xyproc(S)|keep=1); else LOut=cons(xyproc(S),LOut); } if(P[0]==2) dviout(T[2]|option_list=T[1]); else LOut=cons(T[2],Out); } }else if(T[0]==-2) str_tb(["%",T[1],"\n"],Out); 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]); } } S=str_tb(0,Out); if(P[0]==1){ if(F) LOut=cons(xyproc(S),LOut); Out=str_tb(0,0); for(L=reverse(LOut);L!=[];L=cdr(L)) str_tb(car(L),Out); return str_tb(0,Out); } if(F) dviout(xyproc(S)); else dviout(" "); } } def execproc(L) { if(type(N=getopt(var))!=1&&N!=0) N=2; for(R=[];L!=[];L=cdr(L)){ P=car(L); if(type(P[0])==2&&vtype(P[0])==3){ if((VS=vars(cdr(P)))!=[]){ for(I=0;I=0) P=mysubst(P,[V,R[I]]); } } if(length(P)<3) R=cons(call(P[0],P[1]),R); else R=cons(call(P[0],P[1]|option_list=P[2]),R); } } return (getopt(all)==1)?R:car(R); } def myswap(P,L) { X=makenewv(P); for(L=reverse(L);length(L)>1;L=cdr(L)) P=subst(P,L[0],X,L[1],L[0],X,L[1]); return P; } def mysubst(P,L) { if(P==0) return 0; Inv=getopt(inv); if(type(L[0]) == 4){ while((L0 = car(L))!=[]){ P = mysubst(P,(Inv==1)?[L0[1],L0[0]]:L0); L = cdr(L); } return P; } if(Inv==1) L=[L[1],L[0]]; if(type(P) > 3){ if(type(P)==7) return P; if(type(P)>7) return subst(P,L[0],L[1]); #ifdef USEMODULE return mtransbys(os_md.mysubst,P,[L]); #else return mtransbys(mysubst,P,[L]); #endif } P = red(P); if(type(P) == 3){ A=mysubst(nm(P),L);B=mysubst(dn(P),L); return red(nm(A)/nm(B))*red(dn(B)/dn(A)); } L1=(type(L[1])==3)?red(L[1]):L[1];X=L[0]; if(ptype(L1,X)==3){ LN=nm(L1);LD=dn(L1); Deg=mydeg(P,X); if(Deg <= 0) return P; V = newvect(Deg+1); for(V[I=Deg]=1;I >= 1;I--) V[I-1]=V[I]*LD; for(R = 0, I = Deg; I >= 0; I--) R = R*LN + mycoef(P,I,X)*V[I]; return red(R/V[0]); } return subst(P,X,L1); } def mmulbys(FN,P,F,L) { Opt=getopt(); if(type(F) <= 3){ if(type(P) <= 3) return call(FN, cons(P,cons(F,L))|option_list=Opt); if(type(P) == 5){ S = length(P); R = newvect(S); for(I = 0; I < S; I++) R[I] = call(FN, cons(P[I],cons(F,L))|option_list=Opt); return R; }else if(type(P) == 6){ S = size(P); R = newmat(S[0],S[1]); for(I = 0; I < S[0]; I++){ for(J = 0; J < S[1]; J++) R[I][J] = call(FN, cons(P[I][J],cons(F,L))|option_list=Opt); } return R; } } if(type(F) == 5){ S = length(F); if(type(P) <= 3){ R = newvect(S); for(I = 0; I < S; I++) R[I] = call(FN, cons(P,cons(F[I],L))|option_list=Opt); return R; } if(type(P) == 5){ for(J=R=0; J 0) F = mydiff(F,X); R = radd(R,mycoef(P,I,DX)*F); } return R; } #ifdef USEMODULE return mmulbys(os_md.appldo,P,F,[L]); #else return mmulbys(appldo,P,F,[L]); #endif } def appledo(P,F,L) { if(type(F) <= 3){ L = vweyl(L); X = L[0]; DX = L[1]; J = mydeg(P,DX); for(I = R = 0; I <= J; I++){ if(I > 0) F = myediff(F,X); R = radd(R,mycoef(P,I,DX)*F); } return R; } #ifdef USEMODULE mmulbys(os_md.appledo,P,F,[L]); #else mmulbys(appledo,P,F,[L]); #endif } def muldo(P,Q,L) { if(type(Lim=getopt(lim))!=1) Lim=100; if(type(Q) <= 3){ if(type(L) == 4 && type(L[0]) == 4) return mulpdo(P,Q,L|lim=Lim); /* several variables */ R = rmul(P,Q); L = vweyl(L); X = L[0]; DX = L[1]; if(X != 0){ for(I = F = 1; ; I++){ P = mydiff(P,DX); if(I>Lim){ mycat(["Over", Lim,"derivations!"]); break; } if(P == 0) break; Q = mydiff(Q,X); if(Q == 0) break; F *= I; R = radd(R,P*Q/F); } } return R; } #ifdef USEMODULE return mmulbys(os_md.muldo,P,Q,[L]); #else return mmulbys(muldo,P,Q,[L]); #endif } def jacobian(F,X) { F=ltov(F);X=ltov(X); N=length(F); M=newmat(N,N); for(I=0;I 0){ P *= (Q[I][0])^(Q[I][1]); Q[I]=[1,0]; } } } return P; } def ad(P,L,R) { L = vweyl(L); DX = L[1]; K = mydeg(P,DX); S = mycoef(P,0,DX); Q = 1; for(I=1; I <= K;I++){ Q = muldo(Q,DX-R,L); S = radd(S,mycoef(P,I,DX)*Q); } return S; } def add(P,L,R) { return rede(ad(P,L,R),L); } def vadd(P,L,R) { L = vweyl(L); if(type(R) != 4) return 0; N = length(R); DN = 1; Ad = PW = 0; for( ; R != []; R = cdr(R), PW++){ DN *= (T=1-car(R)[0]*L[0]); Ad = Ad*T-car(R)[1]*x^PW; } Ad /= DN; return add(P,L,Ad); } def addl(P,L,R) { return laplace1(add(laplace(P,L),L,R),L); } def cotr(P,L,R) { L = vweyl(L); X = L[0]; DX = L[1]; T = 1/mydiff(P,DX); K = mydeg(P,DX); S = mysubst(mycoef(P,0,DX), [X, R]); Q = 1; for(I = 1; I <= K; I++){ Q = muldo(Q, K*DX, L); S = radd(S,mysubst(mycoef(P,I,DX), [X, R])*Q); } } def rcotr(P,L,R) { return rede(cotr(P,L,R), L); } def muledo(P,Q,L) { if(type(Q)>3) #ifdef USEMODULE return mmulbys(os_md.muledo,P,Q,[L]); #else return mmulbys(muledo,P,Q,[L]); #endif R = P*Q; L = vweyl(L); X = L[0]; DX = L[1]; for(I = F = 1; I < 100; I++){ P = mydiff(P,DX); if(P == 0) break; Q = myediff(Q,X); if(Q == 0) break; F = rmul(F,I); R = radd(R,P*Q/F); } return R; } #if 1 def mulpdo(P,Q,L) { if(type(Q)>3) #ifdef USEMODULE return mmulbys(os_md.mulpdo,P,Q,[L]); #else return mmulbys(mulpdo,P,Q,[L]); #endif if(type(Lim=getopt(lim))!=1) Lim=100; M = vweyl(car(L)); X= M[0]; DX = M[1]; L = cdr(L); R = 0; for(I = 0; Q != 0 && I <= Lim; I++){ if(I>Lim){ mycat(["Over", Lim,"derivations!"]); break; } if(I > 0) P /= I; if(length(L)==0) R = radd(R,P*Q); else R = radd(R,mulpdo(P,Q,L)); if(X==0) break; P = mydiff(P,DX); if(P == 0) break; Q = mydiff(Q,X); } if(I>Lim) mycat(["Over", Lim,"derivations!"]); return R; } #else def mulpdo(P,Q,L); { if(type(Q)>3) #ifdef USEMODULE return mmulbys(os_md.mulpdo,P,Q,[L]); #else return mmulbys(mulpdo,P,Q,[L]); #endif if(type(Lim=getopt(lim))!=1) Lim=100; N = length(L); VO = newvect(2*N); VN = newvect(2*N); for(I = J = 0; I < N; J += 2, I++){ M = vweyl(L[I]); P = subst(P, VO[J]=M[0], VN[J]=strtov("o_"+rtostr(V[J])), VO[J+1]=M[1], VN[J+1] = strtov("o_"+rtostr(V[J+1]))); } for(PQ = P*Q, I = 0; I < 2*N; I += 2){ for(R = PQ, J = 1; J < Lim; J++){ R = mydiff(R, VN[I+1])/J; if(R == 0) break; R = mydiff(R, VO[I]); if(R == 0) break; PQ = radd(PQ,R); } if(I==Lim) mycat(["Over", Lim,"derivations!"]); PQ = red(subst(PQ,VN[I],VO[I],VN[I+1],VO[I+1])); } } #endif def transpdosub(P,LL,K) { Len = length(K)-1; if(Len < 0 || P == 0) return P; KK=K[Len]; if(type(KK)==4){ KK0=KK[0]; KK1=KK[1]; }else{ L = vweyl(LL[Len]); KK0=L[1]; KK1=K[Len]; } Deg = mydeg(P,KK0); K1 = reverse(cdr(reverse(K))); R = transpdosub(mycoef(P,0,KK0),LL,K1); for(I = M = 1; I <= Deg ; I++){ M = mulpdo(M,KK1,LL); S = mycoef(P,I,KK0); if(Len > 0) S = transpdosub(S,LL,K1); R = radd(R,mulpdo(S,M,LL)); } return R; } 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(getopt(ex)==1){ for(LT=LL, KT=K; KT!=[]; LT=cdr(LT), KT=cdr(KT)){ L = vweyl(LL[J]); K1=cons([L[0],car(KT)[0]],K1); K2=cons([L[1],car(KT)[1]],K2); } K2=append(K1,K2); }else{ 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); K2 = cons(K[J][1],K2); } P = mulsubst(P, K1); } return transpdosub(P,LL,K2); } def translpdo(P,LL,M) { S=length(LL); L0=newvect(S);L1=newvect(S); K=newvect(S); for(J=0;J= DQ){ R = mycoef(P,DP,X)/CO; S = radd(S,R*X^(DP-DQ)); P = radd(P, -R*Q*X^(DP-DQ)); } Lcm = lcm(dn(S),dn(P)); Gcd = gcd(nm(S),nm(P)); return [red(P*Lcm/Gcd), red(Lcm/Gcd),red(S*Lcm/Gcd)]; } 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"; } def mygcd(P,Q,L) { if((Dvi=getopt(dviout))==3 || Dvi==-3){ /* dviout=3 */ if((Rev=getopt(rev))!=1) Rev=0; R=mygcd(P,Q,L|rev=Rev); if(type(L)<2) Var=0; else if(type(L)==2){ Val=L;L=[0,L]; }else if(type(L)==4){ L=vweyl(L); Var=[[L[1],"\\partial"]]; } S=mat([P],[Q]);T=mat([R[0]],[0]); M=mat([R[1],R[2]],[R[3],R[4]]); if(type(Val)==4) N=mdivisor(M,L|trans=1)[1]; else N=myinv(M); Tb=str_tb(mtotex(S|var=Var),0); str_tb("&="+mtotex(N|var=Var)+mtotex(T|var=Var)+",\\\\\n",Tb); str_tb(mtotex(T|var=Var),Tb); str_tb("&="+mtotex(M|var=Var)+mtotex(S|var=Var)+".",Tb); Out=str_tb(0,Tb); if(Dvi<0) return Out; dviout(Out|eq="align*"); return 1; } if((type(Dvi)==1||Dvi==0) && getopt(rev)!=1) V=[[P,Q]]; else V=0; if(L==0){ /* integer case */ if(type(P) > 1 || type(Q) > 1 || Q==0 /* P <= 0 || Q <= 0 */ || dn(P) > 1 || dn(Q) > 1) return 0; CPP = CQQ = 1; CQP = CPQ = 0; P1 = P; Q1 = Q; /* P1 = CPP*P + CPQ*Q Q1 = CQP*P + CQQ*Q */ while(Q1 != 0){ Div1 = idiv(P1,Q1); Div2 = irem(P1,Q1); if(type(V)==4) V=cons([Div1,Div2],V); P1 = Q1 ; Q1 = Div2; TP = CQP; TQ = CQQ; CQP = CPP-Div1*CQP; CQQ = CPQ-Div1*CQQ; CPP = TP; CPQ = TQ; } if(V!=0){ V=reverse(V); if((DVI=abs(Dvi))==0) return V; PT=P;QT=Q; if(DVI==1 || DVI==2){ Tb=str_tb(0,0); for(C=0,V=cdr(V);V!=[];V=cdr(V)){ T=car(V); if(C++) str_tb(texcr(11),Tb); if(DVI==1){ Qs=rtostr(QT); if(QT<0) Qs="("+Qs+")"; if(T[1]>0) Qs=Qs+"+"; if(T[1]!=0) Qs=Qs+rtostr(T[1]); str_tb(rtostr(PT)+"&=" +rtostr(T[0])+"\\times"+Qs,Tb); }else{ N=mat([T[0],1],[1,0]); if(C==1){ str_tb(S0=mtotex(mat([PT],[QT])),Tb); M=N; } str_tb("&=",Tb); if(C>1) str_tb(mtotex(M),Tb); str_tb(mtotex(N),Tb); str_tb(S=mtotex(mat([QT],[T[1]])),Tb); if(C>1){ str_tb("=",Tb); str_tb(mtotex(M=M*N),Tb); str_tb(S,Tb); } } PT=QT;QT=T[1]; } if(DVI==2){ str_tb(texcr(43)+S+"&=",Tb); str_tb(mtotex(myinv(M)),Tb); str_tb(S0,Tb); } Out=str_tb(0,Tb); if(Dvi>0){ dviout(Out|eq="align*"); return 1; } return Out; } } if(P1<0) return [-P1,-CPP,-CPQ,CQP,CQQ]; return [P1, CPP, CPQ, CQP, CQQ]; } if(type(L) == 2) /* polynomical case */ L = [0,L]; if(getopt(rev)==1 && L[0]!=0){ R=mygcd(adj(P,L),adj(Q,L),L); return [adj(R[0],L),adj(R[1],L),adj(R[2],L),adj(R[3],L),adj(R[4],L)]; } if(type(P) == 3) P = red(P); if(type(Q) == 3) Q = red(Q); CP=newvect(2,[1/dn(P),0]); CQ=newvect(2,[0,1/dn(Q)]); P=PT=nm(P); Q =QT=nm(Q); L = vweyl(L); while(Q != 0){ R = divdo(P,Q,L); if(type(V)==4) V=cons(R,V); /* R[1] = R[2]*P - R[0]*Q = R[2]*(CP[0]*P0+CP[1]*Q0) - R[0]*(CQ[0]*P0+CQ[1]*Q0) */ /* P(n) |0 1 | P(n-1) = | | R[1] |R[2] -R[0]| P(n) P(n+1) = R[1], P(n) = P, P(n-1) = Q */ P = Q; Q = R[1]; { CT = dupmat(CQ); CQ = [R[2]*CP[0]-muldo(R[0],CQ[0],L), R[2]*CP[1]-muldo(R[0],CQ[1],L)]; CP = CT; } } if(V!=0){ V=reverse(V); if((DVI=abs(Dvi))==0) return V; if(type(L[0])<1) Var=L[1]; else Var=[L[1],"\\partial"]; if(DVI==1 || DVI==2){ Tb=str_tb(0,0); PT=car(V)[0];QT=car(V)[1]; for(C=0,V=cdr(V);V!=[];V=cdr(V)){ T=car(V); if(C++) str_tb(texcr(11),Tb); if(DVI==1){ if(T[2]!=1){ str_tb(monototex(T[2]),Tb); str_tb("(",Tb); str_tb(fctrtos(PT|var=Var,TeX=2),Tb); str_tb(")&=",Tb); }else{ str_tb(fctrtos(PT|var=Var,TeX=2),Tb); str_tb("&=",Tb); } str_tb("(",Tb); str_tb(fctrtos(T[0]|var=Var,TeX=2),Tb); str_tb(")(",Tb); str_tb(fctrtos(QT|var=Var,TeX=2),Tb); if(T[1]!=0){ str_tb(")+(",Tb); str_tb(fctrtos(T[1]|var=Var,TeX=2),Tb); } str_tb(")",Tb); }else{ N=mat([red(T[0]/T[2]),1],[1,0]); if(C==1){ str_tb(S0=mtotex(mat([PT],[QT])|var=Var),Tb); M=N; } str_tb("&=",Tb); if(C>1) str_tb(mtotex(M),Tb); str_tb(mtotex(N|var=Var),Tb); str_tb(S=mtotex(mat([QT],[T[1]])|var=Var),Tb); if(C>1){ str_tb("=",Tb); str_tb(mtotex(M=muldo(M,N,L)|var=Var),Tb); str_tb(S,Tb); } } PT=QT;QT=T[1]; } if(DVI==2){ FT=fctr(PT); for(R=1;FT!=[];FT=cdr(FT)){ if(mydeg(car(FT)[0],L[1])<1) for(J=car(FT)[1];J>0;J--) R*=car(FT)[0]; } if(R!=1){ str_tb(texcr(79),Tb); M=muldo(M,mat([R,0],[0,1]),L); str_tb(mtotex(M|var=Var),Tb); str_tb(S=mtotex(mat([PT/R],[QT])|var=Var),Tb); } str_tb(texcr(43)+S+"&=",Tb); if(type(Var)==4){ N=mdivisor(M,L|trans=1); N=N[1]; }else N=myinv(M); str_tb(mtotex(N|var=Var),Tb); str_tb(S0,Tb); } Out=str_tb(0,Tb); if(Dvi>0){ dviout(Out|eq="align*"); return 1; } return Out; } } Q = rede(P,L); R = red(P/Q); return [Q,red(CP[0]/R),red(CP[1]/R),red(CQ[0]/R),red(CQ[1]/R)]; } def mylcm(P,Q,L) { Rev=(getopt(rev)==1)?1:0; if(Rev==1){ P=adj(P); Q=adj(Q); } R = mygcd(P,Q,L); S=(type(L)<=2)?R[3]*P:muldo(R[3],P,L); S = nm(S); if(type(S) <= 1 && type(L) <= 1){ if(S<0) S = -S; return S; } if(type(L) == 2) return easierpol(S,L); S=rede(easierpol(S,L[1]),L); return (Rev==1)?adj(S):S; } def sftpexp(P,LL,F,Q) { if(type(LL[0]) < 4) LL = [LL]; for(L0=L1=[],LT=LL;LT!=[];LT=cdr(LT)){ W=vweyl(car(LT)); L0=cons(W,L0); D=mydiff(F,W[0]); if(D!=0) L1=cons(W[1]+Q*D/F,L1); else L1=cons(W[1],L1); } return rede(transpdosub(P,L0,L1),L0); } def applpdo(P,F,LL) { if(type(F)>3) #ifdef USEMODULE return mmulbys(os_md.applpdo,P,F,[LL]); #else return mmulbys(applpdo,P,F,[LL]); #endif L = vweyl(LL[0]); LL = cdr(LL); Deg = deg(P,L[1]); S = F; for(I = R = 0; I <= Deg ; I++){ if(I > 0) S = mydiff(S,L[0]); if(LL == []) R = radd(R,mycoef(P,I,L[1])*S); else R = radd(R,applpdo(mycoef(P,I,L[1]), S, LL)); } return R; } def tranlpdo(P,L,M) { N = length(L); R = size(M); if(R[0] != N || R[1] != N){ print("Strange size"); return; } InvM = M; if(InvM[1] == 0){ print("Not invertible"); return; } XL = newvector(N); DL = newvector(N); for(I = 0; I < 0; I++){ R = vweyl(L[I]); XL[I] = R[0]; DL[I] = R[1]; } for(I = 0; I < N; I++){ for(J = XX = D0 = 0; J < N; J++){ XX = radd(XX,M[I][J]*XL[J]); DD = radd(DD, red(InvM[0][I][J]/InvM[1])*DL[J]); P = mysubst(P,[[XL[I],XX],[DL[I],DD]]); } } return P; } def divdo(P,Q,L) { if(L==0){ R=P-idiv(P,Q)*Q; if(R<0){ if(Q>0) R+=Q; else R-=Q; } return [(P-R)/Q,R,1]; } L = vweyl(L); if(getopt(rev)==1){ R=divdo(adj(P,L),adj(Q,L),L); return [adj(R[0],L),adj(R[1],L),R[2]]; } X = L[0]; DX = L[1]; S = 0; M = 1; I = mydeg(Q,DX); CQ = mycoef(Q,I,DX); while((J=mydeg(P,DX)) >= I){ C = mycoef(P,J,DX); SR = red(C/CQ); if(dn(SR) != 1){ M *= dn(SR); P *= dn(SR); S *= dn(SR); SR = nm(SR); } P -= muldo(SR*(DX)^(J-I),Q,L); S += SR*(DX)^(J-I); } return [S,P,M]; } def qdo(P,Q,L) { L = vweyl(L); DX = L[1]; OD = deg(P,DX); V = newvect(OD+1); for(I = 0; I <= OD; I++){ if(I) Q = muldo(DX,Q,L); S = divdo(Q,P,L); V[I] = S[1]*DX-S[2]*zz^I; } for(K = [], I = OD; I >= 0; I--) K = cons(DX^(I+1), K); R = lsol(V,K); S = length(R); for(I = P1 = 0; I < S; I++){ if(type(R[I]) < 4 && mydeg(R[I],DX) == 0 && R[I] != 0 && (mydeg(R[I],zz) <= mydeg(P,DX))) P1 = R[I]; else if(type(R[I]) == 4 && R[I][0] == DX) P2 = R[I][1]; } T=fctr(P1); for(I=0, S=length(T), P1=1; I 0) P1 *= T[I][0]^(T[I][1]); } return subst([P1,P2],zz,DX); } def sqrtdo(P,L) { L = vweyl(L); P = toeul(P,L,0); V = -1; for(R = 0, Ord = mydeg(P,L[1]); Ord >= 0; Ord--){ Q = coef(P,Ord,L[1]); M = mydeg(Q,L[0]); N = mymindeg(Q,L[0]); if(V < 0) V = M+N; else if(V != M+N){ print("Cannot be transformed!"); return; } Q = tohomog(red(Q/L[0]^N), [L[0]], z_z); if(irem(Ord,2)) B = x-z_z; else B = x+z_z; Q = substblock(Q,x,B,z_zz); if(mydeg(Q,x) > 0){ print("Cannot be transformed!"); return; } R += mysubst(Q,[z_zz,x])*L[1]^Ord; } return fromeul(R,L,0); } def ghg(A,B) { R = dx; while(length(B)>0){ R = muldo(x*dx+car(B),R,[x,dx]); B = cdr(B); } T = 1; while(length(A)>0){ T = muldo(x*dx+car(A),T,[x,dx]); A = cdr(A); } return R-T; } def ev4s(A,B,C,S,T) { R4 = x^2*(x-1)^2; R3 = x*(x-1)*((2*A-2*B-8)*x-2*A+5); R2 = (-3/2*(A^2+B^2)+3*A*B+9*A-9*B-29/2+1/4*(S^2+T^2))*x^2 +(5*A^2/2-13*A-3*A*B+B^2/2+7*B-C^2+C+35/2 - 1/4*(S^2+T^2))*x - (2*A+2*C-5)*(2*A-2*C-3)/4; R1 = 1/4*(A-B-2)*(2*A^2-4*A*B-8*A+2*B^2+8*B+10-S^2-T^2)*x +15/4+3*B^2/4-C^2/2+11*A^2/4 - 11*A/2+3*B+B*C-7*A*B/2+C/2-A*B^2/2 #if 1 + A^2*B #endif - B*C^2 - A^3/2+(2*A-3)*(S^2+T^2)/8; /* OK? for the above term added */ R0 = -(A-B-1-S)*(A-B-1+S)*(A-B-1-T)*(A-B-1+T)/16; return (R4*dx^4-R3*dx^3-R2*dx^2-R1*dx-R0); } def b2e(A,B,C,S,T) { R4 = x^2*(x-1)^2; R3 = x*(x-1)*(2*x-1)*(2*c-5); R2 = (-6*C^2+24*C-25+1/2*S^2+1/2*T^2)*x^2 +(6*C^2-24*C+25-1/2*S^2-1/2*T^2-A^2+B^2+A-B)*x +A^2-C^2-A+4*C-15/4; R1 = (2*C-3)*(2*C^2-6*C+5-1/2*S^2-1/2*T^2)*x +(2*C-3)*(-C^2+3*C+1/2*A^2-1/2*B^2+1/2*B-1/2*A-5/2+1/4*S^2+1/4*T^2); R0 = -(2-2*C+S+T)*(2-2*C-S-T)*(2-2*C+S-T)*(2-2*C-S+T)/16; return (R4*dx^4-R3*dx^3-R2*dx^2-R1*dx-R0); } /* T^m = T(T-1)....(T-m+1) f(t) -> g(t) f(t) = a_mt^m + ... + a_1t+a_0 g(x*dx) = a_m*x^m*dx^m + ... + a_1*x*dx+a_0 ret: x(x-1)...(x-i+1) */ def sftpow(X,I) { R = 1; for(J=0;J2) S=1; R = 0; for(I = mydeg(F,A); I >= 0; I--) R = R*(A-I*S) + mycoef(F,I,A); return R; } def binom(P,N) { if(type(N)!=1 || N<=0) return 1; for(S=1;N>0;N--,P-=1) S*=P/N; return red(S); } def expower(P,R,N) { if(type(N)!=1 || N<0) return 0; for(S=S0=K=1;K<=N;K++,R-=1){ S0*=P*R/K;S+=S0; } return red(S); } 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;K=0; II--){ J = mydeg(P=mycoef(F,I,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--) 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--) R += (red(mycoef(F,I,DX)/X^I))*DX^I; return pol2sft(R,DX); } /* def topoldif(P,F,L) { L = vweyl(L); P = nm(red(P)); while(deg(P,L[1]) > 0){ R = coef(P,0,L[0]); Q = red((P-R)/(F*L[0]); P = nm(Q)*zz+F*R*dn(Q); } } */ def fromeul(P,L,V) { if(P == 0) return 0; L = vweyl(L); X = L[0]; DX = L[1]; I = mydeg(P,DX); if(V == "infty"){ P = subst(P,DX,-DX); J = mydeg(P,X); P = red(mysubst(P,[X,1/X])*X^J); } R = mycoef(P,0,DX); S = 1; for(S = J = 1; J <= I; J++){ S = DX*(S*X + mydiff(S,DX)); R += mycoef(P,J,DX)*S; } while(mycoef(R,0,X) == 0) R = tdiv(R,X); if(V != "infty" && V != 0) R = mysubst(R,[X,X-V]); return R; } 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); } def fractrans(P,L,N0,N1,N2) { L = vweyl(L); if(N2 != "infty"){ if(N0 == "infty") N0 = 0; else N0 = red(1/(N0-N2)); if(N1 == "infty") N1 = 0; else N1 = red(1/(N1-N2)); P = mysubst(P,[L[0],L[0]+N2]); P = fromeul(toeul(P,L,"infty"),L,0); } if(N0 != 0){ P = mysubst(P,[L[0],L[0]+N0]); N1 -= N0; } if(N1 != 1) P = mysubst(P,[[L[0],L[0]/N1],[L[1],L[1]*N1]]); return P; } def soldif(P,L,V,Q,N) { L = vweyl(L); X = L[0]; DX = L[1]; P = mysubst(toeul(P,L,V),[DX,DX+Q]); DEG = mydeg(P,X); P0 = newvect(DEG+1); for(I = 0; I <= DEG; I++) P0[I] = coef(P,I,X); if(P0[0] == 0) return 0; if(subst(P0[0],DX,0) != 0){ mycat([Q,"is not the exponent at", V])$ return 0; } R = newvect(N+1); R[0] = 1; for(I = 1; I <= N; I++){ for(S = 0, K = 1; K <= DEG && K <= I; K++) S += mysubst(P0[K],[DX,I-K])*R[I-K]; S = red(S); M = mysubst(P0[0],[DX,I]); if(M != 0){ R[I] = -red(S/M); if(R1 != 0){ for(S = 0, K = 1; K <= DEG && K <= I; K++) S += mysubst(P0[K],[DX,I-K])*R1[I-K] + mysubst(P1[K],[DX,I-K])*R[I-K]; R1[I] = -red(S/M); } }else{ if(S == 0){ if(R1 != 0){ for(S = 0, K = 1; K <= DEG && K <= I; K++) S += mysubst(P0[K],[DX,I-K])*R1[I-K] + mysubst(P1[K],[DX,I-K])*R[I-K]; } if(S == 0) continue; } R1 = newvect(N+1); for(K = 0; K < I; K++){ R1[K] = R[K]; R[K] = 0; } R1[I] = 0; P1 = newvect(DEG); for(K = 0; K <= DEG; K++) P1[K] = mydiff(P0[K], DX); M = mysubst(P1[0],[DX,I]); if(M == 0){ cat(["multiple log at ", I])$ return 0; } R[I] = -red(S/M); } } if(R1 != 0) return [R1, R]; else return R; } def chkexp(P,L,V,Q,N) { L = vweyl(L); X = L[0]; DX = L[1]; P = mysubst(toeul(P,L,V),[DX,DX+Q]); P = fromeul(P,L,0); D = mydeg(P,DX); Z = mindeg(mycoef(P,D,DX), X) - (D-N); R = []; for(I = 0; I < Z; I++){ S = mycoef(P,I,X); if(S != 0){ for(J = mydeg(S,DX); J >= 0; J--){ T = mycoef(S,J,DX); if(T != 0) R = cons(T,R); } } } return R; } def sqrtrat(P) { if(P==0) return 0; if(type(P)==3||type(P)==2){ P=red(P); if(imag(dn(P))!=0||imag(nm(P))!=0){ if(imag(dn(P))==0&&real(P)!=0){ F=red(imag(P)/real(P)); if(F==3^(1/2)||F==-3^(1/2)){ if(eval(real(P))<0) return -real(P)+imag(P)*@i; else{ if(eval(imag(P))>0) return imag(P)+real(P)*@i; else return -imag(P)-real(P)*@i; } } } return []; } F=fctr(dn(P)); R=sqrtrat(car(F)[0]); for(F=cdr(F);F!=[];F=cdr(F)){ if(!iand(car(F)[1],1)) R*=car(F)[0]^(car(F)[1]/2); else return []; } F=fctr(nm(P)); R=sqrtrat(car(F)[0])/R; for(F=cdr(F);F!=[];F=cdr(F)){ if(!iand(car(F)[1],1)) R*=car(F)[0]^(car(F)[1]/2); else return []; } return R; } if(ntype(P)==4){ P0=real(P);P1=imag(P)/2; X=makenewv(P); for(R=fctr(X^4-P0*X^2-P1^2);R!=[];R=cdr(R)){ RT=car(R)[0]; if(deg(RT,X)==1){ X=-mycoef(RT,0,X)/mycoef(RT,1,X); return X+P1/X*@i; } if(deg(RT,X)==2){ if((D=mycoef(RT,1,X)^2-4*mycoef(RT,2,X)*mycoef(RT,0,X))<0) continue; X=(-mycoef(RT,1,X)+sqrtrat(D))/(2*mycoef(RT,2,X)); return X+P1*sqrt2rat(1/X)*@i; } } D=P0^2+4*P1^2; if(P1>0) return ((sqrtrat(D)+P0)/2)^(1/2)+((sqrtrat(D)-P0)/2)^(1/2)*@i; return ((sqrtrat(D)+P0)/2)^(1/2)-((sqrtrat(D)-P0)/2)^(1/2)*@i; }else if(ntype(P)!=0) return []; if(P==1) return P; Dn=dn(P);Nm=nm(P);C=R=1; N=pari(factor,Dn); if(N){ for(II=car(size(N))-1;II>=0;II--){ if(iand(K=N[II][1],1)){ R*=N[II][0]; K++; } C/=N[II][0]^(K/2); } } N=pari(factor,Nm); if(N){ for(II=car(size(N))-1;II>=0;II--){ if(N[II][0]==-1){ C*=@i; continue; } K=N[II][1]; if(iand(K,1)){ R*=N[II][0]; K--; } if(K!=0) C*=N[II][0]^(K/2); } } if(R!=1) C*=R^(1/2); return C; } def fctri(F) { R=(iscoef(F,os_md.israt))?fctr(F):[[1,1],[F,1]]; if(!iscoef(F,os_md.iscrat)||chkfun("af_noalg",0)==0) return R; X=makenewv(vars(F)); for(S=[];R!=[];R=cdr(R)){ if(length(Var=vars(R0=car(R)[0])) == 1 && (D=mydeg(R0,Var=car(Var))) > 0){ if(imag(T=mycoef(R0,D,Var))!=0) R0/=T; T=af_noalg(real(R0)+imag(R0)*X,[[X,X^2+1]]); if(length(T)>1||T[0][1]>1){ T=subst(T,X,@i); for(; T!=[];T=cdr(T)){ if(vars(T[0])!=[]) S=cons([car(T)[0],car(T)[1]*car(R)[1]],S); } continue; } } S=cons(R[0],S); } return reverse(S); } def getroot(F,X) { S=[]; if(type(Cpx=getopt(cpx))!=1) Cpx=0; M=getopt(mult); if(type(F) == 3) F = nm(red(F)); for(R=fctri(F); length(R)>0; R = cdr(R)){ T=car(R); P=car(T); I=car(cdr(T)); if(mydeg(P,X)>0){ if(mydeg(P,X)==1){ C = mycoef(P,1,X); P = X - red(P/C); }else if(mydeg(P,X)==2 && Cpx>0){ C2=mycoef(P,2,X);C1=mycoef(P,1,X);C0=mycoef(P,0,X); C=sqrt2rat(C1^2-4*C0*C2); C0=[]; if(type(C)==0&&ntype(C)==0&&pari(issquare,-C)) C0=sqrt(C); else if(Cpx>1) C0=sqrtrat(C); if(C0==[]&&Cpx>2) C0=C^(1/2); if(C0!=[]){ if(M==1) S=cons([I,sqrt2rat((-C1+C0)/(2*C2))],S); else{ for(II=I; II>0; II--) S=cons(sqrt2rat((-C1+C0)/(2*C2)),S); } P=sqrt2rat((-C1-C0)/(2*C2)); } }else if(mydeg(P,X)==3 && Cpx>1){ Omg=(-1+3^(1/2)*@i)/2; PP=P/mycoef(P,3,X); C2=mycoef(PP,2,X)/3; PP=subst(PP,X,X-C2); if((C1=mycoef(PP,1,X))==0){ C0=mycoef(PP,0,X); if(real(C0)==0||imag(C0)==0){ if(real(C0)==0){ PP=getroot(X^3+imag(C0),X); if(length(PP)==3){ for(;PP!=[];PP=cdr(PP)){ if(imag(PP[0])==0){ C0=PP[0]*@i; break; } } if(PP==[]) C0=0; } }else{ if(C0>0) C0=C0^(1/3); else C0=-(-C0)^(1/3); } if(C0!=0){ if(M==1){ S=cons([I,C0-C2],S); S=cons([I,C0*Omg-C2],S); S=cons([I,C0*(-1-Omg)-C2],S); }else{ for(II=I; II>0; II--){ S=cons(C0-C2,S); S=cons(C0*Omg-C2,S); S=cons(C0*(-1-Omg)-C2,S); } } continue; } } } if(Cpx>2){ Q=X^2+(mycoef(PP,1,X)/3)*X+mycoef(PP,0,X)^3; SQ=getroot(Q,X|cpx=2); SQ=SQ[0]^(1/3);SQ2=mycoef(PP,0,X)/SQ; if(M==1){ S=cons([I,SQ+SQ2-C2],S); S=cons([I,SQ*Omg+SQ2*(-1-Omg)-C2],S); S=cons([I,SQ*(-1-Omg)+SQ2*Omg-C2],S); }else{ for(II=I; II>0; II--){ S=cons(SQ+SQ2-C2,S); S=cons(SQ*Omg+SQ2*(-1-Omg)-C2,S); S=cons(SQ*(-1-Omg)+SQ2*Omg-C2,S); } } continue; } }else if(mydeg(P,X)==4 && Cpx>0){ C2=mycoef(P,3,X)/(4*mycoef(P,4,X)); PP=subst(P,X,X-C2); if(mycoef(PP,1,X)==0){ PP=mycoef(PP,4,X)*X^2+mycoef(PP,2,X)*X+(SQ2=mycoef(PP,0,X)); SQ=getroot(PP,X|cpx=2); if(length(SQ)==2){ if((C0=sqrtrat(SQ[0]))==[]){ if(mycoef(PP,1,X)==0){ if(SQ2<0) C0=(-SQ2)^(1/4); else C0=SQ2^(1/4)*(1+@i)/2; } else if(Cpx>2) C0=SQ[0]^(1/2); else C0=0; } if((C1=sqrtrat(SQ[1]))==[]){ if(mycoef(PP,1,X)==0) C1=-C0; else C1=SQ[1]^(1/2); } if(C0!=0){ if(M==1) S=append([[I,C0-C2],[I,-C0-C2],[I,C1-C2],[I,-C1-C2]],S); else{ for(II=I; II>0; II--) S=append([C0-C2,-C0-C2,C1-C2,-C1-C2],S); } continue; } } }else{ PP/=mycoef(PP,4,X); CC=mycoef(PP,2,X);C1=mycoef(PP,1,X);C0=mycoef(PP,0,X); SQ=getroot(X*(CC+X)^2-4*C0*X-C1^2,X|cpx=Cpx); if(length(SQ)>1){ SQ=sqrt2rat(SQ[0]); SQ2=getroot(X^2-SQ,X|cpx=Cpx); if(length(SQ2)>1){ C1=SQ2[0]*X-C1/SQ2[0]/2; C0=getroot(X^2+CC/2+SQ/2+C1,X|cpx=Cpx); C1=getroot(X^2+CC/2+SQ/2-C1,X|cpx=Cpx); if(length(C0)>1&&length(C1)>1){ C0=[sqrt2rat(C0[0]-C2),sqrt2rat(C0[1]-C2), sqrt2rat(C1[0]-C2),sqrt2rat(C1[1]-C2)]; if(M==1) for(II=0;II<4;II++) S=cons([I,C0[II]],S); else for(II=I; II>0; II--) S=append(C0,S); continue; } } } } } if(M==1) S=cons([I,P],S); else for( ; I>0; I--) S=cons(P,S); } } S=qsort(S); if(M==1) S=reverse(S); return S; } def expat(F,L,V) { L = vweyl(L); if(V == "?"){ Ans = []; F = nm(red(F)); S = fromeul(toeul(F,L,"infty"),L,0); S = mycoef(S,mydeg(S,L[1]),L[1]); if(mydeg(S,L[0]) > 0) Ans = cons(["infty", expat(F,L,"infty")],Ans); S = mycoef(F,mydeg(F,L[1]), L[1]); R = getroot(S,L[0]); for(I = 0; I < length(R); I++){ if(I > 0 && R[I-1] == R[I]) continue; if(mydeg(R[I], L[0]) <= 0) Ans = cons([R[I], expat(F,L,R[I])], Ans); else Ans = cons([R[I]], Ans); } return Ans; } return getroot(subst(toeul(F,L,V),L[0],0),L[1]); } def polbyroot(P,X) { R = 1; while(length(P)){ R *= X-car(P); if(type(R)>2) R = red(R); P = cdr(P); } return R; } def polbyvalue(P,X) { R = 1; S = 0; while(length(P)){ T = car(P); V0 = T[1] - mysubst(S,[X,T[0]]); if(V0 != 0){ if(type(R) > 2) R = red(R); V1 = mysubst(R,[X,T[0]]); if(V1 == 0){ erno(0); return 0; } S += (V0/V1)*R; if(type(S) > 2) S = red(S); } R *= X - T[0]; P = cdr(P); } return S; } def pcoef(P,L,Q) { if(L==0) return 1; Coef=TP=0; if(type(Q)>=4){ TP=1; V=Q[0]; if(type(V)==4) V=ltov(V); else V=dupmat(V); N=length(V); if(type(Q[1])==5) MR=dupmat(Q[1]); else{ MR=newvect(N); for(K=Q[1], I=0; I< N; I++){ MR[I] = car(K); K = cdr(K); } } }else{ V=ltov(vars(P)); N=length(V); MR=newvect(N); for(I=0;I1) return 0; } if(L==1){ for(I=0;I=0 && MR[J]J;II--){ MR[II+1]=MR[II];V[II+1]=V[II]; } MR[II+1]=K1;V[II+1]=K2; } for(NN=N; N>0 && MR[N-1]==0; N--); Mon=[];Coe=[];Q=P; while(Q!=0){ M=newvect(N); for(R=Q,F=I=0,MT=1;I0) MT*=V[I]^K; if(K>MR[I]) F=1; } Q -= R*MT; if(F==0){ Mon=cons(M,Mon); Coe=cons(R,Coe); } } Mon=ltov(reverse(Mon)); Coe=ltov(reverse(Coe)); Len=length(Mon); S=newvect(Len); for(JL=0; JL=0;II++){ if((K1=K0-Mon[0][II])>0){ while(K>K1 && S[I]>0){ S[I]--;S[II]++; K-=K1; I=II; K0=Mon[0][II]; } }else break; } I=0; while(1){ for(T=T0=J=JP=0; J=JL) return Coef; JP=J;T0=1; T+=S[J]*Mon[J][I]; } } if(T==MR[I]){ if(++I1; II--) TT/=II; } } Coef+=TT; if(TP==1 && type(Coef)==3) Coef=red(Coef); if(JP1){ S[JP]-=2;S[JP+1]++;S[JP+2]++; }else{ for(JT=JP-1;JT>=0&&S[JT]==0;JT--); if(JT<0) break; if(JT==JP-1){ S[JT]--; if(JP0 && Mon[JP1][0] < Mon[JP][0]){ S[JP]--;S[Len-1]++;JP=JP-1; }else{ S[JP]--; if(JP1=0 && S[JT]==0;JT--); if(JT<0) break; S[JT]--; if(JT==JP-1){ S[JP]++; }else{ S[JT+1]+=S[JP]+1; S[JP]=0; } } I=0; } return Coef; } def prehombf(P,Q) { if((Mem=getopt(mem))!=1 && Mem!=-1) return prehombfold(P,Q); if(Q==0) Q=P; V=ltov(vars(P)); N=length(V); for(I=1;I=0 && mydeg(P,V[J])J;II--) V[II+1]=V[II]; V[II+1]=K1; } S=newvect(N);T=newvect(N);U=newvect(N); for(R=P,M=1,Deg=I=0;I0) RR*=V[J]^T[J]; } Q-=R*RR; for(J=0,CC=R;J 1) mycat([V-1, "accessory parameters: r1,r2,..."]); return R; } def fuchs3e(P,Q,R) { return getbygrs([R,P,Q],3); } def okubo3e(P,Q,R) { if(getopt(opt)==1){ N=length(R); M1=N-length(P);M2=N-length(Q); V=(M1-1)*(M2-1); if(V>0) mycat([V, "accessory parameters"]); return getbygrs([R,cons([M1,0],P),cons([M2,0],Q)],3); } S = 0; V = -1; L = newvect(3,[[],[],[]]); N = newvect(3,[0,0,0]); if(type(R) < 4){ I = -1; V = 3; }else{ I = 2; V = -1; } for( ; I >= 0; I--){ if(I == 2) U = R; else if(I == 1) U = Q; else U = P; for( ; length(U); U = cdr(U)){ T = car(U); if( T == "?"){ if(V < 0) V = I; else return 0; }else{ if(I == 2) L[I] = cons(-T, L[I]); else L[I] = cons(T, L[I]); S += T; } N[I]++; } } if(V == 3){ N[2] = N[0] + N[1]; P2 = x^N; for(I = 1; I <= N; I++) P2 += makev([R,I])*x^(N-I); }else{ if(N[0]+N[1] != N[2]){ print("Number of exponents are wrong",0); return -1; } S -= N[0]*N[1]; if(V < 0){ if(S != 0){ mycat(["Viorate Fuchs relation ->",S]); return -2; } }else{ if(V != 2) S = -S; L[V] = cons(S, L[V]); } P2 = polinsft(polbyroot(L[2],x),x); } P0 = polinsft(mysubst(polbyroot(L[0],x),[x,x+N[1]]),x); P1 = polinsft(mysubst(polbyroot(L[1],x),[x,x+N[0]]),x); return sub3e(P0,P1,P2,N[0],N[1],N[2]); } /* N = 2*M (N-M = M) or 2*M+1 (N-M = M+1) 0 : 0 1 ..... M-1 B B+1 ... B+N-M-2 A 1 : C C+1 ... C+M-1 0 1 .... N-M-2 N-M-1 */ def eosub(A,B,C,N) { M = N%2; P = []; Q = []; P = cons(A,P); for(I = 0; I < N-M-1; I++) P = cons(B+I,P); for(I = 0; I < M; I++) Q = cons(C+I,Q); P = okubo3e(P,Q,s); C = newvect(2); L = newvect(2); C[1] = chkexp(P,[x,dx],0,b,N-M-1); C[0] = chkexp(P,[x,dx],1,c,M); for(LL = K = 0; K < 2; K++){ L[K] = length(C[K]); C[K] = ltov(C[K]); if(L[K] > LL) LL = L[K]; } JJ = 0; for(I = 1; Do; I++){ Do = 0; S = makev(["r",I]); for(J = JJ; J < LL; J++){ JJ = LL; for(K = 0; K < 2; K++){ if(J >= L[K] || C[K][J] == 0) continue; if(J < JJ) JJ = J; if(Do == 1){ CC = C[K]; CC[J] = mysubst(CC[J], [S, Var]); continue; } if(mydeg(C[K][J]) >= 1){ if(mydeg(C[K][J]) > 1){ print("Internal error"); return; } Var = getroot(C[K][J],S); Var = Var[0]; CC = C[K]; CC[J] = 0; P = mysubst(P, [S, Var]); Do = 1; J = JJ - 1; K++; } } } } if(JJ != L){ print("Internal error (non Rigid)"); return; } return P; } def even4e(X,Y){ if(length(X) != 4 || length(Y) != 2){ print("Usage: even4e([a,b,c,d],[e,f])"); print("0: 0 1 e f"); print("1; 0 1 * *+1"); print("infty: a b c d"); return; } S = -3; for(I = 0; I < 4; I++){ S += X[I]; if(I < 2) S += Y[I]; } S = -S/2; P = okubo3e(Y,[S,"?"],X); T = chkexp(P,x,1,S,2); T = getroot(T[0],r1); return mysubst(P,[r1,T[0]]); } def odd5e(X,Y) { if(length(X) != 5 || length(Y) != 2){ print("Usage: spec6e([a,b,c,d,e],[f,g])"); print("0: 0 1 f g g+1"); print("1: 0 1 2 * *+1"); print("infty: a b c d e"); return; } S = -4; for(I = 0; I < 5; I++){ S += X[I]; if(I < 2) S += Y[I]; } S = -(S + Y[1])/2; P = okubo3e([Y[0],Y[1],Y[1]+1],[S,"?"],X); T = chkexp(P,x,1,S,2); T = getroot(T[0],r1); P = mysubst(P,[r1,T[0]]); T = chkexp(P,x,0,Y[1],2); T = getroot(T[0],r2); return mysubst(P,[r2,T[0]]); } def extra6e(X,Y) { if(length(X) != 6 || length(Y) != 2){ print("Usage: extra6e([a,b,c,d,e,f],[g,h])"); print("0: 0 1 g g+1 h h+1"); print("1: 0 1 2 3 * *+1"); print("infty: a b c d e f"); return; } S = -5; for(I = 0; I < 6; I++){ S += X[I]; if(I < 2) S += 2*Y[I]; } S = -S/2; P = okubo3e([Y[0],Y[0]+1,Y[1],Y[1]+1],[S,"?"],X); T = chkexp(P,x,1,S,2); T = getroot(T[0],r1); P = mysubst(P,[r1,T[0]]); T = chkexp(P,x,0,Y[0],2); T = getroot(T[0],r3); P = mysubst(P,[r3,T[0]]); T = chkexp(P,x,0,Y[1],2); T = getroot(T[0],r2); return mysubst(P,[r2,T[0]]); } def rigid211(X,Y,Z) { if(length(X) != 2 || length(Y) != 2 || length(Z) != 2){ print("Usage: rigid211([a,b],[c,d],[e,f])"); print("0: 0 1 a b"); print("1: 0 1 c d"); print("infty: e e+1 f *"); return; } P = okubo3e(X,Y,[Z[0],Z[0]+1,Z[1],"?"]); T = chkexp(P,x,"infty",Z[0],2); T = getroot(T[0],r1); return mysubst(P,[r1,T[0]]); } def solpokuboe(P,L,N) { if(type(N) > 1 || ntype(N) != 0 || dn(N) != 1){ mycat(["Irrigal argument :", N]); return 0; } L = vweyl(L); DD=N+1; for(U = S = L[0]^N; U != 0; ){ D = mydeg(U,L[0]); if(D>=DD){ mycat(["Internal Error",D,DD]); return -1; } DD=D; UU = L[0]^D; R = appldo(P,UU,L); if(mydeg(R,L[0]) > D){ printf("Bad operator\n"); return 0; } CC = mycoef(R,D,L[0]); if(D == N){ P -= (E = CC); U = R-E*U; continue; } if(CC == 0){ printf("No polynomial\n"); return 0; } CC= mycoef(U,D,L[0])/CC; S = red(S - UU*CC); U = red(U - R*CC); } return [nm(S),E]; } def stoe(M,L,N) { L = vweyl(L); Size = size(M); S = Size[0]; NN = 0; if(type(N) == 4){ NN=N[0]; N=N[1]; }else if(N < 0){ NN=-N; N=0; } if(S != Size[1] || N >= S || NN >= S) return; D = newmat(S+1,S+1); MN = dupmat(M); MD = newmat(S,S); DD = D[0]; DD[N] = 1; DD[S] = 1; for(Lcm = I = 1; ; ){ DD = D[I]; MM = MN[N]; for(J = 0; J < S; J++){ DD[J] = MM[J]; Lcm = lcm(dn(DD[J]),Lcm); } DD[S] = L[1]^I; for(J = 0; J <= S; J++) DD[J] = red(DD[J]*Lcm); if(I++ >= S) break; if(I==S && NN>0){ DD = D[I]; DD[0]=-z_zz; DD[NN]=1; break; } Mm = dupmat(MN*M); for(J = 0; J < S; J++){ for(K = 0; K < S; K++) MN[J][K] = red(diff(MN[J][K],L[0])+Mm[J][K]); } } #if 0 P = fctr(mydet2(D)); #else P = fctr(det(D)); #endif for(I = R = 1; I < length(P); I++){ if(mydeg(P[I][0],L[1]) > 0) R *= P[I][0]^P[I][1]; } if(NN > 0) R = -red(coef(R,0,z_zz)/coef(R,1,z_zz)); return R; } def dform(L,X) { if(type(X)==2) X=[X]; if(type(L[0])!=4) L=[L]; if(type(X)==4) X=ltov(X); M=length(X); if(length(car(L))==2){ R=newvect(M); for(LL=L; LL!=[]; LL=cdr(LL)){ for(I=0; I=0; I--){ if(Dif==1) RR=cons([1,R[I],X[I]],RR); else RR=cons([R[I],X[I]],RR); } if(Dif==1) RR=dform(RR,X); return RR; }else if(length(car(L))!=3) return L; N=M*(M-1)/2; R=newvect(N); S=newvect(N); for(LL=L; LL!=[]; LL=cdr(LL)){ for(I=K=0; I=0; I--) RR=cons([R[I],S[I][0],S[I][1]],RR); return RR; } def polinvsym(P,Q,Sym) { N = length(Q); T = polbyroot(Q,zz); for(I = 1; I <= N; I++){ P = mysubst(P,[makev([Sym,I]), (-1)^I*coef(T,N-I,zz)]); } return P; } def polinsym(P,Q,Sym) { if(type(P) == 3){ P = red(P); if(type(P) == 3){ D = polinsym(dn(P),Q,Sym); if(D == 0) return 0; return polinsym(nm(P),Q,Sym)/D; } } N = length(Q); V = newvect(N+1); S = newvect(N+1); E = newvect(N+1); E0 = newvect(N+1); T = polbyroot(Q,zzz); for(J = 1; J <= N; J++){ K = coef(T,N-J,zzz); if(J % 2) K = -K; S[J] = K; V[J] = makev([Sym,J]); } K = deg(P,Q[0]); for(J = 0; J <= N; J++) E0[J] = K+1; E[0] = K+1; while(deg(P,Q[0]) > 0){ for(P0 = P, J = 1; J <= N; J++){ E[J] = deg(P0,Q[J-1]); P0 = coef(P0,E[J],Q[J-1]); } /* P0*Q[0]^E[1]*Q[1]^E[2]*... E[1] >= E[2} >= ... */ for(J = 1; J <= N; J++){ if(E[J] < E0[J]) break; if(E[J-1] < E[J]) J = N; } if(J > N){ print("Not symmetric"); return 0; } for(J = 1; J <= N; J++) E0[J] = E[J]; for(J = N; J > 1; J--){ if(E[J] != 0) for(K = 1; K < J; K++) E[K] -= E[J]; } for(R0 = P0, K = 1; K <= N; K++){ if(E[K] > 0) P0 *= S[K]^E[K]; R0 *= V[K]^E[K]; } P += R0 - P0; } return P; } def tohomog(P,L,V) { while(length(L)>0){ P = mysubst(P,[car(L),car(L)/V]); L = cdr(L); } P = red(P); N = mindeg(dn(P),V); if(N > 0) P = red(P*V^N); N = mindeg(dn(P),V); if(N > 0) P = red(P/(V^N)); return P; } def substblock(P,X,Q,Y) { P = red(P); if(deg(dn(P),X) > 0) return substblock(nm(P),X,Q,Y)/substblock(dn(P),X,Q,Y); N = mydeg(Q,X); if(N < 1) return P; R = mycoef(Q,N,X); while(M = mydeg(P,X), M >= N) P = red(P - mycoef(P,M,X)*(Q-Y)*X^(M-N)/R); return P; } def okuboetos(P,L) { L = vweyl(L); X = L[0]; DX = L[1]; N = mydeg(P,DX); C = mycoef(P,N,DX); K = mydeg(C,X); if(K > N){ print("Irregular singularity at infinity")$ return 0; } if(N > K) P *= x^(N-K); L = getroot(mycoef(P,N,DX),x); L = ltov(reverse(L)); if(length(L) != N || N == 0){ print("Cannot get exponents")$ return 0; } if( type(LL = getopt(diag)) == 4 ){ LL = ltov(LL); if(length(LL) != N){ mycat(["Length of the option should be", N]); return 0; } Tmp = newvect(N); for(I = N-1; I >= 0; I--){ for(LLT = LL[I], J = N-1; J >=0 ; J--){ if(LLT == L[J] && Tmp[J] == 0){ Tmp[J] = 1; break; } } if(J < 0){ print("option is wrong"); return 0; } } L = LL; } P /= mycoef(C,N,X); A = newmat(N,N); AT = newmat(N+1,N+1); Phi= newvect(N+1); Phi[0] = 1; for(J = 0; J < N; J++) Phi[J+1] = Phi[J]*(X-L[J]); for(ATT = AT[N], J = 0; J < N; J++) ATT[J] = mycoef(P,J,DX); for(K = 1; K <= N; K++){ for(J = N; J >= K; J--){ Aj = A[J-1]; SIG = AT[J][J-K]; for(I = 0; I <= K-2; I++) SIG += Aj[J-I-1]*AT[J-I-1][J-K]; if(K == 1) DAT = mydiff(Phi[J-1],X); else DAT = mydiff(AT[J-1][J-K],X); Aj[J-K] = -SIG+(X-L[J-1])*DAT; Aj[J-K] /= Phi[J-K]; Aj[J-K] = mysubst(Aj[J-K],[X,L[J-1]]); if(J < K+1) continue; ATj = AT[J-1]; ATj[J-K-1] = SIG+Aj[J-K]*Phi[J-K]; ATj[J-K-1] /= (X - L[J-1]); ATj[J-K-1] = red(ATj[J-K-1]-DAT); } } ATT = newmat(N,N); for(J = 0; J < N; J++){ for(K = 0; K < N; K++){ ATj = ATT[J]; ATj[K] = AT[J][K]; } ATj[J] = Phi[J]; if(J < N-1){ ATj = A[J]; ATj[J+1] = 1; } } return [L,A,ATT]; } def heun(X,P,R) { if(type(X) != 4 || length(X) != 5){ print("Usage: huen([a,b,c,d,e],p,r)"); print("0: 0 c"); print("1: 0 d"); print("p: 0 e"); print("infty: a b"); print("Fuchs relation: a+b+1 = c+d+e"); return; } S = 1; V = -1; X = ltov(X); for(I = 0; I < 5; I++){ if(X[I] == "?"){ if(V >= 0) return; V = I; }else if(I < 2){ S += X[I]; }else S -= X[I]; } if(V >= 0){ if(V < 2) X[V] = -S; else X[V] = S; }else if(S != 0){ mycat(["Fuch relation:", S,"should be zero!"]); return; } return x*(x-1)*(x-P)*dx^2 + (X[2]*(x-1)*(x-P)+X[3]*x*(x-P)+X[4]*x*(x-1))*dx + X[0]*X[1]*(x-R); } def fspt(M,T) { if(type(M)==7) M=s2sp(M); if(T == 3) /* 3: cut 0 */ return cutgrs(M); if(T == 4 || T== 5){ /* 4: short 5: long */ for(MN = [] ; M != []; M = cdr(M)){ MT = car(M); for(MNT = []; MT != []; MT = cdr(MT)){ if(type(car(MT)) <= 3){ if(T == 4) MNT = cons(car(MT),MNT); else MNT = cons([1,car(MT)],MNT); }else{ if(T == 5 || car(MT)[0] > 1) MNT = cons(car(MT),MNT); else if(car(MT)[0] == 1) MNT = cons(car(MT)[1],MNT); } } MN = cons(reverse(MNT), MN); } return reverse(MN); } if(type(M[0][0]) == 4){ for(MN = [] ; M != []; M = cdr(M)){ MT = car(M); for(MNT = []; MT != []; MT = cdr(MT)) MNT = cons(car(MT)[0], MNT); MN = cons(reverse(MNT), MN); } return fspt(reverse(MN),T); } if(T == 0) /* 0: sp */ return M; for(MN = [] ; M != []; M = cdr(M)){ MT = qsort(ltov(car(M))); L = length(MT); for(MNT = [], I = 0; I < L; I++) MNT = cons(MT[I], MNT); MN = cons(MNT, MN); } MN = reverse(MN); if(T==6) return MN; /* 7: sort */ L = length(MN); for(M = MN; M != []; M = cdr(M)){ for(I = 0, MT = car(M); MT != []; MT = cdr(MT)) I += car(MT); if(OD == 0) OD = I; else if(OD != I || OD == 0) return 0; } ALL = [MN]; RD=[]; while(OD > 0){ for(S = 0, MT = MN; MT != []; MT = cdr(MT)) S += car(MT)[0]; S -= (L-2)*OD; if(S <= 0){ if(T==7) return [ALL[0],ALL[length(ALL)-1],RD]; return (T==1)?MN:ALL; } RD=cons([S,0,0],RD); for(NP=0, M = [], MT = MN; MT != []; NP++, MT = cdr(MT)){ MTT = car(MT); I = MTT[0] - S; if(I < 0){ if(I+OD!=0) return 0; if(T==7) return [ALL[0],ALL[length(ALL)-1],cdr(RD)]; return (T==1)?MN:ALL; } MTT = cdr(MTT); NC=1; DO=0; for(MNT = []; MTT != []; MTT = cdr(MTT)){ if(MTT[0] > I){ if(DO==0) RD=cons([MTT[0]-I,NP,NC++],RD); MNT = cons(MTT[0], MNT); } else if(MTT[0] <= I && I != 0){ DO=1; MNT = cons(I, MNT); I = 0; if(MTT[0] > 0) MNT = cons(MTT[0], MNT); } } if(I > 0) MNT = cons(I,MNT); M = cons(reverse(MNT), M); } MN = reverse(M); ALL = cons(MN,ALL); OD -= S; } } def abs(X) { if(vars(X)!=[]) return todf(os_md.abs,[X]); if(type(X)==4){ P=X[1];X=X[0]; }else P=0; if(type(X)==1){ if((T=ntype(X))<2 || T==3){ if(X<0) X=-X; }else if(T==4) X=P?pari(abs,X,P):pari(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||type(X)==7){ if(type(L)==4||type(L)==7){ V=L[1]; if(type(X)!=7){ 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; } if((L0=L[0])==">") 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&&type(X)<4){ if(L=="neg") X=-X; else if(L=="abs") X=abs(X); else if(L=="neg") X=-X; else if(L=="sqr") X*=X; else if(L=="inv") X=1/X; else if(L=="sgn"){ if(X>0)X=1; else if(X<0) X=-1; } } } return X; } def isint(X) { if(X==0||(type(X)==1 && ntype(X)==0 && dn(X)==1)) return 1; return 0; } def israt(X) { if(X==0||(type(X)==1 && ntype(X)==0)) return 1; return 0; } def iscrat(X) { if(X==0 || (type(X)==1 && israt(real(X)) && israt(imag(X)))) return 1; return 0; } def isalpha(X) { return ((X>64&&X<91)||(X>96&&X<123))?1:0; } def isnum(X) { return (X>47&&X<58)?1:0; } def isalphanum(X) { return (isalpha(X)||isnum(X))?1:0; } def isdecimal(X) { if(type(X)!=7) return 0; F=S=0; L=strtoascii(X); while(L!=[]&&car(L)==32) L=cdr(L); if(L!=[]&&car(L)==45) L=cdr(L); /* - */ while(L!=[]&&isnum(car(L))){ F=1; L=cdr(L); } while(L!=[]&&car(L)<33){ S=1;L=cdr(L); } if(L==[]) return F; else if(S||car(L)!=46) return 0; /* . */ L=cdr(L);F=0; while(L!=[]&&isnum(car(L))){ F=1; L=cdr(L); } while(L!=[]&&car(L)<33) L=cdr(L); return (L==[])?F:0; } def isvar(X) { return ([X]==vars(X)&&vtype(X)<3)?1:0; } def isyes(F) { if((CC=getopt(set))==1){ IsYes=(type(F[0])==4)?F:[F]; return 1; }else if(CC==0) return(IsYes); if(type(CC)!=7) CC=IsYes; for(;CC!=[]; CC=cdr(CC)){ C=car(CC); V=call(C[0],cons(F,C[1])); if(type(C[2])!=4){ if(V!=C[2]) break; }else{ if(C[2][0]!="" && VC[2][1]) break; } } return (CC==[])?1:0; } def isall(FN,M) { if(type(M)<4 || type(M)>6) return ((*FN)(M)==0)?0:1; if(type(M)==4){ for(;M!=[];M=cdr(M)) if((*FN)(car(M))==0) return 0; }else if(type(M)==5){ K=length(M); for(I=0;I0){ if(type(MP)==7) M=s2sp(MP); else M=chkspt(MP|opt=0); if(I==length(M[0])){ N=s2sp(T);S=SM=SN=K=0; for(MM=M,NN=N;MM!=[];MM=cdr(MM),NN=cdr(NN),K++){ for(MT=car(MM),NT=car(NN);MT!=[];MT=cdr(MT),NT=cdr(NT)){ S+=car(MT)*car(NT); if(K==0){ SM+=car(MT);SN+=car(NT); } } } return S-(length(M)-2)*SM*SN; } } MM=chkspt(MP|opt=7); if(T=="base") return MM; Keep=(getopt(keep)==1)?1:0; Null=getopt(null); Only=getopt(only); if(type(Only)!=1) Only=7; M0=MM[0]; M1=MM[1]; M=MM[2]; if(T=="length") return length(M); if(T=="height"){ for(J=2,S=M1[0][0],M2=M1; M2!=[]; M2=cdr(M2)){ for(MT=cdr(car(M2)); MT!=[]; J++, MT=cdr(MT)){ S+= J*car(MT); } J=1; } return S; } for(OD=0, MT=M1[0]; MT!=[]; MT=cdr(MT)) OD+=car(MT); if(T=="type"){ R=newvect(OD+1); for(MT=M; MT!=[]; MT=cdr(MT)) R[MT[0][0]]++; for(RR=[],I=OD; I>0; I--) if(R[I]>0) RR=cons([R[I],I],RR); return RR; } if(T=="part"||T=="pair"||T=="pairs"){ NP=length(M1); LM=newvect(NP); R=newvect(length(M)); for(K=0; K0 && iand(Only,1)==0) continue; if(Q==0 && iand(Only,2)==0) continue; if(Q<0 && iand(Only,4)==0) continue; for(K=0; K0) str_tb("\\\\\n &=",Out); if(T=="pairs"){ if((S=SS[I])<0) S=-S; if(S>1) str_tb([my_tex_form(S),"("],Out); str_tb(s2sp(car(U)),Out); if(S>1) str_tb(")",Out); str_tb(" \\oplus ",Out); if(SS[I]<0){ #ifdef USEMODULE str_tb(["-(",s2sp(mtransbys(os_md.abs,car(R)[1],[])),")"],Out); #else str_tb(["-(",s2sp(mtransbys(abs,car(R)[1],[])),")"],Out); #endif }else str_tb(s2sp(car(R)[1]),Out); }else str_tb([s2sp(car(R)[0])," \\oplus ",s2sp(car(R)[1])],Out); } str_tb("\n\\end{split}\\end{align}",Out); dviout(str_tb(0,Out)|keep=Keep); } return RR; } for(I=0; I1){ 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); } } close_file(Id); }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]; } if(St!=1){ for(R=[]; B!=[]; B=cdr(B)){ RT=F?s2sp(car(B)|std=F):s2sp(car(B)); if(length(RT)L1) continue; R=cons(RT,R); } return reverse(R); }else{ if(L0<=3 && L1>=MO+4) return B; for(R=[]; B!=[]; B=cdr(B)){ RT=s2sp(T=car(B)); if(length(RT)L1) continue; if(F) T=s2sp(s2sp(T|std=K)); R=cons(T,R); } return reverse(R); } } MP=(L1MO) return 0; LL[R[1]]=R; K=R[1]; } if(K==1||type(Sp)!=4){ LL[1]=[[[1]]]; for(I=2; I<=MO && I=II){ if(S=I){ V=newvect(I); RRR=[]; for(;J>=0;J--){ if(J>=II) RR=[OD,S]; else{ K=length(R[J]); RR=[S+((K==0)?0:car(R[J]))]; K=length(R0[J])-K; for(RT=R0[J]; RT!=[]; K--,RT=cdr(RT)){ if(K!=0) RR=cons(car(RT),RR); } } RRR=cons(reverse(RR),RRR); } RRR=qsort(reverse(RRR)); if(findin(RRR,LL[S+OD])<0) LL[S+OD]=cons(RRR,LL[S+OD]); } } for(K=0; K=II) break; } } } if(L0>0 || L1L1) continue; if(F) T=s2sp(T|std=F); RT=cons((St==1)?s2sp(T):T,RT); } LL[J] = reverse(RT); } } if(Eq==1) return LL[MO]; return LL; } def spType2(L) { C=0;R=[]; for(LT=L;LT!=[];LT=cdr(LT)){ D=-1;LP=car(LT); for(LPT=LP;LPT!=[];LPT=cdr(LPT)){ if(D==-1) D=car(LPT); else D=igcd(D,car(LPT)); if(D==1){ C++;break; } } if(C==2) return 0; R=cons(D,R); } if(C==0) return L; if(C==1){ for(K=length(R)-1;R[K]!=1;K--); D=-1; for(I=length(R)-1;I>=0;I--){ if(I==K) continue; if(D==-1) D=R[I]; else D=igcd(D,R[I]); if(D==1) return 0; } } return L; } /* ret [#points, order, idx, Fuchs, reduction order, reduction exponents, fund] */ def chkspt(M) { Opt= getopt(opt); Mat= getopt(mat); if(type(M)==7) M=s2sp(M); if(type(Opt) >= 0){ if(type(Opt) == 7) Opt = findin(Opt, ["sp","basic","construct","strip","short","long","sort","root"]); if(Opt < 0){ erno(2); return 0; } return fspt(M,Opt); } MR = fspt(M,1); P = length(M); OD = -1; XM = newvect(P); Fu = 0; for( I = SM = SSM = 0; I < P; I++ ){ LJ = length(M[I]); JM = JMV = 0; for(J = SM = 0; J < LJ; J++){ MV = M[I][J]; if(type(MV) == 4){ Fu += MV[0]*MV[1]; MV = MV[0]; } if(MV > JMV){ JM = J; JMV = MV; } SM += MV; SSM += MV^2; } if(OD < 0) OD = SM; else if(OD != SM){ print("irregal partitions"); return 0; } XM[I] = JM; } SSM -= (P-2)*OD^2; for(I = SM = JM = 0; I < P; I++){ MV = M[I][XM[I]]; if(type(MV) == 4){ MV = MV[0]; JM = 1; } if(I == 0) SMM = MV; else if(SMM > MV) SMM = MV; SM += MV; } SM -= (P-2)*OD; if(SM > SMM && SM != 2*OD){ print("not realizable"); return -1; } if(JM==1 && Mat!=1) Fu -= OD - SSM/2; return [P, OD, SSM, Fu, SM, XM, MR]; } def cterm(P) { V = getopt(var); if(type(V) != 4) V=vars(P); for(; V !=[]; V = cdr(V)) P = mycoef(P,0,car(V)); return P; } def terms(P,L) { Lv=getopt(level); if(type(Lv)!=1) Lv=0; V=car(L);L=cdr(L); for(R=[],D=mydeg(P,V);D>=0; D--){ if((Q=mycoef(P,D,V))==0) continue; if(L!=[]){ R0=terms(Q,L|level=Lv+1); for(;R0!=[];R0=cdr(R0)) R=cons(cons(D,car(R0)),R); }else R=cons([D],R); } if(Lv>0) return R; R=qsort(R); Rev = getopt(rev); Dic=getopt(dic); if(Dic==1 && Rev==1) R=reverse(R); for(R0=[];R!=[];R=cdr(R)){ for(RT=car(R),S=0;RT!=[];RT=cdr(RT)) S+=car(RT); R0=cons(cons(S,car(R)),R0); } if(Dic==1) return R0; if(Rev==1){ for(R=[];R0!=[];R0=cdr(R0)){ T=car(R0); R=cons(cons(-car(T),cdr(T)),R); } R0=R; } R0=qsort(R0); if(Rev==1){ for(R=[];R0!=[];R0=cdr(R0)){ T=car(R0); R=cons(cons(-car(T),cdr(T)),R); } R0=R; } return (Rev==1)?R0:reverse(R0); } def polcut(P,N,L) { if(type(L)==2) L=[L]; M=getopt(top); if(type(M)!=1) M=0; T=terms(P,L); for(S=0;T!=[];T=cdr(T)){ LT=car(T); if(LT[0]N) continue; for(PW=1,LT=cdr(LT),V=L,Q=P;LT!=[];LT=cdr(LT),V=cdr(V)){ Q=mycoef(Q,car(LT),car(V));PW*=car(V)^car(LT); } S+=Q*PW; } return S; } def redgrs(M) { Mat = getopt(mat); if(Mat!=1) Mat=0; R = chkspt(M|mat=Mat); if(type(R) < 4) return -1; if(R[4] <= 0) return 1-R[4]; if(R[4] == 2*R[1]) return 0; V = newvect(R[0]); Type = type(M[0][0]); if(Type > 3){ Mu = Mat-1; for(I = 0; I < R[0]; I++) Mu += M[I][R[5][I]][1]; } for(I = 0; I < R[0]; I++){ IR = R[5][I]; L = []; MI = M[I]; MIE=MI[IR]; for(J = length(MI)-1; J >= 0; J--){ if(Type <= 3){ VM = MI[J]; if(J == IR){ VM -= R[4]; if(VM < 0) return -1; } L = cons(VM, L); }else{ VM = MI[J][0]; if(J == IR){ VM -= R[4]; if(VM < 0) return -1; if(I == 0) EV = 1-Mat-Mu; else EV = 0; }else{ if(I == 0) EV = MI[J][1] - M[0][R[5][0]][1] + 1-Mat; /* + MX - Mu; */ else EV = MI[J][1] - MIE[1] + Mu; } L = cons([VM,EV], L); /* if(R[2] >= 2){ */ /* digid */ /* P = dx^(R[1]); } */ } } V[I] = L; } return [R[5], vtol(V)]; } def cutgrs(A) { for(AL=[] ; A!=[]; A=cdr(A)){ /* AT: level 2 */ for(ALT=[], AT=car(A); AT!=[]; AT=cdr(AT)){ M = (type(car(AT)) < 4)?car(AT):car(AT)[0]; if(M > 0) ALT = cons(car(AT), ALT); /* ALT: level 2 */ } AL = cons(reverse(ALT), AL); /* AL: level 3 */ } return reverse(AL); } def mcgrs(G, R) { NP = length(G); Mat = (getopt(mat)==1)?0:1; 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) S += 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; continue; } VP = newvect(L+1); GV = ltov(G); 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++){ if(I == 0) OD += car(GT)[0]; if(car(GT)[1] == RTT && car(GT)[0] > M){ S += car(GT)[0]-M; 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); } GN = cons(reverse(GTN), GN); } } G = cutgrs(GN); } return G; } /* F=0 : unify F=["add",S] : F=["sub",S] : F=["+",A,B] : F=["*",A,B] : F=["mul",K]; F=["get",F,V] : F=["put",F,V] : F=["get1",F,V] : F=["put1",F,V] : F=["put1"] : F=["val",F]; F=["swap"]; */ def anal2sp(R,F) { if(type(F)==4&&type(F[0])==4){ /* multiple commands */ for(;F!=[];F=cdr(F)) R=anal2sp(R,car(F)); return R; } if(type(F)==7) F=[F]; if(F==0){ /* unify */ R=ltov(R); L=length(R); for(J=1;J=0;I--) if(R[I][0]!=0) G=cons(R[I],G); if(length(G[0])==2){ /* sort by multiplicity */ R=ltov(G); L=length(R); for(I=1;I0;J--){ if(R[J-1][0]>R[J][0]) break; if(R[J-1][0]==R[J][0]){ S1=rtostr(R[J-1][1]);S2=rtostr(R[J][1]); if((K=str_len(S1)-str_len(S2))<0) break; if(!K&&S1=0;I--){ V=lsort([0,1,2,3,4],[I],1); for(J=1;J<4;J++){ for(T=[],K=3;K>0;K--) if(K!=J) T=cons(V[K],T); G=cons([[[V[0],V[J]],T],[1,0,0]],G); } } G=mc2grs(G,"sort"); }else if(type(G)==7||(type(G)==4&&length(G)==4)){ if(type(G)==7) G=s2sp(G); F=(getopt(top)==0)?1:0; K=[]; if(type(P)==1&&iand(P,1)&&type(G[0][0])<4){ G=s2sp(G|std=1); if(F) G=[G[1],G[2],G[3],G[0]]; G=sp2grs(G,[d,c,b,a],[1,length(G[0]),-1]|mat=1); G=reverse(G); if(iand(P,3)==3){ V=vars(G); for(H=L=[a,b,c,d];H!=[];H=cdr(H)) if(findin(car(H),V)>=0) G=subst(G,car(H),makev([car(H),1])); G=shortv(G,[a,b,c,d]); V=vars(G); for(H=G[3];H!=[];H=cdr(H)){ T=car(H)[1]; if(type(T)>1&&!isvar(T)){ K=[car(H)[0],T]; break; } } } F=1; } if(F) G=[G[3],G[0],G[1],G[2]]; S=cons(["anal",1],getopt()); if(!(R=m2mc(G,0|option_list=S))) return R; for(G=0,R=cdr(R);R!=[];R=cdr(R)){ TR=car(R)[0]; if(TR[0]) G=mc2grs(G,[[TR[0]]]); G=mc2grs(G,[cdr(TR)]); } if(type(P)==1&&K!=[]){ for(T=10;T<36;T++){ if(findin(X=makev([T]),V)>=0) continue; F=K[0]*(X-K[1]); return [F,simplify(G,[F],4)]; } } } if(type(P)<2) return G; F=0; if(type(P)==7||(type(P)==4&&type(P[0])<4)) P=[P]; if((Dvi=getopt(dviout))!=1&&Dvi!=2&&Dvi!=-1) Dvi=0; Keep=(Dvi==2)?1:0; if(type(P)==4&&type(F=car(P))==7){ if(F=="mult"){ for(P=cdr(P);P!=[];P=cdr(P)) G=mc2grs(G,car(P)|option_list=getopt()); return G; } if(F=="show"){ for(R=str_tb(0,0);G!=[];){ L=car(G); I=L[0][0];J=L[0][1]; str_tb("[A_{"+rtostr(I[0])+rtostr(I[1])+"}:A_{"+rtostr(J[0])+rtostr(J[1]) +"}]&=\\left\\{",R); for(L=cdr(L);;){ S=car(L); str_tb("["+my_tex_form(S[1])+":"+my_tex_form(S[2])+"]",R); if(S[0]!=1) str_tb("_{"+rtostr(S[0])+"}",R); if((L=cdr(L))==[]) break; str_tb(",\\,",R); } str_tb("\\right\\}",R); if((G=cdr(G))==[]) break; str_tb(",\\\\\n",R); } R=texbegin("align*",str_tb(0,R)); if(Dvi!=-1) dviout(R|keep=Keep); return R; } if(F=="show0"){ 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]); if(Dvi){ if(S!="") S=S+","; for(I=J=0,T=append(TL,[[0]]);T!=[];T=cdr(T)){ if(car(T)==I) J++; else{ if(I>0&&J>0){ if(I>9) S=S+"("+rtostr(I)+")"; else S=S+rtostr(I); if(J>1){ if(J>9) S=S+"^{"+rtostr(J)+"}"; else S=S+"^"+rtostr(J); } } I=car(T);J=1; } } } L=cons(TL,L); } if(Dvi){ if(Dvi!=-1) dviout(S|eq=0); return S; } return reverse(L); } if(F=="sort"){ G=ltov(G);L=length(G); for(I=0;IS[0][1]) S=[[S[0][1],S[0][0]],S[1]]; if(S[1][0]>S[1][1]) S=[S[0],[S[1][1],S[1][0]]]; if(S[0]>S[1]){ F=0;S=[S[1],S[0]]; } if(S!=G[I][0]){ if(F==0) G[I]=cons(S,anal2sp(cdr(G[I]),"swap")); else G[I]=cons(S,cdr(G[I])); } for(J=I;J>0;J--){ if(G[J-1][0]=0;I--){ for(J=4;J>I;J--) L=cons(mc2grs(G,[F,[I,J]]),L); } }else{ for(I=P[1],J=4;J>=0;J--){ if(I==J) continue; L=cons(mc2grs(G,[F,(I0) dviout(L|eq=0,keep=Keep); } return L; /* get all spct */ } if(type(T=P[1])==4){ if(F=="get0"&&length(P)==3&&type(I=P[1])==4&&type(J=P[2])==4){ if(I[0]>I[1]) I=[I[1],I[0]]; if(J[0]>J[1]) J=[J[1],J[0]]; 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]]); 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"); if(findin(4,S)<0) D=-D; J=sp2grs(G,["get0",[I,S]]); if(I[0]>S[0]) J=sp2grs(J,"swap"); return anal2sp(J,[["+",0,D],["*",-1,1]]); } if(type(car(T))==4){ if(T[0][0]>T[0][1]) T=[[T[0][1],T[0][0]],T[1]]; if(T[1][0]>T[1][1]) T=[T[0],[T[1][1],T[1][0]]]; if(T[0][0]>T[1][0]) T=[T[1],T[0]]; for(PG=G;PG!=[];PG=cdr(PG)) if(car(PG)[0]==T) return (F=="get")?car(PG):cdr(car(PG)); return []; /* get common spct */ } 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){ FT=1;break; } if(car(PG)[0][1]==T){ FT=2;break; } } if(!FT) return []; L=anal2sp(cdr(car(PG)),[["get1",FT],0]); return (F=="get")?cons(T,L):L; } } if(F=="deg"){ for(S=I=0;I<3;I++){ for(J=I+1;J<4;J++){ L=mc2grs(G,["get0",[I,J]]); L=anal2sp(L,"val"); S+=L[1]; } } return S/L[0]; } if(F=="spct"){ G=mc2grs(G,"get"); M=newmat(5,5); for(;G!=[];G=cdr(G)){ GT=car(G);I=GT[0][0];J=GT[0][1]; for(S=0,L=[],GT=cdr(GT);GT!=[];GT=cdr(GT)){ L=cons(car(GT)[0],L); } L=reverse(qsort(L)); M[I][J]=M[J][I]=L; } for(D=0,GT=M[0][1];GT!=[];GT=cdr(GT)) D+=car(GT); for(I=0;I<5;I++){ S=-2*D^2; for(J=0;J<5;J++){ if(I==J) continue; for(L=M[I][J];L!=[];L=cdr(L)) S+=car(L)^2; } M[I][I]=S; } if(Dvi){ S=[]; for(I=4;I>=0;I--){ L=[M[I][I]]; 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$"]); if(Dvi>0) dviout(M|keep=Keep); } return M; } if(F=="swap"||F=="perm"){ if(F=="perm") TR=P[1]; else{ TR=newvect(5,[0,1,2,3,4]); K=P[1][0];L=P[1][1]; TR[K]=L;TR[L]=K; if(TR[4]!=4) G=mc2grs(G,"deg"); } V=newvect(2); for(L=[],T=G;T!=[];T=cdr(T)){ TP=car(T)[0]; for(TQ=[],I=1;I>=0;I--){ V=[TR[TP[I][0]],TR[TP[I][1]]]; if(V[0]>V[1]) V=[V[1],V[0]]; TQ=cons(V,TQ); } if(TQ[0][0]T[1]) T=[T[1],T[0]]; T1=[T[0],4];T2=[T[1],4]; for(L=[],PG=reverse(G);PG!=[];PG=cdr(PG)){ R=car(PG);R0=R[0];F=0;K=P[0][1]; if(R0[0]==T) F=1; else if(R0[1]==T) F=2; else if(getopt(unique)!=1){ K=-K; if(R0[0]==T1||R0[0]==T2) F=1; else if(R0[1]==T1||R0[1]==T2) F=2; } if(F==0) L=cons(R,L); else{ R1=anal2sp(cdr(R),(F==1)?["+",K,0]:["+",0,K]); L=cons(cons(R0,R1),L); } } G=L; }else if(type(S[0])<4){ if(length(S)==1){ /* mc wrt0 4:cases */ U=mc2grs(G,"deg"); C=P[0][0]; L=[]; /* [[0,1],[2,3]] : [K=[0,k],J=[i,j]], S=[k,4] : 3 cases */ for(K=1;K<4;K++){ J=lsort([1,2,3],[K],1); K4=[K,4];K0=[0,K]; G0=mc2grs(G,["get0",[K0,J]]); LT=anal2sp(G0,["+",C,0]); G0=mc2grs(G,["get0",J]); L0=anal2sp(G0,["put1",1,0]); LT=anal2sp(LT,["add",L0]); G0=mc2grs(G,["get0",K4]); L0=anal2sp(G0,[["put1",1,0],["+",0,U]]); LT=anal2sp(LT,["add",L0]); G0=mc2grs(G,["get0",[[0,J[0]],K4]]); L0=anal2sp(G0,[["get",1,0],["+",0,U]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,J[1]],K4]]); L0=anal2sp(G0,[["get",1,0],["+",0,U]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[K0,J]]); L0=anal2sp(G0,[["get",1,0],["+",C,0]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,4],J]]); L0=anal2sp(G0,[["+",-C,0],["get",1,0]]); LT=anal2sp(LT,[["sub",L0],0]); L=cons(cons([K0,J],LT),L); } /* [[0,1],[2,4]] : [K,I]=[[0,k],[i,4]] S=[j,k] : 6 cases */ for(K=1;K<4;K++){ for(I=1;I<4;I++){ if(I==K) continue; for(J=1;J<4;J++) if(J!=I&&J!=K) break; I4=[I,4];S=(J0;K--){ J=lsort([1,2,3],[K],1); G0=mc2grs(G,["get0",[[0,4],J]]); LT=anal2sp(G0,["+",-C,0]); G0=mc2grs(G,["get0",J]); L0=anal2sp(G0,["put1",1,-C]); LT=anal2sp(LT,["add",L0]); G0=mc2grs(G,["get0",[K,4]]); L0=anal2sp(G0,[["put1",1,-C],["+",0,U]]); LT=anal2sp(LT,["add",L0]); G0=mc2grs(G,["get0",[[0,J[0]],[K,4]]]); L0=anal2sp(G0,[["get",1,0],["+",-C,U]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,J[1]],[K,4]]]); L0=anal2sp(G0,[["get",1,0],["+",-C,U]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,K],J]]); L0=anal2sp(G0,[["get",1,0],["+",-C,0]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,4],J]]); L0=anal2sp(G0,[["get",1,C],["put",1,0]]); LT=anal2sp(LT,[["sub",L0],0]); L=cons(cons([[0,4],J],LT),L); } /* [[1,2],[3,4]] : [J,K]=[[i,j],[k,4]] 3 cases */ for(K=3;K>0;K--){ J=lsort([1,2,3],[K],1); if(K>1) LT=mc2grs(G,["get0",[J,[K,4]]]); else{ LT=mc2grs(G,["get0",[[K,4],J]]); LT=anal2sp(LT,"swap"); } G0=mc2grs(G,["get0",J]); L0=anal2sp(G0,[["put1"],["+",0,-C-U]]); LT=anal2sp(LT,["add",L0]); G0=mc2grs(G,["get0",[K,4]]); L0=anal2sp(G0,[["put1"],["+",U,0]]); LT=anal2sp(LT,["add",L0]); G0=mc2grs(G,["get0",[[0,J[0]],[K,4]]]); L0=anal2sp(G0,[["get1",1,0],["put1"],["+",U,0]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,J[1]],[K,4]]]); L0=anal2sp(G0,[["get1",1,0],["put1"],["+",U,0]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,K],J]]); L0=anal2sp(G0,[["get1",1,0],["put1"],["+",0,-C-U]]); LT=anal2sp(LT,["sub",L0]); G0=mc2grs(G,["get0",[[0,4],J]]); L0=anal2sp(G0,[["get1",1,C],["put1"],["+",0,-C-U]]); LT=anal2sp(LT,[["sub",L0],0]); if(K==1){ LT=anal2sp(LT,"swap"); L=cons(cons([[K,4],J],LT),L); }else L=cons(cons([J,[K,4]],LT),L); } G=L; }else if(length(S)==2){ /* general mc */ if(S[1]!=0){ I=S[0]; if(I!=0) G=mc2grs(G,["swap",[0,I]]); G=mc2grs(G,[S[1]]); if(I!=0) G=mc2grs(G,["swap",[0,I]]); } }else if(length(S)==3||length(S)==4){ /* addition */ for(I=1;I<4;I++,S=cdr(S)) if(S[0]) G=mc2grs(G,[[[0,I],S[0]]]); if(length(S)==1 && S[0]) /* mc */ G=mc2grs(G,[S[0]]); } } } return mc2grs(G,"sort"); } def mcmgrs(G,P) { if(type(G)<2){ if(G>1){ N=G+2;G=[]; for(I=1;I<=N;I++){ for(J=1;J GRS */ G=s2sp(G|std=1); L=length(G); for(V=[],I=L-2;I>=0;I--) V=cons(makev([I+10]),V); V=cons(makev([L+9]),V); G=sp2grs(G,V,[1,length(G[0]),-1]|mat=1); if(getopt(short)!=0){ V=append(cdr(V),[V[0]]); G=shortv(G,V); } R=chkspt(G|mat=1); if(R[2] != 2 || R[3] != 0 || !(R=getbygrs(G,1|mat=1))) return 0; if(getopt(anal)==1) return R; /* called by mcmgrs() */ if(!(G=mcmgrs(L-2,0))) return 0; for(R=cdr(R);R!=[];R=cdr(R)){ TR=car(R)[0]; if(TR[0]) G=mcmgrs(G,[[TR[0]]]); G=mcmgrs(G,[cdr(TR)]); } } L=length(G); for(N=4;N<25;N++){ K=N^2*(N-1)/2; if(K>L) return 0; if(K==L) break; } if(type(P)<2) return G; F=0; if(type(P)==7||(type(P)==4&&type(P[0])<4)) P=[P]; if((Dvi=getopt(dviout))!=1&&Dvi!=2&&Dvi!=-1) Dvi=0; Keep=(Dvi==2)?1:0; if(type(P)==4 && type(F=car(P))==7){ if(F=="mult"){ for(P=cdr(P);P!=[];P=cdr(P)) G=os_md.mc2grs(G,car(P)|option_list=getopt()); return G; } if(F=="get"||F=="get0"){ if(Dvi!=0) F="get"; if(length(P)==2){ if(type(P[1])==4){ if(type(P[1][1])==4){ /* [[,],[,]] */ for(PG=reverse(G);PG!=[];PG=cdr(PG)){ TP=car(PG); if(TP[0]==P[1]) return (F=="get")?TP:cdr(TP); } return []; } if(P[1][0]==0){ if(length(P[1])==2){ /* [0,] */ for(J=1;J<=N;J++) if(J!=P[1][1]) break; for(K=J+1;K<=N;K++) if(K!=P[1][1]) break; L=mcmgrs(G,["get0",[P[1],[J,K]]]); L=anal2sp(L,["get1",1]); }else{ /* [0,*,*] */ L=mcmgrs(G,["get0",[[P[1][0],P[1][1]],P[1]]]); L=anal2sp(L,["get1",2]); } }else{ /* [,] */ for(J=1;J<=N;J++) if(J!=P[1][0]&&J!=P[1][1]) break; L=mcmgrs(G,["get0",[[0,J],P[1]]]); L=anal2sp(L,["get1",2]); } L=anal2sp(L,0); if(F=="get") L=cons(P[1],L); return L; }else{ /* I */ for(L=[],I=P[1],J=0;J<=N;J++){ if(I==J) continue; II=(I10) for(I=9;I0){ if(V!=[]) dviout(L|keep=Keep); else dviout(L|eq=0,keep=Keep); } }else L=reverse(L); return L; } if(F=="show"){ for(R=str_tb(0,0);G!=[];){ L=car(G); I=L[0][0];J=L[0][1]; str_tb("[A_{"+rtostr(I[0])+rtostr(I[1])+"}:A_{"+rtostr(J[0])+rtostr(J[1]),R); if(length(J)==3) str_tb(rtostr(J[2]),R); str_tb("}]&=\\left\\{",R); for(L=cdr(L);;){ S=car(L); str_tb("["+my_tex_form(S[1])+":"+my_tex_form(S[2])+"]",R); if(S[0]!=1) str_tb("_{"+rtostr(S[0])+"}",R); if((L=cdr(L))==[]) break; str_tb(",\\,",R); } str_tb("\\right\\}",R); if((G=cdr(G))==[]) break; str_tb(texcr(43),R); } R=texbegin("align*",str_tb(0,R)); if(Dvi!=-1) dviout(R|keep=Keep); return R; } if(F=="show0"){ for(C=N*(N-1)*(N-2)/2,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]); if(Dvi){ if(S!=""){ if(--C==0) S=S+";"; else S=S+","; } for(I=J=0,T=append(TL,[[0]]);T!=[];T=cdr(T)){ if(car(T)==I) J++; else{ if(I>0&&J>0){ if(I>9) S=S+"("+rtostr(I)+")"; else S=S+rtostr(I); if(J>1){ if(J>9) S=S+"^{"+rtostr(J)+"}"; else S=S+"^"+rtostr(J); } } I=car(T);J=1; } } } L=cons(TL,L); } if(Dvi){ if(Dvi!=-1) dviout(S|eq=0); return S; } return reverse(L); } if(F=="spct"){ G=mcmgrs(G,"get"); M=newmat(N+1,N+1); for(;G!=[];G=cdr(G)){ GT=car(G);I=GT[0][0];J=GT[0][1]; for(S=0,L=[],GT=cdr(GT);GT!=[];GT=cdr(GT)){ L=cons(car(GT)[0],L); } L=reverse(qsort(L)); M[I][J]=M[J][I]=L; } for(D=0,GT=M[0][1];GT!=[];GT=cdr(GT)) D+=car(GT); for(I=0;I<=N;I++){ S=-(N-2)*D^2; for(J=0;J<=N;J++){ if(I==J) continue; for(L=M[I][J];L!=[];L=cdr(L)) S+=car(L)^2; } M[I][I]=S; } if(Dvi){ S=[]; for(LS=[],I=N;I>=0;I--){ L=[M[I][I]]; for(J=N;J>=0;J--){ if(I==J) L=cons("",L); else L=cons(s2sp([M[I][J]]),L); } S=cons(L,S); LS=cons("$x_"+rtostr(I)+"$",LS); } S=cons(append(LS,["idx"]),S); M=ltotex(S|opt="tab",hline=[0,1,z],vline=[0,1,z-1,z],left=cons("",LS)); if(Dvi>0) dviout(M|keep=Keep); } return M; } if(F=="deg"){ for(S=I=0;IT[1]) T=[T[1],T[0]]; T1=[T[0],N];T2=[T[1],N]; T01=cons(0,T1);T02=cons(0,T2); for(PG=G;PG!=[];PG=cdr(PG)){ R=car(PG);R0=R[0];K1=K2=0; TP=R0[0]; if(TP==T) K1=K; else if(TP==T1||TP==T2) K1=-K; if(length(TP=R0[1])==2){ if(TP==T) K2=K; else if(TP==T1||TP==T2) K2=-K; }else{ S=0; if(findin(T[0],TP)>=0) S++; if(findin(T[1],TP)>=0) S++; if(S>0&&TP[2]==N) K2=-K; else if(S==2) K2=K; } R1=anal2sp(cdr(R),["+",K1,K2]); L=cons(cons(R0,R1),L); } G=reverse(L); } }else if(length(S)==1){ /* middle convolution */ C=S[0];L=[]; for(I=1;I<=N;I++){ for(J=1;J<=N;J++){ if(I==J) continue; for(K=J+1;K<=N;K++){ /* [[0,I],[J,K]] */ if(I==K)continue; T=[[0,I],JK=[J,K]]; if(I==N){ LT=mcmgrs(G,["get0",T]); G0=mcmgrs(G,["get0",JK]); L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); G0=mcmgrs(G,["get0",[0,J,K]]); LT=anal2sp(LT,["add",L0]); L0=anal2sp(G0,["put1",1,0]); LT=anal2sp(LT,["add",L0]); for(V=1;V<=N;V++){ if(V==I){ G0=mcmgrs(G,["get0",T]); L0=anal2sp(G0,["get",1,C]); }else if(V==J||V==K){ G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); L0=anal2sp(G0,["get",1,0]); }else{ G0=mcmgrs(G,["get0",[[0,V],JK]]); L0=anal2sp(G0,["get",1,0]); } LT=anal2sp(LT,["sub",L0]); } LT=anal2sp(LT,["+",-C,0]); }else if(K==N){ LT=mcmgrs(G,["get0",T]); LT=anal2sp(LT,["+",C,0]); G0=mcmgrs(G,["get0",JK]); L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); LT=anal2sp(LT,["add",L0]); G0=mcmgrs(G,["get0",[0,J,K]]); L0=anal2sp(G0,[["put1",1,0],["+",0,-C]]); LT=anal2sp(LT,["add",L0]); for(V=1;V<=N;V++){ if(V==I){ G0=mcmgrs(G,["get0",T]); L0=anal2sp(G0,[["get",1,0],["+",C,0]]); }else if(V==J){ G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); L0=anal2sp(G0,[["get",1,0],["+",0,-C]]); }else if(V==N){ G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); L0=anal2sp(G0,[["get",1,C],["+",-C,-C]]); }else{ G0=mcmgrs(G,["get0",[[0,V],JK]]); L0=anal2sp(G0,["get",1,0]); } LT=anal2sp(LT,["sub",L0]); } }else{ G0=mcmgrs(G,["get0",T]); LT=anal2sp(G0,["+",C,0]); G0=mcmgrs(G,["get0",JK]); L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]); LT=anal2sp(LT,["add",L0]); G0=mcmgrs(G,["get0",[0,J,K]]); L0=anal2sp(G0,["put1",1,0]); LT=anal2sp(LT,["add",L0]); for(V=1;V<=N;V++){ if(V==I){ G0=mcmgrs(G,["get0",T]); L0=anal2sp(G0,[["get",1,0],["+",C,0]]); }else if(V==J||V==K){ G0=mcmgrs(G,["get0",[[0,V],[0,J,K]]]); L0=anal2sp(G0,["get",1,0]); }else if(V==N){ G0=mcmgrs(G,["get0",[[0,V],JK]]); L0=anal2sp(G0,[["get",1,C],["+",-C,0]]); }else{ G0=mcmgrs(G,["get0",[[0,V],JK]]); L0=anal2sp(G0,["get",1,0]); } LT=anal2sp(LT,["sub",L0]); } } LT=anal2sp(LT,0); L=cons(cons(T,LT),L); } T=[[0,I],(I0) S=cdr(S); M=findin(L,S); return (M>=0)?findin(L,S)+N:-1; }else if(type(S)==5){ K=length(S); for(I=N;I=0) R=length(S)-IL-R; return R; } if((SJIS=getopt(sjis))!=1) SJIS=0; if((II!=0&&length(II)>1)||(JJ!=0&&length(JJ)>1)){ for(;;){ MJ=str_str(S,N|top=JJ,sjis=SJIS); if(MJ>=0){ MI=str_str(S,II|top=N,sjis=SJIS); if(MI<0 || MI>MJ){ if(C==0) return MJ; C--; N=MJ+length(II); }else if(MI>=0){ C++; N=MI+length(JJ); } } return -1; } } if(type(S)==4){ M=N; while(M-->0) S=cdr(S); while(S!=[]){ if(car(S)==I) C++; else if(car(S)==J){ if(C==0) return N; C--; } S=cdr(S);N++; } }else if(type(S)==5){ K=length(S); for(T=N;T=0;T++){ if(S[T]==I) C++; else if(S[T]==J){ if(C==0) return T; C--; } } } return -1; } def str_cut(S,I,J) { if(type(S)==7) return sub_str(S,I,J); if((JJ=length(S))<=J) J=JJ-1; if(type(S)==5){ for(L=[],K=J; K>=I; K--) L=cons(S[K],L); }else if(type(S)==4){ J-=I; while(I-->0) S=cdr(S); for(L=[];J-->=0;S=cdr(S)) L=cons(car(S),L); L=reverse(L); } return asciitostr(L); } def str_str(S,T) { if(S==0) return -1; if(type(S) == 7) S = strtoascii(S); if(type(J=getopt(top))!=1 || J<0) J=0; LS=length(S); if(LS-J<1) return -1; if(type(S)==4){ LS-=(J0=J); for( ; J>0 && S!=[]; S=cdr(S),J--); } if(type(JJ=getopt(end))!=1 && JJ!=0) JJ=LS; else JJ-=J0; if((SJIS=getopt(sjis))!=1) SJIS=0; if(JJ-J<0) return -1; /* search from J-th to JJ-th */ if(type(T)==1) T=[T]; else if(type(T)==7) T = strtoascii(T); else if(type(T)==4 && type(T[0])>3){ for(K=(KF=-1)-J0; T!=[]; F++,T=cdr(T)){ JK=str_str(S,car(T)|top=J,end=JJ,sjis=SJIS); if(JK>=0){ JJ=(K=JK)-1; KF=F; if(J>JJ) break; } } return [KF,J0+K]; } if(type(T)==4) T=ltov(T); LT = length(T); if(LT>0){ LE = LS-LT; LP = T[0]; if(JJ==0 ||(type(JJ)==1 && JJ128){ if(V<160 || (V>223 && V<240)) J++; } continue; } for(I = 1; I < LT && S[I+J] == T[I]; I++); if(I >= LT) return J; } }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++; } continue; } for(ST=cdr(S), I = 1; I < LT && car(ST) == T[I]; I++, ST=cdr(ST)); if(I >= LT) return J0+J; } } } return -1; } def str_times(S,N) { if(!isint(N)) return ""; if(type(S)==7){ for(Tb=str_tb(0,0);N-->0;) str_tb(S,Tb); return str_tb(0,Tb); } if(type(S)==4){ for(LT=[],I=0;I1) { if((C=car(L=cdr(L)))==0x24 && length(L)>1){ /* $ */ if((C = car(L=cdr(L))) == 0x40 || C == 0x42) { /* @, B */ Mode = 1; } else return 0; }else if(C == 0x28 && length(L)>1) { /* ( */ if((C = car(L=cdr(L)))== 0x42 || C == 0x4a) { /* B, J */ Mode = 0; }else if(C == 0x49) { /* I */ Mode = 2; }else{ R=cons(0x1b,R);R=cons(0x28,R);R=cons(C,R); } }else if (C == 0x26 && length(L)>1 && car(cdr(L))==0x1b) { /* & ESC */ L=cdr(L); }else{ R=cons(0x1b,R);R=cons(C,R); } }else if(C == 0x0e) { Mode = 2; }else if(C == 0x0f) { Mode = 0; }else if(Mode == 1 && C>0x20 && C<0x7f && length(L)>1) { /* JIS KANJI */ D=car(L=cdr(L)); if(D>0x20 && D<0x7f) { R=cons(ior(C,0x80),R);R=cons(ior(D,0x80),R); } else return 0; }else if(Mode == 2 && C > 0x1f && C < 0x60) { /* JIS KANA */ R=cons(0x8e,R); R=cons(ior(C,0x80),R); }else if(((C>0x80 && C<0xa0) || (C>0xdf && C<0xf0)) && length(L)>1) { /* ShiftJIS */ D=car(L=cdr(L)); if(D>0x3f && D<0xfd && D!=0x7f) { T=sjis2jis([C,D]); R=cons(ior(T[0],0x80),R); R=cons(ior(T[1],0x80),R); }else return 0; }else if(C>0x9f && C<0xe0) { /* HanKana */ R=cons(0x8e,R); R=cons(C,R); }else if(C == 0x0a){ CR++; }else if(C == 0x0d){ R=cons(0x0d,R); CR=0; }else{ while(CR-->0) R=cons(0x0d,R); R=cons(C,R); } } while(CR-->0) R=cons(0x0d,R); return asciitostr(reverse(R)); } def s2sjis(S) { for(R=[],CR=0,L=strtoascii(S);L!=[];L=cdr(L)){ if((C=car(L)) == 0x1b && length(L)>1) { if((C=car(L=cdr(L)))==0x24 && length(L)>1){ /* $ */ if((C = car(L=cdr(L))) == 0x40 || C == 0x42) { /* @, B */ Mode = 1; } else return 0; }else if(C == 0x28 && length(L)>1) { /* ( */ if((C = car(L=cdr(L)))== 0x42 || C == 0x4a) { /* B, J */ Mode = 0; }else if(C == 0x49) { /* I */ Mode = 2; }else{ R=cons(0x1b,R);R=cons(0x28,R);R=cons(C,R); } }else if (C == 0x26 && length(L)>1 && car(cdr(L))==0x1b) { /* & ESC */ L=cdr(L); }else{ R=cons(0x1b,R);R=cons(C,R); } }else if(C == 0x0e) { Mode = 2; }else if(C == 0x0f) { Mode = 0; }else if(Mode == 1 && C>0x20 && C<0x7f && length(L)>1) { /* JIS KANJI */ D=car(L=cdr(L)); if(D>0x20 && D<0x7f) { T=jis2sjis([C,D]); R=cons(T[0],R);R=cons(T[1],R); } else return 0; }else if(Mode == 2 && C > 0x1f && C < 0x60) { /* JIS KANA */ R=cons(ior(C,0x80),R); }else if(C>0xa0 && C<0xff && length(L)>1) { /* EUC */ D=car(L=cdr(L)); if(D>0xa0 && D<0xff) { T=jis2sjis([iand(C,0x7f),iand(D,0x7f)]); R=cons(T[0],R);R=cons(T[1],R); }else return 0; }else if(C == 0x0a){ CR++; }else if(C == 0x0d){ R=cons(0x0a,R);R=cons(0x0d,R); CR=0; }else{ while(CR-->0){ R=cons(0x0a,R);R=cons(0x0d,R); } R=cons(C,R); } } while(CR-->0){ R=cons(0x0a,R);R=cons(0x0d,R); } return asciitostr(reverse(R)); } def r2ma(S) { return evalma(S|inv=1); } def evalma(S) { L0=["\n","\d","{","}","[","]","Log","Exp","Sinh","Cosh","Tanh","Sin","Cos","Tan", "ArcSin","ArcCos","ArcTan"]; L1=["", "" ,"[","]","(",")","log","exp","sinh","cosh","tanh","sin","cos","tan", "asin", "acos", "atan"]; if(getopt(inv)==1){ if(type(S)==6) S=m2ll(S); else if(type(S)==5) S=vtol(S); if(type(S)==4){ for(L=[];S!=[];S=cdr(S)){ if(type(car(S))==6) L=cons(m2ll(car(S)),L); else if(type(car(S))==5) L=cons(vtol(car(S)),L); else L=cons(car(S),L); } S=reverse(L); }else return 0; return str_subst(rtostr(S),cdr(cdr(L1)),cdr(cdr(L0))); } if(S==0){ print("Mathematica text (terminated by ;) ?"); purge_stdin(); Tb=str_tb(0,0); for(;;){ S=get_line(); str_tb(S,Tb); if(str_char(S,0,";")>=0) break; } S=str_tb(0,Tb); } /* while((P=str_chr(S,0,";"))>=0){ V0=evalma(str_cut(S,0,P+1)); S=str_cut(S,P+1,length(S)); } if((P=str_char(S,0,"="))>=0){ X=strtoascii(str_cut(S,0,P)); L=length(X); for(P0=P1=-1,I=0;I=0){ for(I==P0;I-->0;) X=cdr(X); if((X0=car(X))>96) X0-=32; Y=[X0];X=cdr(X); for(I=P1-P0;I-->0;X=cdr(X)) Y=cons(car(X),Y); Y=cons(61,Y); Var=asciitostr(reverse(Y)); S=str_cut(S,P,length(S)); } } */ S=eval_str(str_subst(S,L0,L1)); if(type(S)==4){ for(L=-1,T=S;T!=[];T=cdr(T)){ if(type(T0=car(T))>4) break; if(type(T0)<4){ if(L>=0) break; L=-2;continue; } if(L<-2) break; if(L==-1) L=length(T0); else if(L!=length(T0)) break; } if(T==[]){ if(L>0) S=s2m(S); else S=ltov(S); } } /* if(S==0 && V0!=0) return V0; if(type(Var)==7){ T=rtostr(S); if(type(S)==7) T="\""+T+"\""; S=eval_str(Var+T); mycat(["Define",Var]); } */ return S; } def i2hex(N) { Opt=getopt(); if(type(N)==4 && isint(car(N))){ #ifdef USEMODULE L=mtransbys(os_md.i2hex,N,[]|option_list=Opt); #else L=mtransbys(i2hex,N,[]|option_list=Opt); #endif return rtostr(L); } if(!isint(N) || N<0) return 0; if(!N) L=[]; else{ Cap=(getopt(cap)==1)?32:0; for(L=[];N!=0;N=ishift(N,4)){ J=iand(N,15); L=cons(((J>9)?(87-Cap):48)+J,L); } } if(!isint(Min=getopt(min))) Min=2; for(Min-=length(L);Min-->0;) L=cons(48,L); if(getopt(num)==1){ L=cons(120,L);L=cons(48,L); } return asciitostr(L); } def sjis2jis(L) { L1=L[1]; if((L0=L[0])<=0x9f){ if(L1<0x9f) L0=L0*2-0xe1; else L0=(L0*2)-0xe0; }else{ if(L1<0x9f) L0=L0*2-0x161; else L0=L0*2-0x160; } if(L1<0x7f) return [L0,L1-0x1f]; else if(L1<0x9f) return [L0,L1-0x20]; return [L0,L1-0x7e]; } def jis2sjis(L) { L1=L[1]; if(iand(L0=L[0],1)){ if(L1<0x60) L=[L1+0x1f]; else L=[L1+0x20]; }else L=[L1+0x7e]; if(L0<0x5f) return cons(ishift(L0+0xe1,1),L); return cons(ishift(L0+0x161,1),L); } def verb_tex_form(P) { L = reverse(strtoascii(rtostr(P))); for(SS = []; L != []; L = cdr(L)){ Ch = car(L); /* ^~\{} */ if(Ch == 92 || Ch == 94 || Ch == 123 || Ch == 125 || Ch == 126){ SS = append([92,Ch,123,125],SS); /* \Ch{} */ if(Ch != 94 && Ch != 126) /* \char` */ SS = append([92,99,104,97,114,96],SS); continue; } SS = cons(Ch, SS); if((Ch >= 35 && Ch <= 38) || Ch == 95) /* #$%&_ */ SS = cons(92, SS); /* \Ch */ } return asciitostr(SS); } def tex_cuteq(S,P) { if(P==0) return 0; if(S[P]==125){ /* } */ if((Q=str_pair(S,P-1,"{","}"|inv=1))<0) return -1; if(Q<2||S[Q-1]!=95) return Q; return tex_cuteq(S,Q-2); } if(!isalphanum(S[Q=P--])) return -1; while(P>0&&isalphanum(S[P])) P--; if(S[P]==92){ /* \ */ if(P==0) return P; else P--; } if(S[P]!=95||P==0) return Q; /* _ */ return tex_cuteq(S,P-1); } def texket(S) { if(!isint(F=getopt(all))) F=0; if(type(S)==7){ L=str_len(S); SS=strtoascii(S); }else{ L=length(S); SS=S; } for(T="",I=I0=0;I4 && str_str(SS,"\\left"|top=J-5,end=J-1)>=0){ I=J+1;continue; } if((K=str_pair(SS,J+1,"(",")"))>=0){ KK=str_char(SS,J+2,"("); if(KK>K||KK<0){ if(F!=1){ if(!F){ for(N=J+1;N=0;Top=LV+1){ F++; if(Top==0) Tb = string_to_tb(""); LV = str_chr(S, L+6, "`"); if(LV<0) LV=str_len(S); str_tb([my_tex_form(sub_str(S, Top, L-1)|skip=1), "\\texttt{"], Tb); str_tb([verb_tex_form(sub_str(S,L+6, LV-1)),"}"], Tb); Top=LV+1; } if(F>0){ str_tb(my_tex_form(sub_str(S, Top,str_len(S)-1)|skip=1), Tb); return tb_to_string(Tb); } } if(S==0) return ""; S = ltov(strtoascii(S)); L = length(S)-1; while(L >= 1 && S[L] == 10) L--; if((Fr=getopt(frac))!=0 && Fr!=1) Fr=2; for(I = L+1, T = K = 0, SS = []; --I >= 0; ){ if(S[I] == 32 && I!=L){ if(I==L) continue; if(findin(S[I+1], [32,40,41,43,45,123,125]) >= 0 /* " ()+-{}" */ || (S[I+1] >= 49 && S[I+1] <= 57)) /* 1 - 9 */ if(I == 0 || S[I-1] >= 32) continue; } if(Fr && S[I]>=48 && S[I]<=57){ /* 2/3 -> \tfrac{2}{3} */ for(K=0,II=I; II>=0; II--){ if(S[II]>=48 && S[II]<=57) continue; if(S[II]==47){ /* / */ if(K>0) break; K=II; }else break; } if(K>II+1){ SS=cons(125,SS); for(J=I; J>K; J--) SS=cons(S[J],SS); if(AMSTeX){ SS=cons(123,SS);SS=cons(125,SS); }else{ for(J=[114,101,118,111,92];J!=[];J=cdr(J)) /* \over */ SS=cons(car(J),SS); } for(J=K-1;J>II;J--) SS=cons(S[J],SS); SS=cons(123,SS); if(AMSTeX){ J=(Fr==2)?[99,97,114,102,116,92]:[99,97,114,102,92]; for(;J!=[];J=cdr(J)) /* \tfrac */ SS=cons(car(J),SS); } I=II+1; }else{ for(;I>II;I--) SS = cons(S[I], SS); I++; } continue; } SS = cons(S[I], SS); } SS=str_subst(SS,"\\\\\n\\end{pmatrix}","\n\\end{pmatrix}"|raw=1); Subst=getopt(subst); Sub0=["{asin}","{acos}","{atan}"]; Sub1=["\\arcsin ","\\arccos","\\arctan "]; if(type(Subst) == 4){ Sub0=append(Sub0,Subst[0]);Sub1=append(Sub1,Subst[1]); } SS = str_subst(SS,Sub0,Sub1|raw=1); S = ltov(SS); L = length(S); SS = []; while(--L >= 0){ if(S[I=L] == 125){ while(--I >= 0 && S[I] == 125); J = 2*I - L; if(J >= 0 && S[I] != 123){ for(K = J; K < I && S[K] == 123; K++); if(K == I){ if(J-- <= 0 || S[J] < 65 || S[J] > 122 || (S[J] > 90 && S[J] < 97)){ SS = cons(S[I],SS); L = J+1; continue; } } } } SS = cons(S[L],SS); } RT=getopt(root); for(Top=0;;Top++){ /* ((x+1))^{y} , 1/y=2,3,...,9 */ #if 1 P=str_str(SS,["))^","^{\\tfrac{1}"]|top=Top); if(P[0]<0) break; Sq=0; if(P[0]==0){ P=P[1]; if((Q=str_pair(SS,P,"(",")"|inv=1))<0||SS[Q+1]!=40) continue; if((RT==2||(RT!=0 && P-Q<33)) && str_str(SS,"{\\tfrac{1}"|top=P+3,end=P+3)==P+3 && SS[P+14]==125){ if((Sq=SS[P+13]-48)<2||Sq>9) Sq=0; } F=2; }else{ P=P[1]; if(SS[P+12]!=125||(Sq=(SS[P+11]-48))<2||Sq>9) break; if(SS[P-1]==125){ if((Q=str_pair(SS,P-2,"{","}"|inv=1))<0) break; if(Q>1&&SS[Q-1]==95){ if((Q=tex_cuteq(SS,Q-2))<0) break; F=0; }else F=1; }else{ if(!isalphanum(SS[Q=P-1]) || (Q=tex_cuteq(SS,Q))<0) break; F=0; } if(RT!=2&&P-Q>32) break; } #else if((P=str_str(SS,"))^"|top=Top))<0 || (Q=str_pair(SS,P,"(",")"|inv=1))<0) break; else F=2; Sq=0; if((RT==2||(RT!=0 && P-Q<33)) && str_str(SS,"{\\tfrac{1}"|top=P+3,end=P+3)==P+3 && SS[P+14]==125){ if((Sq=SS[P+13]-48)<2||Sq>9) Sq=0; } #endif for(I=0,S=[];SS!=[];SS=cdr(SS),I++){ if(I==Q){ if(Sq){ S=append([116,114,113,115,92],S); if(Sq>2) S=append([93,Sq+48,91],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*/ 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); I+=3; } continue; }else if(I==P){ if(Sq){ if(F>0) S=cdr(S); S=cons(125,S); if(F==2) SS=cdr(SS); for(J=0;J<12;J++) SS=cdr(SS); } continue; } S=cons(car(SS),S); } SS=reverse(S); Top=P; } S=asciitostr(SS); if((K=getopt(ket))==1) S=texket(S); else if(K==2) S=texket(S|all=1); return S; } def smallmattex(S) { return str_subst(S,[["\\begin{pmatrix}","\\left(\\begin{smallmatrix}"], ["\\end{pmatrix}","\\end{smallmatrix}\\right)"], ["\\begin{Bmatrix}","\\left\\{\\begin{smallmatrix}"], ["\\end{Bmatrix}","\\end{smallmatrix}\\right\\}"], ["\\begin{bmatrix}","\\left[{\\begin{smallmatrix}"], ["\\end{bmatrix}","\\end{smallmatrix}\\right]"], ["\\begin{vmatrix}","\\left|\\begin{smallmatrix}"], ["\\end{vmatrix}","\\end{smallmatrix}\\right|"], ["\\begin{Vmatrix}","\\left\\|\\begin{smallmatrix}"], ["\\end{Vmatrix}","\\end{smallmatrix}\\right\\|"], ["\\begin{matrix}","\\begin{smallmatrix}"], ["\\end{matrix}","\\end{smallmatrix}"]],0); } def divmattex(S,T) { TF=["matrix","pmatrix","Bmatrix","bmatrix","vmatrix","Vmatrix"]; TG=[0,"(","\\{","[","|","\\|"]; TH=[0,")","\\}","]","|","\\|"]; if(type(S)!=7) S=mtotex(S); S=strtoascii(S0=S); if((P0=str_str(S,"\\begin{"))<0 || (P1=str_str(S,"}"|top=P0+7))<0) return S0; F=str_cut(S,P0+7,P1-1); if((K=findin(F,TF))<0) return S0; Q=str_str(S,"\\end{"+F+"}"); if(Q<0) return S0; for(J=P1+1;S[J]<33;J++); for(L0=L=[],I=J;J=J) L0=cons(0,L0); else L0=cons(str_cut(S,I,J-1),L0); I=J+1; } if(S[J]==92&&S[J+1]==92){ /* \\ */ if(I>=J) L0=cons(0,L0); else L0=cons(str_cut(S,I,J-1),L0); L=cons(reverse(L0),L); L0=[]; J++; for(I=J+1;S[I]<33;I++); } } J--; if(S[J]<33) J--; if(I<=J) L0=cons(str_cut(S,I,J),L0); if(length(L0)>0) L=cons(reverse(L0),L); L=lv2m(reverse(L)); /* get matrix */ if(T==0) return L; Size=size(L);S0=Size[0]; if(type(T[0])!=4){ S1=Size[1]; T=append(T,[S1]); for(TT=[],I=0;T!=[];T=cdr(T)){ J=car(T); if(J>S1) J=S1; for(T0=[];J>I;J--) T0=cons(J-1,T0); if(T0!=[]) TT=cons(T0,TT); I=car(T); } T=reverse(TT); } SS=length(T); St=str_tb(0,0); if(SS==1) St=str_tb("\\begin{"+F+"}\n",St); else{ if(K>0) St=str_tb("&\\left"+TG[K],St); St=str_tb("\\begin{matrix}\n",St); } for(;T!=[];T=cdr(T)){ for(I=0;I0) St=str_tb("&",St); if(L[I][car(TT)]!=0) St=str_tb(L[I][car(TT)],St); } if(I1) St=str_tb("\\end{matrix}\\right.\\\\\n&\\quad\\left.\\begin{matrix}\n",St); else{ if(SS==1) St=str_tb("\\end{"+F+"}\n",St); else St=str_tb("\\end{matrix}\\right"+TH[K]+"\n",St); } } S=str_tb(0,St); if(SS==1) return S; return texbegin("align*",S); } def str_subst(S, L0, L1) { if(type(S) == 7) S = strtoascii(S); if(type(S) == 4) S = ltov(S); SE = length(S); if(L1 == 0){ for(L1 = L = [], L0 = reverse(L0); L0 != []; L0 = cdr(L0)){ L = cons(car(L0)[0], L); L1 = cons(car(L0)[1], L1); } L0 = L; } if(type(L0)==7) L0 = [strtoascii(L0)]; else{ for(LT = []; L0 != []; L0 = cdr(L0)) LT = cons(strtoascii(car(L0)), LT); L0 = ltov(LT); } E0 = length(L0); if(type(L1)==7) L1 = [strtoascii(L1)]; else{ for(LT = []; L1 != []; L1 = cdr(L1)) LT = cons(strtoascii(car(L1)), LT); L1 = ltov(LT); } if(getopt(inv)==1){ L2=L0;L0=L1;L0=L2; } if((SJIS=getopt(sjis))!=1) SJIS=0; for(J = JJ = 0, ST = []; J < SE; J++){ SP = S[J]; for(I = E0-1; I >= 0; I--){ if(SP != L0[I][0] || J + (K = length(L0[I])) > SE) continue; while(--K >= 1) if(L0[I][K] != S[J+K]) break; if(K > 0) continue; for(KE = length(L1[I]), K = 0 ;K < KE; K++) ST = cons(L1[I][K],ST); J += length(L0[I])-1; break; } if(I < 0){ ST = cons(S[J],ST); if(SJIS && (V=S[J])>128){ if(V<160 || (V>223 && V<240)) ST = cons(S[J++],ST); } } } if(getopt(raw)==1) return reverse(ST); return asciitostr(reverse(ST)); } def dviout0(L) { Cmd=["TikZ","TeXLim","TeXEq","DVIOUT","XYPrec","XYcm","XYLim","Canvas"]; if(type(Opt=getopt(opt))==7){ if((F=findin(Opt,Cmd)) < 0) return -1; if(L==-1){ if(F<=3){ if(F==0) V=TikZ; else if(F==1) V=TeXLim; else if(F==2) V=TeXEq; else V=iand(DVIOUTF,1); }else{ if(F==4) V=XYPrec; else if(F==5) V=XYcm; else if(F==6) V=XYLim; else V=Canvas; } return V; } if(F==0) TikZ=L; else if(F==2) TeXEq=L; else if(F==3){ if(iand(DVIOUTF,1)==L) mycat0(["DVIOUTA=\"", DVIOUTA,"\""],1); else dviout0(4); return 1; }else if(F==7&&type(L)==4) Canvas=L; else if(L>0){ if(F==1) TeXLim=L; else if(F==4) XYPrec=L; else if(F==5) XYcm=L; else if(F==6) XYLim=L; } mycat0([Cmd[F],"=",L],1); return 1; } if(type(L) == 4){ for( ; L != []; L = cdr(L)) dviout0(car(L)); return 1; } if(type(L) == 7){ if(L=="") dviout(" \n"|keep=1); else if(L=="cls") dviout0(0); else if(L=="show") dviout(" "); else if(L=="?") dviout0(3); else dviout("\\"+L+"\n"|keep=1); return 1; } if(L == 0) dviout(" "|keep=1,clear=1); else if(L == 1) dviout(" "); else if(L == 2) dviout(" "|clear=1); else if(L>10) dviout("\\setcounter{MaxMatrixCols}{"+rtostr(L)+"}%"|keep=1); else if(L < 0) dviout(" "|delete=-L,keep=1); else if(L == 3){ mycat0(["DIROUT =\"", DIROUT,"\""],1); mycat0(["DVIOUTH=\"", DVIOUTH,"\""],1); mycat0(["DVIOUTA=\"", DVIOUTA,"\""],1); mycat0(["DVIOUTB=\"", DVIOUTB,"\""],1); mycat0(["DVIOUTL=\"", DVIOUTL,"\""],1); mycat(["Canvas =", Canvas]); mycat(["TeXLim =", TeXLim]); mycat(["TeXEq =", TeXEq]); mycat(["AMSTeX =", AMSTeX]); mycat(["TikZ =", TikZ]); mycat(["XYPrec =", XYPrec]); mycat(["XYcm =", XYcm]); mycat(["XYLim =", XYLim]); }else if(L==4){ Tmp=DVIOUTA; DVIOUTA=DVIOUTB; DVIOUTB=Tmp; mycat0(["DVIOUTA=\"", DVIOUTA,"\""],1); DVIOUTF++; }else if(L==5){ if(!iand(DVIOUTF,1)) dviout0(4); }else if(L==6){ TikZ=1;mycat("TikZ=1"); }else if(L==7){ TikZ=0;mycat("TikZ=0"); } return 1; } def myhelp(T) { /* extern DVIOUT; */ /* extern HDVI; */ /* extern DVIOUTH; */ if(type(T)==2){ if(T==getbygrs){ getbygrs(0,0); return 0; } else if(T==m2mc){ m2mc(0,0); return 0; } else if(T==mgen){ mgen(0,0,0,0); return 0; } else T=rtostr(T); } if(type(T)==4 && typeT[0]==7){ if(length(T)==2 && type(T[1])==1){ DVIOUTH="start "+T[0]+" -"+rtostr(T[1])+"-hyper:0x90 \"%ASIRROOT%\\help\\os_muldif.dvi\" #r:%LABEL%"; }else if(str_len(T[0])>2) DVIOUTH=T[0]; mycat(["DVIOUTH="+DVIOUTH,"\nmyhelp(fn) is set!"]); return 0; } if(T==0){ mycat([ "myhelp(t) : show help\n", #ifdef USEMODULE " t : -1 (dvi), 1 (pdf) or os_md.getbygrs, os_md.m2mc, os_md.mgen\n", #else " t : -1 (dvi), 1 (pdf) or getbygrs, m2mc, mgen\n", #endif " \"fn\" : Help of the function fn\n", " [path,n] : path of dviout, n = # dviout\n", " [DVIOUTH] : Way to jump to the help of a function\n", " default: start dviout -2 \"%ASIRTOOT%\\help\\os_muldif.dvi\" #r:%LABEL%" ]); return 0; } if(type(T)==7){ if(str_str(T,"os_md.")==0) T=str_cut(T,6,str_len(T)-1); Dr=str_subst(DVIOUTH,["%ASIRROOT%","%LABEL%"],[get_rootdir(),"r:"+str_subst(T,"_","")]); shell(Dr); return 0; } Dr=get_rootdir(); if(T==-1) Dr+="\\help\\os_muldif.dvi"; else Dr+="\\help\\os_muldif.pdf"; if(!isMs()) Dr=str_subst(Dr,"\\","/"); shell(Dr); return 0; } def isMs() { if(type(Tmp=getenv("TEMP"))!=7) { if (type(Tmp=getenv("TMP")) != 7) Tmp=getenv("HOME"); } if(type(Tmp)==7 && str_chr(Tmp,0,"\\")==2) return 1; else return 0; } def tocsv(L) { if(type(L)==6) L=m2ll(L); else if(type(L)==5) L=vtol(L); Null=getopt(null); Tb=str_tb(0,0); for(LL=L; LL!=[]; LL=cdr(LL)){ LT=car(LL); 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((T=car(LT))==Null) continue; if(type(T)==7){ K=str_len(T); T=str_subst(T,["\""],["\"\""]); if(str_len(T)>K||str_char(T,0,",")>=0) T="\""+T+"\""; str_tb(T,Tb); }else str_tb(rtostr(T),Tb); } str_tb("\n",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) { if((ID=open_file(F))<0) return -1; SJIS=isMs(); L=[]; if(type(V=getopt(eval))!=4){ if(V=="all") V=1; else if(type(V)==1) V=[V]; else V=[]; } Eq=getopt(eq); Sp=getopt(sp); if(type(T=getopt(col))!=1) T=0; Null=getopt(null); if(type(Null)<0) Null=(Eq==1)?0:""; while((S=get_line(ID))!=0){ S=strtoascii(S); N=length(S); for(I=J=F=0,LL=LT=[];I128 && C<160)||(C>223 && C<240))){ LT=cons(C,LT);LT=cons(S[++I],LT);continue; } if(F>0){ LT=cons(C,LT);continue; } LS=asciitostr(reverse(LT)); if(V==1||findin(++J,V)>=0){ if(Eq==1) LS=(LS=="")?Null:eval_str(LS); else LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); } if(!T || T==J) LL=cons(LS,LL); if(F==-2) while(++I0)){ /* lastline */ LS=asciitostr(reverse(LT)); if(V==1||findin(++J,V)>=0){ if(Eq==1) LS=(LS=="")?Null:eval_str(LS); else LS=(isdecimal(LS))?eval_str(LS):((LS=="")?Null:LS); } if(!T || T==J) LL=cons(LS,LL); } L=cons(reverse(LL),L); } close_file(ID); if(T) L=m2l(L|flat=1); L=reverse(L); return L; } def showbyshell(S) { Id = getbyshell(S); if(Id<0) return Id; while((S=get_line(Id))!=0) print(S,2); return close_file(Id); } def getbyshell(S) { /* extern DIROUT; */ Home=getenv("HOME"); if(type(Home)!=7) Home=""; if(type(Tmp=getenv("TEMP"))!=7 && type(Tmp=getenv("TMP")) != 7) Tmp=str_subst(DIROUT,["%HOME%","%ASIRROOT%"],[Home,get_rootdir()]); Sep=isMs()?"\\":"/"; F=Tmp+Sep+"muldif.tmp"; 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 show(P) { T=type(P); S=P; Var=getopt(opt); if(Var=="verb"){ dviout("{\\tt"+verb_tex_form(T)+"}\n\n"); return; } if(type(Var)<0) Var=getopt(var); if(T==6){ if((Sp=getopt(sp))==1 || Sp==2) S=mtotex(P|lim=1,small=2,sp=Sp,null=1,mat="B"); else if(type(Var)==4 || type(Var)==7) S=mtotex(P|lim=1,small=2,var=Var); else S=mtotex(P|lim=1,small=2); Size=size(P); Size=(Size[0]>Size[1])?Size[0]:Size[1]; if(Size>10) dviout0(Size); }else if(T<=3){ X=0; if(Var=="pfrac") X=var(P); else X=getopt(pfrac); if(isvar(X)){ 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{ if(isdif(P)!=0) Opt=cons(["var","dif"],Opt); else Opt=cons(["br",1],Opt); fctrtos(P|option_list=Opt); } return; }else if(T==4){ if(type(Var)==4 || type(Var)==7){ S=ltotex(P|option_list=getopt()); if(Var=="text"){ dviout(S); return; } }else{ for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ LL=car(L); if(type(LL)==4){ if(F==0){ T=type(LL[0]); if(T==4) F=2; /* [[[? */ else if(T==1 || T==0) F=1; /* [[num,.. */ } if(F==1){ if(length(LL)!=2 || !isint(LL[0]) || LL[0]<0 || type(LL[1])>3) F=-1; /* [[num,rat],[num,rat],...] */ }else if(F==2){ for(LLT=LL; LLT!=[] && F!=-1; LLT=cdr(LLT)){ LLL=car(LLT); /* [[[num,rat],[num,rat],...],[[..],..]],....] */ if(length(LLL)!=2 || !isint(LLL[0]) || LLL[0]<0 || type(LLL[1])>3) F=-1; } } }else if((F==0 || F==7) && type(LL)==7){ F=7; }else F=-1; } if(F==1) S=ltotex(P|opt="spt"); else if(F==2){ M=mtranspose(lv2m(S)); show(M|sp=1); /* GRS */ return; }else if(F==7) S=ltotex(P|opt="spts"); else{ for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ LL=car(L); if(type(LL)!=4){ F=-1; break; } for(LLT=LL; LLT!=[] && F!=-1; LLT=cdr(LLT)){ T=type(LLL=car(LLT)); if(T<7 && T!=4) F0++; else if(T==7){ if(str_char(LLL,0,"\\")<0) F1++; else F2++; }else F=-1; } } } if(F==0 && F0>0 && (F1+F2)>0){ /* list of list of eq and str */ if(F2>0) S=ltotex(P|opt=["cr","spts0"],str=1); else S=ltotex(P|opt=["cr","spts"]); }else{ for(S="[";;){ S+=my_tex_form(car(P)); if((P=cdr(P))==[]){ S+="]";break; } S+=","; } } } }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; } } dviout(S|eq=5); } /* options : eq = 1 - 8, clear=1, keep=1, delete=1, title=s, fctr=1, begin=s */ def dviout(L) { /* extern AMSTeX, TeXEq, DIROUT, DVIOUTA, DVIOUTB, DVIOUTL; */ MyEq = [ ["\\[\n ","\\]"], ["\\begin{align}\n","\\end{align}"], ["\\begin{gather}\n ","\\end{gather}"], ["\\begin{multline}\n ","\\\\[-15pt]\\end{multline}"], ["\\begin{align}\\begin{split}\n &","\\end{split}\\end{align}"], ["\\begin{align*}\n &","\\end{align*}"], ["\\begin{gather*}\n ","\\end{gather*}"], ["\\begin{equation}\n ","\\end{equation}"] ]; if(!chkfun("print_tex_form", "names.rr")) return 0; Home=getenv("HOME"); if(type(Home)!=7) Home=""; Dir=str_subst(DIROUT,["%HOME%","%ASIRROOT%","\\"],[Home,get_rootdir(),"/"]); Dirout=Dir+(AMSTeX?"/out.tex":"/out0.tex"); Risaout=(AMSTeX)?"risaout":"risaout0"; Dirisa=Dir+"/"+Risaout+".tex"; Viewer="dviout"; SV=["c:/w32tex/dviout","c:/dviout"]; Risatex=str_subst(AMSTeX?DVIOUTA:DVIOUTL, ["%HOME%","%ASIRROOT%","%TikZ%"],[Home,get_rootdir(),rtostr(TikZ)]); if(isMs() && !access(Risatex)){ for(TV=SV; TV!=[]; TV=cdr(TV)){ VV=car(TV)+"/dviout.exe"; if(access(VV)){ Viewer=str_subst(VV,"/","\\"); break; } } output(Risatex); print("cd \""+str_subst(Dir,"/","\\")+"\""); print("latex -src=cr,display,hbox,math,par "+Risaout); print("start "+Viewer+" -1 \""+Dr+"\\tex\\"+Risaout+"\" 1000"); output(); } if(access(Dirisa) == 0){ D0="\""+(isMs()?str_subst(Dir,"/","\\")+"\"":Dir); shell("mkdir "+D0); output(Dirisa); if(AMSTeX){ print("\\documentclass[a4paper]{amsart}"); print("\\usepackage{amsmath,amssymb,amsfonts}"); }else print("\\documentclass[a4paper]{article}"); print("\\pagestyle{empty}\n\\begin{document}\n\\thispagestyle{empty}"); print(AMSTeX?"\\input{out}\n\\end{document}":"\\input{out0}\n\\end{document}"); output(); } if((K = getopt(delete)) >= 1){ /* delete */ LC = 0; if(type(K) == 1 && K > 10) K = 10; if(type(K) == 4){ K = qsort(K); LC = 1; /* specific lines */ } Done = 1; Id = open_file(Dirout); if(Id >= 0){ Buf = Buf0 = Buf1 = Key = ""; PE = 0; if(type(K) == 1) BufE = newvect(K--); Dout = Dirout+"0"; remove_file(Dout); output(Dout); while((S = get_line(Id)) != 0){ if(LC){ while(K != [] && car(K) < LC) K = cdr(K); if(K == [] || car(K) > LC) output(S); } if(Key == ""){ if((P0 = str_str(S,"\\begin{")) == 0){ Key = sub_str(S,7,str_str(S,"}")-1); if(findin(Key,["align", "gather","multline", "equation","align*"]) < 0) Key = ""; else{ Key = "\\end{"+Key+"}"; if(!LC){ if(Buf != ""){ if(PE < K) BufE[PE++] = Buf1+Buf; else{ if(K > 0){ print(BufE[0]); for(I = 1; I < K; I++) BufE[I-1]=BufE[I]; BufE[K-1] = Buf1+Buf; }else print(Buf1+Buf); Done = 0; } Buf1 = Buf0; Buf = Buf0 =""; } } } } if(Key == "" && !LC) Buf0 += S; } if(Key != ""){ if(!LC) Buf += S; if(str_str(S,Key) >= 0){ Key = ""; if(LC) LC++; } } } output(); close_file(Id); } if(Done==0){ Id = open_file(Dout); if(Id >= 0){ remove_file(Dirout); output(Dirout); while((S = get_line(Id)) != 0) print(S,0); output(); close_file(Id); } remove_file(Dout); }else L=" "; } if(getopt(clear) == 1 || Done == 1){ /* clear */ remove_file(Dirout); if(L == "" || L == " "){ output(Dirout); print("\\centerline{Risa/Asir}"); output(); } } if(L != " "){ Eq=1; Eqo = getopt(eq); Fc = getopt(fctr); if(Fc == 1 && (type(L) == 2 || type(L) == 3)){ L = fctrtos(L|TeX=1); if(type(L) == 4) L = "\\fact{"+L[0]+"}{"+L[1]+"}"; if(type(Eqo) != 0 && type(Eqo) !=7){ Eqo=0; } } if(type(L) != 4 || getopt(mult) != 1) L = [L]; if(type(Eqo)!=7 && (Eqo<1 || Eqo>8)) Eqo = (AMSTeX==1)?TeXEq:1; Title = getopt(title); if(type(Title) == 7){ output(Dirout); print(Title); output(); } Sb = getopt(subst); for( ; L != []; L = cdr(L)){ Eq = 1; if(type(LT=car(L)) != 7 && type(LT) != 21) LT = my_tex_form(LT); else if(type(getopt(eq)) < 0) Eq = 0; if(type(Sb) == 4) LT = str_subst(LT,Sb[0],Sb[1]); output(Dirout); if(Eq == 1){ if(type(Eqo)==7) print(texbegin(Eqo,LT)); else if(Eqo >= 1 && Eqo <= 8){ mycat0([MyEq[Eqo-1][0],LT,"%"],1); print(MyEq[Eqo-1][1]); }else print(LT); }else print(LT); output(); } } if(str_char(Risatex,0," ")>=0 && str_char(DVIOUTA,0," ")<0 && str_char(DVIOUTB,0," ")<0 && str_char(DVIOUTL,0," ")<0) Risatex="\""+Risatex+"\""; if(getopt(keep) != 1) shell(Risatex); return 1; } def rtotex(P) { S = my_tex_form(P); return (str_len(S) == 1)?S:"{"+S+"}"; } def mtotex(M) { /* extern TexLim; */ MB=mat(["(",")","p"],["\\{","\\}","B"],["[","]","b"],["|","|","v"], ["\\|","\\|","V"], [".",".",""]); if(type(MT=getopt(mat))==7){ MT=findin(MT,["p","B","b","v","V",""]); if(MT<0) MT=0; } else MT=0; MT=MB[MT]; if((F=getopt(small))!=1 && F!=2) F=0; Lim=getopt(lim); if(type(Lim)==1){ if(Lim<30 && Lim!=0) Lim = TexLim; }else Lim=0; FL=getopt(len); Rw=getopt(raw); Sp=getopt(sp); Idx=getopt(idx); if(type(Idx)==4) Idx=ltov(Idx); if(type(Idx)==6 && length(Idx)==0) Idx=-1; Var=getopt(var); if(Lim>0) FL=1; Null=getopt(null); if(Null!=1 && Null!=2) Null=0; if(type(M)==5) M=lv2m([V]); else if(type(M)!=6) return monototex(M); S=size(M); if(FL==1){ L=newmat(S[0],S[1]); LL=newvect(S[1]); } SS=newmat(S[0],S[1]); for(I=0; I1)?fctrtos(P|TeX=2,lim=0,var=Var):fctrtos(P|TeX=2,lim=0); if(type(P)==1 && str_str(SS[I][J],"\\frac{-"|end=0)==0) SS[I][J]="-\\frac{"+str_cut(SS[I][J],7,100000); } }else if(type(P)==6){ ST= mtotex(P|small=1,len=1); SS[I][J]=ST[0]; L[I][J]=ST[1]; }else if(type(P)==7){ if(Rw==1) SS[I][J]=P; else SS[I][J]="\\text{"+P+"\}"; }else if(type(P)==4 && length(P)==2 && P[0]>0 && (Sp==1 || Sp==2)){ if(P[0]==1){ SS[I][J]=fctrtos(P[1]|TeX=2,lim=0); }else{ ST=my_tex_form(P[0]); if(Sp==2) ST="("+ST+")"; SS[I][J]="["+fctrtos(P[1]|TeX=2,lim=0)+"]_"; if(str_len(ST)<2) SS[I][J]+=ST; else SS[I][J]+="{"+ST+"}"; } }else SS[I][J]=my_tex_form(P); if(FL==1) L[I][J]=texlen(SS[I][J]); } } if(Lim>0 || FL==1){ for(LLL=J=0; J0){ if(F==2 && LLL>Lim-2*S[1]-2) F=1; if(F==1) Lim=idiv(Lim*6,5); if(LLL<=Lim-(2-F)*S[I]-2) Lim=0; } Mat=(F==1)?"smallmatrix}":"matrix}"; if(F==1) Out=str_tb("\\left"+MT[0]+"\\begin{",0); else Out=str_tb((Lim==0)?"\\begin{"+MT[2]:"\\left"+MT[0]+"\\begin{",0); Out = str_tb(Mat,Out); for(I=II=LT=0; II<=S[0]; II++){ if(Lim==0) II=S[0]; if(II=0 && P>=0){ if(Opt==2 || Opt==4 || Opt==0){ if(N==0) return (Opt>0)?"0":0; Pw=0; if(NT==4){ NN=abs(real(N));N1=abs(imag(N)); if(NN-1){ Pw--; N*=10;NN*=10; } while(N>=10 || N<=-10){ Pw++; N/=10;NN/=10; } if(Opt==0) return sint(N*10^Pw,P-Pw-1); S=(getopt(sqrt)==1)?sint(N,P|str=(Opt==4)?3:1,sqrt=1):sint(N,P|str=(Opt==4)?3:1); if(Pw==0) return S; if(NT==4) S="("+S+")"; if(Pw==1){ if(Opt==2) return S+"*10"; else return S+"\\times10"; } if(Opt==2) return S+"*10^("+rtostr(Pw)+")"; else return S+"\\times10^{"+rtostr(Pw)+"}"; } if(NT==4){ NN=real(N); if(NN!=0){ S=sint(NN,P|str=1); if(imag(N)>0) S=S+"+"; } else S=""; S=S+sint(imag(N),P|str=1)+((Opt==3)?((getopt(sqrt)==1)?"\\sqrt{-1}":"i"):"@i"); return S; } if(N<0){ 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(NV),1,P); } if(NT==4) return sint(real(N),P)+sint(imag(N),P)*@i; X = rint( N*10^P ); return deval(X/10^P); } if( (type(N)==2) || (type(N)==3) ){ NN = eval(N); if( type(NN)==1 ) return sint(NN,P|option_list=getopt()); else return N; } if( type(N)>3 && type(N) < 7) #ifdef USEMODULE return mtransbys(os_md.sint,N,[P]|option_list=getopt()); #else return mtransbys(sint,N,[P]|option_list=getopt())); #endif return N; } 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; else if(ntype(N)!=4) return N; else return (E*(1+@i)*N)/(E*(1+@i)); } if(T==3||T==2){ N=red(N); Nm=nm(N);Var=vars(Nm);V=car(Var);K=length(Var); 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 (E*N)/E; #ifdef USEMODULE return mtransbys(os_md.frac2n,N,[]|option_list=getopt()); #else return mtransbys(frac2n,N,[]|option_list=getopt()); #endif } def xyproc(F) { if(type(Opt=getopt(opt))!=7) Opt=""; if(type(Env=getopt(env))!=7) Env=(!TikZ)?"xy":"tikzpicture"; if(F==1) return(Opt=="")?"\\begin{"+Env+"}\n":"\\begin{"+Env+"}["+Opt+"]\n"; if(F==0) return "\\end{"+Env+"}\n"; if(type(F)==7){ F=xyproc(1|opt=Opt,env=Env)+F+xyproc(0|env=Env); if(getopt(dviout)==1) dviout(F); else return F; } } def xypos(P) { if(type(P[0])==7){ if(P[0]=="") S=""; else S=(!TikZ)?"\""+P[0]+"\"":"("+P[0]+")"; } else{ if(TikZ==0 && XYcm==1){ X=sint(P[0]*10,XYPrec); Y=sint(P[1]*10,XYPrec); }else{ X=sint(P[0],XYPrec); Y=sint(P[1],XYPrec); } S="("+rtostr(X)+","+rtostr(Y)+")"; } if(!TikZ){ if(length(P)>2 && (PP=P[2])!=""){ S=S+" *"; if(type(PP)==4 && length(PP)==2 && type(PP[0])==7){ S=S+PP[0]; PP=PP[1]; } if(type(PP)==7){ L=str_len(PP); if(str_chr(PP,0,"$")==0 && str_chr(PP,L-1,"$")==L-1){ PP=str_cut(PP,1,L-2); }else S+="\\txt"; } else PP=my_tex_form(PP); S=S+"{"+PP+"}"; } if(length(P)>3){ if(type(P[3])==7 && P[3]!="") S=S+"=\""+P[3]+"\""; if(length(P)>4 && type(P[4])==7) S=S+P[4]; } }else{ T=""; if(length(P)>2 && (PP=P[2])!=""){ F=1; if(type(PP)==4){ if(length(PP)==2 && type(PP[0])==7){ T="["+PP[0]+"]"; PP=PP[1]; } } if(type(PP)!=7) PP="$"+my_tex_form(PP)+"$"; S=S+"{"+PP+"}"; }else F=0; if(length(P)>3){ if(type(P[3])==7 && P[3]!="") T=T+"("+P[3]+")"; else if(P[3]==1) T=T+"(_)"; if(length(P)>4 && type(P[4])==7) S=S+P[4]; } if(length(P)>2){ if(F) S="node"+T+" at"+S; else S="coordinate"+T+" at"+S; } } return S; } def xyput(P) { if((type(Sc=getopt(scale))==1 && Sc!=1) || type(Sc)==4){ if(type(Sc)==1) Sc=[Sc,Sc]; Sx=Sc[0];Sy=Sc[1]; if(length(P)>2) P1=cons(Sy*P[1],cdr(cdr(P))); else P1=[Sy*P[1]]; P=cons((type(P[0])==7)?P[0]:(Sx*P[0]),P1); } if(!TikZ) return "{"+xypos(P)+"};\n"; return "\\"+xypos(P)+";\n"; } def xyline(P,Q) { if(!TikZ) return "{"+xypos(P)+" \\ar@{-} "+xypos(Q)+"};\n"; if(type(T=getopt(opt))!=7) T=""; else T="["+T+"]"; if(length(P)<3 && length(Q)<3) return "\\draw"+T+xypos(P)+"--"+xypos(Q)+";\n"; if(length(P)==2) P=[P[0],P[1],"","_0"]; else if(length(P)==3 || (length(P)==4 && P[3]=="")) P=[P[0],P[1],P[2],"_0"]; else if(length(P)>4 && P[3]=="") P=[P[0],P[1],P[2],"_0",P[4]]; if(length(Q)==2) Q=[Q[0],Q[1],"","_1"]; else if(length(Q)==3 || (length(Q)==4 && Q[3]=="")) Q=[Q[0],Q[1],Q[2],"_1"]; else if(length(Q)>4 && Q[3]=="") Q=[Q[0],Q[1],Q[2],"_1",Q[4]]; return "\\draw "+T+xypos(P)+" "+xypos(Q)+"("+P[3]+")--("+Q[3]+");\n"; } def xylines(P) { Lf=getopt(curve); if(type(Lf)!=1) Lf=0; SS=getopt(opt); SF=(SS==0)?1:0; if((Proc=getopt(proc))==1||Proc==2||Proc==3){ OL=cons(["opt",0],delopt(getopt(),["opt","proc"])); R=xylines(P|option_list=OL); OP=(type(SS)<0)?[]:((type(SS)==4)?[["opt",SS[0]],["cmd",SS[1]]]:[["opt",SS]]); return [1,OP,R]; } if(type(SS)!=7 && type(SS)!=4){ if(Lf==0 && !TikZ) SS="@{-}"; else SS=""; } if(type(Sc=getopt(scale))==1 || type(Sc)==4){ if(type(Sc)==1) Sc=[Sc,Sc]; Sx=Sc[0];Sy=Sc[1]; if(Sx!=1 || Sy!=1){ for(PP=[], P0=P; P0!=[]; P0=cdr(P0)){ PT=car(P0); if((type(PT)!=4 && type(PT)!=5) || (type(PT[0])!=1 && PT[0]!=0)) PP=cons(PT,PP); else{ if(length(PT)>2 && type(PT)==4) P1=cons(Sy*PT[1],cdr(cdr(PT))); else P1=[Sy*PT[1]]; PP=cons(cons(Sx*PT[0],P1),PP); } } P=reverse(PP); } } if(type(Cl=CL0=getopt(close))!=1) Cl=0; if((Vb=getopt(verb))!=1&&type(Vb)!=4) Vb=0; if(type(Lf)!=1 || Lf==0){ /* lines */ if(TikZ||SF){ for(L=[],F=0,PT=P;PT!=[];PT=cdr(PT)){ if(type(car(PT))<4){ L=cons(car(PT),L); F=0; }else{ if(F++>1) L=cons(1,L); L=cons(car(PT),L); } } if(Cl==1){ L=cons(1,L);L=cons(-1,L); } if(L) L=reverse(L); if(SF) return L; if(type(SS)!=4) S=xybezier(L|opt=SS); else S=xybezier(L|opt=SS[0],cmd=SS[1]); }else{ Out = str_tb(0,0); for(PT=P; PT!=[]; ){ PS1=car(PT); PT=cdr(PT); if(PT==[]){ if(Cl==1) PS2=car(P); else PS2=0; }else PS2=car(PT); str_tb(xyarrow(PS1,PS2|opt=SS),Out); } S=str_tb(0,Out); } }else if(Lf==2){ /* B-spline */ if(SF) return P; if(!TikZ){ Out = str_tb("{\\curve{",0); for(PT=P;PT!=[];PT=cdr(PT)){ if(car(PT)==0){ str_tb("}};\n{\\curve{",Out); continue; } if(PT!=P) str_tb("&",Out); str_tb(xypos([car(PT)[0],car(PT)[1]]),Out); } str_tb("}};\n",Out); S=str_tb(0,Out); }else Out=str_tb(xybezier(P|opt=SS),0); for(I=0;I<2;I++){ Q=car(P); if(length(Q)>2) str_tb(xyput(Q),Out); P=reverse(P); } S=str_tb(0,Out); }else{ /* extended Bezier */ RTo=getopt(ratio); if(type(Acc=getopt(Acc))!=1) Acc=0; if(type(RTo)!=1 || RTo>1.5 || RTo<0.001) RTo=0; if(Cl==1){ PR=reverse(P); PT=car(PR); PR=cons(P[0],PR); PR=cons(P[1],PR); P=cons(PT,reverse(PR)); }else if(Cl==-1) Cl=1; for(L=P2=P3=0,PT=P;;){ P1=P2;P2=P3;P3=P4; P4=(PT==[])?0:car(PT); if(PT==[] && (Cl==1 || P3==0)) break; PT=cdr(PT); if(P3==0) str_tb("%\n", Out); if(P2==0 || P3==0 || (Cl==1 && P1==0)) continue; if(L!=0){ if(car(L)==P2) L=cons(1,L); else{ L=cons(0,L); L=cons(P2,L); } }else L=[P2]; X=P3[0]-P2[0];Y=P3[1]-P2[1]; DL1=DL2=0;DL=Acc?sqrt(X^2+Y^2):dsqrt(X^2+Y^2); if(P4!=0){ XD1=P4[0]-P2[0];YD1=P4[1]-P2[1];DL1=Acc?sqrt(XD1^2+YD1^2):dsqrt(XD1^2+YD1^2); } if(P1!=0){ XD2=P3[0]-P1[0];YD2=P3[1]-P1[1];DL2=Acc?sqrt(XD2^2+YD2^2):dsqrt(XD2^2+YD2^2); } if(RTo!=0) R=RTo; else if(DL1>0 && DL2>0){ Cos=(XD1*XD2+YD1*YD2)/(DL1*DL2); RT=4/(3*(Acc?sqrt((1+Cos)/2):dsqrt((1+Cos)/2))+3); R=DL*RT/(DL1+DL2); }else if(DL1!=0) R=DL/(2*DL1); else if(DL2!=0) R=DL/(2*DL2); if(DL2!=0) L=cons([P2[0]+R*XD2,P2[1]+R*YD2],L); if(DL1!=0) L=cons([P3[0]-R*XD1,P3[1]-R*YD1],L); L=cons([P3[0],P3[1]],L); } if(CL0==1) L=cons(-1,cdr(L)); if(L!=0) L=reverse(L); if(SF) return L; if(type(SS)==4) S=xybezier(L|opt=SS[0],cmd=SS[1],verb=Vb); else S=xybezier(L|opt=SS,verb=Vb); } if(getopt(dviout)!=1) return S; xyproc(S|dviout=1); } def saveproc(S,Out) { if(type(Out)==4){ Out=cons(S,Out); return Out; }else{ str_tb(S,Out); return 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 xy2graph(F0,N,Lx,Ly,Lz,A,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{ Proc=0;OPT0=[]; } if(type(DV=getopt(dviout))==4){ S=["ext","shift","cl","dviout"]; OL=delopt(getopt(),S); OL=cons(["proc",1],OL); R=xy2graph(F0,N,Lx,Ly,Lz,A,B|option_list=OL); OL=delopt(getopt(),S|inv=1); return execdraw(R,DV|optilon_list=OL); } if(N==0 || N>100 || N<-100) N=-16; if(N<0){ N=-N;N1=-1;N2=NN+1; }else{ N1=0;N2=NN=N; } Ratio=Ratio2=1; if(type(Sc=Sc0=getopt(scale))!=1 && type(Sc)!=4) Sc=1; if(type(Sc)==4){ Ratio=Sc[1]/Sc[0]; if(length(Sc)>2) Ratio2=Sc[2]/Sc[0]; Sc=Sc[0]; } if(type(Vw=getopt(view))!=1) Vw=0; if(type(Raw=getopt(raw))!=1) Raw=0; if(type(M1=getopt(dev))==1) M2=M1; else if(type(M1)==4){ M2=M1[1];M1=M1[0]; }else M1=0; if(type(M3=getopt(acc))!=1 || (M3<0.5 && M3>100)) M3=1; if(M1<=0) M1=16; if(M2<=0) M2=16; OL=[["para",1],["scale",Sc]]; if(Raw==1) OL=cons(["raw",1],OL); if(type(Prec=getopt(prec))>=0) OL=cons(["prec",Prec],OL); L=newvect(4,[[Lx[1],Ly[0]],[Lx[1],Ly[1]],[Lx[0],Ly[1]],[Lx[0],Ly[0]]]); Lx=[deval(Lx[0]),deval(Lx[1])]; Ly=[deval(Ly[0]),deval(Ly[1])]; Lz=[deval(Lz[0]),deval(Lz[1])]; A=(A0=A)%360; F00=F0; if(type(F0)<4){ FC=f2df(F0); if(findin(z,Vars=vars(FC))>=0 && findin(x,Vars)<0 && findin(y,Vars)<0) F0=[w,[z,0,x+y*@i],[w,os_md.abs,FC]]; } if(type(Org=getopt(org))==4){ /* shift origin */ Lx=[Lx[0]-Org[0],Lx[1]-Org[0]]; Ly=[Ly[0]-Org[1],Ly[1]-Org[1]]; Lz=[Lz[0]-Org[2],Lz[1]-Org[2]]; F0=mysubst(F0,[[x,x+Org[0]],[y,y+Org[1]]]); if(type(F0)==4){ F0=cons(F0[0]-Org[2],cdr(F0)); } else F0-=Org[2]; }else Org=[0,0,0]; Cpx=getopt(cpx); if(type(Cpx)<0){ if(str_str(rtostr(F0),"@i")>=0) Cpx=1; else Cpx=0; } if(A<0) A+=360; if(A<90){ Sh=1;F1=F0;Cx=x-Org[0];Cy=y-Org[1]; }else if(A<180){ /* x -> y, y -> -x */ Sh=2;A-=90; F1=mulsubst(F0,[[x,-y],[y,x]]); LL=Ly;Ly=[-Lx[1],-Lx[0]];Lx=LL;Cx=y-Org[1];Cy=-x+Org[0]; }else if(A<270){ Sh=3;A-=180; F1=subst(F0,[[x,-x],[y,-y]]); Lx=[-Lx[1],-Lx[0]];Ly=[-Ly[1],-Ly[0]];Cx=-x+Org[0];Cy=-y+Org[1]; }else{ Sh=4;A-=270;F1=mulsubst(F0,[[x,y],[y,-x]]); LL=Lx;Lx=[-Ly[1],-Ly[0]];Ly=LL;Cx=-y+Org[1];Cy=x-Org[0]; } A=@pi*A/180; B=@pi*B/180; if(A==0) A=@pi/3; if(B==0) B=@pi/12; NN=N*M2; Ac=dcos(deval(A)); As=dsin(deval(A)); if(Ac<=0.087 || As<=0.087){ mycat(["Unsuitable angle",A0,"(6-th argument)!"]); return -1; } Bc=Ratio*dcos(deval(B)); Bs=dsin(deval(B)); if(Bc<0){ mycat("Unsuitable angle (7-th argument)!"); return -1; } /* z = f(x,y) => X=-As*x+Ac*y, Y= Bc*f(x,y)-Bsc*x-Bss*y Out X-coord is in [X0,X1], dvided by Dev segments J-th segment of Y-coord : ZF[J]==1 => [Z0[0],Z1[J]] */ Bsc=Bs*Ac;Bss=Bs*As; if(Ratio2!=1){ if(Sh%2==1){ Ac*=Ratio2;Bss*=Ratio2; }else{ As*=Ratio2;Bsc*=Ratio2; } } CX=-As*Cx+Ac*Cy;CY=Bc*(z-Org[2])-Bsc*Cx-Bss*Cy; if(type(Dvi=getopt(dviout))!=1 && getopt(trans)==1) return [CX*Sc,CY*Sc]; if(type(N1=getopt(inf))==1){ if(Proc) Dvi=N1; else if(Dvi<=0) Dvi=-N1; } X0=-As*Lx[1]+Ac*Ly[0];X1=-As*Lx[0]+Ac*Ly[1]; F1=mysubst(F1,[@pi,deval(@pi)]); Tf=type(F1=f2df(F1|opt=0)); if(Tf!=4) F=Bc*F1-Bsc*x-Bss*y; else F=append([Bc*F1[0]-Bsc*x-Bss*y],cdr(F1)); Dx=(Lx[1]-Lx[0])/NN; Dy=(Ly[1]-Ly[0])/NN; if(type(Err=getopt(err))==1) F=mysubst(F,[[x,x+Err*Dx/1011.23],[y,y+Err*Dy/1101.34]]); Out=(Proc)?[]:str_tb(0,0); Dev=N*M1; XD=(X1-X0)/Dev; OLV=newvect(2,[OL,OL]); if(type(Ura=getopt(opt))==4 || type(Ura)==7){ if(type(Ura)==7) Ura=[Ura,Ura]; else{ OLV[0]=cons(["opt",Ura[0]],OL); OLV[1]=cons(["opt",Ura[1]],OL); } } for(KC=0; KC<=1; KC++){ /* draw curves */ Z0=newvect(Dev+1); Z1=newvect(Dev+1); ZF=newvect(Dev+1); for(I=0; I<=NN; I++){ FV=I%M2; if(KC==0){ X=x; Y=Ly[1]-I*Dy; LX=Lx; DD=Dx; G=mysubst(F,[y,Y]); if(!FV){ if(!Proc) str_tb(["%y=",rtostr(Y),"\n"],Out); else Out=cons([-2,"y="+rtostr(Y)],Out); } }else{ X=Lx[1]-I*Dx; Y=x; LX=Ly; DD=Dy; G=mysubst(F,[[x,X],[y,Y]]); if(!FV){ if(!Proc) str_tb(["%x=",rtostr(X),"\n"],Out); else Out=cons([-2,"x="+rtostr(X)],Out); } } XX=-As*X+Ac*Y; A1=coef(XX,1,x); A0=coef(XX,0,x); /* XX = A1*x + A0, x = (XX-A0)/A1 */ if(!FV && Vw==1){ if(Proc) Out=cons(xygraph([XX,G],N,LX,[X0,X1],Lz|scale=Sc,para=1,proc=3),Out); else str_tb(xygraph([XX,G],N,LX,[X0,X1],Lz|scale=Sc,para=1),Out); continue; } V=VT=LX[1]; J0=(subst(XX,x,LX[0])-X0)/XD; J1=(subst(XX,x,LX[1])-X0)/XD; if(J0 (x,z):(dec,inc) */ }else{ J0=floor(J0); J1=ceil(J1); JD=-1; /* fixed y: x: dec => (x,z):(inc,inc) */ } for(FF=1,J=J1;;J-=JD){ V1=VT; VT=(X0+J*XD-A0)/A1;GG=mysubst(G,[x,VT]); if(Cpx>=1) VV=myeval(GG); else VV=(Tf==4)? mydeval(GG):deval(GG); /* J -> V */ if(ZF[J]==0 || VV<=Z0[J] || VV>=Z1[J]){ /* visible */ if(FF==0){ V0=(VT+V1)/2; if(!FV && Vw==-1 && Raw!=1){ /* draw doted line */ K=ceil(M3*(V-V0)/(M2*DD)); if(N1<0) K=-K; OPT=append(OPT0,[["opt",(TikZ)?"dotted":"~*=<3pt>{.}"],["scale",Sc],["para",1]]); Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz| option_list=OPT),Out); } V=V0; } if(ZF[J]==0){ ZF[J]=1; Z0[J]=Z1[J]=VV; }else if(VV<=Z0[J]) Z0[J]=VV; else Z1[J]=VV; if(VV>=Z1[J]) FF=1; else if(VV<=Z0[J]) FF=-1; }else{ if(FF!=0){ V0=(VT+V1)/2; K=ceil(M3*(V-V0)/(M2*DD)); if(N1<0) K=-K; if(!FV){ OPT=append(OPT0,OLV[(1-FF)/2]); Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz|option_list=OPT),Out); } V=V0; } FF=0; } if(J==J0) break; } if(FV) continue; V0=LX[0];K=ceil(M3*(V-V0)/(M2*DD)); if(N1<0) K=-K; if(FF!=0){ if(Raw!=1){ OPT=append(OPT0,OLV[(1-FF)/2]); Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz|option_list=OPT),Out); }else if(Vw==-1 && Raw!=1){ OPT=append(OPT0,[["opt",(TikZ)?"dotted":"~*=<3pt>{.}"]]); Out=saveproc(xygraph([XX,G],K,[V0,V],[X0-1,X1+1],Lz|option_list=OPT),Out); } } } } OptSc=(Sc==1)?[]:[["scale",Sc]]; if(type(LZ=getopt(ax))==4){ /* draw box */ FC=0; if(length(LZ)==3) FC=LZ[2]; P0=newvect(2,[-As*Lx[1]+Ac*Ly[1],Bc*(LZ[0]-Org[0])-Bsc*Lx[1]-Bss*Ly[1]]); Vx=newvect(2,[As*(Lx[1]-Lx[0]),Bsc*(Lx[1]-Lx[0])]); Vy=newvect(2,[Ac*(Ly[0]-Ly[1]),Bss*(Ly[1]-Ly[0])]); Vz=newvect(2,[0,Bc*(LZ[1]-LZ[0])]); OL=OL0=append(OPT0,OL); if(TikZ && type(Ura)==4 && length(Ura)>2) OL0=cons(["opt",Ura[2]],OL); LL=[[P0+Vz,P0+Vx+Vz],[P0,P0+Vx]]; if(Bs>0){ LL=cons([P0+Vy+Vz,Pz=P0+Vx+Vy+Vz],LL); LL=cons([P0+Vx+Vz,Pz],LL); PP=Pz-Vz; } else{ LL=cons([P0+Vy,Pz=P0+Vx+Vy+Vz],LL); LL=cons([P0+Vx,Pz],LL); PP=Pz+Vz; } J=ceil((PP[0]-X0)/XD+0.5); LL=append([[P0+Vy,P0+Vy+Vz],[P0+Vy,P0+Vy+Vz],[P0+Vx,P0+Vx+Vz],[P0,P0+Vz], [P0+Vz,P0+Vy+Vz],[P0,P0+Vy]],LL); for(LL=reverse(LL);LL!=[];LL=cdr(LL)) Out=saveproc(xylines(car(LL)|option_list=OL0),Out); if(Dev>4) Dev2=ceil(Dev/2); if(FC<0 && Raw!=1){ if(TikZ){ if(type(Ura)==4 && length(Ura)>2) OL1=cons(["opt",Ura[2]+",dotted"],OL); else OL1=cons(["opt","dotted"],OL); }else OL1=cons(["opt","@{.}"],OL); if(FC==-8) FC=0; } for(I=0;I<3;I++){ /* box with hidden part */ if(I==1) Pz=PP-Vx; else if(I==2) Pz=PP-Vy; LP=Pz-PP; for(FV=-1,K=0;K<=Dev2; K++){ PPx=PP[0]+(K/Dev2)*LP[0]; PPy=PP[1]+(K/Dev2)*LP[1]; J=ceil((PPx-X0)/XD); if(K!=Dev2 && (J<0||J>Dev)) continue; if(K!=Dev2 && (ZF[J]==0 || PPyZ1[J])){ /* visible */ if(FV!=1){ FV=1; PPP=[PPx,PPy]; } }else{ if(FV!=0){ if(FV==1) Out=saveproc(xylines([PPP,[PPx,PPy]]|option_list=OL1),Out); FV=0; } } } } if(FC!=0 && Raw!=1){ /* show coordinate*/ if(iand(FC,4)){ Sub=1; if(TikZ){ S0="\\scriptsize";S1=""; }else{ S0="{}_{"; S1="}"; } }else Sub=0; if(iand(FC,2)) LLL=[[1,0,P0+Vx,(TikZ)?"right":"+!L"],[3,0,P0+Vy,(TikZ)?"left":"+!R"]]; else LL=[]; if(Bs>0){ LLL=cons([0,0,P0,(TikZ)?"below":"+!U"],LLL); LLL=cons([2,1,P0+Vx+Vy+Vz,(TikZ)?"above":"+!D"],LLL); }else{ LLL=cons([2,0,P0+Vx+Vy,(TikZ)?"below":"+!U"],LLL); LLL=cons([0,1,P0+Vz,(TikZ)?"above":"+!D"],LLL); } for(TLL=LLL;TLL!=[];TLL=cdr(TLL)){ TL=car(TLL);LL=L[(Sh+TL[0])%4]; if(Cpx==0 || Cpx==3){ S=ltotex([LL[0],LL[1],LZ[TL[1]]]|opt="coord"); SS="("+rtostr(LL[0]) +","+rtostr(LL[1])+","+rtostr(LZ[TL[1]])+")"; }else{ S=ltotex([LL[0]+LL[1]*@i,LZ[TL[1]]]|opt="coord",cpx=Cpx); SS="("+rtostr(LL[0])+"+"+rtostr(LL[1])+"i,"+ rtostr(LZ[TL[1]])+")"; } if(TikZ) S="$"+S+"$"; if(Sub) S=S0+S+S1; if(!TikZ) S="$"+S+"$"; if(Proc) Out=cons([2,OptSc,[TL[2][0],TL[2][1]],[[TL[3],S]],SS],Out); else str_tb(xyput([TL[2][0],TL[2][1],[TL[3],S]]|option_list=OptSc),Out); } } } if(type(Pt=getopt(pt))==4){ /* option pt=[] */ if(type(Pt[0])<4) Pt=[[Pt]]; if(length(Pt)>1&&type(Pt[1])!=4) Pt=[Pt]; for(PT=Pt;PT!=[];PT=cdr(PT)){ PP=car(PT); if(type(PP)==4 && length(PP)==3 && type(PP[0])<2 && type(PP[2])<2) PP=[PP]; P=car(PP); if(type(P)==7) Q=[P,0]; else if(P==1) Q=["_",0]; else Q=mysubst([CX,CY],[[x,deval(P[0])],[y,deval(P[1])],[z,deval(P[2])]]); if(length(PP)>1 && type(PP[1])==4 && length(PP[1])==3){ /* draw line */ PP=cdr(PP);P=car(PP); if(type(P)==7) Q1=P; else if(P==1) Q="_"; else Q1=mysubst([CX,CY],[[x,deval(P[0])],[y,deval(P[1])],[z,deval(P[2])]]); if(length(PP)<2 || PP[1]==0 || iand(PP[1],1)) OL2=""; else OL2=(TikZ)?"dotted":"@{.}"; if(length(PP)>2 && type(PP[2])==7){ if(OL2=="") OL2=PP[2]; else{ if(TikZ) OL2=OL2+","; OL2=OL2+PP[2]; } } OL1=OL; if(OL2!="") OL1=cons(["opt",OL2],OL1); if(length(PP)<2 || PP[1]>=0) Out=saveproc(xylines([Q,Q1]|option_list=OL1),Out); else{ LP0=Q1[0]-Q[0];LP1=Q1[1]-Q[1]; for(FV=-1,K=0;K<=Dev2; K++){ PPx=Q[0]+(K/Dev2)*LP0; PPy=Q[1]+(K/Dev2)*LP1; J=ceil((PPx-X0)/XD); if(K!=Dev2 && (J<0 || J>Dev || ZF[J]==0 || PPyZ1[J])){ /* visible */ if(FV!=1){ FV=1; PPP=[PPx,PPy]; } }else{ if(FV!=0){ if(FV==1) Out=saveproc(xylines([PPP,[PPx,PPy]]|option_list=OL1),Out); FV=0; } } } } continue; } if(length(PP)==1) S="$\\bullet$"; else if(type(PP[1])==7) S=PP[1]; else if(type(PP[1])==4){ if(length(PP[1])>1 && type(PP[1][1])!=7) S=cons(car(PP),cons("$\\bullet$",cdr(cdr(PP)))); else S=PP[1]; }else S="$\\bullet$"; if(length(PP)<=2){ if(Proc) Out=cons([2,OptSc,[Q[0],Q[1]],[S]],Out); else str_tb(xyput([Q[0],Q[1],S]|option_list=OptSc),Out); }else if(!TikZ){ if(Proc) Out=cons([2,OptSc,[Q[0],Q[1]],[S,"",PP[2]]],Out); else str_tb(xyput([Q[0],Q[1],S,"",PP[2]]|option_list=OptSc),Out); }else{ if(Proc) Out=cons([2,OptSc,[Q[0],Q[1]],cons(S,cdr(cdr(PP)))],Out); else str_tb(xyput(append([Q[0],Q[1],S],cdr(cdr(PP)))|option_list=OptSc),Out); } } } if(Proc){ S=reverse(Out); if(Proc==1||Proc==3){ for(W=[],I=0;I<2;I++) for(J=0;J<2;J++) for(K=0;K<2;K++) W=cons(mysubst([CX*Sc,CY*Sc],[[x,Lx[I]],[y,Ly[J]],[z,Lz[K]]]),W); W=ptbbox(W); S=cons([0,W[0],W[1],(TikZ)?1:1/10],S); } }else S=str_tb(0,Out); if(type(Dvi)!=1||(Proc&&abs(Dvi)<2)) return S; Lout=[]; if(abs(Dvi)>=2){ /* show title */ L0=[]; Title=getopt(title); if(type(Title)!=7) Title=(type(F00)==4)?("\\texttt{"+verb_tex_form(F00)+"}"):my_tex_form(F00); if(type(Title)==7){ T=my_tex_form(L[3][0])+"\\le x\\le "+my_tex_form(L[1][0])+",\\,"+ my_tex_form(L[3][1])+"\\le y\\le "+my_tex_form(L[1][1])+")"; if(Proc){ if(Cpx>=1) L0=[[5,[["eq",1]],"|"+Title+"|\\quad(z=x+yi,\\ "+T]]; else L0=[[5,[["eq",1]],"z="+Title+"\\ \\ ("+T]]; }else{ if(Cpx>=1) dviout("|"+Title+"|\\quad(z=x+yi,\\ "+T|eq=1,keep=1); else dviout("z="+Title+"\\ \\ ("+T|eq=1,keep=1); } } A=rint(deval(180*A/@pi))+90*(Sh-1); if(A>=180) A-=180; B=rint(deval(180*B/@pi)); if(abs(Dvi)>=3){ T="\\text{angle } ("+my_tex_form(A)+"^\\circ,"+my_tex_form(B)+"^\\circ)"; if(Ratio!=1 || Ratio2!=1) T=T+"\\quad\\text{ratio }1:" +my_tex_form(sint(Ratio2,2))+":"+my_tex_form(sint(Ratio,2)); if(Proc) L0=cons([5,[["eq",1]],T],L0); else dviout(T|eq=1,keep=1); } SS="% range "+rtostr([L[3][0],L[1][0]])+"x"+rtostr([L[3][1],L[1][1]])+ " angle ("+ rtostr(A) +","+ rtostr(B)+") dev="; if(M1==M2) SS=SS+rtostr(M1); else SS=SS+rtostr([M1,M2]); if(M3!=1) SS=SS+" acc="+rtostr(M3); if(type(Sc0)>=0) SS=SS+" scale="+rtostr(Sc0); if(Proc){ S=cons([5,[],SS],S); for(;L0!=[];L0=cdr(L0)) S=cons(car(L0),S); return S; } if(Dvi>0){ dviout(SS|keep=1); dviout(xyproc(S)|eq=8); }else Lout=[SS,S]; }else{ if(Dvi>0) dviout(xyproc(S)); else Lout=[S]; } if(getopt(trans)==1) return cons([CX*Sc,CY*Sc],Lout); 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>=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(myf2eval(car(B),I,Y),C); B=C; } 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]]); V=dexp(@i*X); for(C=A,P=1,I=0;C!=[];C=cdr(C),I++){ R+=S*car(C)*P; P*=V; } V=dexp(-@i*X); for(C=B,P=1,I=0;C!=[];C=cdr(C),I++){ P*=V; R+=car(C)*P; } return R; } if(type(X=eval(X))>1) return todf(os_md.fouriers,[[A],[B],[X]]); for(C=A,I=0;C!=[];C=cdr(C),I++) R+=car(C)*mycos(I*X); for(C=B,I=1;C!=[];C=cdr(C),I++) R+=car(C)*mysin(I*X); return R; } def myexp(Z) { if(type(Z=eval(Z))>1) return todf(os_md.myexp,[Z]); if((Im=imag(Z))==0) return dexp(Z); return dexp(real(Z))*(dcos(Im)+@i*dsin(Im)); } def mycos(Z) { if(type(Z=eval(Z))>1) return todf(os_md.mycos,[Z]); if((Im=imag(Z))==0) return dcos(Z); V=myexp(Z*@i); return (V+1/V)/2; } def mysin(Z) { if(type(Z=eval(Z))>1) return todf(os_md.mysin,[Z]); if((Im=imag(Z))==0) return dsin(Z); V=myexp(Z*@i); return (1/V-V)*@i/2; } def mytan(Z) { if(type(Z=eval(Z))>1) return todf(os_md.mytan,[Z]); if((Im=imag(Z))==0) return dtan(Z); V=myexp(2*Z*@i); return @i*(1-V)/(1+V); } def mylog(Z) { if(type(Z=eval(Z))>1) return todf(os_md.mylog,[Z]); if((Im=imag(Z))==0) return dlog(Z); return dlog(dabs(Z))+@i*myarg(Z); } def mypow(Z,R) { if(type(Z=eval(Z))>1||type(R=eval(R))>1) return todf(os_md.mypow,[Z,R]); if(Z==0) return 0; if(isint(2*R)){ if(R==0) return 1; if(isint(R)) return Z^R; V=dsqrt(Z); if(R==1/2) return V; return Z^(R-1/2)*V; } return myexp(R*mylog(Z)); } def myarg(Z) { if(type(Z=map(eval,Z))==4){ if(length(Z)!=2) return todf(os_md.myarg,[Z]); Re=Z[0];Im=Z[1]; }else if(type(Z)>1){ return todf(os_md.myarg,[Z]); }else { Im=imag(Z);Re=real(Z); } if(Re==0) return (Im<0)?-deval(@pi)/2:deval(@pi)/2; V=datan(Im/Re); if(Re>0) return V; return (V>0)?(V-deval(@pi)):(V+deval(@pi)); } def myatan(Z) { if(type(Z=eval(Z))>1) return todf(os_md.myatan,[Z]); if((Im=imag(Z))==0) return datan(Z); mylog((1-Z*@i)/(1+Z*@i))*@i/2; } def myasin(Z) { if(type(Z=eval(Z))>1) return todf(os_md.myasin,[Z]); return deval(@pi/2)-myacos(Z); } def frac(X) { if(type(X=eval(X))>1) return todf(os_md.frac,[X]); return (ntype(X)==3)? pari(frac,X):(X-floor(X)); } def myacos(Z) { if(type(Z=eval(Z))>1) return todf(os_md.myacos,[Z]); if(imag(Z)==0 && Z<=1 && Z>=-1) return dacos(Z); return mylog(Z-dsqrt(Z^2-1))*@i; } def arg(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.arg,[Z]); return (type(Z)==4)?pari(arg,Z[0],Z[1]):arg(sqrt,Z); } def sqrt(Z){ if(vars(Z=map(eval,Z))!=[]) return todf(os_md.sqrt,[Z]); R=(type(Z)==4)?Z[1]:Z; if(ntype(R)==0){ if(R==0) return 0; if(R>0){ if(pari(issquare,R)) return pari(isqrt,nm(R))/pari(isqrt,dn(R)); }else{ R=-R; if(pari(issquare,R)) return pari(isqrt,nm(R))/pari(isqrt,dn(R))*@i; } } return (type(Z)==4)?pari(sqrt,Z[0],Z[1]):pari(sqrt,Z); } def gamma(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.gamma,[Z]); return (type(Z)==4)?pari(gamma,Z[0],Z[1]):pari(gamma,Z); } def lngamma(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.lngamma,[Z]); return (type(Z)==4)?pari(lngamma,Z[0],Z[1]):pari(lngamma,Z); } def digamma(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.digamma,[Z]); return (type(Z)==4)?pari(digamma,Z[0],Z[1]):pari(digamma,Z); } def dilog(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.dilog,[Z]); return (type(Z)==4)?pari(dilog,Z[0],Z[1]):pari(dilog,Z); } def erfc(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.erfc,[Z]); return (type(Z)==4)?pari(erfc,Z[0],Z[1]):pari(erfc,Z); } def zeta(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.zeta,[Z]); return (type(Z)==4)?pari(zeta,Z[0],Z[1]):pari(zeta,Z); } def eta(Z) { if(vars(Z=map(eval,Z))!=[]) return todf(os_md.eta,[Z]); return (type(Z)==4)?pari(eta,Z[0],Z[1]):pari(eta,Z); } def jell(Z) { if(vars(Z=map(eval,V))>1) return todf(os_md.jell,[Z]); return (type(Z)==4)?pari(jell,Z[0],Z[1]):jell(jell,Z); } def evals(F) { if(type(F)==7){ if(type(Del=getopt(del))!= 7) return eval_str(F); S=strtoascii(Del);K=length(S); if(K==0) return [eval_str(F)]; Raw=getopt(raw); F=strtoascii(F);L=[];T1=0; do{ T2=str_str(F,S|top=T1); if(T2<0) T2=10000; FT=str_cut(F,T1,T2-1); L=cons((Raw==1)?FT:evals(FT),L); T1=T2+K; }while(T2!=10000); return reverse(L); } if(type(F)==4){ if(type(S=car(F))==7){ S+="("; for(I=0,FT=cdr(F); FT!=[]; I++,FT=cdr(FT)){ if(type(ST=car(FT))!=7) ST=rtostr(ST); if(I>0) S=S+","+ST; else S=S+ST; } S=S+")"; return eval_str(S); }else return call(S,cdr(F)); } return F; } def myval(F) { if(type(F)!=4){ F=f2df(sqrt2rat(F)); if(type(F)!=4) return F; }; if(length(F)==1) V=car(F); else for(V=car(F),F=cdr(F); F!=[];){ FT=car(F); if(type(G=FT[1])==2){ if(length(FT)>2){ FT2=myval(FT[2]); if(length(FT)>3) FT3=myval(FT[3]); }; X=red(FT2/@pi);Vi=-red(FT2*@i/@pi);W=red(FT2/@e); if(G==os_md.mypow && FT3==1/2){ G=os_md.sqrt; FT=[FT[0],G,FT[2]]; } if((T=findin(G, [sin,os_md.mysin,cos,os_md.mycos,tan,os_md.mytan]))>=0 &&(isint(6*X)||isint(4*X))){ if(T==2||T==3){ T=0;X=1/2-X; } X=X-floor(X/2)*2; if(T==0||T==1){ if(X>1){ S=-1;X-=1; }else S=1; if(X>1/2) X=1-X; if(X==0) R=0; else if(X==1/6) R=1/2; else if(X==1/4) R=2^(1/2)/2; else if(X==1/3) R=3^(1/2)/2; else R=1; R*=S; }else{ if(X>1) X-=1; if(X>1/2){ S=-1;V=1-X; }else S=1; if(X==0) R=0; else if(X==1/6) R=3^(1/2)/3; else if(X==1/4) R=1; else if(X==1/3) R=3^(1/2); else R=2^512; R*=S; } }else if((G==exp||G==os_md.myexp)&&(isint(FT2)||isint(6*Vi)||isint(4*Vi))){ if(isint(FT2)) R=@e^FT2; else R=myval([z+w*@i,[z,cos,Vi*@pi],[w,sin,Vi*@pi]]); }else if((G==pow||G==os_md.mypow) && (isint(FT3)||FT2==1||FT2==0)){ if(FT2==0) R=0; else if(FT2==1) R=1; else R=FT2^FT3; }else if(G==os_md.abs&&ntype(P=eval(FT2))<4){ R=FT2; if(P<0) R=-R; }else if((G==os_md.sqrt||G==dsqrt)&&type(FT2)<2&&ntype(FT2)==0) R=sqrtrat(FT2); else if((G==os_md.mylog||G==dlog)&&(FT2==@e||FT2==1)) R=(FT2==1)?0:1; else if(length(FT)==3) R=eval((*G)(myeval(FT2))); #ifdef USEMODULE else R=call(G,map(os_md.myeval,cdr(cdr(FT)))); #else else R=call(G,map(myeval,cdr(cdr(FT)))); #endif } else if(G==0) R=FT[2]; #ifdef USEMODULE else R=eval(call(G[0],map(os_md.myeval,cdr(cdr(FT)))|option_list=G[1])); #else else R=eval(call(G[0],map(myeval,cdr(cdr(FT)))|option_list=G[1])); #endif V=mysubst(V,[FT[0],R]); F=mysubst(cdr(F),[FT[0],R]); } if(type(V)<4 && !iscoef(V,os_md.iscrat)) V=eval(V); #if 0 return (type(V)<4)?myeval(V):mtransbys(os_md.myeval,V,[]); #else return V; #endif } /* -1:空 0:整数 1:有理数 2:Gauss整数 3:Gauss有理数 4:それ以外の複素数 */ /* def vntype(F) { if((T=type(F))<2){ if(T<0) return -1; if((Tn=ntype(F))==0){ return (isint(F))?0:1; } if(Tn==4){ if(ntype(real(F))==0&&ntype(real(F))==0) return (isint(F)&&isint(F))?2:3; return 4; } } if(T==2){ V=vars(F); if((VV=lsort(V,[@e,@pi],1))==[]){ FT=mycoef( }else{ if(length(VV)==1){ }else } }else if(T==3){ } } */ def myeval(F) { if(type(F)!=4) V=F; else if(length(F)==1) V=car(F); else for(V=car(F),F=cdr(F); F!=[];){ FT=car(F); if(type(G=FT[1])==2){ if(length(FT)==3) R=(*G)(myeval(FT[2])); #ifdef USEMODULE else R=call(G,map(os_md.myeval,cdr(cdr(FT)))); #else else R=call(G,map(myeval,cdr(cdr(FT)))); #endif } else if(G==0) R=myeval(FT[2]); #ifdef USEMODULE else R=call(G[0],map(os_md.myeval,cdr(cdr(FT)))|option_list=G[1]); #else else R=call(G[0],map(myeval,cdr(cdr(FT)))|option_list=G[1]); #endif V=mysubst(V,[FT[0],R]); F=mysubst(cdr(F),[FT[0],R]); } return (type(V)<4)?eval(V):mtransbys(eval,V,[]); } def mydeval(F) { if(type(F)!=4) V=F; else if(length(F)==1) V=car(F); else for(V=car(F),F=cdr(F); F!=[]; ){ FT=car(F); if(type(G=FT[1])==2){ if(length(FT)==3) R=(*G)(myeval(FT[2])); #ifdef USEMODULE else R=call(G,map(os_md.mydeval,cdr(cdr(FT)))); #else else R=call(G,map(mydeval,cdr(cdr(FT)))); #endif } else if(G==0) R=mydeval(FT[2]); #ifdef USEMODULE else R=call(G[0],map(os_md.mydeval,cdr(cdr(FT)))|option_list=G[1]); #else else R=call(G[0],map(mydeval,cdr(cdr(FT)))|option_list=G[1]); #endif V=mysubst(V,[FT[0],R]); F=mysubst(cdr(F),[FT[0],R]); } return (type(V)<4)?deval(V):mtransbys(deval,V,[]); } def myfeval(F,X) { if(type(X)==4){ if(isvar(X[0])&&length(X)==2) return mydeval(mysubst(F,[X[0],X[1]])); if(type(X[0])==4&&isvar(X[0][0])&&length(X[0])==2){ for(Y=X;Y!=[];Y=cdr(Y)) F=mysubst(F,[car(Y)[0],car(Y)[1]]); return myeval(F); } } return myeval(mysubst(F,[x,X])); } def myf2eval(F,X,Y) { return myeval(mysubst(F,[[x,X],[y,Y]])); } def myf3eval(F,X,Y,Z) { return myeval(mysubst(F,[[x,X],[y,Y],[z,Z]])); } def myfdeval(F,X) { if(type(X)==4){ if(isvar(X[0])&&length(X)==2) return mydeval(mysubst(F,[X[0],X[1]])); if(type(X[0])==4&&isvar(X[0][0])&&length(X[0])==2){ for(Y=X;Y!=[];Y=cdr(Y)) F=mysubst(F,[car(Y)[0],car(Y)[1]]); return mydeval(F); } } return mydeval(mysubst(F,[x,X])); } def myf2deval(F,X,Y) { return mydeval(mysubst(F,[[x,X],[y,Y]])); } def myf3deval(F,X,Y,Z) { return mydeval(mysubst(F,[[x,X],[y,Y],[z,Z]])); } def df2big(F) { AG=[[os_md.mysin,sin],[os_md.mycos,cos],[os_md.mytan,tan],[os_md.myasin,asin], [os_md.acos,acos],[os_md,atan,atan],[os_md.myexp,exp],[os_md.mylog,log],[os_md.mypow,pow]]; if(getopt(inv)!=1) return mysubst(F,AG); else return mysubst(F,AG|inv=1); } def f2df(F) { if(type(Opt=getopt(opt))!=1) Opt=0; if(iand(Opt,1)){ if(Opt>0) F=map(eval,F); else F=map(deval,F); } Cpx=getopt(cpx); if(type(F)==4 && iand(Opt,2)==0) return F; K=getopt(level); if(type(K)!=1) K=0; AG=[sin,cos,tan,asin,acos,atan,exp,sinh,cosh,tanh,log,pow]; AGd=[os_md.mysin,os_md.mycos,os_md.mytan,os_md.myasin,os_md.myacos, os_md.myatan,os_md.myexp,os_md.myexp,os_md.myexp,os_md.myexp, os_md.mylog,os_md.sqrt,os_md.myexp]; for(R=[],I=0,Arg=vars(F);Arg!=[];Arg=cdr(Arg)){ Fn=functor(car(Arg)); if(vtype(Fn)!=3) continue; V=args(car(Arg)); for(PAG=AG,PAGd=AGd;PAG!=[];PAG=cdr(PAG),PAGd=cdr(PAGd)){ if(Fn==car(PAG)){ if(K==0) L="z__"; else L="z"+rtostr(K)+"__"; if(I==0) VC=makev([L]); else VC=makev([L,I]); I++; VC0=VC; if(Fn==sinh || Fn==cosh || Fn==tanh){ VC=makev([L,I++]); if(Fn==sinh) R=cons([VC0,0,(VC^2-1)/(2*VC)],R); else if(Fn==cosh) R=cons([VC0,0,(VC^2+1)/(2*VC)],R); else R=cons([VC0,0,(VC^2-1)/(VC^2+1)],R); } if(Fn==pow && (V[1]!=1/2||Cpx==1)){ #if 0 R0=f2df(V[1]*((type(V[0])==1)?dlog(V[0]):log(V[0]))|level=K+1); PAGd=cdr(PAGd); #else R=cons([VC,os_md.mypow,V[0],V[1]],R); F=mysubst(F,[car(Arg),VC0]); Arg=cons(0,vars(F)); break; #endif }else R0=f2df(V[0]|level=K+1); R=cons([VC,car(PAGd),R0],R); F=mysubst(F,[car(Arg),VC0]); Arg=cons(0,vars(F)); break; } } } if(R==[]) return F; if(Cpx==1){ for(PAG=P,PAGd=AGd;PAG!=[];PAG=cdr(PAG),PAGd=cdr(PAGd)) R=mysubst(R,[car(PADd),car(PAG)]); } return cons(F,reverse(R)); } def todf(F,V) { if(type(V)!=4) V=[V]; for(R=[];V!=[];V=cdr(V)){ R=cons(f2df(car(V)),R); } V=reverse(R); Z=makenewv([F,V]); return [Z,cons(Z,cons(F,V))]; } 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(F)==7){ if(str_str(F,"|")==0){ F="abs("+str_cut(F,1,str_len(F)-2)+")"; }else if(str_str(F,"[")==0){ F="floor("+str_cut(F,1,str_len(F)-2)+")"; } I=str_str(F,"("); Var=x; if(I>0){ J=str_pair(F,I+1,"(",")"); if(J<0) return 0; Var=eval_str(str_cut(F,I+1,J-1)); Var=f2df(Var); F0=str_cut(F,0,I-1); } if((I=findin(F0,FL))<0&&(I=findin(F,FL))<0) F=f2df(eval_str(F)); else F=[z__,[z__,FS[I],Var]]; } 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]); if(findin(X,VF)<0 && findin(X,VG)<0){ E=1;break; } } if(E) break; } if(!E) return 0; 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]); if(isvar(G[0])){ G=mysubst(G,[G[0],X]); if(length(G)==2&&type(G[1])==4&&G[1][0]==X) G=G[1]; G=cons(G,cdr(F)); } else G=cons([X,0,G],cdr(F)); return cons(car(F),G); } def fzero(F,LX) { if(length(LX)==3){ V=LX[0];LX=cdr(LX); }else V=x; LX1=eval(LX[0]);LX2=eval(LX[1]); if(getopt(zero)==1){ if(getopt(cont)==1) CT=1; else CT=0; if(getopt(trans)!=1 && type(F)<4) F=f2df(F); F=mysubst(F,[[@pi,deval(@pi)],[@e,deval(@e)]]); if(type(Dev=getopt(dev))!=1 || Dev<2) Dev=16; V1=myeval(mysubst(F,[V,X1=LX1])); V2=myeval(mysubst(F,[V,X2=LX2])); if(V1>0){ V0=V1;V1=V2;V2=V0; X0=X1;X1=X2;X2=X0; } if(V1<0 && V2>0){ D=(V2-V1)*1024; for(I=0; ID) return []; V2=V0;X2=X0; } } X0=(V2*X1-V1*X2)/(V2-V1); return [X0,myeval(mysubst(F,[V,X0]))]; } if(V0==0) return [X0,V0]; if(V1==0) return [X1,V1]; return []; } if(type(F)<4) F=f2df(F); F=mysubst(F,[[@pi,deval(@pi)],[@e,deval(@e)]]); L=[]; if(type(F)<4){ if(type(F)==3) F=nm(red(F)); if((Deg=deg(F,V))<=2){ if(Deg==2){ D=(C1=coef(F,1,V))^2-4*(C2=coef(F,2,V))*coef(F,0,V); if(D>=0){ R=dsqrt(D); if((S=(-C1+R)/(2*C2))>=LX1&&S<=LX2) L=[[S,mysubst(F,[V,S])]]; if(D!=0 && (S=(-C1-R)/(2*C2))>=LX1&&S<=LX2) L=cons([S,mysubst(F,[V,S])],L); } L=qsort(L); }else if(Deg==1&&(S=-coef(F,0,V)/coef(F,1,V))>=LX1&&S<=LX2) L=[[S,mysubst(F,[V,S])]]; return L; } for(L=[];S!=[];S=cdr(S)) if(car(S)>=LX1&&car(S)<=LX2) L=cons([car(S),mysubst(F,[V,car(S)])],L); return qsort(L); } if(type(Div=getopt(mesh))!=1 || Div<=0) Div = 2^(10); W=(LX2-LX1)/Div; for(I=V2=0;I<=Div;I++){ X1=X2;X2=LX1+I*W;V1=V2; if((V2=myeval(mysubst(F,[V,X2])))==0) L=cons([X2,V2],L); if(V1*V2<0){ L0=fzero(F,[V,X1,X2]|zero=1,trans=1); if(L0!=[]) L=cons(L0,L); } } return reverse(L); } def fmmx(F,LX) { if(length(LX)==3){ V=LX[0];LX=cdr(LX); }else V=x; LX1=eval(LX[0]);LX2=eval(LX[1]); FT=F; if(getopt(trans)!=1 && type(F)<4) FT=f2df(FT); FT=mysubst(FT,[[@pi,eval(@pi)],[@e,eval(@e)]]); if(type(G=getopt(dif))>=1){ if(G==1) G=os_md.mydiff(F,V); L=fzero(G,[V,LX1,LX2]|option_list=getopt()); R=[[LX1,myeval(mysubst(FT,[V,LX1]))]]; for(I=0;L!=[];L=cdr(L),I++){ X=car(L)[0]; if(X==LX1) continue; R=cons([X,myeval(mysubst(FT,[V,X]))],R); } if(X!=LX2) R=cons([LX2,myeval(mysubst(FT,[V,LX2]))],R); if(getopt(mmx)!=1) return reverse(R); for(Mi=Ma=car(R);R!=[];R=cdr(R)){ if(car(R)[1]>Ma[1]) Ma=car(R); else if(car(R)[1]Ma[1]) Ma=car(L); else if(car(L)[1]1&&Pc<31)||Pc>-5) Lim+=Pc; } if(type(Pc=getopt(init))==1 && Pc>0) FS*=Pc; if(type(L)==7) L=[L]; else if(type(L)<2){ K=flim(F,["+",L]|option_list=getopt()); if(K=="") return K; K1=flim(F,["-",L]|option_list=getopt()); if(K1=="") return K1; if(type(K)==7||type(K1)==7){ if(K!=K1) return ""; return K; } if(abs(K)<10^(-5)){ if(abs(K1)<10^(-5)) return (K1+K)/2; else return ""; } if(abs((K1-K)/K)<10^(-4)) return (K1+K)/2; return ""; } if(type(L)!=4||type(L[0])!=7) return ""; if(L[0]=="-"||L[0]=="-infty"){ FS=-FS; }else if(L[0]!="+"&&L[0]!="infty") return ""; FI=(length(L)==1)?1:0; for(Inf=0,I=Lim0;ID2){ D=D1;D1=D2;D1=D; X1=D1;X2=D2; } if(FI==0){ D1+=L[1];D2+=L[1]; } K=fmmx(FD,[D1,D2]|mmx=1,mesh=16,dev=4); if(I>Lim0){ if(DF10^(-8)&&DF<10^7){ if(I>Lim0+1){ if(Inf==0) return ""; }else Inf=1; }else if(Inf==1) return ""; } DF=K[1][1]-K[0][1]; } if(Inf==1){ if(K[0][1]>10^8) return "+"; else if(K[1][1]<-10^8) return "-"; return ""; } V=(myfeval(FD,D1)+1.0)-1.0; if(V!=0 && abs(V)<10^(-9)) return 0; return V; } def fcont(F,LX) { if(length(LX)==3){ V=LX[0];LX=cdr(LX); }else V=x; LX1=eval(LX[0]);LX2=eval(LX[1]); if(getopt(trans)!=1 && type(F)<4) FT=f2df(F); if(type(Div=getopt(mesh))!=1 || Div<=0) Div = 2^(10); if(type(Dev=getopt(dev))!=1 || Dev<2) Dev=16; W=(LX2-LX1)/Div; if((Df=getopt(dif))!=1){ Df=0; }else{ if(Dev==16) Dev=6; WD=W/2^(Dev+1); } F=FT; C=2; for(I=V2=V3=0;I<=Div;I++){ X1=X2;X2=X3;X3=LX1+I*W;V1=V2;V2=V3; V3=myeval(mysubst(F,[V,X3])); if(Df){ if(I==Div) break; V3=(myeval(mysubst(F,[V,X3+WD]))-V3)/WD; } if(I==0) L=[[X3,V3]]; if(I<2) continue; if(C*dabs(2*V2-V1-V3) > dabs(V1-V3)){ X01=X1;V01=V1;X02=X2;V02=V2;X03=X3;V03=V3; for(J=0; X01!=X03; J++){ if(dabs(V01-V02)>dabs(V02-V03)){ X03=X02;V03=V02; }else{ X01=X02;V01=V02; } if(J==Dev) break; X02=(X01+X02)/2; V02=myeval(mysubst(F,[V,X02])); if(Df) V02=(myeval(mysubst(F,[V,WD]))-V02)/WD; if(C*dabs(2*V02-V01-V03) < dabs(V01-V03)) break; } if(J==Dev||X01==X03) L=cons([X01,X03,V03-V01],L); } } return reverse(L); } def xygraph(F,N,LT,LX,LY) { if((Proc=getopt(proc))!=1&&Proc!=2&&Proc!=3) Proc=0; if(type(DV=getopt(dviout))==4){ OL=delopt(getopt(),["dviout","shift","ext","cl"]); OL=cons(["proc",1],OL); R=xygraph(F,N,LT,LX,LY|option_list=OL); OL=delopt(getopt(),["shift","ext","cl"]|inv=1); return execdraw(R,DV|optilon_list=OL); } if(N==0) N=32; if(N<0){ N=-N; N1=-1; N2=N+1; }else{ N1=0; N2=N; } if(length(LT)==3 && isvar(LT[0])==1){ TT=LT[0]; LT=cdr(LT); F=mysubst(F,[TT,x]); } if(LX==0) LX=LT; if((Acc=getopt(Acc))!=1) Acc=0; if(Acc){ LX=[eval(LX[0]),eval(LX[1])]; LY=[eval(LY[0]),eval(LY[1])]; LT=[eval(LT[0]),eval(LT[1])]; }else{ LX=[deval(LX[0]),deval(LX[1])]; LY=[deval(LY[0]),deval(LY[1])]; LT=[deval(LT[0]),deval(LT[1])]; } TD=(LT[1]-LT[0])/N; if(type(Mul=getopt(scale))!=1){ if(type(Mul)==4){ MulX=Mul[0]; MulY=Mul[1]; }else MulX=MulY=1; }else MulX=MulY=Mul; if(type(Org=getopt(org))==4){ Orgx=Org[0];Orgy=Org[1]; }else Orgx=Orgy=0; if(type(F)!=4 || (getopt(para)!=1 && length(F)>1 && type(F[0])<4 && type(F[1])==4)) { if(getopt(rev)!=1){ F1=x; /* LX[0]+(LX[1]-LX[0])*(x-LT[0])/(TD*N); */ F2=F; }else{ F1=F; F2=x; /* LY[0]+(LY[1]-LY[0])*(x-LT[0])/(TD*N); */ } }else{ F1=F[0]; F2=F[1]; } if(F1==0 || F2==0) LT=[]; if(length(LT)==2){ if(Acc){ for(LTT=[],I=N2;I>=N1;I--) LTT=cons(eval(LT[0]+I*(LT[1]-LT[0])/N),LTT); }else{ for(LTT=[],I=N2;I>=N1;I--) LTT=cons(deval(LT[0]+I*(LT[1]-LT[0])/N),LTT); } LT=LTT; } Cpx=getopt(cpx); if(Cpx!=1 && (str_str(rtostr(F1),"@i")>=0 || str_str(rtostr(F2),"@i")>=0)) Cpx=1; if(type(Cpx)<0) Cpx=0; if(!Acc){ if(type(F1)<4) F1=f2df(F1); if(type(F2)<4) F2=f2df(F2); } if(type(Err=getopt(err))==1){ F1=mysubst(F1,[x,x+Err*TD/1001.23]); F2=mysubst(F2,[x,x+Err*TD/1001.23]); } if(type(F1)==4 || type(F2)==4){ Dn=1; }else Dn=dn(F1)*dn(F2); for(V=[],PT=LT;PT!=[]; PT=cdr(PT)){ T=car(PT); if(myfeval(Dn,T)==0){ V=cons(0,V); continue; } if(Cpx>0||Acc){ X=myfeval(F1,T);Y=myfeval(F2,T); }else{ X=myfdeval(F1,T);Y=myfdeval(F2,T); } if((N1==0||(PT!=LT&&length(PT)!=1)) && (XLX[1]||YLY[1])) V=cons(0,V); else V=cons([MulX*(X-Orgx),MulY*(Y-Orgy)],V); } V=reverse(V); Gap0=Gap=Arg=0; if(type(Prec=getopt(prec))<0) Level=0; else if(Prec==0) Level=4; else if(type(Prec)==1){ Level=Prec; if(Level<0){ Level=-Level; Gap0=1; } }else if(type(Prec)==4){ Level=Prec[0]; if(length(Prec)>1) Arg=Prec[1]; if(length(Prec)>2) Gap0=Prec[2]; } if(Level>0){ if(Level>16) Level=16; if(Arg<=0) Arg=30; else if(Arg>120) Arg=120; Arg=Acc?eval(@pi*Arg/180):deval(@pi*Arg/180); SL=dcos(Arg); } if(Gap0>0){ if(Gap0<2) Gap0=16; else if(Gap0>512) Gap0=512; Gap=((MulX*(LX[1]-LX[0]))^2+(MulY*(LY[1]-LY[0]))^2)/(Gap0^2); } for(I=0;I1){ if((CV1=car(cdr(PV)))!=0 && CV!=0) D1=[CV[0]-CV1[0],CV[1]-CV1[1]]; else D1=0; }else K=-1; /* ? */ if(K>0 &&(((D1==0||D0==0)&&(CV0!=0||CV!=0||CV1!=0)) || dvangle(D0,D1)0 && type(D0)==4 && (TG=(D0[0]^2+D0[1]^2-Gap)>0)))){ G++;T1=(CLT0+CLT)/2; if(F==0 && (CV0!=0 || CV!=0)){ if(myfdeval(Dn,T1)==0){ NV=cons(0,NV); NLT=cons(T1,NLT); } if(Cpx>0||Acc){ X=myfeval(F1,T1);Y=myfeval(F2,T1); }else{ X=myfdeval(F1,T1);Y=myfdeval(F2,T1); } if(K==1 && N1<0){ NV=[];NLT=[]; } if((K>1||N1==0)&&(XLX[1]||YLY[1])){ NV=cons(0,NV);NLT=cons(T1,NLT);F=0; }else{ NV=cons([MulX*(X-Orgx),MulY*(Y-Orgy)],NV);NLT=cons(T1,NLT); } } NV=cons(CV,NV);NLT=cons(CLT,NLT); if(!TG&&(CV0!=0||CV1!=0)){ T2=(car(cdr(PLT))+CLT)/2; if(myfdeval(Dn,T2)==0){ NV=cons(0,NV); NLT=cons(CLT,NLT); } if(Cpx>0||Acc){ X=myfeval(F1,T2);Y=myfeval(F2,T2); }else{ X=myfdeval(F1,T2);Y=myfdeval(F2,T2); } if((N1==0||length(PV)!=2)&&(XLX[1]||YLY[1])){ NV=cons(0,NV);NLT=cons(T1,NLT); }else{ NV=cons([MulX*(X-Orgx),MulY*(Y-Orgy)],NV);NLT=cons(T2,NLT); } } if(length(PV)==2 && N1==-1) break; F=1; }else{ F=0;NV=cons(CV,NV);NLT=cons(CLT,NLT); } } V=reverse(NV);LT=reverse(NLT); if(G==0) break; } if(Gap>0){ for(NV=[],PV=V;PV!=[];PV=cdr(PV)){ NV=cons(P0=car(PV),NV); if(length(PV)>1 && P0!=0 && PV[1]!=0 && (P0[0]-PV[1][0])^2+(P0[1]-PV[1][1])^2>Gap) NV=cons(0,NV); } V=reverse(NV); } 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); } if(Acc==1) OL=cons(["Acc",1],OL); if(N1<0) OL=cons(["close",-1],OL); if(type(Opt=getopt(opt))!=7 && type(Opt)!=4){ if(Opt==0) return xylines(V|option_list=cons(["opt",0],OL)); } OL=cons(["opt",(Proc)?0:Opt],OL); if(type(Opt)>=0) OLP=cons(["opt",Opt],OLP); if(type(Vb=getopt(verb))==1||type(Vb)==4){ OL=cons(["verb",Vb],OL);OLP=cons(["verb",Vb],OL); } if(Proc){ S=(Proc==1)? [[0,[MulX*(LX[0]-Orgx),MulX*(LX[1]-Orgx)],[MulY*(LY[0]-Orgy),MulY*(LY[1]-Orgy)], (TikZ)?1:1/10]]:[]; S=cons([1,OLP,xylines(V|option_list=OL)],S); if(Proc==3) return car(S); }else S=xylines(V|option_list=OL); if(type(Pt=getopt(pt))==4){ if(type(Pt[0])!=4) Pt=[Pt]; if(length(Pt)>1 && type(Pt[1])!=4) Pt=[Pt]; for(PT=Pt;PT!=[];PT=cdr(PT)){ PP=car(PT); if(type(PP[0])!=4) PP=[PP]; P=car(PP);PP=cdr(PP); Qx=MulX*(P[0]-Orgx);Qy=MulY*(P[1]-Orgy); if(length(PP)>0 && type(PP[0])==4){ /* draw line */ P=car(PP); Q1x=MulX*(P[0]-Orgx);Q1y=MulY*(P[1]-Orgy); if(length(PP)<1 || car(PP)==0 || iand(car(PP),1)) OL=["opt",(TikZ)?"-":"@{-}"]; else OL=["opt",(TikZ)?".":"@{.}"]; if(Proc) S=cons([1,OL,[[Qx,Qy],[Q1x,Q1y]]],S); else S=S+xylines([[Qx,Qy],[Q1x,Q1y]]|optilon_list=OL); continue; } if(length(PP)==0 || type(car(PP))!=7) SS="$\\bullet$"; else SS=car(PP); if(length(PP)<=1){ if(Proc) S=cons([2,[],[Qx,Qy],[SS]],S); else S=S+xyput([Qx,Qy,SS]); }else{ if(Proc) S=cons([2,[],[Qx,Qy],[[SS],"",PP[1]]],S); S=S+xyput([Qx,Qy,SS,"",PP[1]]); } } } if(type(Ax=getopt(ax))==4){ /* draw axis */ Adx0=Ady0=0; Adx1=Ady1=0.1; if(!TikZ){ if(!XYcm) Adx1=Ady1=1; LOp="@{-}"; LxOp="+!U"; LyOp="+!R"; }else{ LOp="-"; LxOp="below"; LyOp="left"; } LOp0=LOp1=LOp; LxOO=(Ax[1]==LY[0])?LxOp:(TikZ)?"below left":"+!UR"; if(type(AxOp=getopt(axopt))>0){ if(type(AxOp)==1){ if(AxOp>0) Adx1=Ady1=AxOp; else if(AxOp<0){ Adx1=Ady1=0; Adx0=Ady0=AxOp; } }else if(type(AxOp)==4){ if(type(T=car(AxOp))==4 && length(AxOp)>1){ if(type(T)==7){ LxOp=T; LyOp=AxOp[1]; }else if(type(T)==4){ Ay0=T[0]; Ay1=T[1]; Ax0=AxOp[1][0]; Ax1=AxOp[1][1]; if(length(T)>2) LxOp=T[2]; if(length(AxOp[1])>2) LyOp=AxOp[1][2]; } } if(length(AxOp)>2 && type(AxOp[2])==7) LxOO=AxOp[2]; if(length(AxOp)>3 && type(AxOp[3])==7) LOp0=AxOp[3]; if(length(AxOp)>4 && type(AxOp[4])==7) LOp1=AxOp[4]; } if(type(AxOp)==7) LOp0=AxOp; } if(Ax[0]>=LX[0] && Ax[0]<=LX[1]){ /* draw marks on x-axis */ if(Proc) S=cons([3,(type(LOp0)>=0)?[["opt",LOp0]]:[], [MulX*(Ax[0]-Orgx),MulY*(LY[0]-Orgy)],[MulX*(Ax[0]-Orgx),MulY*(LY[1]-Orgy)]],S); else S=S+xyarrow([MulX*(Ax[0]-Orgx),MulY*(LY[0]-Orgy)], [MulX*(Ax[0]-Orgx),MulY*(LY[1]-Orgy)]|opt=LOp0); if(length(Ax)>2){ D=Ax[2]; if(type(D)==1 && D>0){ I0=ceil((LX[0]-Ax[0])/D); I1=floor((LX[1]-Ax[0])/D); for(DD=[],I=I0; I<=I1; I++){ if(length(Ax)<5) DD=cons(I*D,DD); else if(Ax[4]==0) DD=cons([I*D,I*D+Ax[0]],DD); else if(Ax[4]==1) DD=cons([I*D,I*D],DD); else if(Ax[4]==2) DD=cons([I*D,I],DD); } D=DD; } if(type(D)==4){ for(;D!=[]; D=cdr(D)){ T=car(D); if(type(T)==4) T=car(T); X=MulX*(T+Ax[0]-Orgx); Y=MulY*(Ax[1]-Orgy); if(T!=0){ if(Proc) S=cons([3,(type(LOp1)>=0)?[["opt",LOp1]]:[],[X,Y+Ady0],[X,Y+Ady1]],S); else S=S+xyarrow([X,Y+Ady0],[X,Y+Ady1]|opt=LOp1); } if(type(car(D))==4){ Arg=[(T==0)?LxOO:LxOp,D[0][1]]; if(Proc) S=cons([2,[],[X,Y+Ady0],[Arg]],S); else S=S+xyput([X,Y+Ady0,Arg]); } } } } } if(Ax[1]>=LY[0] && Ax[1]<=LY[1]){ /* draw marks on y-axis */ if(Proc) S=cons([3,[["opt",LOp0]], [MulX*(LX[0]-Orgx),MulY*(Ax[1]-Orgy)], [MulX*(LX[1]-Orgx),MulY*(Ax[1]-Orgy)]],S); else S=S+xyarrow([MulX*(LX[0]-Orgx),MulY*(Ax[1]-Orgy)], [MulX*(LX[1]-Orgx),MulY*(Ax[1]-Orgy)]|opt=LOp0); 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); for(DD=[],I=I0; I<=I1; I++){ if(length(Ax)<5) DD=cons(I*D,DD); else if(I!=0){ if(Ax[4]==0) DD=cons([I*D,I*D+Ax[1]],DD); if(Ax[4]==1) DD=cons([I*D,I*D],DD); if(Ax[4]==2) DD=cons([I*D,I],DD); } } D=DD; } if(type(D)==4){ for(;type(D)==4&&D!=[]; D=cdr(D)){ T=car(D); if(type(T)==4) T=car(T); X=MulX*(Ax[0]-Orgx); Y=MulY*(T+Ax[1]-Orgy); if(T!=0){ if(Proc) S=cons([3,(type(LOp0)>=0)?[["opt",LOp1]]:[], [X+Adx0,Y],[X+Adx1,Y]],S); else S=S+xyarrow([X+Adx0,Y],[X+Adx1,Y]|opt=LOp1); } if(type(car(D))==4){ if(Proc) S=cons([2,[],[X,Y+Ady0],[[LyOp,D[0][1]]]],S); else S=S+xyput([X,Y+Ady0,[LyOp,D[0][1]]]); } } } } } } if(Proc) return reverse(S); if(getopt(dviout)!=1) return S; xyproc(S|dviout=1); } def xyarrow(P,Q) { Cmd = ["fill","filldaw","shade","shadedraw","clip ","pattern","path ","node","coordinate"]; if(type(P)<4) return "%\n"; SS=getopt(opt); if(!TikZ){ if(type(Q)<4) return ""; S="{"+xypos(P)+" \\ar"; if(type(SS)==7) S=S+SS; return S+" "+xypos(Q)+"};\n"; } if(type(SS)==4 && length(SS)>1){ if(length(SS)>2) SU=SS[2]; ST=SS[1]; SS=SS[0]; } if(type(SS)!=7) SS="->"; if(type(ST)!=7) ST=" -- "; if(type(SU)!=7) SU=""; if(type(S=getopt(cmd))==7) S="\\"+S; else S="\\draw"; if(type(Q)!=4){ if(Q>0 && Q<=length(Cmd)) S="\\"+Cmd[Q-1]+""; if(SS!="-") S=S+"["+SS+"]"; if(SU!="") SU="["+SU+"]"; return S+xypos(P)+ST+SU+";\n"; } if(SS!="-"&&SS!="") S=S+"["+SS+"]"; if(length(P)<3 && length(Q)<3) return S+xypos(P)+ST+xypos(Q)+SU+";\n"; if(length(P)==2) P=[P[0],P[1],"","_0"]; else if(length(P)==3 || (length(P)==4 && P[3]=="")) P=[P[0],P[1],P[2],"_0"]; else if(P[3]=="") P=[P[0],P[1],P[2],"_0",P[4]]; if(length(Q)==2) Q=[Q[0],Q[1],"","_1"]; else if(length(Q)==3 || (length(Q)==4 && Q[3]=="")) Q=[Q[0],Q[1],Q[2],"_1"]; else if(Q[3]=="") Q=[Q[0],Q[1],Q[2],"_1",Q[4]]; return S+xypos(P)+" "+xypos(Q)+"("+P[3]+")"+ST+"("+Q[3]+")"+SU+";\n"; } def xyarrows(P,Q,R) { PQ=newvect(4); PQ[0]=(type(P[0])!=4)?f2df(P[0]):P[0]; PQ[1]=(type(P[1])!=4)?f2df(P[1]):P[1]; PQ[2]=(type(Q[0])!=4)?f2df(Q[0]):Q[0]; PQ[3]=(type(Q[1])!=4)?f2df(Q[1]):Q[1]; if(type(R[0])!=4) R=[R]; TR=R[0];NX=TR[2];X=X0=TR[0];DX=(TR[1]-TR[0])/NX; if(length(R)==2){ TR=R[1];NY=TR[2];Y=TR[0];DY=(TR[1]-TR[0])/NY; }else{ NY=1;Y=DY=0; } if(type(L=getopt(abs))!=1) L=0; if(type(Sc=getopt(scale))!=1) Sc=0; OL=[]; if(type(Opt=getopt(opt))==7) OL=cons(["opt",Opt],OL); Tb=str_tb(0,0); for(J=0;J0){ C=dnorm([VX,VY]); if(C!=0){ VX*=L/C;VY*=L/C; } } if(Sc){ VX*=Sc;VY*=Sc; } if(VX||VY) str_tb(xyarrow([PX,PY],[PX+VX,PY+VY]|optilon_list=OL),Tb); } } return str_tb(0,Tb); } def polroots(L,V) { INIT=1; if(type(CF=getopt(comp))!=1) CF=0; OL=getopt(); if(CF>32){ CF-=64; INIT=0; }else OL=cons(["comp",CF+64],delopt(OL,"comp")); if(type(V)==4&&length(V)==1){ L=L[0];V=V[0]; } Lim=Lim2=[]; if(type(L)<4){ if(type(Lim=getopt(lim))==4){ 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]; if(length(Lim)==3) Lim2=Lim[2]; Lim=Lim[1]; } }else{ Lim=Lim2=[]; } if((CF==-2||CF==-1||CF==2)&&iscoef(L,os_md.israt)){ /* Rat+Comp, Rat+Real or Rat */ S=(CF==-1)?getroot(L,V|cpx=1):getroot(L,V); for(RR=[],F=x;S!=[];S=cdr(S)){ if(findin(V,vars(C=car(S)))<0){ /* Rational solution */ if(type(C)<2){ if(Lim!=[]&&(real(C)Lim[1])) continue; if(Lim2!=[]&&(imag(C)Lim2[1])) continue; } if(F!=C) RR=cons(F=C,RR); }else if(CF<0){ /* Irrational solution */ if((R=pari(roots,mysubst(C,[V,x])))!=0){ for(R=vtol(R);R!=[];R=cdr(R)) if((C=car(R))!=F && ntype(C)Lim[1])) continue; if(Lim2!=[]&&(imag(C)Lim2[1])) continue; RR=cons(F=C,RR); } } } } return qsort(RR); } R=pari(roots,subst(L,V,x)); if(R==0){ R=[0]; if(CF==1){ for(R=[0],I=mydeg(L,V);I>1; I--) R=cons(0,R); } return R; } if(CF==1){ /* Complex */ if(Lim==[]&&Lim2==[]) return vtol(R); for(L=[],I=length(R)-1;I>=0;I--){ C=R[I]; if(Lim!=[]&&(real(C)Lim[1])) continue; if(Lim2!=[]&&(imag(C)Lim2[1])) continue; L=cons(C,L); } return L; } for(L=[],F=x,I=length(R)-1;I>=0;I--){ /* Real */ if(ntype(R[I])<4 && F!=R[I]){ if(Lim!=[] && (R[I]Lim[1])) continue; L=cons(F=R[I],L); } } return qsort(L); } if(SS==0&&INIT==1){ SS=polroots(L,V|option_list=OL); if(SS!=0) return SS; 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--) Q+=L[J]*(I+K)^J; LL=cons(Q,LL); } SS=polroots(LL,V|option_list=OL); if(SS!=0) return SS; } return SS; } C=2^(-32); if(type(getopt(err))==1) C=err; if((N=length(V))!=length(L)) return []; if(N==1) return polroots(L[0],V[0]|option_list=OL); for(L1=[],I=1;IC) break; } if(LT==[]) SS=cons(S0,SS); } } return reverse(SS); } def ptcommon(X,Y) { if(length(X)!=2 || length(Y)!=2) return 0; if(type(X[1])==4){ /* X is a line */ if((In=getopt(in))==-1||In==-2||In==-3){ X0=(X[0][0]+X[1][0])/2;X1=(X[0][1]+X[1][1])/2; X=[[X0,X1],[X0+X[1][1]-X[0][1],X1-X[1][0]+X[0][0]]]; if(In==-1&&type(Y[1])==4) return ptcommon(Y,X|in=-2); /* for the second line */ if(In==-3) In=1; else In=0; }else if(In==2||In==3){ X=(X[1][0]-X[0][0])+(X[1][1]-X[0][1])*@i; if(X==0) return 0; Y=(Y[1][0]-Y[0][0])+(Y[1][1]-Y[0][1])*@i; X=myarg(Y/X); return (In==2)?X:(X*180/deval(@pi)); }else if(In!=1) In=0; if(type(Y[0])<=3){ if(In==1){ return [(Y[1]*X[0][0]+Y[0]*X[1][0])/(Y[0]+Y[1]), (Y[1]*X[0][1]+Y[0]*X[1][1])/(Y[0]+Y[1])]; } XX=X[1][0]-X[0][0];YY=X[1][1]-X[0][1]; Arg=(length(Y)<2)?0:Y[1]; Arg=deval(Arg); if(Arg!=0){ S=dcos(Arg)*XX-dsin(Arg)*YY; YY=dsin(Arg)*XX+dcos(Arg)*YY; XX=S; } S=dnorm([XX,YY]); if(S!=0){ XX*=Y[0]/S;YY*=Y[0]/S; } return [X[1][0]+XX,X[1][1]+YY]; } S=[X[0][0]+(X[1][0]-X[0][0])*x_,X[0][1]+(X[1][1]-X[0][1])*x_]; if(type(Y[1])==4){ /* Y is a line */ 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])>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]; } return ((Y[0][I]X1&&Y[1][I]>X1))?0:1; }else if(Y[1]==0){ /* orth */ T=[Y[0][0]+(X[1][1]-X[0][1])*y_-S[0], Y[0][1]-(X[1][0]-X[0][0])*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)) return subst(S,x_,R[0][1],y_,R[1][1]); } return (X[0]==X[1])?0:1; }else if(type(Y[1])==1 && Y[1]>0){ /* circle */ T=(S[0]-Y[0][0])^2+(S[1]-Y[0][1])^2-Y[1]^2; D=mycoef(T,1,x_)^2-4*mycoef(T,0,x_)*mycoef(T,2,x_); if(D==0){ V=mycoef(T,1,x_)/(2*mycoef(T,2,x_)); if(!in||(V>=0&&V<=1)) return [subst(S,x_,V)]; } else if((type(D)==1&&D>0)){ D=dsqrt(D); V=-(mycoef(T,1,x_)+D)/(2*mycoef(T,2,x_)); if(!In||(V>=0&&V<=1)) L=[subst(S,x_,V)]; else L=[]; V=(D-mycoef(T,1,x_))/(2*mycoef(T,2,x_)); if(!In||(V>=0&&V<=1)) L=cons(subst(S,x_,V),L); if(length(L)>0) return L; } } return 0; } if(type(Y[1])==4 || X[1]==0) return ptcommon(Y,X); /* X is a circle */ if(Y[1]==0){ /* tangent line */ if(Y[0][0]==X[0][0]+X[1] || Y[0][0]==X[0][0]-X[1]) L=[[Y[0][0],X[0][1]]]; else L=[]; P=(Y[0][0]+x_-X[0][0])^2+(Y[0][1]+x_*y_-X[0][1])^2-X[1]^2; Q=mycoef(P,1,x_)^2-4*mycoef(P,2,x_)*mycoef(P,0,x_); for(R=polroots(Q,y_);R!=[];R=cdr(R)){ X0=-subst(mycoef(P,1,x_)/(2*mycoef(P,2,x_)),y_,car(R)); L=cons([Y[0][0]+X0,Y[0][1]+car(R)*X0],L); } }else{ /* Y is a circle */ P=(x_-X[0][0])^2+(y_-X[0][1])^2-X[1]^2; Q=(x_-Y[0][0])^2+(y_-Y[0][1])^2-Y[1]^2; V=(X[0][0]!=Y[0][0])?[x_,y_]:[y_,x_]; R=subst(P,V[0],T=lsol(P-Q,V[0])); if(type(T[0])<4) return (T[0]==0)?1:0; S=polroots(R,V[1]); for(L=[];S!=[];S=cdr(S)){ R=subst(T,V[1],car(S)); if(V[0]==x_) L=cons([R,car(S)],L); else L=cons([S,R],L); } } if(length(L)!=0) return L; return 0; } def tobezier(L) { if((Div=getopt(div))==1||Div==2){ if(length(L)!=4) return [tobezier(L|inv=[0,1/2]),tobezier(L|inv=[1/2,1])]; if(type(L)==4) L=ltov(L); if(type(L[0])==4) L=[ltov(L[0]),ltov(L[1]),ltov(L[2]),ltov(L[3])]; S=[(L[0]+3*L[1]+3*L[2]+L[3])/8]; T=[L[3]]; S=cons((L[0]+2*L[1]+L[2])/4,S); T=cons((L[2]+L[3])/2,T); S=cons((L[0]+L[1])/2,S); T=cons((L[1]+2*L[2]+L[3])/4,T); S=cons(L[0],S); T=cons((L[0]+3*L[1]+3*L[2]+L[3])/8,T); return [S,T]; } if(Div>2&&Div<257){ L=tobezier(L); for(R=[],I=Div-1;I>=0;I--) R=cons(tobezier(L|inv=[I/Div,(I+1)/Div]),R); return R; } if((V=getopt(inv))==1 || type(V)>3){ if(type(L[0])>3 && type(V)>3) L=tobezier(L); if(type(V)>3 && length(V)>2) V2=V[2]; if(type(V2)!=2) V2=t; if(type(V)>3) L=subst(L,V2,(V[1]-V[0])*V2+V[0]); N=mydeg(L,V2); for(R=[],I=0;I<=N;I++){ RT=mycoef(L,I,V2); R=cons(RT/binom(N,I),R); L-=RT*V2^I*(1-V2)^(N-I); } return reverse(R); }; N=length(L)-1; V=newvect(2); for(I=0;I<=N;I++,L=cdr(L)){ if(type(X=car(L))==4) X=ltov(X); V+=X*binom(N,I)*t^I*(1-t)^(N-I); } return V; } def cutf(F,X,VV) { if(type(car(V=VV))==2){ Y=[car(V),X]; V=cdr(V); }else Y=X; if(type(X)>1){ Y=(type(Y)==4)?Y[0]:x; V1=makenewv(F); if(X==Y||Y==x){ V2=makenewv([F,V1]); F=mysubst(F,[Y,V2]); V=cons(V2,V); } return [V1,[V1,os_md.cutf,[F],X,[V]]]; } if(car(V)!=[] && Xcar(V)[0]) continue; if(X==car(V)[0]) return car(V)[1]; return myfeval(F,Y); } } 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); }else X=0; 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+=(Sub==1)?subst(F,X?X:x,I):os_md.myfeval(F,X?[X,I]:I); } } 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,F]); Z=makenewv([X,Y,F]); return [Z,[Z,os_md.periodicf,[mysubst(F,[x,Y])],(type(L)==4)?[L]:L,[[Y,X]]]]; } 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){ X-=floor((X-L[0])/(L[1]-L[0]))*(L[1]-L[0]); return myfeval(F,[V,X]); } } def cmpf(X) { if(type(X)>3){ if(type(L)==7) return [S_Fc,Dx,S_Ic,S_Ec,S_EC,S_Lc]; S_Lc=0; if(type(S_Fc=X[0])!=4) S_Fc=f2df(S_Fc); S_Ic=X[1]; if(length(S_Ic)>2){ S_Fc=mysubst(S_Fc,[S_Ic[0],x]); S_Ic=cdr(S_Ic); } S_Dc=(type(S_Ic[0])==7)?1:0; if(type(S_Ic[1])==7) S_Dc=ior(S_Dc,2); if(type(S_Ec=getopt(exp))!=1) S_Ec=0; if(S_Ec<=0){ S_EC=-S_Ec; if(S_EC==0) S_EC=1; if(S_Dc==3) S_EC*=2; else S_EC/=4; if(type(F=X[0])==3&&vars(F)==[x]&&(D=deg(nm(F),x))==deg(dn(F),x)-2){ S_Lc=S_EC*coef(nm(F),D,x)/coef(dn(F),D+2,x); } }else{ S_EC=S_Ec; if(S_Dc==3) S_EC*=12; else S_EC/=6; } if(type(S_Fc)==3) S_Fc=red(S_Fc); S_EC=1/S_EC; return [z_,[z_,os_md.cmpf,x]]; } if(X<=0 && iand(S_Dc,1)) return S_Lc; if(X>=1 && iand(S_Dc,2)) return S_Lc; if(S_Dc==3){ if(S_Ec>0){ Y0=dexp(1/X)*S_EC; Y1=dexp(1/(1-X))*S_EC; return myfeval(S_Fc,Y1-Y0)*(Y0/X^2+Y1/(1-X)^2); } return myfeval(S_Fc,S_EC/(1-X)-S_EC/X)*(S_EC/(1-X)^2+S_EC/X^2); } if(S_Dc==1){ if(S_Ec>0){ Y=dexp(1-1/X); R=myfeval(S_Fc,S_EC*(Y-1)+I[1])*Y; } else R=myfeval(S_Fc,I[1]+(1-1/X)*S_EC); return R*S_EC/X^2; } if(S_Dc==2){ if(S_Ec>0){ Y=dexp(X/(1-X)); R=myfeval(S_Fc,S_EC*(Y-1)+S_Ic[0])*Y; }else R=myfeval(S_Fc,S_EC*X/(1-X)+S_Ic[0]); return R*S_EC/(1-X)^2; } X=S_Ic[0]+(S_Ic[1]-S_Ic[0])*X; return myfeval(S_Fc,X)/(S_Ic[1]-Ic[0]); } def fresidue(P,Q) { if(iscoef(Q,os_md.israt)) S=fctr(Q); else S=[[Q,1]]; for(R=[];S!=[];S=cdr(S)){ T=car(S); if((D=mydeg(T[0],z))==0) continue; L=[]; if(iscoef(T[0],os_md.iscrat)) L=getroot(T[0],z|cpx=2); if(findin(z,vars(L))>=0) L=[]; if(L==[]) L=polroots(T[0],z|comp=-1); for(;L!=[];L=cdr(L)){ QQ=Q; for(I=T[1]; I>1;I--) QQ=mydiff(QQ,z); for(U=0,W=I=T[1];I>0;I--,W++){ QQ=diff(QQ,z); U+=subst(QQ,z,L[0])*(z-L[0])^(W-T[1])/fac(W); } UD=mydiff(U,z); for(I=T[1],K=1,PP=P; I>1;I--,K++) PP=diff(PP,z)*U-K*PP*UD; QQ=subst(PP,z,L[0])/subst(U,z,L[0])^K; /* if(D==2) QQ=sqrt2rat(QQ); */ R=cons([L[0],sqrt2rat(QQ)],R); } } if(type(L=getopt(cond))==4){ for(S=[];R!=[];R=cdr(R)){ Z=car(R); for(LL=L;LL!=[];LL=cdr(LL)){ X=real(car(Z));Y=imag(car(Z)); if(myf3eval(car(LL),X,Y,car(Z))<=0) break; } if(LL==[]) S=cons(Z,S); } R=reverse(S); } if((Sum=getopt(sum))==1||Sum==2){ for(S=0;R!=[];R=cdr(R)) S+=car(R)[1]; if(Sum==2) S*=2*@pi*@i; return sqrt2rat(S); } return R; } def fint(F,D,V) { if(((L=length(V))==2 || (L==3&&isvar(V[0])<3)) && (type(V[L-1])==7||(type(V[L-1])<3&&type(eval(V[L-1]))<2))) /* real integral */ return areabezier([F,D,V]|option_list=getopt()); /* complex integral */ if(L>1&&type(V[1])==4&&type(V[1][1])<4){ if(type(V[0])==4&&type(V[0][0])<2){ for(R=[],VT=car(V),VV=cdr(V);VV!=[];VV=cdr(VV),VT=VU){ if((VU=car(VV))==-1) VU=car(V); R=cons([ptcommon([VT,VU],[t,1-t]|in=1),[0,1]],R); } V=reverse(R); } else if(L==2) V=[V]; } Opt=cons(["cpx",1],getopt()); for(R=0;V!=[];V=cdr(V)){ VT=car(V); X=car(VT)[0];XD=red(diff(X,t)); Y=car(VT)[1];YD=red(diff(Y,t)); F=mysubst(F,[[x,X],[y,Y],[z,X+@i*Y]]); if(type(F)==4) FF=cons(F[0]*(XD+@i*YD),cdr(F)); else FF=red(F*(XD+@i*YD)); R+=areabezier([FF,D,cons(t,VT[1])]|option_list=Opt); } return R; } def areabezier(V) { if(getopt(cpx)==1){ Opt=delopt(getopt(),"cpx"); F=V[0]; if(!isvar(Var=V[2][0])) Var=x; if(type(F)==3 && vars(F)==[Var] && imag(dn(F))!=0){ F=(nm(F)*conj(dn(F)))/(dn(F)*conj(dn(F))); V0=red(real(nm(F))/dn(F)); R=areabezier([V0,V[1],V[2]]|option_list=Opt); V0=red(imag(nm(F))/dn(F)); return R+@i*areabezier([V0,V[1],V[2]]|option_list=Opt); } if(getopt(Acc)!=1) F=f2df(F); V0=compdf([o,[o,real,o_]],o_,F); R=areabezier([V0,V[1],V[2]]|option_list=Opt); V0=compdf([o,[o,imag,o_]],o_,F); return R+@i*areabezier([V0,V[1],V[2]]|option_list=Opt); } if(type(V[0])!=4 || vars(V[0][0])!=0){ Mx=[-2.0^(512),2.0^(512)]; I=length(V[2]); if(type(V[2][I-1])==7||type(V[2][I-2])==7){ /* infinite interval */ if(type(Ec=getopt(exp))==1) R=cmpf([V[0],V[2]]|exp=Ec); else R=cmpf([V[0],V[2]]); V=[R,V[1],[0,1]]; } if(type((Int=getopt(int)))==1 && type(V[0])<4 && (V1=V[1])>=0){ if(Int==2&&iand(V1,1)) V1++; if(!V1) V1=32; Opt=cons(["raw",1],getopt()); W=xygraph(V[0],V[1],V[2],Mx,Mx|option_list=Opt); SS=W[0][1]; for(S0=S1=0,I=0,L=W;L!=[] && I<=V1;I++, L=cdr(L)){ if(iand(I,1)) S1+=car(L)[1]; else S0+=car(L)[1]; if (I==V1) SS+=car(L)[1]; } VV=deval(V[2][1]-V[2][0]); if(Int==2) return (2*S0+4*S1-SS)*VV/(3*V1); else return (2*S0+2*S1-SS)*VV/(2*V1); } Opt=cons(["opt",0],getopt()); V=xygraph(V[0],V[1],V[2],Mx,Mx|option_list=Opt); } if(type(V[0][0])!=4) V=os_md.lbezier(V); for(S=0; V!=[]; V=cdr(V)){ B=tobezier(car(V)); P=intpoly(B[1]*diff(B[0],t),t); S+=mysubst(P,[t,1]); } return S; } def velbezier(V,L) { if(L==0) L=[t,0,1]; else L=[(length(L)==3)?L[2]:t,L[0],L[1]]; for(R=[],II=length(V)-1;II>=0;II--){ S=fmmx(diff(V[II],L[0]|dif=1),L|dif=1); for(U=0;S!=[];S=cdr(S)) if((T=abs(car(S)[1]))>U) U=T; R=cons(U,R); } return R; } def ptbezier(V,L) { if(type(V[0])==4&&type(V[0][0])!=4) V=lbezier(V); K=length(V); if(type(L)<2){ if(L<0) return K; if(L>=K-1) L=[K-1,1]; else{ L0=floor(L); if(L0>=K-1) L0=K-1; L=[L0,L-L0]; } } if(L[0]>=0) B=V[L[0]]; else B=V[K+L[0]]; B=tobezier(B); BB=[diff(B[0],t),diff(B[1],t)]; return [subst(B,t,L[1]),subst(BB,t,L[1])]; } def ptcombezier(P,Q,T) { if(type(T)<2){ if(T<2) T=20; /* default */ return ptcombezier(P,Q,[0,0,1,T]); } V=T[2]/2;; PB=tobezier(P|div=1); PP=[ptbbox(PB[0]),ptbbox(PB[1])]; QB=tobezier(Q|div=1); QQ=[ptbbox(QB[0]),ptbbox(QB[1])]; for(L=[],I=0;I<2;I++){ for(J=0;J<2;J++){ if(!iscombox(PP[I],QQ[J])) continue; if(T[3]<=1) return [[T[0]+(I+0.5)*V,T[1]+(J+0.5)*V, [(PP[I][0][0]+PP[I][0][1])/2,(PP[I][1][0]+PP[I][1][1])/2]]]; else{ #if 0 U=PB[I][0];V=PB[I][length(PB[I])-1]; if(abs(A=(U[0]-V[0]))>abs(B=(U[1]-V[I]))) M=mat([1,0],[-B/A,1]); else if(U!=V) M=mat([1,-A/B],[0,1]); else continue; if(!iscombox(ptbox(ptaffine(M,PB[I])),ptbox(ptaffine(M,QB[J])))) continue; #endif LN=ptcombezier(PB[I],QB[J],[T[0]+I*V,T[1]+J*V,V,T[3]-1]); #if 0 L=append(LN,L); #else if(LN!=[]){ if(L==[]) L=LN; else for(VV=3*V/2^T[3];LN!=[];LN=cdr(LN)){ for(LT=L;LT!=[];LT=cdr(LT)){ if(abs(car(LN)[0]-car(LT)[0])32){ /* Too many points */ I=J=2; } #endif } } } return L; } def ptcombz(P,Q,T) { if(P==Q) Q=0; if(type(P[0][0])!=4) P=P0=lbezier(P); if(Q==0){ Q=P;F=1; } else if(type(Q[0][0])!=4) Q=lbezier(Q); for(R=[],I=0,Q0=Q;P!=[];P=cdr(P),I++){ for(J=0,Q=Q0;Q!=[];Q=cdr(Q),J++){ if(F==1&&IX1) X1=ST[0]; if(ST[1]Y1) Y1=ST[1]; } } } } V0=(X1-X0)/2^M;V1=(Y1-Y2)/2^M; for(RR=[],RT=R;RT!=[];RT=cdr(RT)) for(S=cdr(car(RT));S!=[];S=cdr(S)) RR=cons(car(S)[2],RR); RR=ltov(RR);L=length(RR); for(I=0;I=0;I--) if(RR[I]!=0) R0=cons(RR[I],R0); }else{ for(RT=R;RT!=[];RT=cdr(RT)){ R00=[car(RT)[0]]; for(S=cdr(car(RT));S!=[];S=cdr(S),I--) if(RR[L-I-1]!=0) R00=cons(car(S),R00); if(length(R00)>1) R0=cons(reverse(R00),R0); } } return R0; } return reverse(R); } def draw_bezier(ID,IDX,B) { if(getopt(init)==1){ S_FDot=0; return; } if(type(Col=getopt(col))!=1&&Col!=0) Col=0; Dot=0; if(type(Opt=getopt(opt))==7){ if(!Col){ Col=drawopt(Opt,0); if(Col==-1) Col=0; } T=drawopt(Opt,3); if(iand(T,2)){ M=iand(T,1)?1/8:1/4; for(C=Col,Col=I=0;I<20;I+=8) Col+=ishift(0xff-(floor((0xff-iand(0xff,ishift(C,I)))*M)),-I); } if(iand(T,4)) Dot=2; /* 2 or 3 or 4 or 6 */ else if(iand(T,8)) Dot=4; } if(type(B)==4 && (type(B[0])==4||type(B[0])==5) && type(B[0][0])<2) B=lbezier(B); else if(type(B)==5) B=[vtol(B)]; for(;B!=[];B=cdr(B)){ if(vars(F=car(B))==[]){ #if 1 if(length(F)<3&&!Dot){ /* line or point */ if(length(F)>0){ G=[rint(F[0][0]),rint(F[0][1])]; if(length(F)==1) draw_obj(ID,IDX,G,Col); else{ G=[G[0],G[1],rint(F[1][0]),rint(F[1][1])]; draw_obj(ID,IDX,G,Col); } } continue; } #endif if(length(F)<2) continue; F=tobezier(F); } N=velbezier(F,0); N=(N[0]>N[1])?N[0]:N[1]; if(!N) N=1; for(I=0;I<=N;I++,S_FDot++){ if(Dot!=iand(S_FDot,Dot)) continue; G=subst(F,t,I/N); G=[rint(G[0]),rint(G[1])]; if(G!=G0){ draw_obj(ID,IDX,G,Col); G0=G; } } } if(S_FDot-->=2^32) S_FDot=0; return 0; } def lbezier(L) { if((In=getopt(inv))==1||In==2||In==3){ for(F=0,R=[];L!=[];L=cdr(L)){ LT=car(L); if(F==car(LT)) R=cons(1,R); else{ if(R!=[]&&F!=0) R=cons(0,R); R=cons(G=car(LT),R); if(In==3) In==2; } for(LT=cdr(LT);LT!=[];LT=cdr(LT)) R=cons(car(LT),R); if((F=car(R))==G&&In==1){ R=cons(-1,cdr(R)); F=0; } } if(In==3 && car(R)==G) R=cons(-1,cdr(R)); return reverse(R); } for(F=0,RT=R=[];L!=[];L=cdr(L)){ if(type(T=car(L))==4||type(T)==5){ if(F==0){ FT=T;F=1; } RT=cons(T,RT); }else if(T==0){ if(RT==[]) R=cons(reverse(RT),R); RT=[];F=0; }else if(T==1){ if(RT!=[]){ R=cons(reverse(RT),R); RT=[car(RT)]; }else{ RT=[];F=0; } }else if(T==-1){ RT=cons(FT,RT); R=cons(reverse(RT),R); RT=[];F=0; } } if(RT!=[]) R=cons(reverse(RT),R); return reverse(R); } def xybezier(L) { if(L==0 || (LS=length(L))==0) return ""; Out=str_tb(0,0); if(type(VF=getopt(verb))==4){ if(type(car(VF))>3){ VFS=VF;VF=1; }else{ VFS=cdr(VF);VF=car(VF); } }else VFS=["$\\bullet$","$\\times$"]; if(VF!=1 && VF!=2) VF=0; if(!TikZ){ if(VF) Ob=str_tb(0,0); T="\n**\\crv{"; if(type(Opt=getopt(opt))==7 && Opt!="") T=T+Opt; L00=Q=L[I0=0];S=S1=""; for(F=0,I=1;I<=LS;I++){ P=Q;Q=(I==LS)?0:L[I]; if(type(Q)==4){ if(F==0){ S1="";L0=P;F=1; continue; }else if(F==1) F=2; else if(F==2){ S1=S1+"&"; } S1=S1+xypos(P); if(VF&&length(VFS)>1) str_tb(xyput([P[0],P[1],VFS[1]]),Ob); }else{ if(Q==0){ if(F>0){ str_tb("{"+xypos(L0)+";"+xypos(P)+T+S1+"}};\n",Out); if(VF){ str_tb(xyput([L[0][0],L[0][1],VFS[0]]),Ob); if(VF==1) str_tb(xyput([P[0],P[1],VFS[0]]),Ob); } F=0; } }else if(Q==1){ str_tb("{"+xypos(L0)+";"+xypos(P)+T+S1+"}};\n",Out); if(VF){ str_tb(xyput([L[0][0],L[0][1],VFS[0]]),Ob); if(VF==1) str_tb(xyput([P[0],P[1],VFS[0]]),Ob); } F=1; }else if(Q==-1){ if(F==2) S1=S1+"&"; str_tb("{"+xypos(L0)+";"+xypos(L00)+T+S1+xypos(P)+"}};\n",Out); if(VF) str_tb(xyput([L[0][0],L[0][1],VFS[0]]),Ob); F=0; } if(F==1){ if(I=LS) break; if(F==1){ Q=P;I--;F=0; }else L00=Q=L[I]; } } }else{ if(type(T=getopt(cmd))==7){ if(T!="") T="\\"+T; }else T="\\draw"; if((Rel=getopt(relative))==1) VF=0; if(VF) Ob=str_tb(0,0); if(type(Opt=getopt(opt))==7 && Opt!="") T=T+"["+Opt+"]"; Out=str_tb(T,0); Q=L[0]; for(F=M=0,I=1;I<=LS;I++){ P=Q; Q=(I==LS)?0:L[I]; if(++M>XYLim){ str_tb("\n",Out);M=1; } if(type(Q)==4 || type(Q)==5 || type(Q)==7){ if(F==0){ str_tb(" ",Out); F=1; }else if(F==1){ str_tb(" .. controls ",Out); F=2; }else if(F==2){ str_tb(" and ",Out); F=2; } PP=xypos(P); if(Rel==1 && F==2) PP="+"+PP; str_tb(PP,Out); if(VF&&((F<2)||length(VFS)>1)) str_tb(xyput([P[0],P[1],(F<2)?VFS[0]:VFS[1]]),Ob); }else{ /* if(I1) str_tb(xyput([P[0],P[1],VFS[1]]),Ob); F=0; } if(F==1){ if(I=LS) break; Q=L[I]; } } str_tb(";\n",Out); } if(VF) str_tb(str_tb(0,Ob),Out); return str_tb(0,Out); } def xybox(L) { K=length(L); P=L[0];Q=L[1]; if(K==2) LL=[ P, [P[0],Q[1]], Q, [Q[0],P[1]] ]; else{ R=L[2]; LL=[ P, R, Q, [P[0]+Q[0]-R[0],P[1]+Q[1]-R[1]] ]; } Opt=getopt(); SS=getopt(opt); FL=getopt(color); if(TikZ&&type(SS)<1&&K==2){ if(type(FL)==4){ F=FL[0]; if(length(FL)>1) CMD=FL[1]; }else if(type(FL)==7) F=FL; else F=""; F=cons(F,["rectangle"]); if(CMD) return xyarrow(P,Q|opt=F,cmd=CMD); else return xyarrow(P,Q|opt=F); } if(type(SS)!=7&&!TikZ) Opt=cons(["opt","@{-}"],Opt); Opt=cons(["close",1],Opt); return xylines(LL|option_list=Opt); } def xyang(S,P,Q,R) { Opt=getopt(); if(type(Prec=getopt(prec))!=1) Prec=0; if(type(Q)>2){ 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){ /* 矢印 */ 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]; 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); }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]; X=ANG[AR-5]; 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)]; 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); 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); if(getopt(dviout)!=1) return S; dviout(S); return 1; } } if(type(Q)<3){ X=deval(Q); Y=deval(R); }else{ X=myarg([Q[0]-P[0],Q[1]-P[1]]); Y=myarg([R[0]-P[0],R[1]-P[1]]); } if(Prec>2) N=8; else if(Prec==2) N=6; else if(Prec==1) N=4; else N=3; U=deval(@pi)*2/N; if(X==Y||Y-X>6.28318){ for(L=[],I=N-1;I>=0;I--) L=cons([P[0]+S*dcos(I*U),P[1]+S*dsin(I*U)],L); return xylines(L|option_list=append([["curve",1],["close",1]],Opt)); } for(M=1;(Y-X)/M>U;M++); for(L=[],I=M+1;I>-2;I--){ Ang=X+(Y-X)*I/M; L=cons([P[0]+S*dcos(Ang),P[1]+S*dsin(Ang)],L); } if(getopt(ar)!=1) return xylines(L|option_list=append([["curve",1],["close",-1]],Opt)); OL=delopt(Opt,["dviout","opt","proc"]); S=xylines(L|option_list=append([["curve",1],["close",-1],["opt",0]],OL)); T=xylines([P,L[1]]|option_list=cons(["opt",0],OL)); S=ptaffine("close",[S,T]); /* connect curves */ if(getopt(opt)==0) return S; OL=(type(SS=getopt(opt))>1)?[["opt",SS]]:[]; if(type(T=getopt(proc))==1 && T>=1 && T<=3) return [1,OL,S]; if(OL==[]) S=xybezier(S); else S=(type(SS)==7)? xybezier(S|opt=SS):xybezier(S|opt=SS[0],cmd=SS[1]); if(getopt(dviout)==1) return xyproc(S|dviout=1); return S; } def xyoval(P,L,R) { if(type(Arg=getopt(arg))!=4 && type(Arg=getopt(deg))==4){ if(length(Arg)>2) Arg=[@pi*Arg[0]/180,@pi*Arg[1]/180,@pi*Arg[2]/180]; else Arg=[@pi*Arg[0]/180,@pi*Arg[1]/180]; } if(type(Arg)==4){ Arg0=deval(Arg[0]); Arg1=deval(Arg[1]); if(length(Arg)>2) Arg2=deval(Arg[2]); if(Arg11)? [["opt2",Opt]]:[]; if(getopt(proc)==1) return [1,Opt,L]; S=xybezier(L|option_list=getopt()); if(getopt(dviout)==1){ xyproc(S|dviout=1); return 1; } return S; } def xycirc(P,R) { ST=getopt(opt); if(type(ST)<0) ST=""; if(type(Arg=getopt(arg))!=4 && type(Arg=getopt(deg))==4){ Arg=[@pi*Arg[0]/180,@pi*Arg[1]/180]; } /* Is it OK? if(TikZ==0 && XYcm==1){ R*=10; P=[P[0]*10,P[1]*10]; } */ if(type(Arg)==4){ Arg0=deval(Arg[0]); Arg1=deval(Arg[1]); if(Arg1<=Arg0 || Arg0<-7 || Arg1-Arg0>7) return 0; if(type(ST)==7) S=xygraph([R*cos(x)+P[0],R*sin(x)+P[1]],-4,[Arg0,Arg1],[P[0]-R-1,P[0]+R+1], [P[1]-R-1,P[1]+R+1]|opt=ST); else S=xygraph([R*cos(x)+P[0],R*sin(x)+P[1]],-4,[Arg0,Arg1],[P[0]-R-1,P[0]+R+1], [P[1]-R-1,P[1]+R+1]); if(getopt(close)==1){ S=S+xyline([0,0], [deval(subst(R*cos(x)+P[0],x,Arg0)),deval(subst(R*sin(x)+P[0],x,Arg0))]); S=S+xyline([0,0], [deval(subst(R*cos(x)+P[0],x,Arg1)),deval(subst(R*sin(x)+P[0],x,Arg1))]); } return S; } if(TikZ){ SP=""; if(length(P)>2) SP=P[2]; if(type(SP)!=7) SP="$"+my_tex_form(SP)+"$"; if(R==0){ if(ST!="") ST=ST+","; return "\\node ["+ST+"circle,draw]"+xypos([P[0],P[1]])+ "{"+SP+"};\n"; } if(type(R)!=7) R=rtostr(deval(R)); if(ST!="") ST="["+ST+"]"; S="\\draw "+ST+xypos([P[0],P[1]])+" circle [radius="+R+"]"; if(SP!="") S=S+" node at"+xypos([P[0],P[1]])+" {"+SP+"}"; return S+";\n"; } S="{"+xypos([P[0],P[1]]); if(length(P)>2){ SP=P[2]; if(type(P)!=7) SP=my_tex_form(SP); S=S+" *+{"+SP+"}"; } S =S+" *\\cir"; if(R!=0){ R=deval(R); S=S+"<"+rtostr(R)+((XYcm)?"cm>":"mm>"); } S = S+"{"; if(type(ST)==7) S=S+ST; return S+"}};\n"; } def ptaffine(M,L) { if(type(L)!=4&&type(L)!=5){ erno(0);return L; } if(type(M)==7){ /* connect lists */ if(M=="reverse"){ for(LO=LR=[],F=0,LT=L; LT!=[]; LT=cdr(LT)){ if(type(P=car(LT))==4 || type(P)==7){ LR=cons(P,LR); continue; }else{ if(P==-1){ LL=reverse(LR); LO=append(reverse(cons(-1,cdr(LL))),LO); LO=cons(car(LL),LO); LR=[]; }else if(P==1){ LR=cons(car(LR),cons(1,cdr(LR))); }else if(P==0 || length(LT)==1){ if(LO!=[] && car(LO)!=0 && (type(car(LO))==4 || car(LO)==1)) LO=cons(0,LO); LO=append(LR,LO); if(length(LT)>1&&length(LO)>0&&car(LO)!=0) LO=cons(0,LO); LR=[]; } } } return append(LR,LO); } if(type(L[0][0])!=4) L=[L]; LO=[]; if(M=="connect" || M=="close" || M=="loop"){ Top=car(car(L)); for(K=1,LL=L; LL!=[]; LL=cdr(LL)){ for(F=0,LT=car(LL); LT!=[]; LT=cdr(LT),F++){ if((LTT=car(LT))==0) LTT=1; if(F==0 && LO!=[]){ LO0=car(LO); if(car(LO)!=1&&length(LO)>1) LO=cons(1,LO); if(LTT==LO0) continue; else LO=cons(1,cons(LTT, LO)); }else LO=cons(LTT, LO); } } if(M!="connect"){ if(Top==car(LO) || car(LO)==1 || M=="loop") LO=cons(-1,cdr(LO)); else LO=cons(-1,cons(1,LO)); } return reverse(LO); } if(M=="union"){ for(LL=reverse(L); LL!=[]; LL=cdr(LL)){ if(LO!=[]) LO=cons(0,LO); LO=append(car(LL),LO); } L=LO; } return L; } if(type(Arg=getopt(deg))==1) Arg=@pi*Arg/180; else Arg=getopt(arg); if(type(Arg)==2) Arg=deval(Arg); if(type(Arg)==1) M=M*mat([dcos(Arg),-dsin(Arg)],[dsin(Arg),dcos(Arg)]); if(type(Sft=getopt(org))==4){ Sft=ltov(Sft); Sft-=M*Sft; }else Sft=ltov([0,0]); if(type(V=getopt(shift))==4) Sft+=ltov(V); if(getopt(proc)==1){ if(Sft!=0&<ov(Sft)!=[0,0]) Sft=[["shift",vtol(Sft)]]; else Sft=[]; for(LO=[],LT=L;LT!=[];LT=cdr(LT)){ if(type(car(T=car(LT)))<2){ if((P=car(T))==0){ /* exedraw 0 */ V=[[T[1][0],T[2][0]],[T[1][0],T[2][1]],[T[1][1],T[2][0]],[T[1][1],T[2][1]]]; V=ptbbox(ptaffine(M,V|option_list=Sft)); L1=cdr(cdr(cdr(T))); LO=cons(append([0,V[0],V[1]],L1),LO); continue; }else if(P==1){ /* exedraw 1 */ L1=[]; for(TT=cdr(cdr(T));TT!=[];TT=cdr(TT)){ D=car(TT); if(type(D[0][0])==4){ for(L2=[],DT=D;DT!=[];DT=cdr(DT)) L2=cons(ptaffine(M,car(DT)|option_list=Sft),L2); L1=cons(reverse(L2),L1); }else L1=cons(ptaffine(M,D|option_list=Sft),L1); } LO=cons(append([1,T[1]],reverse(L1)),LO); continue; }else if(P>=2 && P<=5){ L1=ptaffine(M,cdr(cdr(T))|optilon_list=Sft); LO=cons(append([P,T[1]],L1),LO); continue; } } LO=cons(T,LO); } return reverse(LO); } F=0; if(type(L)==4){ for(LT=L; LT!=[]; LT=cdr(LT)){ if((T=type(car(LT)))==4||T==5){ F=1; break; } } } if(F==0) return (Sft==0)?ptaffine(M,[L])[0]:ptaffine(M,[L]|shift=vtol(Sft))[0]; for(LO=[],LT=L; LT!=[]; LT=cdr(LT)){ if(((T=type(P=car(LT)))!=4 && T!=5)||type(P[0])>3) LO=cons(P,LO); else{ if(T==4) P=ltov(P); V=M*P; if(Sft!=0) V+=Sft; if(T==4) V=vtol(V); LO=cons(V,LO); } } return reverse(LO); } def ptlattice(M,N,X,Y) { if(type(S=getopt(scale))!=1) S=1; if(type(Cond=getopt(cond))!=4) Cond=[]; Line=getopt(line); if(Line==1 || Line==2) F=newmat(M,N); else Line=0; if(type(Org=getopt(org))==4) Org=ltov(Org); else Org=newvect(length(X)); X=ltov(X); Y=ltov(Y); for(L=[],I=M-1;I>=0;I--){ for(P0=P1=0,J=N-1;J>=0;J--){ P=Org+I*X+J*Y; for(C=Cond; C!=[]; C=cdr(C)) if(subst(car(C),x,P[0],y,P[1])<0) break; if(C!=[]) continue; if(Line) F[I][J]=1; else L=cons(vtol(S*P),L); } } if(Line==0) return L; for(I=M-1;I>=0;I--){ for(T0=0,T1=J=N-1;J>=0;J--){ if((K=F[I][J])!=0){ if(T0==0) T0=J; else T1=J; } if(K==0 || T1==0){ if(T1=0;J--){ for(T0=0,T1=I=M-1;I>=0;I--){ if((K=F[I][J])!=0){ if(T0==0) T0=I; else T1=I; } if(K==0 || T1==0){ if(T1=0; I--) L=cons([S*(Org[0]+R*dcos(Arg+I*D)),S*(Org[1]+R*dsin(Arg+I*D))],L); return L; } def ptwindow(L,X,Y) { if(type(S=getopt(scale))==1){ X=[S*X[0],S*X[1]]; Y=[S*Y[0],S*Y[1]]; } for(R=[],LT=L;LT!=[];LT=cdr(LT)){ P=car(LT); if(P[0]X[1] || P[1]Y[1]) R=cons(0,R); else R=cons(P,R); } return reverse(R); } def lninbox(L,W) { if(L[0]==L[1]) return 0; R=newvect(2);C=newvect(2); for(J=0;J<2;J++){ C[J]=L[1][J]-L[0][J]; if(C[J]!=0){ R[J]=[(W[J][0]-L[0][J])/C[J],(W[J][1]-L[0][J])/C[J]]; if(R[J][0]>R[J][1]) R[J]=[R[J][1],R[J][0]]; } } if(R[0]==0) R[0]=R[1]; if(R[1]==0) R[1]=R[0]; S0=(R[0][0]1) S1=1; } if(S0>S1) return 0; return [[L[0][0]+C[0]*S0,L[0][1]+C[1]*S0],[L[0][0]+C[0]*S1,L[0][1]+C[1]*S1]]; } def ptbbox(L) { J=length(L[0]); if((Box=getopt(box))==1){ for(R=[],I=0;IQ) Q=T[I][1]; } } R=cons([P,Q],R); } }else if(type(Box)==4) return ptbbox([ptbbox(L),Box]|box=1); else{ for(R=[],I=0;IQ) Q=V; } } R=cons([P,Q],R); } } return reverse(R); } def iscombox(S,T) { for(;S!=[];S=cdr(S),T=cdr(T)) if(car(S)[0]>car(T)[1] || car(S)[1]M1) M1=V; } 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; } def m2ll(M) { for(R=[],I=size(M)[0]-1; I>=0; I--) R=cons(vtol(M[I]),R); return R; } def madjust(M,W) { if(type(Null=getopt(null))<0) Null=0; if(type(M)==4 && type(M[0])==4){ M=lv2m(M|null=Null); return m2ll(madjust(M,W|null=Null)); } S=size(M); if(W<0){ W=-W; T0=ceil(S[0]/W); T1=S[1]*W; N=newmat(T0,T1); for(I=0; I127) return N; S=(iand(N,8))? "\\allowdisplaybreaks":""; if(iand(N,2)) S=S+"\\\\"; if(iand(N,16)) S=S+"\\pause"; if(iand(N,1)) S=S+"\n"; if(iand(N,4)) S=S+"& "; else if(!iand(N,1)) S=S+" "; if(iand(N,64)) S=S+"="; if(iand(N,32)) S=","+S; return S; } def ltotex(L) { /* extern TeXLim; */ if(type(L)==5) L = vtol(L); if(type(L) != 4) return my_tex_form(L); Opt=getopt(opt); Pre=getopt(pre); if(type(Var=getopt(var))<1) Var=0; Cr2="\n"; if(type(Cr=getopt(cr))==4){ Cr2=Cr[1];Cr=Cr[0]; } if(isint(Cr)) Cr=texcr(Cr); if(type(Cr)!=7) Cr="\\\\\n & "; /* Cr=7 */ if(type(Opt)==7) Opt=[Opt]; if(type(Opt)!=4) Op = -1; else{ Op=findin(Opt[0],["spt","GRS","Pfaff","Fuchs","vect","cr","text","spts","spts0", "dform","tab", "graph","coord"]); Opt=cdr(Opt); } if(Op==0){ /* spt */ Out = str_tb("\\left\\{\n ",0); for(CC=0; L!=[]; L=cdr(L), CC++){ if(CC>0) str_tb(",\\, ",Out); TP=car(L); if(Op!=0) str_tb(my_tex_form(TP),Out); else if(TP[0]==1) str_tb(my_tex_form(TP[1]),Out); else str_tb(["[", my_tex_form(TP[1]), "]_", rtotex(TP[0])],Out); } str_tb("%\n\\right\\}\n",Out); }else if(Op==1){ /* GRS */ Out = string_to_tb("\\begin{Bmatrix}\n"); if(type(Pre)==7) str_tb(Pre,Out); MC=length(M=ltov(L)); for(ML=0, I=length(M); --I>=0; ){ if(length(M[I]) > ML) ML=length(M[I]); } for(I=0; I 0) str_tb(" & ",Out); }else if(M[J][I][0] <= 1){ if(M[J][I][0] == 0) str_tb(" & ",Out); else str_tb([(!CC)?" ":" & ", my_tex_form(M[J][I][1])], Out); }else str_tb([((!CC)?" [":" & ["), my_tex_form(M[J][I][1]), "]_", rtotex(M[J][I][0])], Out); } str_tb((I0)?" + ":" ",mtotex(L[I]),"\\frac{d",monototex(Opt[I]),"}{", my_tex_form(Opt[I]),(I==II-1)?"}\n":"}\n\\\\&\n"],Out); } str_tb(["\\Biggr)",V,"\n"],Out); }else if(Op==3){ /* Fuchs */ Out = string_to_tb("\\frac{d"); V=my_tex_form(Opt[0]); str_tb([V,"}{d",my_tex_form(Opt[1]),"}="] ,Out); Opt=cdr(Opt); Opt=cdr(Opt); II=length(Opt); for(I=0; I0)?" +":"\\Biggl(", " \\frac{", my_tex_form(L[I]),"}{", my_tex_form(Opt[I]),"}\n"],Out); } str_tb(["\\Biggr)",V,"\n"],Out); }else if(Op==4){ /* vect */ Out=str_tb(mtotex(matc(L)|lim=0,var=Var),0); }else if(Op==5 || Op==6){ /* cr or text */ Out = str_tb(0,0); if(type(Lim=getopt(lim))!=1) Lim=0; else if(Lim<30&&Lim>0) Lim=TeXLim; Str=getopt(str); if(length(Opt)==1 && (car(Opt)=="spts" || car(Opt)=="spts0") && type(Str)!=1) Str=2; for(K=I=0; L!=[]; I++, L=cdr(L)){ LT=car(L); if((!Lim||Op==6)&&I>0) str_tb((Op==5)?Cr:"\n",Out); if(Op==6){ if(type(LT)==7){ str_tb([LT," "],Out); I=-1; continue; } str_tb("$",Out); } KK=0; if(Str>0 && type(LT)==4 && Opt!=[]) S=ltotex(LT|opt=car(Opt),lim=0,str=Str,cr=Cr2,var=Var); else if(type(LT)==6){ if(Lim>0){ S=mtotex(LT|var=Var,lim=0,len=1); KK=S[1]; S=S[0]; }else S=mtotex(LT|var=Var,lim=0); }else if(type(LT)==3 || type(LT)==2) S=fctrtos(LT|TeX=2,lim=0,var=Var); else S=my_tex_form(LT); if(Op!=6&&I>0&&Lim){ if(Lim<0){ if(I%(-Lim)==0) str_tb((Op==5)?Cr:"\n",Out); }else if((K+=(KK=(KK)?KK:texlen(S)))>Lim){ str_tb((Op==5)?Cr:"\n",Out); K=KK; } } str_tb(S,Out); if(Op==6) str_tb("$",Out); } }else if(Op==7||Op==8){ /* spts, spts0 */ if(type(Lim=getopt(lim))!=1 || (Lim<30 && Lim!=0)) Lim=TeXLim; Str=getopt(str); Out = str_tb(0,0); for(K=0; L!=[]; L=cdr(L)){ LT=car(L); KK=0; if(type(LT)==7 && Str==1) S=LT; else if(type(LT)==3 || type(LT)==2) S=fctrtos(LT|TeX=2,lim=0,var=Var); else if(type(LT)==6){ if(Lim){ S=mtotex(LT|var=Var,lim=0,len=1); KK=S[1]; S=S[0]; }else S=mtotex(LT|var=Var,lim=0); }else S=my_tex_form(LT); if(Lim!=0){ if(!KK) KK=texlen(S); if(K>0 && K+KK>Lim){ str_tb(Cr,Out); K=0; } } if(K>0){ str_tb((Op==7)?"\\ ":" ",Out); if(type(LT)>3 && type(LT)<7) str_tb("%\n",Out); } str_tb(S,Out); K+=KK; if(OP==7) K++; } }else if(Op==9){ /* dform */ Out=str_tb(0,0); for(I=0;L!=[];L=cdr(L),I++){ for(J=0,LT=car(L); LT!=[]; LT=cdr(LT),J++){ if(J==0){ if((V=car(LT))==0) continue; if(I>0){ if(type(V)==1){ if(V<0){ str_tb("-",Out); V=-V; } else str_tb("+",Out); if(V==1 && length(LT)>1) continue; str_tb(monototex(V),Out); continue; } else str_tb("+",Out); } }else if(J>0) str_tb((J>1)?"\\wedge d":"\\,d",Out); V=monototex(car(LT)); if(V<"-" || V>=".") str_tb(V,Out); else str_tb(["(",V,")"],Out); } } }else if(Op==10 && type(L)==4 && type(car(L))==4){ /* tab */ if(type(Null=getopt(null))<0) Null=""; if(getopt(vert)==1){ M=lv2m(L|null=Null); L=m2ll(mtranspose(M)); } if(type(W=getopt(width))==1) L=madjust(L,W|null=Null); LV=ltov(L); S=length(LV); #if 1 if(type(T=getopt(left))==4){ T=str_times(T,S); for(L=[],I=0;ICS) CS=length(LV[I]); if(type(T=getopt(top))==4){ LV=cons(str_times(T,CS),vtol(LV)); S++; } if(type(T=getopt(last))==4){ LV=append(vtol(LV),[str_times(T,CS)]); S++; } #else for(I=CS=0; ICS) CS=length(LV[I]); #endif if(type(Title=getopt(title))!=7) Title=""; if(type(Vline=getopt(vline))!=4) Vline=[0,CS]; else Vline=subst(Vline,z,CS); for(VV=[],VT=Vline;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); }else VV=cons(T,VV); } Vline=qsort(VV); Out=str_tb("\\begin{tabular}{",0); if(type(Al=getopt(align))==7 && str_len(Al)>1){ str_tb(Al,Out); }else{ if(type(Al)!=7 || str_len(Al)<1) Al="r"; for(I=0;I<=CS;I++){ if(I!=0) str_tb(Al,Out); while(Vline!=[] && car(Vline)==I){ str_tb("|",Out); Vline=cdr(Vline); } } } str_tb("}",Out); if(Title!="") str_tb("\n\\multicolumn{"+rtostr(CS)+"}{c}{"+Title+"}\\\\",Out); if(type(Hline=getopt(hline))!=4) Hline=[0,S]; 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<=S;I+=T[1]) VV=cons(I,VV); }else VV=cons(T,VV); } Hline=qsort(VV); while(Hline!=[] && car(Hline)==0){ str_tb(" \\hline\n",Out); Hline=cdr(Hline); } /* if(type(getopt(left))==4) CS++; if(type(getopt(right))==4) CS++; if(type(T=getopt(top))==4){ LV=cons(str_times(T,CS),vtol(LV)); S++; } if(type(T=getopt(last))==4){ LV=append(vtol(LV),[str_times(T,CS)]); S++; } if(type(T=getopt(left))==4){ T=str_times(T,S); for(L=[],I=0;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) VMerg=VMerg=V[3]; if(length(V)>4) HMerg=V[4]; } Val=getopt(value); if(!isint(Val)) Val=-1; 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]; }else Line=0; }else Opt="@{-}"; if(type(car(L))==4){ LL=L[1]; L=L[0]; }else LL=[]; if(Line==-1){ for(Sum=0, LT=L; LT!=[]; LT=cdr(LT)){ if((S=car(LT))<=0) return 0; Sum+=S; } for(R=[],LT=L;LT!=[];LT=cdr(LT)) R=cons(car(LT)/Sum,R); R=reverse(R); Opt0=Opt*2/3; 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)){ 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),car(LT)]),Out); LT=cdr(LT); } } if(!Strip) str_tb(xyproc(0),Out); return str_tb(0,Out); } if(MX==0){ for(MX=0,LT=L; LT!=[]; LT=cdr(LT)) if(car(LT)>MX) MX=car(LT); } MX-=Shift; S=length(L); WStep=Width/S; WWStep=WStep*WRet; HStep=(Hight<0)?-Hight:Hight/MX; if(LL!=[]&&length(LL)==S-1) WS2=WStep/2; else WS2=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; 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!=[]&&I3 || imag(X)==0) str_tb(my_tex_form(X),Out); else{ XR=real(X);XI=imag(X); S=monototex(imag(X)); if(S=="1") S=""; else if(S=="- 1") S="-"; if(getopt(cpx)==2) S=S+"\\sqrt{-1}"; else S=S+"i"; if(XR!=0){ if(str_char(S,0,"-")==0) S=monototex(XR)+S; else S=monototex(XR)+"+"+S; } str_tb(S,Out); } if((LT=cdr(LT))==[]) break; else str_tb(",",Out); } str_tb(")",Out); } else return my_tex_form(L); S = str_tb(0,Out); return (getopt(small)==1)?smallmattex(S):S; } def str_tb(L,TB) { if(type(TB) == 0) TB = ""; if(L == 0) return (type(TB) == 7)?string_to_tb(TB):tb_to_string(TB); if(type(L) == 7) L = [L]; else if(type(L) != 4){ erno(0); return 0; } if(type(TB) <= 7) TB = string_to_tb((type(TB)==7)?TB:""); for(; L != []; L = cdr(L)) write_to_tb(car(L), TB); return TB; } /* def redgrs(M,T) { L = [zzz]; for(I=S=0,Eq=[],MT=M; MT!=[]; I++, MT=cdr(MT)){ for(J=LS=0, N=car(MT); N!=[]; N=cdr(N)){ X = makev([z,I,z,J]); L=cons(X,L); LS += X; S += car(N)[1]*X; } Eq = cons(LS-zzz,Eq); } Eq = cons(S-T,Eq); Sol= lnsol(Eq,L); for(LS=[],S=Sol; S!=[]; S=cdr(S)){ T=car(S); if(type(S)!=4) return 0; LS=cons(car(S)[0],LS); } } */ /* T=0 : all reduction =1 : construction procedure =2 : connection coefficient =3 : operator =4 : series expansion =5 : expression by TeX =6 : Fuchs relation =7 : All =8 : basic =9 : "" =10: irreducible =11: recurrence */ def getbygrs(M, TT) { /* extern TeXEq; */ if(type(M)==7) M=s2sp(M); if(type(M) != 4 || TT =="help"){ mycat( ["getbygrs(m,t) or getbygrs(m,[t,s_1,s_2,...]|perm=?,var=?,pt=?,mat=?)\n", " m: generalized Riemann scheme or spectral type\n", " t: reduction, construct, connection, series, operator, TeX, Fuchs, irreducible, basic, recurrence,\n", " All\n", " s: TeX dviout simplify short general operator irreducible top0 x1 x2 sft\n", "Ex: getbygrs(\"111,21,111\", [\"All\",\"dviout\",\"operator\",\"top0\"])\n"]); return 0; } if(type(TT) == 4){ T = TT[0]; T1 = cdr(TT); }else{ T = TT; T1 = []; } if(type(T) == 7) T = findin(T,["reduction","construct","connection", "operator", "series", "TeX", "Fuchs", "All", "basic", "", "irreducible", "recurrence"]); TeX = findin("TeX", T1); Simp = findin("simplify", T1); Short = findin("short", T1); Dviout= findin("dviout", T1); General=findin("general", T1); Op =findin("operator", T1); Irr =findin("irreducible", T1); Top0 =findin("top0",T1); X1 =findin("x1",T1); X2 =findin("x2",T1); Sft =findin("sft",T1); Title = getopt(title); Mat = getopt(mat); if(Mat!=1 || T<0 ||(T!=0&&T!=1&&T!=5&&T!=6&&T!=8&&T!=10&&T!=9)) Mat = 0; if(findin("keep",T1) >= 0) Keep = Dviout = 1; else Keep = 0; if(Dviout >= 0 || T == 5) TeX = 1; for(J = 0, MM = M; J == 0 && MM != []; MM = cdr(MM)){ for(MI = car(MM); MI != []; MI = cdr(MI)){ if(type(car(MI)) != 1 || car(MI) <= 0){ J = 1; break; } } } /* spectral type -> GRS */ if(J == 0){ for(R = [], S = J = 0, MM = M; MM != []; MM = cdr(MM), J++){ MT = qsort(car(MM)); R = cons(reverse(MT), R); if(J == 1){ S = length(MT)-1; if(MT[S] > MT[0]) S = 0; } } M = reverse(R); R = getopt(var); if(type(R)<1){ for(R = [], I = J-1; I >= 0; I--) R = cons(asciitostr([97+I]), R); } Sft=(Sft>=0)?1:0; if(General < 0) Sft=-Sft-1; M = sp2grs(M,R,Sft|mat=Mat); } for(M0=[],MM=M;MM!=[];MM=cdr(MM)){ /* change "?" -> z_z */ for(M1=[],Mm=car(MM);Mm!=[];Mm=cdr(Mm)){ Mt=car(Mm); if(type(Mt)==4 && Mt[1]=="?"){ M1=cons([Mt[0],z_z],M1); continue; }else if(type(Mt)==7 && Mt=="?"){ M1=cons(z_z,M1); continue; } M1=cons(Mt,M1); } M0=cons(reverse(M1),M0); } M = fspt(reverse(M0),5); /* short -> long */ if(findin(z_z,vars(M))>=0) M=subst(M,z_z,lsol(chkspt(M|mat=Mat)[3],z_z)); /* Fuchs relation */ NP = length(M); Perm = getopt(perm); if(type(Perm) == 4) M = mperm(M,Perm,0); if(T == 9){ /* "" */ if(Short >= 0) M = chkspt(M|opt=4,mat=Mat); return M; } R = [0,M]; ALL = [R]; while(type(R = redgrs(R[1]|mat=Mat)) == 4) ALL = cons(R, ALL); if(R < 0) return 0; /* TeX */ if(TeX >= 0 && !chkfun("print_tex_form", "names.rr")) return 0; if(Dviout >= 0 && type(Title) == 7) dviout(Title|keep=1); if(T == 7 && Dviout >= 0){ S=["keep","simplify"]; if(Top0 >= 0) S = cons("top0",S); getbygrs(M,cons(5,S)|title="\\noindent Riemann Scheme",mat=Mat); Same = 0; if(R > 0){ MM = getbygrs(M,8|mat=Mat); /* basic GRS */ MS = chkspt(MM|opt=0,mat=Mat); /* spectral type */ if(M != MM) getbygrs(MM,cons(5,S)|title="Basic Riemann Scheme",mat=Mat); else{ dviout("This is a basic Riemann Scheme.\n\n\\noindent"|keep=1); Same = 1; } dviout(MS|keep=1); } if(chkspt(ALL[0][1]|mat=Mat)[3] != 0) getbygrs(M,cons(6,S)|title="Fuchs condition",mat=Mat); if(Same == 0){ M1 = M[1]; if(M1[length(M1)-1][0]==1 && Mat!=1){ M1=M[2]; if(M1[length(M1)-1][0] == 1){ getbygrs(M,cons(2,S)|title="Connection formula"); if(M1[length(M[0][0])-1][0] == 1 && R==0) getbygrs(M,cons(11,S)|title="Recurrence relation shifting the last exponents at $\\infty$, 0, 1"); } getbygrs(M,cons(1,S)|title="Integral representation"); getbygrs(M,cons(4,S)|title="Series expansion"); } if(Irr < 0){ TI="Irreduciblity $\\Leftrightarrow$ any value of the following linear forms $\\notin\\mathbb Z$"; if(R > 0) TI += " + fundamental irreducibility"; getbygrs(M,cons(10,S)|title=TI,mat=Mat); dviout("which coorespond to the decompositions"|keep=1); sproot(chkspt(M|opt=0),"pairs"|dviout=1,keep=1); } } if(Op >= 0 && Mat!=1) getbygrs(M,cons(3,S)|title="Operator"); dviout(" "); return 1; } if(T == 0 && TeX >= 0){ T = 1; TeX = 16; } /* Fuchs */ Fuc = chkspt(ALL[0][1]|Mat=mat)[3]; if(Fuc == 0) Simp = -1; if(type(Fuc) == 1){ print("Violate Fuchs condition"); return 0; } if(T == 6){ if(Dviout >= 0) dviout(Fuc|eq=0,keep=Keep); return (TeX >= 0)?my_tex_form(Fuc):Fuc; } Fuc = [Fuc]; /* Generelized Riemann scheme */ if(T == 5){ M = ltov(M); for(ML=0, I=0; I ML) ML = L; } Out = string_to_tb("P\\begin{Bmatrix}\nx="); if(Top0 < 0) write_to_tb("\\infty & ",Out); Pt = getopt(pt); if(type(Pt) == 4){ for(J = 3; J < NP; J++){ str_tb(["& ",rtotex(car(Pt))],Out); Pt = cdr(Pt); } } else if(X2>=0) str_tb("0 & x_2",Out); else str_tb((X1>=0)?"x_1 & x_2":"0 & 1",Out); for(J = 3; J < NP; J++) str_tb(["& x_",rtotex(J)],Out); if(Top0 >= 0) write_to_tb("& \\infty",Out); write_to_tb("\\\\\n",Out); for(I = 0; I < ML; I++){ for(CC = 0, J = (Top0 >= 0)?1:0; ; J++, CC++){ if(J == NP){ if(Top0 < 0) break; J = 0; } if(length(M[J]) <= I){ if(CC > 0) write_to_tb(" & ",Out); }else if(M[J][I][0] <= 1){ if(M[J][I][0] == 0) str_tb(" & ",Out); else str_tb([(!CC)?" ":" & ", my_tex_form(M[J][I][1])], Out); }else{ str_tb([((!CC)?"[":" & ["), my_tex_form(M[J][I][1]), (Mat==1)?"]_{":"]_{("],Out); str_tb([my_tex_form(M[J][I][0]),(Mat==1)?"}":")}"],Out); } if(Top0 >= 0 && J == 0) break; } if(I == 0) str_tb("&\\!\\!;x",Out); str_tb("\\\\\n",Out); } str_tb("\\end{Bmatrix}",Out); Out = str_tb(0,Out); if(Dviout >= 0) dviout(Out|eq=0,keep=Keep); return Out; } /* Reduction */ if(T == 0){ if(Simp >= 0) ALL = simplify(ALL,Fuc,4); return reverse(ALL); } LA = length(ALL) - 1; NP = length(ALL[0][1]); /* irreducible */ if(T == 10){ for(IR=[], I = 0; I < LA; I++){ AI = ALL[I]; AIT = AI[1]; K = AI[0][0]; P = -AIT[0][K][1]; P -= cterm(P); IR = cons(P, IR); for(J = 0; J < NP; J++){ K = AI[0][J]; for(L = length(AIT[J]) - 1; L >= 0 ; L--){ if(L == K || AIT[J][L][0] <= AIT[J][K][0]) continue; P = AIT[J][L][1] - AIT[J][K][1]; Q = cterm(P); if(dn(Q)==1) P -= Q; IR = cons(P,IR); } } } P=Fuc[0]; Q=cterm(P); if(type(Q)==1 && dn(Q)==1){ for(F=0,V=vars(P);V!=[];V=cdr(V)){ R=mycoef(P,1,car(V)); if(type(R)!=1 || Q%R!=0){ F=1; break; } } if(F==0){ P-=Q; Simp=0; } } if(Simp >= 0){ IR=simplify(IR,[P],4); for(R=[]; IR!=[]; IR=cdr(IR)){ P=car(IR); Q=cterm(P); if(dn(Q)==1) P-=Q; R=cons(P,R); } IR=R; } for(R=[]; IR!=[]; IR=cdr(IR)){ P=car(IR); if(str_len(rtostr(P)) > str_len(rtostr(-P))) P = -P; R = cons(P,R); } R = ltov(R); #ifdef USEMODULE R = qsort(R,os_md.cmpsimple); #else R = qsort(R,cmpsimple); #endif R = vtol(R); if(TeX >= 0){ Out = string_to_tb(""); for(I=L=K=0; R!=[]; R=cdr(R),I++){ K1 = K; RS = my_tex_form(car(R)); K = nmono(car(R)); L += K; if(I){ if(K1 == K && L < 30) str_tb("\\quad ",Out); else{ L = K; str_tb((TeXEq==5)?["\\\\%\n &"]:["\\\\%\n "],Out); } } str_tb(RS,Out); } R = Out; if(Dviout>=0){ dviout(R|eq=0,keep=Keep); return 1; } } return R; } AL = []; SS = 0; for(I = 0; I <= LA; I++){ AI = ALL[I]; AIT = AI[1]; /* AIT: GRS */ if(I > 0){ for(S = J = 0; J < NP; J++){ GE = AIT[J][AI0[J]][1]; S += GE; if(J == 0) SS = []; else SS = cons(GE,SS); } SS = cons(1-Mat-S, reverse(SS)); } AI0 = AI[0]; AL = cons([SS, cutgrs(AIT)], AL); } AL = reverse(AL); AD = newvect(NP); ALT = AL[0][1]; for(J = 1; J < NP; J++){ /* AD[J] = ALT[J][0][1]; [J][?][1] <- [J][?][0]: max */ for(MMX=0, K = KM = length(ALT[J])-1; K >= 0; K--){ if(MMX <= ALT[J][K][0]){ if(J == 1 && MMX == ALT[J][K][0]) continue; KM = K; MMX = ALT[J][K][0]; } } AD[J] = ALT[J][KM][1]; } AL = cdr(AL); AL = cons([vtol(AD), ALT], AL); AL = cons([0, mcgrs(ALT, [vtol(-AD)]|mat=Mat)], AL); if(Simp >= 0 && T != 3) AL = simplify(AL,Fuc,4); /* Basic */ if(T == 8){ ALT = AL[0][1]; if(TeX >= 0){ if(Dviout >= 0){ return getbygrs(ALT,["TeX","dviout","keep"]); } return getbygrs(ALT,"TeX"); } if(Short >= 0) ALT = chkspt(ALT|opt=4); return ALT; } /* Construct */ if(T == 1){ if(TeX >= 0){ L = length(AL); I = Done = 0; Out0=Out1=""; NM = DN = []; if(TeX != 16){ AL11=AL[L-1][1][1]; AT = AL11[length(AL11)-1]; if(type(AT) == 4){ PW = (AT[0] > 1)?"":AT[1]; }else PW = AT; } Out = string_to_tb(""); while(--L >= 0){ if(TeX == 16){ if(Done) write_to_tb(":\\ ", Out); write_to_tb(getbygrs(AL[L][1],(Top0>=0)?["TeX", "top0"]:"TeX"|mat=Mat), Out); Done = 1; if(L != 0) write_to_tb((TeXEq==5)? "\\\\%\n&\\leftarrow ":"\\\\%\n\\leftarrow ", Out); } ALT = AL[L][0]; if(TeX != 16){ V1 = (I==0)?"x":V2; V2 = /* (I==0 && L<=2)?"s": */ "s_"+rtotex(I); }else V1=V2="x"; JJ = (type(ALT) == 4)?length(ALT):0; if(I > 0 && L > 0) write_to_tb("\n ", Out); for(Outt = "", J = 1; J < JJ; J++){ if(ALT[J] == 0) continue; if(J == 1) Outt += V1; else if(J == 2) Outt += "(1-"+V1+")"; else Outt += "(x_"+rtotex(J)+"-"+V1+")"; Outt += "^"+ rtotex(ALT[J]); } if(TeX != 16) write_to_tb(Outt, Out); else if(Outt != "") str_tb(["\\mathrm{Ad}\\Bigl(",Outt,"\\Bigr)"], Out); if(JJ == 0){ if(I != 0) Out1 = "ds_"+rtotex(I-1)+Out1; continue; } if(ALT[0] == 0) continue; Out0 += "\\int_p^{"+V1+"}"; if(TeX == 16) str_tb(["mc_",rtotex(ALT[0])], Out); else{ str_tb(["(",V1,"-",V2,")^",rtotex(-1+ALT[0])], Out); AL11=AL[L-1][1][1]; AT = AL11[length(AL11)-1]; if(type(AT) == 4) AT = AT[1]; DN = cons(ALT[0]+AT+1,DN); NM = cons(AT+1,cons(ALT[0],NM)); } if(L != 2) Out1 += "d"+V2; I++; } if(R){ if(I == 0) Ov = "x"; else Ov = "s_"+rtotex(I-1); Out1 = "u_B("+Ov+")"+Out1; } if(TeX != 16){ Out0 = string_to_tb(Out0); str_tb([Out, Out1], Out0); Out = Out0; NM = simplify(NM, Fuc, 4); DN = simplify(DN, Fuc, 4); DNT = lsort(NM,DN,"reduce"); NMT = DNT[0]; DNT = DNT[1]; if(NMT != [] && PW != ""){ write_to_tb((TeXEq==5)?"\\\\\n &\\sim\\frac{\n" :"\\\\\n \\sim\\frac{\n", Out); for(PT = NMT; PT != []; PT = cdr(PT)) str_tb([" \\Gamma(",my_tex_form(car(PT)), ")\n"], Out); write_to_tb(" }{\n", Out); for(PT = DNT; PT != []; PT = cdr(PT)) write_to_tb(" \\Gamma("+my_tex_form(car(PT))+")\n", Out); write_to_tb(" }", Out); if(R > 0) write_to_tb("C_0", Out); write_to_tb("x^"+rtotex(PW) +"\\ \\ (p=0,\\ x\\to0)", Out); } }else Out = str_tb(0, Out); if(Dviout >= 0){ dviout(Out|eq=0,keep=Keep); return 1; } return O; } if(Short >= 0){ for(ALL = [] ; AL != []; AL = cdr(AL)){ AT = car(AL); ALL = cons([AT[0], chkspt(AT[1]|opt=4)], ALL); } AL = reverse(ALL); } return AL; /* AL[0][1] : reduced GRS, R==0 -> rigid */ } if(T == 2 || T == 4 || T == 11){ for(I = (T==2)?2:1; I >= (T==11)?0:1; I--){ ALT = M[I]; if(ALT[length(ALT)-1][0] != 1){ mycat(["multiplicity for",I,":",ALT[length(ALT)-1][1], "should be 1"]); return; } } } LA++; NM = DN = []; /* Three term relation */ if(T == 11){ if(R > 0){ print("This is not rigid\n"); return 0; } for(I = 0; I <= LA; I++){ if(I > 0){ AI = AL[I][0]; /* operation */ if(AI[0] != 0){ DN = cons(simplify(AI1+1,Fuc,4),DN); NM = cons(simplify(AI1+AI[0]+1,Fuc,4),NM); } } ALT = AL[I][1][1]; AI1 = ALT[length(ALT)-1][1]; } DNT = lsort(NM,DN,"reduce"); if(TeX < 0) return DNT; NMT = DNT[0]; DNT = DNT[1]; Out = str_tb("u_{0,0,0}-u_{+1,0,-1}=\\frac{",""); for(PT = NMT; PT != []; PT = cdr(PT)) str_tb(["(",my_tex_form(car(PT)),")"], Out); str_tb(["}\n{"],Out); for(PT = DNT; PT != []; PT = cdr(PT)) str_tb(["(",my_tex_form(car(PT)),")"], Out); write_to_tb("}u_{0,+1,-1}",Out); if(Dviout >= 0){ dviout(Out|eq=0,keep=Keep); return 1; } return Out; } AD=newvect(NP); for(I = 0; I <= LA; I++){ if(I > 0){ AI = AL[I][0]; /* operation */ if(T == 2 && AI[0] != 0){ DN = cons(simplify(-AI2,Fuc,4), cons(simplify(AI1+1,Fuc,4),DN)); NM = cons(simplify(-AI2-AI[0],Fuc,4), cons(simplify(AI1+AI[0]+1,Fuc,4), NM)); } for(J = 1; J < NP; J++) AD[J] += simplify(AI[J],Fuc,4); } if(T == 2){ ALT = AL[I][1][1]; AI1 = ALT[length(ALT)-1][1]; ALT = AL[I][1][2]; AI2 = ALT[length(ALT)-1][1]; if(I == 0){ C3 = AI1; C4 = AI2; } } } /* Connection */ if(T == 2){ DNT = lsort(NM,DN,"reduce"); NMT = DNT[0]; DNT = DNT[1]; if(TeX < 0) return [NMT,DNT,AD]; C0 = M[1][length(M[1])-1][1]; C1 = M[2][length(M[2])-1][1]; M = AL[0][1]; C3 = M[1][length(M[1])-1][1]; C4 = M[2][length(M[2])-1][1]; Out = str_tb(["c(0\\!:\\!", my_tex_form(C0), " \\rightsquigarrow 1\\!:\\!", my_tex_form(C1),")"], ""); if(R > 0 && AMSTeX == 1 && (TeXEq == 4 || TeXEq == 5)){ write_to_tb("\\\\\n", Out); if(TeXEq == 5) write_to_tb(" &", Out); } write_to_tb("=\\frac{\n",Out); for(PT = NMT; PT != []; PT = cdr(PT)) write_to_tb(" \\Gamma("+my_tex_form(car(PT))+")\n", Out); write_to_tb(" }{\n",Out); for(PT = DNT; PT != []; PT = cdr(PT)) write_to_tb(" \\Gamma("+my_tex_form(car(PT))+")\n",Out); write_to_tb(" }", Out); for(J = 3; J < length(AD); J++){ if(AD[J] == 0) continue; str_tb(["\n (1-x_", rtotex(J), "^{-1})^", rtotex(AD[J])], Out); } if(R != 0) str_tb(["\n c_B(0\\!:\\!", my_tex_form(C3), " \\rightsquigarrow 1\\!:\\!", my_tex_form(C4), ")"], Out); Out = tb_to_string(Out); if(Dviout >= 0){ dviout(Out|eq=0,keep=Keep); return 1; } return Out; } /* Series */ if(T == 4){ AL11 = AL[0][1][1]; V = AL11[length(AL11)-1][1]; S00 = -V; S01 = (R==0)?[]:[[0,0]]; S1 = S2 = []; for(Ix = 1, ALL = cdr(AL); ALL != []; ){ ALT = ALL[0][0]; if(ALT[0] != 0){ /* mc */ for(Sum = [], ST = S01; ST != []; ST = cdr(ST)) Sum = cons(car(ST)[0], Sum); S1 = cons(cons(S00+1,Sum), S1); S2 = cons(cons(S00+1+ALT[0],Sum),S2); S00 += ALT[0]; } ALL = cdr(ALL); for(I = 1; I < length(ALT); I++){ /* addition */ if(I == 1){ S00 += ALT[1]; if(ALL == []) S00 = [S00]; }else{ if(ALT[I] == 0) continue; if(ALL != []){ S1 = cons([-ALT[I],Ix],S1); S2 = cons([1,Ix],S2); S01= cons([Ix,I],S01); Ix++; }else S00 = cons([ALT[I],I],S00); } } } S00 = reverse(S00); S01 = qsort(S01); S1 = qsort(S1); S2 = qsort(S2); if(Simp >= 0){ S00 = simplify(S00,Fuc,4); S01 = simplify(S01,Fuc,4); S1 = simplify(S1,Fuc,4); S2 = simplify(S2,Fuc,4); SS = lsort(S1,S2,"reduce"); S1 = SS[0]; S2 = SS[1]; } if(TeX >= 0){ /* Top linear power */ TOP = Ps = Sm = ""; for(TOP = Ps = Sm = "", ST = cdr(S00); ST != []; ST = cdr(ST)){ SP = car(ST); if(SP[0] != 0){ if(SP[1] == 2) TOP += "(1-x)^"+rtotex(SP[0]); else TOP += "(1-x/x_"+rtotex(SP[1])+")^"+rtotex(SP[0]); } } /* Top power */ PW = my_tex_form(car(S00)); if(PW == "0") PW = ""; NP = length(AL[0][1]); PWS = newvect(NP); for(I = 0; I < NP; I++) PWS[I] = ""; for(S = S01, I = 0; S != []; S = cdr(S), I++){ SI = rtotex(car(S)[0]); if(I > 0) Sm += ",\\ "; Sm += "n_"+SI+"\\ge0"; if(PW != "") PW += "+"; PW += "n_"+SI; if(car(S)[1] > 2) PWS[car(S)[1]] += "-n_"+rtotex(car(S)[0]); else if(car(S)[1] == 0) Ps = "C_{n_0}"+Ps; } for(I = 3; I < NP; I++){ if(PWS[I] != "") Ps += "x_"+rtotex(I)+"^{"+PWS[I]+"}"; } Out = str_tb([TOP, Ps, "x^{", PW, "}"], ""); /* Gamma factor */ for(I = 0, SS = S1; I <= 1; I++, SS = S2){ PW = string_to_tb(""); for(PW1=""; SS != [] ; SS = cdr(SS)){ for(J = 0, SST = car(SS); SST != []; SST = cdr(SST), J++){ if(J == 0){ JJ = (car(SST) == 1)?((length(SST)==2)?(-1):0):1; if(JJ > 0) str_tb(["(", my_tex_form(car(SST)), ")_{"], PW); else if(JJ == 0) PW1 = "("; }else{ if(JJ > 0){ if(J > 1) write_to_tb("+", PW); str_tb(["n_", rtotex(car(SST))], PW); }else{ if(J > 1) PW1 += "+"; PW1 += "n_"+rtotex(car(SST)); } } } if(JJ > 0) write_to_tb("}", PW); else PW1 += (JJ == 0)?")!":"!"; } if(I == 0) Out0 = "\\frac"; Out0 += "{"+tb_to_string(PW)+PW1+"}"; PW = string_to_tb(""); PW1 = ""; } if(Out0 == "\\frac{}{}") Out0 = ""; Out = "\\sum_{"+Sm+"}"+Out0 + Top + tb_to_string(Out); if(length(S01) == 1){ Out = str_subst(Out, "{n_"+SI+"}", "n"); Out = str_subst(Out, "n_"+SI, "n"); } if(Dviout >= 0) dviout(Out|eq=0,keep=Keep); return Out; } return [cons(S00, S01), S1, S2]; } /* Operator */ if(T==3){ Fuc0 = car(Fuc); if(Fuc0 != 0){ /* Kill Fuchs relation */ for(V = vars(Fuc0); V != []; V = cdr(V)){ VT = car(V); if(deg(Fuc0,VT) == 1){ AL = mysubst(AL, [VT, -red(coef(Fuc0,0,VT)/coef(Fuc0,1,VT))]); break; } } if(V == []){ print("Fuchs condition has no variable with degree 1"); return 0; } } L = newvect(NP); Pt = getopt(pt); for(I = NP-1; I >= 1; I--){ if(type(Pt) == 4) L[I] = Pt[I-1]; else if(I >= 3 || X1 >= 0 || (X2 >= 0 && I >= 2)) L[I] = makev(["x_", I]); else L[I] = I-1; } if(R){ /* non-rigid basic */ MM = AL[0][1]; /* Riemann scheme */ for(OD = 0, MT = car(MM); MT != []; MT = cdr(MT)) OD += car(MT)[0]; for(V = DN = [], M = MM; M != []; M = cdr(M)){ MT = car(M); /* exponents */ for(K = KM = 0, NT = []; ; K++){ for(J = 0, P = 1, MTT = MT; MTT != []; MTT = cdr(MTT)){ if(J == 0 && car(MTT)[1] == 0) KM = car(MTT)[0]; for(KK = car(MTT)[0] - K -1; KK >= 0; KK--) P *= (dx-car(MTT)[1]-KK); } if(P == 1) break; NT = cons(P,NT); } V = cons(reverse(NT), V); DN = cons(KM, DN); } V = ltov(reverse(V)); /* conditions for GRS */ DN = ltov(reverse(DN)); /* dims of local hol. sol. */ for(J = OD; J >= 0; J--){ for(I = Q = 1; I < NP; I++){ if(J > DN[I]) Q *= (x-L[I])^(J-DN[I]); } K = mydeg(Q,x); if(J == OD){ P = Q*dx^J; DM = K; }else{ for(I = DM-OD+J-K; I >= 0; I--){ X = makev(["r",J,"_",I]); P += Q*x^I*X*dx^J; } } } for(R = [], I = 0; I < NP; I++){ Q = toeul(P, [x,dx], (I==0)?"infty":L[I]); /* Euler at I-th pt */ for(VT = V[I], J=0; VT != [] ; VT = cdr(VT), J++){ if(car(VT) != 0) R = cons(rpdiv(coef(Q,J,x), car(VT), dx)[0], R); /* equations */ } } for(RR = RRR = [], I = OD-1; I>=0; I--){ RR = []; for(RT = R; RT != [] ; RT = cdr(RT)){ if( (VT = mycoef(car(RT), I, dx)) != 0) RR = cons(VT, RR); /* real linear eqs */ } J = mydeg(mycoef(P,I,dx),x); for(S = 0, VVV = []; J >= 0; J--){ X = makev(["r",I,"_",J]); VVV = cons(X, VVV); /* unknowns */ } RR = lsol(RR,VVV); LN = length(RR); for(K=0; K=0)? simplify(P,Fuc,4|var=[dx]):simplify(P,Fuc,4); if(TeX >= 0){ Val = 1; if(mydeg(P,dx) > 2 && AMSTeX == 1 && TeXEq > 3) Val = (TeXEq==5)?3:2; Out = fctrtos(P|var=[dx,"\\partial"],TeX=Val); if(Dviout < 0) return Out; dviout(Out|eq=0,keep=Keep); return 1; } return P; } return 0; } def mcop(P,M,S) { for(V=[],ST=S;ST!=[];ST=cdr(ST)) if(isvar(VT=car(ST))) V=cons(vweyl(VT),V); V=reverse(V); N=length(V); for(MT=M;MT!=[];MT=cdr(MT)){ T=car(MT); if(T[0]!=0) P=mc(P,V[0],T[0]); for(TT=cdr(T),ST=cdr(S);ST!=[];TT=cdr(TT),ST=cdr(ST)) if(car(TT)!=0) P=sftpexp(P,V,S[0]-ST[0],-car(TT)); } return P; } /* option: zero, all, raw */ def shiftop(M,S) { if(type(M)==7) M=s2sp(M); if(type(S)==7) S=s2sp(S); Zero=getopt(zero); NP=length(M); for(V=L=[],I=NP-1; I>=0; I--){ V=cons(strtov(asciitostr([97+I])),V); if(I>2) L=cons(makev(["y_", I-1]),L); else L=cons(I-1,L); } if(type(M[0][0])==4){ F=1;RS=M;SS=S; R=chkspt(M); if(R[2]!=2 || R[3]!=0){ mycat("GRS is not valid!");return 0; } for(; S!=[]; S=cdr(S)){ if(nmono(S[0][0])!=1) break; if(isint(S[0][1]-S[0][0])==0) break; } if(S!=[]){ mycat("Error in shift!"); return 0; } }else{ F=0; RS=sp2grs(M,V,[1,length(M[0]),1]); for(SS=S0=[],I=0; I0 && Zero==1 && F==0){ RS=mysubst(RS,[RS[I][J][1],0]); F=J+1; } } if((F>0 && J==2) || (I==0 && J==1)){ J=(I==0)?0:2-F; VT=RS[I][J][1]; S0=cons([VT,strtov(asciitostr([strtoascii(rtostr(VT))[0]]))],S0); } } } RS1=mysubst(RS,SS); if(F==1){ R=chkspt(RS1); if(R[2]!=2 || R[3]!=0){ mycat("Error in shift!"); return 0; } } R=getbygrs(RS,1); R1=getbygrs(RS1,1); RT=R[0][1][0]; if(length(RT)!=1 || RT[0][0]!=1){ mycat("Not rigid!"); return 0; } P=dx;Q=Q1=1; for(RT = R, RT1=R1; RT != []; RT = cdr(RT), RT1=cdr(RT1)){ V=car(RT)[0]; V1=car(RT1)[0]; if(type(V) != 4) continue; if(V[0] != 0){ P = mc(P,x,V[0]); /* middle convolution */ QT = mc(Q,x,V[0]); }else QT=Q; D0=mydeg(Q,dx);D0T=mydeg(QT,dx); C0=red(mycoef(Q,D0,dx)/mycoef(QT,D0T,dx)); if(C0!=1) QT=red(C0*QT); if(V1[0] != 0) Q1T = mc(Q1,x,V1[0]); else Q1T=Q1; D1=mydeg(Q1,dx);D1T=mydeg(Q1T,dx); C1=red(mycoef(Q1,D1,dx)/mycoef(Q1T,D1T,dx)); if(C1!=1) Q1T=red(C1*Q1T); DD=(V[0]-V1[0])+(D0-D0T)-(D1-D1T); if(DD>0){ QT=muldo(dx^DD,QT,[x,dx]); D0T+=DD; }else if(DD<0){ Q1T=muldo(dx^(-DD),Q1T,[x,dx]); D1T-=DD; } C=mylcm(dn(QT),dn(Q1T),x); if(C!=1){ QT=red(C*QT); Q1T=red(C*Q1T); } Q=QT;Q1=Q1T; for(I = 1; I < NP; I++){ if(V[I]!=0){ P = sftexp(P,x,L[I],-V[I]); /* addition u -> (x-L[I])^V[I]u */ QT = sftexp(QT,x,L[I],-V[I]); } if(V1[I]!=0) Q1T = sftexp(Q1T,x,L[I],-V1[I]); } C=red(mycoef(QT,D0T,dx)*mycoef(Q1,D1T,dx)/(mycoef(Q,D0T,dx)*mycoef(Q1T,D1T,dx))); Q=red(dn(C)*QT);Q1=red(nm(C)*Q1T); for(I = 1; I < NP; I++){ if((J=V[I]-V1[I])!=0){ if(J>0) Q1*=(x-L[I])^J; else Q*=(x-L[I])^(-J); } while((QT=tdiv(Q,x-L[I]))!=0){ if((Q1T=tdiv(Q1,x-L[I]))!=0){ Q=QT;Q1=Q1T; }else break; } } } P1=mysubst(P,SS); if(type(S0)==4 && S0!=[]){ P=mysubst(P,S0); Q=mysubst(Q,S0); P1=mysubst(P1,S0); Q1=mysubst(Q1,S0); RS=mysubst(RS,S0); RS1=mysubst(RS1,S0); } R=mygcd(Q1,P1,[x,dx]); if(findin(dx,vars(R[0]))>=0){ mycat("Some error!"); return 0; } Q=muldo(R[1]/R[0],Q,[x,dx]); R=divdo(Q,P,[x,dx]); Q=red(R[1]/R[2]); R=fctr(nm(Q)); QQ=Q/R[0][0]; R1=fctr(dn(QQ)); for(RR=cdr(R1); RR!=[]; RR=cdr(RR)){ VT=vars(car(RR)[0]); if(findin(x,VT)<0 && findin(dx,VT)<0){ for(I=car(RR)[1];I>0;I--) QQ=red(QQ*car(RR)[0]); } } Raw=getopt(raw); Dviout=getopt(dviout); if(Dviout==1) Raw=4; if(Raw!=1){ for(RR=cdr(R); RR!=[]; RR=cdr(RR)){ VT=vars(car(RR)[0]); if(findin(x,VT)<0 && findin(dx,VT)<0){ for(I=car(RR)[1];I>0;I--) QQ=red(QQ/car(RR)[0]); } } } if(Raw==2||Raw==3||Raw==4){ R=mygcd(QQ,P,[x,dx]); /* R[0]=R[1]*QQ + R[2]*P */ Q1=red(R[0]/R[2]); for(Q=1,RR=cdr(fctr(nm(Q1))); RR!=[]; RR=cdr(RR)){ VT=vars(car(RR)[0]); if(findin(x,VT)<0){ for(I=car(RR)[1];I>0;I--) Q*=car(RR)[0]; } } if(Raw==3) QQ=[QQ,Q]; else if(Raw==4) /* Q=Q*R[1]/R[0]*QQ+Q/R[0]*P */ QQ=[QQ,Q,red(R[1]*Q/R[0])]; else QQ=Q; } F=getopt(all); if(Dviout==1){ Pre = " x=\\infty & 0 & 1"; for(I=3; I S1){ print("Error in data!"); return 0; } } if(Conf==0){ for(L=[], I=L0-2; I>=0; I--) L=cons(I,L); L=cons(L0-1,L); P = getbygrs(G,["operator","x2"]|perm=L); }else if(X1) P = getbygrs(mperm(G,[[1,2]],[]), ["operator","x2"]); else P = getbygrs(G,["operator","x1"]); if(Conf==0) P=nm(mysubst(P,[X,c])); else{ P = nm(mysubst(P,[X,1/c])); if(X2==-1){ for(I=2; I 0) P = mysubst(P,[V,V/c^D]); CV = mycoef(P,1,V); DD = mydeg(CV,dx); CVV = mycoef(CV,DD,dx); CD1 = mydeg(CVV,x); CD = (X==x1)?0:CD1; while(CD>=0 && CD<=CD1){ CC = mycoef(CVV,CD,x); if(type(CC)==1){ VT = mycoef(mycoef(mycoef(P,DD,dx),CD,x),0,V)/CC; if(VT != 0) P = mysubst(P,[V,V-VT]); break; } if(X==x1) CD++; else CD--; } while(subst(P,c,0,V,0) == 0) P = red(mysubst(P,[V,c*V])/c); } VS =cdr(VS); } return P; } def pgen(L,VV) { if(type(L[0])<4) L=[L]; if(type(L)==4) L=ltov(L); K=length(L); V=newvect(K); if(type(Sum=getopt(sum))!=1) Sum=0; if((Num=getopt(num))!=1) Num=0; if((Sep=getopt(sep))!=1) Sep=0; if(type(Shift=getopt(shift))!=1) Shift=0; for(;;){ for(PP=1,R=[],II=K-1; II>=0; II--){ R=cons(V[II]+Shift,R); if(II>0 && Sep==1) R=cons("_",R); PP*=L[II][0]^V[II]; } P+=makev(cons(VV,R)|num=Num)*PP; for(I=0;I0){ for(S=II=0;IISum){ V[I++]=0; continue; } } }else{ V[I++]=0; continue; } break; } if(I>=K) return P; } } def diagm(M,A) { return mgen(M,0,A,1); } def mgen(M,N,A,S) { if(M==0 && N==0){ mycat([ "mgen(m,n,a,s|sep=1) : generate a matrix of size m x n\n", " n : a number or \"diagonal\", \"highdiag\", \"lowdiag\",\"skew\",\"symmetric\",\"perm\" = 0,-1,-2,..\n", " a : a symbol or list (ex. a, [a], [a,b,c], [1,2,3])\n", " s : 0 or 1 (shift of suffix)\n" ]); return 0; } if(type(N)==7) N=-findin(N,["diag","highdiag","lowdiag","skew","symmetric","perm"]); Sep=(getopt(sep)==1)?1:0; if(S < 0 || S > 2) S = 0; if(M+S > 30 || N+S > 30){ erno(1); return; } if(N==-5){ NM=newmat(M,M); for(I=0;I= -2){ MM = newmat(M,M); J = K = 0; if(N == -1){ K = 1; M--; }else if(N == -2){ J = 1; M--; } for(I = 0; I < M; I++){ if(L >= 0) MM[I+J][I+K] = A[(I > L)?L:I]; else if(type(A)==7 || isvar(A)) MM[I+J][I+K] = makev([A,S+I]|sep=Sep); else MM[I+J][I+K] = A; } return MM; } K = N; if(K < 0) N = M; MM = newmat(M,N); for(I = 0; I < M; I++){ if(L >= 0) AA = rtostr(A[(I > L)?L:I]); else AA = rtostr(A)+rtostr(I+S); if(AA>="0" && AA<=":"){ erno(0); return; } for(J = 0; J < N; J++){ if(K < 0){ if(I > J) continue; if(K == -3 && I == J) continue; } MM[I][J] = makev([AA,J+S]|sep=Sep); } } if(K < 0){ for(I = 0; I < M; I++){ for(J = 0; J < I; J++) MM[I][J] = (K == -4)?MM[J][I]:-MM[J][I]; } } return MM; } def newbmat(M,N,R) { S = newvect(M); T = newvect(N); IM = length(R); for(I = 0; I < IM; I++){ RI = R[I]; JM = length(RI); for(J = 0; J < JM; J++){ RIJ = RI[J]; if(type(RIJ) == 6){ S[I] = size(RIJ)[0]; T[J] = size(RIJ)[1]; } } } for(I = K = 0; I < M; I++){ if(S[I] == 0) S[I] = 1; K += S[I]; } for(J = L = 0; J < N; J++){ if(T[J] == 0) T[J] = 1; L += T[J]; } M = newmat(K,L); if(type(Null=getopt(null))>0){ for(I=0;I0)?RIJ[I]:RIJ[J]; else M[I0+I][J0+J] = RIJ; } } } } return M; } def unim(S) { if(!Rand++) random(currenttime()); if(!isint(Wt=getopt(wt))||Wt<0||Wt>10) Wt=2; if(!isint(Xa=getopt(abs)) || Xa<1) Xa=9; if((Xaa=Xa)>10) Xaa=10; if(Xaa%2) Xaa++; Xh=Xaa/2; if(type(S0=SS=S)==4){ Int=(getopt(int)==1)?1:0; U=[1,1,1,1,1,1,1,1,1,1,1,1,2,2,3,4]; M=newmat(S[0],S[1]); SS=cdr(S);SS=cdr(SS); if(Rk=length(SS)) L=SS; else{ L=[0]; I=(S[0]>S[1])?S[1]:S[0]; if(I<=2) return 0; if(!isint(Rk=getopt(rank))||Rk<1||Rk>S[0]||Rk>S[1]) Rk=random()%(I-1)+2; for(I=1;IXa) P=Xa; M[I][L[I]]=(random()%2)?P:(-P); } for(I=0;I1) M[K=random()%I][KK=L[I]]=1; I0=(I==0)?1:L[I]+1; I1=(I==Rk-1)?S[1]:L[I+1]; for(J=I0;J20) return 0; if(getopt(conj)==1){ M=S+Wt; if(M>15) M=10; M0=floor((M-1)/2); for(R=[],I=0;I0) M[0][0]--; else M[S-1][S-1]++; } } if(getopt(res)==1) RR=diagm(S,[1]); S1=S; Res=dupmat(S=M); if(isint(I=getopt(int))&&I>1&&random()%I==0){ K=S[0][0];L=K+1; for(I=1;IL && S[I-1][I]==0 && (I==S1-1||S[I][I+1]==0)){ L=S[I][I]; if(RR){ RR[I][I]=L-K;RR[0][I]=1; } S[0][I]=1; if(!(random()%3)) break; } } if(random()%3==0){ for(I=0;I=0&&S[J][I]==0;J--); if(J>=0) continue; S[I][I+1]=2; for(J=0;J3||S1>3)?100:200; if(getopt(both)==1){ OL=delopt(getopt(),"both"); M=unim(mtranspose(M)|option_list=OL); M=mtranspose(M); } Mx=20; for(I=K=LL=0;ICt) T=random()%Xaa-Xh; else if(5*K=0) T++; if(P==Q) continue; for(G=0,J=S1-1;J>=0;J--){ if((H=abs(M[Q][J]+M[P][J]*T))>Xa&&(!Conj||J!=P)) break; if(K1) J=1; if(J>0) continue; if(J<0&&Conj==1){ for(J=S1-1;J>=0;J--) if(J!=Q&&abs(M[J][P]-M[J][Q]*T)>Xa) break; if(J<0&&abs(M[Q][P]-M[Q][Q]*T+M[P][P]*T-M[P][Q]*T^2)>Xa) J=1; if(J<0&&M[P][P]==M[Q][Q]){ LF=0; for(L=S1-1;J>=0;J--) if(L!=Q&&M[J][Q]!=0) LF++; for(L=S1-1;J>=0;J--) if(L!=P&&M[P][J]!=0) LF++; if(!LF) J=1; } } if(J<0){ for(J=S1-1;J>=0;J--) M[Q][J]+=M[P][J]*T; if(Conj==1) for(J=S1-1;J>=0;J--) M[J][P]-=M[J][Q]*T; if(RR) for(J=S1-1;J>=0;J--) RR[Q][J]+=RR[P][J]*T; K++; } if(K%5==0){ if(!Nt) M=mtranspose(M); else if(!Conj&&K%2==0){ for(F=0;F1){ for(L=0;LCt){ for(L=S-1;L>=0;L--){ for(F=0,J=S1-1;J>=0;J--) if(M[L][J]!=0) F++; if(F<2){ F=-1;break; } else F=0; } if(F<0 && LL++<5){ I=(CT-CT%2)/2;K=1; } if(I>Ct) break; } } if(RR){ for(I=F=0;I=0;K--,VN=cdr(VN)) RR[K][J]=car(VN); F=1; } } } K=I;I=J;J=K; } } if(F&&I==S1-1){ F=0;I=-1; } } if(getopt(int)==1){ N=mtranspose(M); for(F=I=0;I1||lgcd(N[I])>1) F++; if(F){ for(F=I=0;IXa*10||abs(lmin(RR))>Xa*10)?1:0; for(I=0;!F&&I0) V++; else if(RR[J][I]<0) V--; } if(I0){ FE=cons([C*(X+S)^2-C1^(1/2)*(X+S)+C0,car(FT)[1]],FE); FE=cons([C*(X+S)^2+C1^(1/2)*(X+S)+C0,car(FT)[1]],FE); RT=cons(C1,RT); continue; } } } FE=cons(car(FT),FE); } FC=reverse(FE); } N = Q = 0; L = []; for(I = length(FC)-1; I >= 0; I--){ if((D = mydeg(FC[I][0],X)) == 0) continue; for(K=1; K<=FC[I][1]; K++){ for(J=P=0; J < D; J++){ V = makev(["zz_",++N]); P = P*X + V; L = cons(V,L); } Q += P/(FC[I][0]^K); Q = red(Q); } } L=reverse(L); Q = nm(red(red(Q*FD)-FN)); Q = ptol(Q,X); S = lsol(Q,L); R = (R0==0)?[]:[[R0,1,1]]; for(N=0,I=length(FC)-1; I >= 0; I--){ if((D = mydeg(FC[I][0],X)) == 0) continue; for(K=1; K<=FC[I][1]; K++){ for(P=J=0; J < D; N++,J++) P = P*X + S[N][1]; if(P!=0) R = cons([P,FC[I][0],K],R); } } for(;RT!=[];RT=cdr(RT)){ RTT=car(RT); R=mtransbys(os_md.substblock,R,[RTT^(1/2),(RTT^(1/2))^2,RTT]); } TeX=getopt(TeX); if((Dvi=getopt(dviout))==1||TeX==1){ V=strtov("0"); for(S=L=0,RR=R;RR!=[];RR=cdr(RR),L++){ RT=car(RR); S+=(RT[0]/RT[1]^RT[2])*V^L; } if(TeX!=1) fctrtos(S|var=[V,""],dviout=1); else return fctrtos(S|var=[V,""],TeX=3); } return reverse(R); } def cfrac(X,N) { F=[floor(X)]; if(N<0){ Max=N=-N; } X-=F[0]; if(Max!=1) M=mat([F[0],1],[1,0]); for(;N>0 && X!=0;N--){ X=1/X; F=cons(Y=floor(X),F); X-=Y; if(Max){ M0=M[0][0];M1=M[1][0]; M=M*mat([Y,1],[1,0]); if(M[0][0]>Max) return M0/M1; } } return (Max==0)?reverse(F):M[0][0]/M[1][0]; } def sqrt2rat(X) { if(type(X)>3) return X; X=red(X); if(getopt(mult)==1){ for(V=vars(X);V!=[];V=cdr(V)){ T=funargs(F=car(V)); if(type(T)==4&&length(T)>1){ Y=T[1]; Z=sqrt2rat(Y); if(Y!=Z){ if(length(T)==2){ T0=T[0]; X=subst(X,F,T0(Z)); }else if(T[0]==pow) X=subst(X,F,Y^T[2]); } } } } for(V=vars(X);V!=[];V=cdr(V)){ /* r(x)^(1/2+n) -> r(x)^n*r(x)^(1/2) */ T=args(Y=car(V)); if(functor(Y)==pow&&T[1]!=1/2&&isint(T2=2*T[1])){ if(iand(T2,1)){ R=(T[0])^(1/2);T2--; }else R=1; R*=T[0]^(T2/2); X=red(subst(X,Y,R)); } } D=dn(X);N=nm(X); if(imag(D)!=0){ N*=conj(D); D*=conj(D); return sqrt2rat(N/D); } for(V=vars(N);V!=[];V=cdr(V)){ /* (r(x)^(n/m))^k */ T=args(Y=car(V)); if(functor(Y)==pow&&(T[1]==0||(type(T[1])==1&&ntype(T[1])==0))){ Dn=dn(T[1]);Nm=nm(T[1]); N=substblock(N,Y,Y^Dn,T[0]^Nm); } } for(V=vars(D);V!=[];V=cdr(V)){ T=args(Y=car(V)); if(functor(Y)==pow&&(T[1]==0||(type(T[1])==1&&ntype(T[1])==0))){ Dn=dn(T[1]);Nm=nm(T[1]); D=substblock(D,Y,Y^Dn,T[0]^Nm); } } for(V=vars(D);V!=[];V=cdr(V)){ T=args(Y=car(V)); if(functor(Y)==pow&&T[1]==1/2&&mydeg(D,Y)==1){ N*=mycoef(D,0,Y)-mycoef(D,1,Y)*Y; N=mycoef(N,0,Y)+mycoef(N,1,Y)*Y+mycoef(N,2,Y)*T[0]; D=mycoef(D,0,Y)^2-mycoef(D,1,Y)^2*T[0]; X=red(N/D); D=dn(X);N=nm(X); break; } } X=red(N/D); D=dn(X);N=nm(X); for(V=vars(D);V!=[];V=cdr(V)){ T=args(Y=car(V)); if(functor(Y)==pow&&T[1]==1/2) D=substblock(D,T[0]^T[1],(T[0]^T[1])^2,T[0]); } for(V=vars(N);V!=[];V=cdr(V)){ T=args(Y=car(V)); if(functor(Y)==pow&&T[1]==1/2) N=substblock(N,T[0]^T[1],(T[0]^T[1])^2,T[0]); } for(V=vars(N);V!=[];V=cdr(V)){ T=args(Y=car(V)); if(functor(Y)==pow&&T[1]==1/2){ Ag=T[0]; R=S=1; An=fctr(nm(Ag)); CA=An[0][0]; if(CA<0){ CA=-CA;R=-1; } if(type(I=sqrtrat(CA))<2) S=I; else R*=CA; for(An=cdr(An);An!=[];An=cdr(An)){ Pw=car(An)[1];I=iand(Pw,1); if(I) R*=car(An)[0]; if((Q=(Pw-I)/2)>0) S*=car(An)[0]^Q; } for(An=fctr(dn(Ag));An!=[];An=cdr(An)){ Pw=car(An)[1];I=iand(Pw,1); if(I) R/=car(An)[0]^I; if((Q=(Pw-I)/2)>0) S/=car(An)[0]^Q; } if(S!=1) N=subst(N,Y,R^(1/2)*S); } } for(V=vars(N);V!=[];V=cdr(V)){ T=args(Y=car(V)); if(functor(Y)==pow&&T[1]==1/2){ C=mycoef(N,1,Y); for(VC=vars(C);VC!=[];VC=cdr(VC)){ TC=args(YC=car(VC)); if(functor(YC)==pow&&TC[1]==1/2){ Ag=red(T[0]*TC[0]); R=S=1; An=fctr(nm(Ag)); CA=An[0][0]; if(CA<0){ CA=-CA;R=-1; } if(type(I=sqrtrat(CA))<2) S=I; else R*=CA; for(An=cdr(An);An!=[];An=cdr(An)){ Pw=car(An)[1];I=iand(Pw,1); if(I) R*=car(An)[0]; if((Q=(Pw-I)/2)>0) S*=car(An)[0]^Q; } for(An=fctr(dn(Ag));An!=[];An=cdr(An)){ Pw=car(An)[1];I=iand(Pw,1); if(I) R/=car(An)[0]^I; if((Q=(Pw-I)/2)>0) S/=car(An)[0]^Q; } CC=mycoef(C,1,YC); N=N-CC*YC*Y+CC*R^(1/2)*S; } } } } return red(N/D); } def cfrac2n(X) { if(type(L=getopt(loop))==1&&L>0) C=x; else{ C=0;L=0; } if(L>1){ for(Y=[];L>1;L--){ Y=cons(car(X),Y); X=cdr(X); } if(X!=[]){ P=cfrac2n(X|loop=1); for(V=P,Y=reverse(Y);Y!=[];Y=cdr(Y)) V=sqrt2rat(car(Y)+1/V); return V; }else{ C=0;X=reverse(Y); } } for(V=C,X=reverse(X);X!=[];X=cdr(X)){ if(V!=0) V=1/V; V+=car(X); } if(C!=0){ V=red(V);P=dn(V)*x-nm(V); S=getroot(P,x|cpx=2); T=map(eval,S); V=(T[0]>0)?S[0]:S[1]; } return V; } def s2sp(S) { if(getopt(short)==1){ if(type(F=getopt(std))==1) S=s2sp(S|std=F); if(type(S)!=7) S=s2sp(S); L=strtoascii(S); for(LS=[],F=C=0;L!=[];L=cdr(L)){ if((G=car(L))!=F){ LS=cons(G,LS);C=0; }else if(C<3){ LS=cons(G,LS); }else if(C==3){ LS=cdr(LS);LS=cdr(LS); LS=cons(94,LS);LS=cons(52,LS); }else if(C==9){ LS=cdr(LS);LS=cons(97,LS); }else{ K=car(LS);LS=cdr(LS);LS=cons(K+1,LS); } C++;F=G; } return asciitostr(reverse(LS)); } if(type(F=getopt(std))==1){ F=(F>0)?1:-1; if(type(S)==7) S=s2sp(S); for(L=[];S!=[];S=cdr(S)) L=cons(os_md.msort(car(S),[-1,0]),L); return os_md.msort(L,[F,2]); } if(type(S)==7){ S = strtoascii(S); if(type(S) == 5) S = vtol(S); for(N=0,R=TR=[]; S!=[]; S=cdr(S)){ if(car(S)==45) /* - */ N=1; else if(car(S)==47) /* / */ N=2; if(N>0){ while(car(S)<48&&car(S)!=40) S=cdr(S); } if((T=car(S))>=48 && T<=57) TR=cons(T-48,TR); else if(T>=97) TR=cons(T-87,TR); else if(T>=65 && T<=90) TR=cons(T-29,TR); /* A-Z */ else if(T==44){ R=cons(reverse(TR),R); TR=[]; }else if(T==94){ /* ^ */ S=cdr(S); if(car(S)==40){ /* ( */ S=cdr(S); for(T=0; car(S)!=41 && S!=[]; S=cdr(S)){ V=car(S)-48; if(V>=10) V-=39; T=10*T+V; } }else{ while(car(S)<48) S=cdr(S); T=car(S)-48; if(T>=10) T-=39; } while(--T>=1) TR=cons(car(TR),TR); }else if(T==40){ /* ( */ S=cdr(S); if(N==1){ N=0; NN=1; }else NN=0; if(car(S)==45){ /* - */ S=cdr(S); NN=1-NN; } for(I=0; I<2; I++){ for(V=0; (SS=car(S))!=41 && SS!=47 && S!=[]; S=cdr(S)){ T=SS-48; if(T>=10) T-=39; V=10*V+T; } if(NN==1){ V=-V; NN=0; } TR=cons(V,TR); if(SS!=47) break; else{ N=2; S=cdr(S); } } }else if(T==60){ for(V=[],S=cdr(S);S!=[]&&car(S)!=62;S=cdr(S)) V=cons(car(S),V); if(car(S)!=62) continue; TR=cons(eval_str(asciitostr(reverse(V))),TR); }else if(T<48) continue; if(N==1){ T = car(TR); TR=cons(-T,cdr(TR)); N=0; }else if(N==2){ T=car(TR); TR=cdr(TR); TR=cons(car(TR)/T,cdr(TR)); N=0; } } return reverse(cons(reverse(TR),R)); }else if(type(S)==4){ Num=getopt(num); for(R=[]; ; ){ if(type(TS=car(S))!=4) return; for(; TS!=[]; TS=cdr(TS)){ V=car(TS); if(type(V)>1||(type(V)==1&&ntype(V)>0)){ V="<"+rtostr(V)+">"; R=append(reverse(strtoascii(V)),R); continue; } if(dn(V)>1){ P=reverse(strtoascii(rtostr(V))); R=append(P,cons(40,R)); R=cons(41,R); continue; } if(V<0 && V>-10){ V=-V; R=cons(45,R); } if(V<0 || V>35 || (V>9 && Num==1)){ P=reverse(strtoascii(rtostr(V))); R=append(P,cons(40,R)); V=41; }else if(V<10) V+=48; else V+=87; R=cons(V,R); } if((S=cdr(S))==[]) break; R=cons(44,R); } return asciitostr(reverse(R)); } return 0; } def sp2grs(M,A,L) { MM = []; T0 = 0; Mat=getopt(mat); if(Mat!=1) Mat=0; if(type(M)==7) M=s2sp(M); if((LM = length(M)) > 10 && type(A) < 4) CK = 1; Sft = (type(L)==1)?L:0; if(type(L)==4 && length(L)>=3) Sft = L[2]; if(Sft < 0){ T0 = 1; Sft = -Sft-1; } for(I = LM-1; I >= 0; I--){ MI = M[I]; MN = []; if(CK == 1 && length(MI) > 10){ erno(1); return; } if(type(A) == 4) AA = rtostr(A[I]); else AA = rtostr(A)+rtostr(I); for(J = LM = length(MI)-1; J >= 0; J--){ V = MI[J]; if(type(V) > 3) V = V[0]; if(T0 == 0 || I == 0) MN = cons([V, makev([AA,J+Sft])], MN); else{ if(LM == 1) MN = cons([V, (J==0)?0:makev([AA])], MN); else if(I == 1 && Mat == 0) MN = cons([V, (J==length(MI)-1)?0:makev([AA,J+Sft])], MN); else MN = cons([V, (J==0)?0:makev([AA,J])], MN); } } MM = cons(MN, MM); } if(type(L) == 4 && length(L) >= 2){ R = chkspt(MM|mat=Mat); /* R[3]: Fuchs */ AA = var(MM[L[0]-1][L[1]-1][1]); if(AA==0) AA=var(R[3]); if(AA!=0 && (P = mycoef(R[3],1,AA))!=0){ P = -mycoef(R[3], 0, AA)/P; MM = mysubst(MM,[AA,P]); } } return MM; } def intpoly(F,X) { if((T=ptype(F,X))<4){ if(T<3){ /* polynomial */ if(type(C=getopt(cos))>0){ V=vars(F); Z=makenewv(V); W=makenewv(cons(Z,V)); Q=intpoly(F,X|exp=Z); Q=(subst(Q,Z,@i*C)*(Z+@i*W)+subst(Q,Z,-@i*C)*(Z-@i*W))/2; return [mycoef(Q,1,Z),mycoef(Q,1,W)]; } if(type(C=getopt(sin))>0){ Q=intpoly(F,X|cos=C); return [-Q[1],Q[0]]; } if(type(C=getopt(log))>0){ Q=intpoly(F,X); if(C[0]==0) return [Q,0]; if(length(C)<3) C=[C[0],C[1],1]; Q-=subst(Q,X,-C[1]/C[0]); if(iscoef(Q,os_md.israt)) Q=red(Q); if(C[2]==0) return [Q]; S=subst(-Q*C[0]*C[2],X,X-C[1]/C[0]); for(R=0,D=mydeg(S,X);D>0;D--) R+=mycoef(S,D,X)*X^(D-1); R=subst(R,X,X+C[1]/C[0]); return cons(Q,intpoly(R,X|log=[C[0],C[1],C[2]-1])); } if(type(C=getopt(exp))>0){ D = mydeg(F,X); for(P=Q=F/C;D>=0;D--){ Q=-mydiff(Q,X)/C; P+=Q; } return P; } for(P=0,I=mydeg(F,X);I >= 0;I--) P += mycoef(F,I,X)*X^(I+1)/(I+1); return P; } R=pfrac(F,X|root=2); /* rational */ for(P=0;R!=[];R=cdr(R)){ if(type(V=getopt(dumb))==5){ for(PF=[],RR=R;RR!=[];RR=cdr(RR)) PF=cons(RR[0][0]/RR[0][1]^RR[0][2],PF); PF=[cons(X,reverse(PF))]; if(P) PF=cons([1,P],PF); V[0]=cons(PF,V[0]); } RT=car(R); if(mydeg(RT[1],X)==0) P+=intpoly(RT[0]*RT[2],X); else if((Deg=mydeg(RT[1],X))==1){ if(RT[2]>1) P+=RT[0]*RT[1]^(1-RT[2])/(1-RT[2])/mycoef(RT[1],1,X); else P+=RT[0]*log(RT[1])/mycoef(RT[1],1,X); P=red(P); }else if(Deg==2){ D1=diff(RT[1],X);C1=mycoef(D1,1,X); B=2*C1*mycoef(RT[1],0,X)-mycoef(RT[1],1,X)^2; /* ax^2+bx+c => B=4ac-b^2 */ B=sqrt2rat(B); N=RT[0]; for(I=RT[2];I>0&&N!=0;I--){ C0=mycoef(N,1,X)/C1;N-=C0*D1; if(C0){ if(I>1) P-=C0/RT[1]^(I-1)/(I-1); else P+=C0*log(RT[1]); } if(I>1){ BB=B/C1; P+=N*X/RT[1]^(I-1)/(I-1)/BB; N*=(2*I-3)/(I-1)/BB; }else{ if(type(BR=sqrtrat(B))>3){ mycat(["Cannot obtain sqare root of ",B]); return []; } if(real(nm(BR))!=0){ P+=(2*N/BR)*atan(sqrt2rat(D1/BR|mult=1)); }else{ BR*=@i;BRI=sqrt2rat(1/BR); R1=(-mycoef(RT[1],1,X)+BR)/C1; R2=(-mycoef(RT[1],1,X)-BR)/C1; P+=N*BRI*log( /* sqrt2rat */((x-R1)/(x-R2))); } } P=red(P); } P=sqrt2rat(P); }else{ mycat(["Cannot get an indefinite integral of ",F]); return []; } } Q=simplog(P,X); if(type(V)==5&&nmono(P)!=nmono(Q)) V[0]=cons([[1,red(P)]],V[0]); return red(Q); } return []; } def fshorter(P,X) { Q=sqrt2rat(P); R=trig2exp(Q,X|inv=1); if(str_len(fctrtos(R))=0){ if(!C){ F=car(V)[2]; }else{ R=red(car(V)[2]/F); if(type(R)!=1) break; F/=dn(R); } C++; } } if(getopt(period)==1) return F; if(!isint(Log=getopt(log))) Log=0; if(V==[]&&F!=0){ if(iand(Log,1)){ H=append(cdr(fctr(nm(Q))),cdr(fctr(dn(Q)))); for(L=0;H!=[];H=cdr(H)) L+=str_len(rtostr(car(H)[0])); }else L=str_len(fctrtos(Q)); S=trig2exp(P,X); for(T=[sin(F),tan(F),cos(F),sin(F/2),cos(F/2),tan(F/2)];T!=[];T=cdr(T)){ R=trig2exp(S,X|inv=car(T)); if(iand(Log,1)){ H=append(cdr(fctr(nm(R))),cdr(fctr(dn(R)))); for(K=0;H!=[];H=cdr(H)) K+=str_len(rtostr(car(H)[0])); }else K=str_len(fctrtos(R)); if(Kstr_len(rtostr(-P)))?1:0; } def simplog(R,X) { for(V=[],Var=pfargs(R,X);Var!=[];Var=cdr(Var)){ VT=car(Var); if(VT[1]==log && ptype(R,VT[0])==2 && mydeg(R,VT[0])==1) V=cons([VT[0],VT[2],mycoef(R,1,VT[0])],V); } for(;V!=[];V=cdr(V)){ VT=car(V); for(V2=cdr(V);V2!=[];V2=cdr(V2)){ Dn=1; if((C=red(car(V2)[2]/VT[2]))!=1&&C!=-1){ if(getopt(mult)==1&&type(C)==1&&ntype(C)==0){ Dn=dn(C);C*=Dn; }else continue; } Log=red(VT[1]^Dn*car(V2)[1]^(Dn*C)); L=str_len(rtostr(dn(Log)))-str_len(rtostr(nm(Log))); if(L>0 || (L==0&&isshortneg(VT[2])) ){ Dn=-Dn;Log=1/Log; } R=mycoef(R,0,VT[0]);R=mycoef(R,0,car(V2)[0]); return(R+VT[2]*log(Log)/Dn); } } return R; } def integrate(P,X) { Dvi=getopt(dviout); if(type(I=getopt(I))==4){ if((R=integrate(P,X))==[]) II="?"; else if(type(I[0])>3||type(I[1])>3){ R=subst(R,X,x); V=flim(R,I[0]);VV=flim(R,I[1]); if(V==""||VV=="") II="?"; else if(type(V)==7||type(VV)==7){ if(V==VV) II="?"; else II=(VV=="+"||V=="-")?"\\infty":"-\\infty"; }else{ II=VV-V; if(II>10^10) II="\\infty"; else if(II<-10^10) II="-\\infty"; } }else{ V=subst(R,X,I[1])-subst(R,X,I[0]); VV=myval(V); II=(type(VV)>=2||ntype(VV)<1)?VV:evalred(V); } if(type(Dvi)!=1) return II; I=ltov(I); for(J=0;J<2;J++){ if(type(I[J])>3){ if(type(I[J])==4&&length(I[J])>1) I[J]=I[J][1]; else I[J]=(J==0)?"-\\infty":"\\infty"; } if(type(I[J])<4) I[J]=my_tex_form(I[J]); } S=(type(II)==7)?II:my_tex_form(II); S="\\int_{"+I[0]+"}^{"+I[1]+"}"+monototex(P)+"\\,d"+my_tex_form(X)+"&="+S; if(Dvi==1) dviout(texbegin("align",S)); return S; } if(isint(Dvi)==1){ if(Dvi==2||getopt(dumb)==-1){ V=newvect(1);V[0]=[]; }else V=0; if((RR=integrate(P,X|dumb=V))==[]) return R; S=fshorter(RR,X); VV=[X]; if(V!=0){ R=cons([[1,RR]],V[0]); if(S!=RR) R=cons([[1,RR=S]],R); for(V=FR=[];R!=[];R=cdr(R)) if(car(R)!=FR) V=cons(FR=car(R),V); Var=varargs(V|all=2); for(S0=[x0,x1,x2,x3],S=[t,s,u,v,w];S0!=[]&&S!=[];){ if(findin(car(S0),Var)<0){ S0=cdr(S0); continue; } if(findin(car(S),Var)>=0){ S=cdr(S); continue; } V=subst(V,[car(S0),car(S)]);S0=cdr(S0);S=cdr(S); } if(Dvi==-2) return V; S1="\\,dx&"; }else{ V=[[],[[1,RR=S]]]; S1="\\,dx"; } if(type(P)>2){ if(type(nm(P))<2){ P=P*dx;S1=V?"&":""; } S=fctrtos(P|TeX=2,lim=0);SV0=my_tex_form(P); if(str_len(SV0)2) CT=cdr(CT); S0=["\\qquad(",CT[0],"=",CT[1],")"]; break; }else{ for(FT=0,S2=[],CT=cdr(CT);CT!=[];CT=cdr(CT),FT++){ SV=fctrtos(car(CT)|TeX=2,lim=0);SV0=my_tex_form(car(CT)); if(str_len(SV0)1){ if(length(S2)>1){ S1="\\int\\left(";S3="\\right)\\,d"; }else{ S1="\\int";S3="\\,d"; } S2=cons(S1,append(S2,[S3,Y])); if(findin(Y,VV)<0) VV=cons(Y,VV); } if(FL) S0=append(S0,cons("+",S2)); else S0=append(S0,S2); } } L=append([S0],L); }; V=pfargs(RR,X|level=1); for(Var=[];V!=[];V=cdr(V)) Var=cons(car(V)[0],Var); Var=reverse(Var); if(!isint(J=getopt(frac))) J=0;; if(!iand(J,4)&&(!iand(J,2)||length(Var)==1)&&(iand(J,8)==8||ptype(RR,Var)==2)){ F=1; if(iand(J,1)){ K=str_len(fctrtos(RR)); I=str_len(fctrtos(RR|var=Var)); if(I>=K) F=0; } if(F){ V=[fctrtos(RR|var=Var,TeX=2)]; if(Dvi!=-2) V=cons("=",V); if(length(L)>0) L=cdr(L); L=append([V],L); } }else if(ptype(RR,X)==2){ L=cdr(L); V=[fctrtos(RR|var=X,TeX=2)]; if(Dvi!=-2) V=cons("=",V); L=append([V],L); } S=texket(S+ltotex(reverse(L)|opt=["cr","spts0"],str=1)); if(getopt(log)!=1){ for(V=[];VV!=[];VV=cdr(VV)) V=cons(strtoascii(my_tex_form(car(VV))),V); S1=strtoascii("\\log"); for(F=1;F;){ /* log(log(x)) */ F=FT=0; S0=strtoascii(S); /* log(x) -> log|x| */ L=length(S0); S2=str_tb(0,0); for(I=0;;){ if(I>=L||(J=str_str(S0,S1|top=I+FT))<0){ S=str_tb(0,S2)+str_cut(S0,I,100000); break; } if((K=str_str(S0,40|top=J+4))<0 ||(K!=J+4&&K!=J+9)||(N=str_pair(S0,K+1,40,41))<0){ FT=J-I+4;continue; } FT=0; if(str_str(S0,V|top=K+1,end=N-1)[0]<0) S2=str_tb(str_cut(S0,I,N),S2); else{ /* log(a) -> log(a) */ F=1; if(N (log|x|)^2 */ S2=str_tb([str_cut(S0,I,J-1),"\\left(",str_cut(S0,J,K-1), "|",str_cut(S0,K+1,N-1),"|\\right)"],S2); } else S2=str_tb([str_cut(S0,I,K-1),"|",str_cut(S0,K+1,N-1),"|"],S2); } I=N+1; } } } if(Dvi>0){ dviout(texbegin("align*",S)); return 1; } return S; } /* end of dviout */ SM=["Cannot integrate",P,"at present"]; P=sqrt2rat(P|mult=1); Dumb2=1;Dumb3=0;W=newvect(1);W[0]=[]; if(type(Dumb=getopt(dumb))==5){ Dumb2=Dumb3=Dumb;D2=W; }else if(!isint(Dumb)) Dumb=0; if(Dumb==-1){ Dumb2=Dumb3=-1; } if(type(Dumb)!=5) D2=Dumb2; if(!isint(Mul=getopt(mult))) Mul=0; else Mul++; if(type(VAR=getopt(var))!=4) VAR=[]; if(type(P)>4) return []; if(iand(T=ptype(P=red(P),X),63)>3||Mul>4){ if(Dumb!=1) mycat(SM); return []; } if(Dumb==-1) mycat(["integrate", P]); else if(type(Dumb)==5) Dumb[0]=cons([[X,P]],Dumb[0]); if(T<4 && (T<3||iscoef(P,os_md.israt))){ if(Dumb==-1) mycat(["rational function",P]); else if(type(Dumb)==5) Dumb[0]=cons([[X,P]],Dumb[0]); return intpoly(P,X|dumb=Dumb); /* rational function */ } Var=pfargs(P,X); for(F=0,VV=Var;VV!=[];VV=cdr(VV)){ /* p(x)*log(x^2-1), @e^x, a^x, f(x)^(m/n) etc.->simplify */ V=car(VV); if(V[1]==log && (T=ptype(V[2],X))>1 && T<4){ if(mydeg(dn(V[2]),X)>0||mydeg(nm(V[2]),X)>1){ FC=pfctr(V[2],X);RV=1; if(length(FC)>2){ RR=0;RV=1; if((F0=car(FC)[0])!=1){ if(type(F0)!=1 && F0<0){ for(FT=cdr(FT);FT!=[];FT=cdr(FT)){ if(iand(car(FT)[1],1)){ RV=-1;F0=-F0;break; } } } } if(F0!=1) RR=log(F0); for(FC=cdr(FC);FC!=[];FC=cdr(FC)){ if(RV==-1&&iand(car(FC)[1],1)==1){ RR+=car(FC)[1]*log(-car(FC)[0]); RV=1; }else RR+=car(FC)[1]*log(car(FC)[0]); } P=subst(P,V[0],RR); F=1; } } F=1; }else if(V[1]==pow){ if(ptype(V[2],X)==1){ F=1; if(V[2]==@e){ /* @e^(f(x)) */ P=subst(P,V[0],exp(V[3])); }else P=subst(P,V[0],exp(log(V[2])*V[3])); }else if(type(V[3])<=1 && ntype(V[3])==0){ /* r(x)^(m/n) */ if((Pw=floor(V[3]))!=0){ R=V[2]^Pw; if((PF=V[3]-Pw)!=0) R*=V[2]^PF; P=subst(P,V[0],R); F=1; V=[V[2]^PF,V[1],V[2],PF]; } if(ptype(nm(V[2]),X)<2&&V[3]>0){ /* (1/p(x))^(m/n) */ P=subst(P,V[0],V[2]*red(1/V[2])^(1-V[3])); F=0;VV=cons(0,Var=pfargs(P,X));continue; } if(ptype(V[2],X)<4&&(K=dn(V[3]))>1){ V2=red(V[2]); DN=mydeg(nm(V2),X);DD=mydeg(dn(V2),X); if(DN+DD>1){ VF=pfctr(V2,X); R=car(VF)[0]^(car(VF)[1]);RR=0; for(VF=cdr(VF);VF!=[];VF=cdr(VF)){ TV=car(VF);TM=TV[1]; while(abs(TM)>=K){ RR=1; if(TM>0){ TM-=K; RR*=TV[0]^nm(V[3]); }else{ TM+=K; RR/=TV[0]^nm(V[3]); } } if(TM!=0) R*=TV[0]^TM; } if(RR){ P=subst(P,V[0],RR*red(R)^(V[3]));F=1; F=0;VV=cons(0,Var=pfargs(P,X));continue; } } } } } } if(F){ P=sqrt2rat(P|mult=1); Var=pfargs(P=red(P),X);T=ptype(P,X); if(T<4 && (T<3||iscoef(P,os_md.israt))){ if(Dumb==-1) mycat(["rational function",P]); else if(type(Dumb)==5){ Dumb[0]=cons([[X,P]],Dumb[0]); return intpoly(P,X|dumb=Dumb3); } return intpoly(P,X); /* rational function */ } } #if 1 for(P0=P,V=pfargs(P,X|level=1);V!=[];V=cdr(V)) /* P:tan(x) -> P0:sin(x)/cos(x) */ if(car(V)[1]==tan) P0=red(subst(P0,car(V)[0],sin(car(V)[2])/cos(car(V)[2]))); if(iand(ptype(P0,X),128)){ /* (log f)'=f'/f */ for(Df=cdr(fctr(dn(P0)));Df!=[];Df=cdr(Df)){ if(!iand(ptype(car(Df)[0],X),64)) continue; Q=car(Df)[0]^(car(Df)[1]);QQ=red(dn(P0)/Q); DQ=red(diff(Q,X)*QQ); if(type(C=DQ/nm(P0))<2&&C!=0){ PP=0;DN=[1]; }else for(DN=cdr(fctr(DQ));DN!=[];DN=cdr(DN)){ Y=car(DN)[0]; if(!iand(ptype(Y,X),64)||(I=mydeg(nm(P0),Y))!=mydeg(DQ,Y) || ptype((C=red(mycoef(nm(P0),I,Y)/mycoef(DQ,I,Y))),X)>1||C==0) continue; PP=red(P0-C*diff(Q,X)/Q); if(nmono(P0)>nmono(PP)) break; } if(DN!=[]){ R=C*log(Q); if(PP==0){ if(P!=P0&&type(Dumb)==5) Dumb[0]=cons([[X,P0]],Dumb[0]); return R; } W[0]=[]; S=integrate(PP,X|dumb=D2); if(S!=[]){ if(type(Dumb)==5){ Dumb[0]=cons([[X,red(P0-PP),PP]],Dumb[0]); TD=W[0]; for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ if(car(TD)[0][0]){ WL=cons([1,R],car(TD)); Dumb[0]=cons(WL,Dumb[0]); } else Dumb[0]=cons(car(TD),Dumb[0]); } } return red(R+S); } } } } #endif if((length(Var)==1||getopt(exe)==1) && /* p(x)*atan(q(x))^m+r(x), etc */ findin((VT=car(Var))[1],[atan,asin,acos,log])>=0 && ptype(P,VT[0])==2 && (VT[1]!=log||(T!=65&&T!=66)||mydeg(VT[2],X)!=1)){ /* exclude x*log(x+1)^2 */ for(R=0,D=mydeg(P,VT[0]);D>=0;D--){ Q=S=mycoef(P,D,VT[0]); if(S){ if(D>0){ if((Q=integrate(S,X|mult=Mul))==[]) return Q; }else{ W[0]=[]; if((Q=integrate(S,X|dumb=D2,var=VAR,mult=Mul))==[]) return Q; if(type(Dumb)==5){ TD=W[0]; for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ if(car(TD)[0][0]){ WL=cons([1,R],car(TD)); Dumb[0]=cons(WL,Dumb[0]); } else Dumb[0]=cons(car(TD),Dumb[0]); } if(car(Dumb[0])!=[[1,R],[1,Q]]) Dumb[0]=cons([[1,R,Q]],Dumb[0]); } return red(R+Q); } }else if(D>0) continue; if(D==0){ if(Q!=0&&type(Dumb)==5) Dumb[0]=cons([[1,R,Q]],Dumb[0]); return red(Q+R); } R0=Q*VT[0]^D; P=(P0=P)-S*VT[0]^D-Q*diff(VT[0]^D,X); if(mydeg(P,VT[0])>=D){ /* (x+1)*log(x)/x^2 */ if(mydeg(P,VT[0])==D && ptype(C=red(mycoef(P,D,VT[0])/diff(VT[0],X)),VT[0])<2){ P=P0-(S*VT[0]^D+Q*diff(VT[0]^D,X)+C*diff(VT[0]^(D+1),X)/(D+1)); R0+=C*VT[0]^(D+1)/(D+1); }else{ P=P0; if(Dumb!=1) mycat(SM); return []; } } if(type(Dumb)==5){ if(P) Dumb[0]=cons([R?[1,R,R0]:[1,R0],[X,P]],Dumb[0]); else if(R!=0) Dumb[0]=cons([[1,R,R0]],Dumb[0]); } R+=R0; } } if(length(Var)==1 && (VT=car(Var))[1]==pow && mydeg(P,VT[0])==1 && (PT=ptype(VT[2],X))<4){ PR=mycoef(P,0,VT[0]); if(RR!=0){ RR=integrate(RR,X|dumb=Dumb3,var=Var); if(RR==[]) return RR; } PW=VT[3]; if((D=mydeg(nm(V2=VT[2]),X))==2&&PT==2){ /* f(x)*(ax^2+bx+c)^(m/2)+r(x) */ if(isint(2*PW)){ C2=mycoef(V20=V2,2,X);F=1; if((C21=sqrtrat(C2))==[]) return []; if(imag(C21)!=0){ if(real(C21)!=0) return []; C21=C21/@i;F=-1; } if(type(C21)>3) return []; P=subst(P,X,X/C21);VT=mysubst(VT,[X,X/C21]);V2=VT[2]; C1=mycoef(V2,1,X)/F/2; if(C1!=0){ P=subst(P,X,X-C1);VT=mysubst(VT,[X,X-C1]);V2=VT[2]; } C0=mycoef(V2,0,X); if((C01=sqrtrat(C0))==[]) return []; if(imag(nm(C01))!=0){ if(real(nm(C01))!=0) return []; C01=C01/@i;G=-1; }else G=1; if(type(C01)>3||(F==-1&&G==-1)) return []; Y=makenewv([P,VAR]|var=x); if(F==-1){ /* (c^2-x^2)^(1/2) */ Q=subst(P,VT[0],(C01*cos(Y))^(2*PW),X,YX=C01*sin(Y)) *C01*cos(Y)/C21; SY=(C21*X+C1);CY=V20;YY=asin(sqrt2rat((C21*X+C1)/C01|mult=1)); }else if(G==-1){ /* (x^2-c^2)^(1/2) */ Q=subst(P,VT[0],(C01*sin(Y)/cos(Y))^(2*PW),X,YX=C01/cos(Y)) *C01*sin(Y)/cos(Y)^2/C21; SY=V20;CY=1/(C21*X+C1);YY=acos(sqrt2rat(C01*(C21*X+C1)|mult=1)); }else{ /* (x^2+c^2)^(1/2) */ Q=subst(P,VT[0],(C01/cos(Y))^(2*PW),X,YX=C01*sin(Y)/cos(Y)) *C01/cos(Y)^2/C21; CY=V20; YY=atan(sqrt2rat((C21*X+C1)/C01|mult=1)); } if(Dumb==-1) mycat([C21*X+C1,"=",YX]); else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,C21*X+C1,YX]],Dumb[0]); Q=sqrt2rat(Q); QQ=red(substblock(nm(Q),sin(Y),sin(Y)^2,1-cos(Y)^2) /substblock(dn(Q),sin(Y),sin(Y)^2,1-cos(Y)^2)); if(cmpsimple(QQ,Q|comp=2)<0) Q=QQ; QQ=red(substblock(nm(Q),cos(Y),cos(Y)^2,1-sin(Y)^2) /substblock(dn(Q),cos(Y),cos(Y)^2,1-sin(Y)^2)); if(cmpsimple(QQ,Q|comp=2)<0) Q=QQ; if((Q=integrate(Q,Y|dumb=Dumb2,var=cons(X,Var)))==[]) return []; Q=trig2exp(Q,Y|inv=cos(Y)); for(V=vars(Q);V!=[];V=cdr(V)){ FA=funargs(car(V)); if(type(FA)==4&&FA[0]==log){ QQ=trig2exp(FA[1],Y|inv=cos(Y)); Q=mycoef(Q,0,car(V))+mycoef(Q,1,car(V))*log(QQ); } } if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); if(F==-1) Q=subst(Q,sin(Y),SY/C01,cos(Y),CY^(1/2)/C01,Y,YY); else if(G==-1){ Q=red(subst(Q,sin(Y),SY^(1/2)*cos(Y)/C01)); Q=red(subst(Q,cos(Y),C01*CY,Y,YY)); }else{ Q=red(subst(Q,sin(Y),(C21*X+C1)*cos(Y)/C01)); Nm=substblock(nm(Q),cos(Y),C01^2/CY,cos(Y)^2); Nm=subst(Nm,cos(Y),C01/CY^(1/2)); Dn=substblock(dn(Q),cos(Y),C01^2/CY,cos(Y)^2); Dn=subst(Dn,cos(Y),C01/CY^(1/2)); Q=red(subst(Nm/Dn,Y,YY)); } if(findin(Y,vars(Q))>=0) return []; for(R=[],Var=vars(Q);Var!=[];Var=cdr(Var)){ VT=funargs(V=car(Var)); if(type(VT)==4&&VT[0]==log&&ptype(VT[1],X)>60&&mydeg(Q,V)==1) R=cons([mycoef(Q,1,V),V],R); } if(length(R)==2 && (R[0][0]==R[1][0]||R[0][0]+R[1][0]==0)){ R0=args(R[0][1])[0];R1=args(R[1][1])[0]; if(R[0][0]==R[1][0]) S=R0*R1; else S=R1/R0; Q=mycoef(Q,0,R[0][1]);Q=mycoef(Q,0,R[1][1]); Q+=R[1][0]*log(red(S)); } for(Var=vars(Q);Var!=[];Var=cdr(Var)){ VT=funargs(car(Var)); if(type(VT)==4&&VT[0]==log&&ptype(VT[1],X)>60){ S=trig2exp(VT[1],X|inv=cos(X),arc=1); if(ptype(dn(S),X)<2 && mydeg(Q,car(Var))==1 && ptype(mycoef(Q,1,car(Var)),X)<2){ S=nm(S); SF=fctr(S); S/=SF[0][0]; } if(cmpsimple(S,-S)>0) S=-S; Q=subst(Q,car(Var),log(S)); } } /* x/(1-x^2)^(1/2) */ if(type(Q=red(Q+RR))==2&&type(Dumb)!=5) Q-=cterm(Q); if(Dumb==-1) mycat(["->",Q]); else if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); return Q; } }else if(D==1 && mydeg(Dn=dn(V2),X)<2 && type(PW)==1 && ntype(PW)==0 && (V2!=X||ptype(mycoef(P,1,VT[0]),X)>2)){ /* p(x)((ax+b)/(cx+d))^(m/n) */ PN=nm(PW);PD=dn(PW); Y=makenewv([P,VAR]|var=x);Q=Y^PD*Dn-nm(V2);F=-mycoef(Q,0,X)/mycoef(Q,1,X); Q=red(subst(P,VT[0],Y^PN,X,F)*diff(F,Y)); if(Dumb==-1) mycat([Y,"=",V2^(1/PD)]); else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,V2^(1/PD)]],Dumb[0]); if((Q=integrate(Q,Y|dumb=Dumb3,var=cons(X,Var)))==[]) return []; Q=red(Q); QN=subst(substblock(nm(Q),Y,Y^PD,V2),Y,V2^(1/PD)); QD=subst(substblock(dn(Q),Y,Y^PD,V2),Y,V2^(1/PD)); Q=red(QN/QD+RR); if(Dumb==-1) mycat(["->",Q]); else if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); return Q; } }else if(length(Var)==2 && /* r(x,(ax+b)^(1/2),(cx+d)^(1/2)) */ (VT=car(Var))[1]==pow && ptype(VT[2],X)==1 && mydeg(VT[2],X)==1 && VT[3]==1/2 && (VS=car(car(Var)))[1]==pow && ptype(VS[2],X)==1 && mydeg(VS[2],X)==1 && VS[3]==1/2){ Y=makenewv([P,VAR]|var=x);R=(Y^2-myceof(VS[0],0,X))/(C=mycoef(VS[0],1,X)); if(Dumb==-1) mycat([Y,"=",VS[0]]); else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,VD[0]]],Dumb[0]); R=integrate(subst(P,VS[0],Y,X,R)*2*Y/C,Y|dumb=Dumb3,var=cons(X,Var)); if(R!=[]){ R=subst(substblock(R,Y,VS[0],Y^2),Y,VS[0]); if(Dumb==-1) mycat(["->",R]); else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); } return R; } if(T==65||T==66){ /* polynomial including sin, exp etc */ for(F=0,VT=Var;VT!=[];VT=cdr(VT)){ VTT=car(VT); if(ptype(VTT[2],X)>2||mydeg(VTT[2],X)>1) F=ior(F,256); /* compos. or rat. or nonlin. */ K=findin(VTT[1],[cos,sin,tan,exp,log,pow]); F=ior(F,2^(K+1)); /* 1:other,2:cos,4:sin,8:tan,16:exp,32:log,64:pow */ if((Deg=mydeg(P,VTT[0]))>1&&K!=4) F=ior(F,1024); /* nonlinear */ if(K==5 && (ptype(VTT[3],X)!=0 || VTT[2]!=x||Deg>1)) F=ior(F,8192); /* pow */ for(;Deg>0;Deg--){ /* coef */ if(ptype(mycoef(P,Deg,VTT[0]),X)>2){ if(K==4||K==5) F=ior(F,2048); /* exp, log */ else F=ior(F,4096); } } } if(!iand(F,1+8+64+256+512+2048+8192)){ /* cos,sin,exp,log^n,x^c */ if(iand(F,1024+4096)&&!iand(F,32+64)){ /* cos,sin,exp */ if(type(Dumb)==5){ S=trig2exp(P,X|inv=1); if(P!=S) Dumb[0]=cons([[X,S]],Dumb[0]); } R=integrate(trig2exp(P,X),X); if(R!=[]) S=trig2exp(R,X|inv=1); R=fshorter(S,X); if(type(Dumb)==5&&R!=S){ Dumb[0]=cons([[1,S]],Dumb[0]); } return R; } for(R=0,VT=Var;VT!=[];VT=cdr(VT)){ CV=car(VT); C0=mycoef(CV[2],0,X);C1=mycoef(CV[2],1,X); Q=mycoef(P,1,CV[0]); if(CV[1]==sin||CV[1]==cos){ TR=(CV[1]==sin)?intpoly(Q,X|sin=C1):intpoly(Q,X|cos=C1); R+=TR[0]*cos(CV[2])+TR[1]*sin(CV[2]); }else if(CV[1]==exp){ QT=exp(CV[2]); for(V2=vars(C1);V2!=[];V2=cdr(V2)){ /* exp(2*log(a)*x) => a^(2*x) */ if(vtype(VA=car(V2))==2&&functor(VA)==log){ if(ptype(C1,VA)!=2||mydeg(C1,VA)==1&&mycoef(C1,0,VA)==0){ QT=args(VA)[0]^(red(C1/VA)*X); if(C0!=0) QT*=exp(C0); break; } } } R+=intpoly(Q,X|exp=C1)*QT; }else if(CV[1]==pow) R+=intpoly(Q,X|pow=CV[2])*x^CV[2]; else if(CV[1]==log){ for(Deg=mydeg(P,CV[0]);Deg>0; Deg--){ Q=mycoef(P,Deg,CV[0]); TR=intpoly(Q,X|log=[C1,C0,Deg]); for(I=0;TR!=[];I++,TR=cdr(TR)){ if(I==Deg) R+=car(TR)-subst(car(TR),X,0); else R+=car(TR)*CV[0]^(Deg-I); } } } P=mycoef(P,0,CV[0]); } R+=intpoly(P,X); return R; } } for(K=0,VX=[],VT=Var;VT!=[];VT=cdr(VT)){ /* contain only both pow and trig */ VTT=car(VT); if(findin(VTT[1],[cos,sin,tan])>=0){ if(ptype(VTT[2],X)!=2||mydeg(VTT[2],X)!=1) break; VX=cons(VTT,VX); }else if(VTT[1]==pow) K=1; else break; } if(VT==[]&&K==1&&VX!=[]){ D=VX[0][2]; if(VX[0][1]==tan) D*=2; for(VT=cdr(VX);VT!=[];VT=cdr(VT)){ K=VT[0][2]/D; if(VT[0][1]==tan) K*=2; if(type(K)!=1||ntype(K)!=0) break; D/=dn(K); } if(VT==[]){ Y=makenewv([P,VAR]|var=x); for(Q=P,VT=VX;VT!=[];VT=cdr(VT)){ VTT=car(VT); if(VTT[1]==cos||VTT[1]==sin){ VV=trig2exp(VTT[0],X|inv=cos(D)); VV=subst(VV,cos(D),(1-Y^2)/(1+Y^2),sin(D),2*Y/(Y^2+1)); }else if(VTT[1]==tan){ VV=trig2exp(VTT[0],X|inv=tan(D/2)); VV=subst(VV,tan(D),Y); } Q=subst(Q,VTT[0],VV); } Q*=2/(Y^2+1); if(diff(Q,X)==0){ if(Dumb==-1) mycat([Y,"=",tan(D/2)]); else if(type(Dumb)==5) Dumb[0]=cons([[0,Y,tan(D/2)]],Dumb[0]); R=integrate(Q,Y|dumb=Dumb2,var=cons(X,Var)); if(R!=[]){ if(Dumb==-1) mycat(["->",R]); else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); return sqrt2rat(subst(R,Y,tan(D/2))|mult=1); } } } } if(T>65||iand(F,8)){ /* rational for functions or tan */ if(findin(X,vars(P))<0){ for(XV=XE=0,VT=Var;VT!=[];VT=cdr(VT)){ VTT=car(VT); if(mydeg(VTT[2],X)!=1) break; if(VTT[1]==cos||VTT[1]==sin||VTT[1]==tan){ K=red(VTT[2]/X); if(type(K)>1||ntype(K)>0) break; if(XV==0) XV=K; else XV/=dn(K/XV); if(VTT[1]==tan) P=red(subst(P,VTT[0],sin(VTT[2])/cos(VTT[2]))); }else if(VTT[1]==exp){ K=red(VTT[2]/X); if(type(K)>1||ntype(K)>0) break; if(XE==0) XE=K; else XE/=dn(K/XE); }else break; } if(VT==[]&&XE*XV==0){ if(XE){ if(XE<0) XE=-XE; Y=makenewv([P,VAR]|var=x); for(F=0,VT=Var;VT!=[];VT=cdr(VT),F++){ VTT=car(VT);C=red(VTT[2]/X/XE); P=subst(P,VTT[0],Y^C); if(!F){ if(Dumb==-1) mycat([Y^C,"=",VTT[0]]); else if(type(Dumb)==5) Dumb[0]=cons([[0,Y^C,VTT[0]]],Dumb[0]); } } P/=XE*Y; Q=integrate(P,Y|dumb=Dumb3,var=cons(X,VAR)); if(Q==[]) return []; Q=subst(Q,Y,exp(XE*X)); Q=trig2exp(Q,X); if(Dumb==-1) mycat(["->",Q]); else if(type(Dumb)==5) Dumb[0]=cons([[1,Q]],Dumb[0]); return Q; } P=trig2exp(nm(P),X|inv=cos(XV*X))/trig2exp(dn(P),X|inv=cos(XV*X)); Y=makenewv([P,VAR]|var=x); Q=red(subst(P,sin(XV*X),Y*cos(XV*X))); Q=substblock(nm(Q),cos(XV*X),cos(XV*X)^2,1/(Y^2+1))/ (substblock(dn(Q),cos(XV*X),cos(XV*X)^2,1/(Y^2+1))*(Y^2+1)); Q=red(Q); if(ptype(Q,X)<2){ XV*=2;P=Q; }else{ P=subst(P,cos(XV*X),(1-Y^2)/(1+Y^2),sin(XV*X),2*Y/(1+Y^2))*2/K/(1+Y^2); P=red(P); } if(Dumb==-1){ mycat([Y,"=",tan(XV*X/2)]); mycat(["integrate",P]); }else if(type(Dumb)==5) Dumb[0]=cons([[Y,P]],cons([[0,Y,tan(XV*X/2)]],Dumb[0])); R=intpoly(P,Y|dumb=Dumb); if(R==[]) return R; if(Dumb==-1) mycat(["->",R]); else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); for(Log=1,K=0,Var=pfargs(RR=R,Y);Var!=[];Var=cdr(Var)){ VTT=car(Var); if(VTT[1]==log){ C=mycoef(R,1,VTT[0]); VT2=VTT[2]; if(K==0){ K=C;Log=VT2; if(K<0){ K=-K;Log=1/Log; } }else{ if((V=red(C/K))<0){ VT2=1/VT2;V=-V; } if(type(V)>1||ntype(V)>0){ Log=1;break; } if(isint(V)) Log*=VT2^V; else{ D=dn(V);K/=D; Log=Log^D*VT2^nm(V); } } RR=mycoef(RR,0,VTT[0]); } } if(Log!=1){ R=RR; if(type(Dumb)==5){ if(RR) Dumb[0]=cons([[1,K*log(Log),RR]],Dumb[0]); else Dumb[0]=cons([[1,K*log(Log)]],Dumb[0]); } Log=red(subst(red(Log),Y,sin(XV*X/2)/cos(XV*X/2))); Log=fshorter(Log,X|log=1); /* log(cos(2*x)+1)=-2*log(cos(x)) */ Nm=fctr(nm(Log)); for(T=[];Nm!=[];Nm=cdr(Nm)){ if(ptype(car(Nm)[0],X)>1) T=cons(car(Nm),T); } Nm=fctr(dn(Log)); for(;Nm!=[];Nm=cdr(Nm)){ if(ptype(car(Nm)[0],X)>1) T=cons([car(Nm)[0],-car(Nm)[1]],T); } for(I=0,Nm=T;T!=[];T=cdr(T)){ if(I=0) I=abs(car(T)[1]); else I=igcd(I,car(T)[1]); } for(Log=1;Nm!=[];Nm=cdr(Nm)) Log*=car(Nm)[0]^(car(Nm)[1]/I); K*=I; if(cmpsimple(nm(Log),dn(Log))<0){ K=-K;Log=red(1/Log); } Log=K*log(Log); if(type(Dumb)==5){ if(RR) Dumb[0]=cons([[1,Log,RR]],Dumb[0]); else Dumb[0]=cons([[1,Log]],Dumb[0]); } }else Log=0; for(Atan=0,Var=pfargs(RR=R,Y);Var!=[];Var=cdr(Var)){ VTT=car(Var); if(VTT[1]==atan){ W=subst(VTT[2],Y,sin(XV*X/2)/cos(XV*X/2)); W=trig2exp(W,X|inv=1); V2=funargs(dn(W)); if(type(V2)==4&&length(V2)==2){ V3=V2[1]*mycoef(R,1,VTT[0]); Z=0; if(V2[0]==cos) Z=red(W*cos(V2[1])/sin(V2[1])); else if(V2[0]==sin){ Z=red(W*sin(V2[1])/cos(V2[1])); V3=-V3; } if(Z==1){ Atan+=V3;W=0; }else if(Z==-1){ Atan-=V3;W=0; } } R0=mycoef(R,0,VTT[0]); if(W!=0) Atan+=subst(R-R0,VTT[0],atan(W)); /* atan(W); */ R=R0; } } if(R!=0){ R=subst(R,Y,sin(XV*X/2)/cos(XV*X/2)); R=red(R); R=trig2exp(nm(R),X|inv=1)/trig2exp(dn(R),X|inv=1); } if(type(Dumb)==5){ F=0;WL=[]; if(R){ WL=cons(R,WL); F++; } if(Atan){ WL=cons(Atan,WL); F++; } if(Log){ WL=cons(Log,WL); F++; } WL=cons(1,WL); if(F>1) Dumb[0]=cons([WL],Dumb[0]); } R=red(R+Log+Atan); if(Dumb==-1) mycat(["->",R]); else if(type(Dumb)==5) Dumb[0]=cons([[1,R]],Dumb[0]); return fshorter(R,X); } } } VT=pfargs(Q=P,X|level=1); V=(iand(ptype(P,X),7)<3)?[X]:[]; for(;VT!=[];VT=cdr(VT)) if(ptype(P,car(VT)[0])<3) V=cons(car(VT)[0],V); if(length(V)>0){ /* 1/x+tan(x)+... etc.: sums */ for(R=0;V!=[];V=cdr(V)){ T=mycoef(Q,0,car(V)); W[0]=[]; S=integrate(TD=red(Q-T),X|dumb=D2,mult=Mul,exe=1); if(S==[]) continue; if(type(Dumb)==5){ WL=0; if(T!=0) WL=[[X,TD,T]]; if(R!=0) WL=cons([1,R],WL); if(WL) Dumb[0]=cons(WL,Dumb[0]); TD=W[0]; if(R!=0||T!=0){ for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ if(car(TD)[0][0]){ WL=(!T)?[]:[[X,T]]; WL=append(car(TD),WL); if(R!=0) WL=cons([1,R],WL); }else WL=car(TD); Dumb[0]=cons(WL,Dumb[0]); } }else Dumb[0]=append(TD,Dumb[0]); } R+=S;Q=T; if(!Q) return red(R); } W[0]=[]; if(P!=Q&&type(S=integrate(Q,X|dumb=D2,mult=Mul))<4){ RR=red(R+S); if(type(Dumb)==5){ TD=W[0]; for(W0=[],TD=reverse(TD);TD!=[];TD=cdr(TD)){ if(car(TD)[0][0]){ WL=cons([1,R],car(TD)); Dumb[0]=cons(WL,Dumb[0]); } else Dumb[0]=append(TD,Dumb[0]); } if(nmono(R)+nmono(S)!=nmono(RR)) Dumb[0]=cons([[1,R,S]],Dumb[0]); } return RR; } } if(Dumb!=1) mycat(SM); return []; } def fimag(P) { for(V=vars(P);V!=[];V=cdr(V)){ Q=[]; if(vtype(VF=car(V))==2){ VAA=args(VF); if(VAA==[]) continue; VA=sqrt2rat(VAA[0]); if(functor(VF)==exp){ if(imag(VA)!=0){ R=(real(VA)!=0)?exp(real(VA)):1; Q=subst(P,VF,R*(cos(imag(VA))+sin(imag(VA))*@i)); } }else if(functor(VF)==pow){ VA=sqrt2rat(VAA[1]); if(imag(VA)!=0){ R=(real(VA)!=0)?VAA[0]^(real(VA)):1; L=(VAA[0]!=@e)?log(VAA[0]):1; Q=subst(P,VAA[0]^(VAA[1]),R*(cos(L*imag(VA))+sin(L*imag(VA))*@i)); }else if(VAA[1]!=(V0=fimag(VA))) Q=subst(P,VAA[0]^(VAA[1]),VAA[0]^(V0)); } V0=VA; if(length(VAA)==1&&(VAA[0]!=V0||VA!=(V0=fimag(VA)))) Q=subst(P,VF,subst(VF,VAA[0],V0)); } if(Q!=[]&&P!=Q){ P=Q;V=cons(0,vars(P)); } } return P; } def trig2exp(P,X) { if(iand(ptype(P,X),128)){ OL=getopt(); Nm=trig2exp(nm(P),X|option_list=OL); Dn=trig2exp(dn(P),X|option_list=OL); R=red(Nm/Dn); if(getopt(arc)==1) return sqrt2rat(R); } if((Inv=getopt(inv))==1||type(Inv)==2){ for(VT=T=vars(P);T!=[];T=cdr(T)){ if(findin(functor(car(T)),[cos,sin,tan])>=0){ P=trig2exp(P,X);VT=vars(P);break; } } for(;VT!=[];VT=cdr(VT)){ if(functor(CT=car(VT))==exp){ if((Re=real(args(CT)[0]))!=0){ if(isint(Re)) S=@e^Re; else S=exp(Re); }else S=1; if((Im=imag(args(CT)[0]))!=0){ Q=nm(Im);Q=mycoef(Q,mydeg(Q,X),X); if(-Q>Q) S*=cos(-Im)-@i*sin(-Im); else S*=cos(Im)+@i*sin(Im); } P=subst(P,CT,S); } } P=red(P); U=vars(Inv); if(length(U)!=1||((F=functor(car(U)))!=sin&&F!=cos&&F!=tan)) return P; XX=args(car(U))[0]; if(mydeg(XX,X)!=1) return P; if(!isvar(XX)) P=subst(P,X,(X-mycoef(XX,0,X))/mycoef(XX,1,X)); for(VT=vars(P);VT!=[];VT=cdr(VT)){ if(vtype(CT=car(VT))<2) continue; TX=args(CT)[0]; if(mydeg(TX,X)!=1) continue; if(!isint(C1=mycoef(TX,1,X))) continue; if((C0=mycoef(TX,0,X))==0){ CC=1;CS=0; }else if(vars(C0)==[@pi]){ CC=myval(cos(C0)); if(CC!=0&&type(CC)==1&&ntype(CC)!=0){ CC=cos(C0);CS=sin(C0); }else CS=myval(sin(C0)); }else{ CC=cos(C0);CS=sin(C0); } K=C1; if(K<0) K=-K; for(CC1=0,I=K;I>=0;I-=2) CC1+=(-1)^((K-I)/2)*binom(K,I)*cos(X)^I*sin(X)^(K-I); for(CS1=0,I=K-1;I>=0;I-=2) CS1+=(-1)^((K-I-1)/2)*binom(K,I)*cos(X)^I*sin(X)^(K-I); if(C1<0) CS1=-CS1; if((TF=functor(CT))==cos) P=subst(P,cos(TX),CC1*CC-CS1*CS); else if(TF==sin) P=subst(P,sin(TX),CS1*CC+CC1*CS); } if(F==sin) P=substblock(P,cos(X),cos(X)^2,1-sin(X)^2); else{ P=substblock(P,sin(X),sin(X)^2,1-cos(X)^2); if(F==tan){ P=subst(P,sin(X),cos(X)*tan(X)); P=substblock(P,cos(X),cos(X)^2,1/(tan(X)^2+1)); } } if(!isvar(XX)) P=subst(P,X,XX); if(getopt(arc)==1){ for(VT=vars(P);VT!=[];VT=cdr(VT)){ FA=funargs(car(VT)); if(type(FA)==4&&(FA[0]==cos||FA[0]==sin)&&ptype(FA[1],X)>60){ VTT=vars(FA[1]); if(type(FA[1])!=2||length(VTT)!=1) break; FB=funargs(VTT[0]); if(type(FB)!=4||(FF=findin(FB[0],[asin,acos,atan]))<0) break; if(!isint(2*(C=mycoef(FA[1],1,VTT[0])))||mycoef(FA[1],0,VTT[0])!=0) break; if(C==1/2){ if(FF==1){ U=(FA[0]==cos)?(1+FB[1])/2:(1-FB[1])/2; P=subst(P,car(VT),red(U)^(1/2)); }else if(FF==2){ if(FA[0]==sin){ FB1=red(FB[1]); Nm=nm(FB1);CC=fctr(Nm)[0][0];Dn=dn(FB1); if(CC<0) CC=-CC; Nm/=CC;Dn/=CC; NN=Nm^2+Dn^2; P=subst(P,car(VT),((NN)^(1/2)-Dn)/Nm*cos(FA[1])); } } P=red(P); }else if(C==1){ if(FF==1){ if(FA[0]==cos) P=subst(P,car(VT),FB[1]); else P=subst(P,car(VT),(1-FB[1])^(1/2)); }else if(FF==0){ if(FA[0]==sin) P=subst(P,car(VT),FB[1]); else P=subst(P,car(VT),(1-FB[1])^(1/2)); } P=red(P); } } } P=sqrt2rat(P); } return red(P); } Var=pfargs(P,X); for(VT=Var;VT!=[];VT=cdr(VT)){ CT=car(VT); if(CT[1]==cos) P=subst(P,CT[0],exp(CT[2]*@i)/2+exp(-CT[2]*@i)/2); else if(CT[1]==sin) P=subst(P,CT[0],exp(-CT[2]*@i)*@i/2-exp(CT[2]*@i)*@i/2); else if (CT[1]==tan) P=subst(P,CT[0],(exp(-CT[2]*@i)*@i-exp(CT[2]*@i)*@i)/(exp(CT[2]*@i)+exp(-CT[2]*@i))); else if(CT[1]==pow){ if(ptype(CT[2],X)>1) continue; if(CT[2]==@e) P=subst(P,CT[0],exp(CT[3])); else P=subst(P,CT[0],exp(log(CT[2])*exp(CT[3]))); } } P=red(P); for(PP=1,Lp=(dn(P)==1)?1:0;Lp<2;Lp++){ PP=1/PP; U=(Lp==0)?dn(P):nm(P); if(U==1) continue; Var=vars(U); for(R=[],VT=Var;VT!=[];VT=cdr(VT)) if(functor(car(VT))==exp) R=cons(car(VT),R); RR=os_md.terms(U,R); for(Q=0,RRT=RR;RRT!=[];RRT=cdr(RRT)){ for(S=0,CT=cdr(car(RRT)),CR=R,UT=U;CR!=[];CR=cdr(CR),CT=cdr(CT)){ UT=mycoef(UT,car(CT),car(CR));S+=car(CT)*args(car(CR))[0]; } if(S==0) Q+=UT; else Q+=UT*exp(S); } PP*=Q; } return PP; } def powsum(N) { if (N < 0) return 0; if (N == 0) return x; P = intpoly(N*powsum(N-1),x); C = subst(P,x,1); return P+(1-C)*x; } def bernoulli(N) { return mydiff(powsum(N),x) - N*x^(N-1); } /* linfrac01([x,y]) */ /* linfrac01(newvect(10,[0,1,2,3,4,5,6,7,8,9]) */ /* 0:x=0, 1:x=y, 2:x=1, 3:y=0, 4:y=1, 5:x=\infty, 6:y=\infty, 7:x=y=0, 8:x=y=1, 9:x=y=\infty 10:y_2=0, 11:y_2=x, 12:y_2=y, 13: y_2=1, 14: y_2=\infty 15:y_3=0, 16:y_3=x, 17:y_3=y, 18: y_3=y_2, 19: y_3=1, 20:y_3=\infty X[0],X[11],X[2],X[10],X[13],X[5],X[14],X[7],X[8],X[9], X[3],X[1],X[12],X[4],X[6] T=0 (x_2,x_1,x_3,x_4,...) T=-j (x_1,x_2,..,x_{j-1},x_{j+1},x_j,x_{j+2},...) T=1 (1-x_1,1-x_2,1-x_3,1-x_4,...) T=2 (1/x_1,1/x_2,1/x_3,1/x_4,...) T=3 (x_1,x_1/x_2,x_1/x_3,x_1/x_4,...) */ def lft01(X,T) { MX=getopt(); if(type(X)==4){ K=length(X); if(K>=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); } R=newvect(K,[X[3],X[1],X[4],X[0],X[2],X[6],X[5]]); for(I=7;I3 && getopt(over)!=1) return(-1); II=(K==-1)?3:4; for(CC=C=1,L=[X]; C!=0; CC+=C){ for(F=C,C=0,R=L; F>0; R=cdr(R), F--){ P=car(R); for(I=-K; I1){ if(L<2 &&(ptype(VT[1],X)>1 || (length(VT)>2 && ptype(VT[2],X)>1))) Var=cons(cons(car(V),VT),Var); if(L!=1 && (R=pfargs(VT[1],X|level=L-1))!=[]) Var=append(R,Var); } } } return reverse(Var); } def ptype(P,L) { if((T=type(P))<2 || T>3) return T; if(type(L)!=4) L=[L]; F=0; if(lsort(L,varargs(dn(P))[1],2)!=[]) F=128; if(lsort(L,varargs(nm(P))[1],2)!=[]) F+=64; if(lsort(L,vars(dn(P)),2)!=[]) return F+3; return (lsort(L,vars(nm(P)),2)==[])?(F+1):(F+2); } def nthmodp(X,N,P) { X=X%P; for(Z=1;;){ if((W=iand(N,1))==1) Z=(Z*X)%P; if((N=(N-W)/2)<=0) return Z; X=irem(X*X,P); } } def issquaremodp(X,P) { N=getopt(power); if(!isint(N)) N=2; if(P<=1 || !isint(P) || !pari(ispsp,P) || !isint(X) || !isint(N) || N<1){ errno(0); return -2; } M=(P-1)/igcd(N,P-1); if((X%=P) == 0) return 0; if(X==1 || M==P-1) return 1; return (nthmodp(X,M,P)==1)?1:-1; } def iscoef(P,F) { if(P==0) return 1; if(type(P)==1) return F(P); if(type(P)==2) { X=var(P); for(I=deg(P,X); I>=0; I--){ if(!iscoef(mycoef(P,I,X),F)) return 0; } }else if(type(P)==3){ if(!iscoef(nm(P),F)||!iscoef(dn(P),F)) return 0; }else if(type(P)==4){ for(;P!=[];P=cdr(P)) if(!iscoef(P,F)) return 0; }else if(type(P)>4 && type(P)<7) return iscoef(m2l(PP),F); else return 0; return 1; } def rootmodp(X,P) { X%=P; if(X==0) return [0]; N=getopt(power); PP=pari(factor,P); P0=PP[0][0]; P1=PP[0][1]; P2=pari(phi,P); if(!isint(N)) N=2; N%=P2; if(P0==2 || size(PP)[0]>1){ for(I=1,R=[]; I=G) break; W=(W*Z)%P; } return qsort(R); } def primroot(P) { PP=pari(factor,P); P0=PP[0][0]; P1=PP[0][1]; S=size(PP); if(S[0]>1 || !isint(P) || P0<=2){ print("Not odd prime(power)!"); return 0; } if(isint(Ind=getopt(ind))){ Ind %= P; if(Ind<=0 || igcd(Ind,P)!=1 || (Z=primroot(P))==0){ print("Not exist!"); return 0; } P2=P0^(P1-1)*(P0-1); for(I=1,S=1; I1 && igcd(P0,J)!=1) continue; if(igcd(P0-1,J)!=1) continue; L=cons(nthmodp(I,J,P),L); } return qsort(L); } if(PP[0][1]>1){ I=primroot(P0); P2=P0^(P1-2)*(P0-1); if(nthmodp(I,P2,P)==1) I+=P0; return I; } F=pari(factor,P-1); SF=size(F)[0]; for(I=2; I0&&Z!=1&&Z!=P-1;M--,Z=(Z*Z)%P); return (M=P) break; L0=cons(PP, L0); } L0=reverse(L0); } if(FE==0) All=getopt(all); for(I=0, PP=P, LL=[]; 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); } if(Df==1){ for(LD=[],LL=L;LL!=[];LL=cdr(LL)){ if(LD==[]) LD=cons([car(LL)[0],car(LL)[1],0],LD); else LD=cons([car(LL)[0],car(LL)[1],abs(car(LL)[1]-car(LD)[1])],LD); } L=reverse(LD); } 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[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); } Str=reverse(Str); for(LD=[],LL=L;LL!=[];LL=cdr(LL)){ for(K=[],J=length(Str); --J>=0; ) K=cons(sint(car(LL)[J],Str[J][0]|str=Str[J][1]),K); LD=cons(K,LD); } L=LD; }else L=reverse(L); if(type(M=getopt(mult))==1){ Opt=[["opt","tab"],["vline",[[0,2+Df]]],["width",-M]]; if(type(T=getopt(title))==7) Opt=cons(["title",T],Opt); if(type(Tp=getopt(top))==4) Opt=cons(["top",Tp],Opt); L=ltotex(L|option_list=Opt); } return L; } def distpoint(L) { L=m2l(L|flat=1); if(getopt(div)==5) Div=5; else Div=10; V=newvect(100/Div); for(LT=L,LL=[],N=0; LT!=[]; LT=cdr(LT)){ if(type(K=car(LT))>1||K<0){ N++; continue; } LL=cons(K,LL); T=idiv(K,Div); if(Div==10 && T>=9) T=9; else if(Div==5 && T>=19) T=19; V[T]++; } V=vtol(V); if((Opt=getopt(opt))=="data") return V; Title=getopt(title); OpList=[["opt","tab"]]; if(type(Title=getopt(title)) == 7) OpList=cons(["title",Title],OpList); if(Opt=="average"){ T=isMs()?["平均点","標準偏差","最低点","最高点","受験人数"]: ["average","deviation","min","max","examinees"]; L=average(LL); L=[sint(L[0],1),sint(L[1],1),L[3],L[4],L[2]]; if(N>0){ T=append(T,[isMs()?"欠席者":"absentees"]);L=append(L,[N]); } OpList=cons(["align","c"],OpList); return ltotex([T,L]|option_list=OpList); } if(getopt(opt)=="graph"){ Mul=getopt(size); if(Div==5){ V0=["00","05","10","15","20","25","30","35","40","45","50","55", "60","65","70","75","80","85","90","95"]; if(type(Mul)!=4){ Size = (TikZ)?[12,3,1/2,0.2]:[120,30,1/2,2]; } }else{ V0=["00-","10-","20-","30-","40-","50-","60-","70-","80-","90-"]; if(type(Mul)!=4){ Size = (TikZ)?[8,3,1/2,0.2]:[80,30,1/2,2]; } } return ltotex([V,V0]|opt="graph",size=Size); } if(Div==5) V0=["00--04","05--09","10--14","15--19", "20--24", "25--29", "30--34", "35-39", "40--44", "45--49","50--54", "55--59","60--64", "65--69", "70--74", "75--79","80--84", "85--89","90--94", "95--100"]; else V0=["00--09","10--19","20--29","30--39","40--49","50--59","60--69", "70--79","80--89","90--100"]; Title=getopt(title); return ltotex([V0,V]|option_list=OpList); } def keyin(S) { print(S,2); purge_stdin(); S=get_line(); L=length(S=strtoascii(S)); if(L==0) return ""; return str_cut(S,0,L-2); } def init() { 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.")]); if(!isMs()){ DIROUT="%HOME%/asir/tex"; DVIOUTA=str_subst(DVIOUTA,[["\\","/"],[".bat",".sh"]],0); DVIOUTB=str_subst(DVIOUTB,[["\\","/"],[".bat",".sh"]],0); DVIOUTL=str_subst(DVIOUTL,[["\\","/"],[".bat",".sh"]],0); DVIOUTH="%ASIRROOT%/help/os_muldif.pdf"; } Home=getenv("HOME"); if(type(Home)!=7) Home=""; for(Id=-7, F=Home; Id<-1;){ G = F+"/.muldif"; if(access(G)) Id = open_file(G); else Id++; if(Id==-6) F+="/asir"; else if(Id==-5) F=get_rootdir(); else if(Id==-4) F+="/bin"; else if(Id==-3) F=get_rootdir()+"/lib-asir-contrib"; } if(Id>=0){ while((S=get_line(Id))!=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){ for(P1=P0;(P2=str_char(S,P1+1,"\""))>0; P1=P2); if(P1>P0+1){ SS=str_cut(S,P0+1,P1-1); SS=str_subst(SS,["\\\\","\\\""],["\\","\""]); if(P[0]==0) DIROUT=SS; else if(P[0]==1) DVIOUTA=SS; else if(P[0]==2) DVIOUTB=SS; else if(P[0]==3) DVIOUTH=SS; else if(P[0]==4) DVIOUTL=SS; } } if(P0<0 || P1