/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.98 2022/08/22 23:50:18 takayama Exp $ */
/* The latest version will be at https://www.ms.u-tokyo.ac.jp/~oshima/index-j.html
scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs
*/
#define USEMODULE 1
/* #undef USEMODULE */
/* os_muldif.rr (Library for Risa/Asir)
* Toshio Oshima (Nov. 2007 - July. 2022)
*
* 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 TeXPages$
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$
static SVORG$
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 mypdiff$
localf difflog$
localf pTaylor$
localf pwTaylor$
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 getCatalan$
localf pg2tg$
localf pg2tgb;
localf pgpart$
localf xypg2tg;
localf trpos$
localf sprod$
localf sadj$
localf sinv$
localf slen$
localf sexps$
localf sord$
localf vprod$
localf dvangle$
localf dvprod$
localf dnorm$
localf dext$
localf mulseries$
localf pluspower$
localf vtozv$
localf dupmat$
localf matrtop$
localf mytrace$
localf mydet$
localf permanent$
localf mperm$
localf mtranspose$
localf mtoupper$
localf mydet2$
localf myrank$
localf lext2$
localf meigen$
localf pf2kz$
localf mext2$
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 lsub$
localf lchange$
localf llsize$
localf llbase$
localf llget$
localf lcut$
localf rev$
localf qsortn$
localf lsort$
localf rsort$
localf lpair$
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 isfctr$
localf fctrtos$
localf texlim$
localf fmult$
localf radd$
localf getel$
localf ptol$
localf rmul$
localf mtransbys$
localf trcolor$
localf mcolor$
localf drawopt$
localf execdraw$
localf execproc$
localf myswap$
localf mysubst$
localf sort2$
localf n2a$
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 nlog$
localf dlog10$
localf mypow$
localf scale$
localf catalan$
localf iceil$
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 caldo$
localf jacobian$
localf hessian$
localf wronskian$
localf adj$
localf laplace1$
localf laplace$
localf mce$
localf mcme$
localf mc$
localf rede$
localf ad$
localf add$
localf vadd$
localf addl$
localf cotr$
localf rcotr$
localf muledo$
localf mulpdo$
localf transppow$
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 sgnstrum$
localf polstrum$
localf polrealroots$
localf polradiusroot$
localf fctri$
localf binom$
localf expower$
localf seriesHG$
localf seriesMc$
localf seriesTaylor$
localf mulpolyMod$
localf solveEq$
localf res0$
localf eqs2tex$
localf baseODE$
localf baseODE0$
localf taylorODE$
localf evalred$
localf toeul$
localf fromeul$
localf sftexp$
localf fractrans$
localf soldif$
localf chkexp$
localf sqrtrat$
localf getroot$
localf expat$
localf polbyroot$
localf polbyvalue$
localf pcoef$
localf pmaj$
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 etos$
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 spbasic$
localf chkspt$
localf cterm$
localf terms$
localf polcut$
localf redgrs$
localf cutgrs$
localf mcgrs$
localf mc2grs$
localf mcmgrs$
localf spslm$
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 evalcoord$
localf readTikZ$
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 getline$
localf showbyshell$
localf readcsv$
localf tocsv$
localf getbyshell$
localf show$
localf dviout$
localf rtotex$
localf togreek$
localf mtotex$
localf ltotex$
localf texbegin$
localf texcr$
localf texsp$
localf getbygrs$
localf mcop$
localf shiftop$
localf shiftPfaff;
localf conf1sp$
localf confexp$
localf confspt$
localf vConv$
localf mcvm$
localf s2cspb$
localf s2csp$
localf partspt$
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 rungeKutta$
localf simplog$
localf fshorter$
localf isshortneg$
localf intrat$
localf powsum$
localf bernoulli$
localf lft01$
localf linfrac01$
localf nthmodp$
localf issquare$
localf issquaremodp$
localf rootmodp$
localf rabin$
localf primroot$
localf varargs$
localf ptype$
localf pfargs$
localf regress$
localf average$
localf tobig$
localf sint$
localf frac2n$
localf openGlib$
localf xyproc$
localf xypos$
localf xyput$
localf xylabel$
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 xyplot$
localf xyaxis$
localf xygraph$
localf xy2graph$
localf addIL$
localf xy2curve$
localf xygrid$
localf xyarrow$
localf xyarrows$
localf xyang$
localf xyoval$
localf xypoch$
localf xycircuit$
localf ptline$
localf ptcommon$
localf ptinversion$
localf ptcontain$
localf ptcopy$
localf ptaffine$
localf ptlattice$
localf ptpolygon$
localf ptwindow$
localf pt5center$
localf ptconvex$
localf ptbbox$
localf darg$
localf dwinding$
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 TeXPages$
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 TeXPages$
extern Canvas$
extern ID_PLOT$
extern Rand$
extern LQS$
extern SV=SVORG$
#endif
static S_Fc,S_Dc,S_Ic,S_Ec,S_EC,S_Lc$
static S_FDot$
extern AMSTeX$
extern Glib_math_coordinate$
extern Glib_canvas_x$
extern Glib_canvas_y$
Muldif.rr="00220804"$
AMSTeX=1$
TeXEq=5$
TeXLim=80$
TeXPages=20$
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"]$
SVORG=["x","y","z","w","u","v","p","q","r","s"]$
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("");
else print("",2);
}
def fcat(S,X)
{
if(type(S)!=7){
if(type(DIROUTD)!=7){
DIROUTD=str_subst(DIROUT,["%HOME%","%ASIRROOT%","\\"],
[getenv("HOME"),get_rootdir(),"/"])+"/";
if(isMs()) DIROUTD=str_subst(DIROUTD,"/","\\"|sjis=1);
}
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("");
else print("",2);
}
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)<S&&L!=[]) L=cdr(L);
S+=M;
for(R=[],C=I=0;L!=[];){
if(car(L)<S||(Step>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 mypdiff(P,L)
{
if(type(P)>3) return map(os_md.mypdiff,P,L);
for(Q=0;L!=[];L=cdr(L)){
Q+=mydiff(P,car(L))*L[1];
L=cdr(L);
}
return red(Q);
}
def difflog(L)
{
if(!isvar(X=getopt(var))) X=x;
if(type(L)!=4) return 0;
for(S=0;L!=[];L=cdr(L)){
if(type(L0=car(L))==4) S+=L0[1]*mydiff(L0[0],X)/L0[0];
if(type(L0)<4) S+=mydiff(L[0],X);
}
S=red(S);
if(type(F=getopt(mc))>0){
X=vweyl(X);
S=mc(X[1]-S,X,F);
}
return red(S);
}
def pTaylor(S,X,N)
{
if(!isvar(T=getopt(time))) T=t;
if(type(S)<4) S=[S];
if(type(X)<4) X=[X];
if(findin(T,varargs(S|all=2))>=0){
S=cons(z_z,S);X=cons(z_z,X);FT=1;
}else FT=0;
LS=length(S);
FR=(getopt(raw)==1)?1:0;
if(!FR) R=newvect(LS);
else R=R1=[];
for(L=[],I=0,TS=S,TX=X;I<LS;I++,TS=cdr(TS),TX=cdr(TX)){
if(!FR) R[I]=car(TX)+car(TS)*T;
else{
R=cons(car(TX),R);R1=cons(car(TS),R1);
}
L=cons(car(TS),cons(car(TX),L));
}
L=reverse(L);
if(FR) R=[reverse(R1),reverse(R)];
for(K=M=1;N>1;N--){
S=mypdiff(S,L);
K*=++M;
for(TS=S,I=0,R1=[];TS!=[];TS=cdr(TS),I++){
if(!FR) R[I]+=car(TS)*t^M/K;
else R1=cons(car(TS)/K,R1);
}
if(FR) R=cons(reverse(R1),R);
}
if(FT){
if(!FR){
S=newvect(LS-1);
for(I=1;I<LS;I++) S[I-1]=R[I];
}else{
for(S=[];R!=[];R=cdr(R)){
S=cons(cdr(car(R)),S);
}
R=S;
}
R=subst(S,z_z,0);
}
return (FR&&!FT)?reverse(R):R;
}
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 && type(X)==2)
return deg(P,X);
II=(type(X)==4)?-100000:-1;
Opt = getopt(opt);
if(type(P) >= 4){
S=(type(P) == 6)?size(P)[0]:0;
P = m2l(P);
for(I = 0, Deg = -100000; P != []; P = cdr(P), I++){
if( (DT = mydeg(car(P),X)) == -2&&type(X)!=4)
return -2;
if(DT > Deg){
Deg = DT;
II = I;
}
}
return (Opt==1)?([Deg,(S==0)?II:[idiv(II,S),irem(II,S)]]):Deg;
}
P = red(P);
if(type(X)==2){
if(deg(dn(P),X) == 0)
return deg(nm(P),X);
}else{
P=nm(red(P));
for(D=-100000,I=deg(P,X[1]);I>=0;I--){
if(TP=mycoef(P,I,X[1])){
TD=mydeg(TP,X[0])-I;
if(D<TD) D=TD;
}
}
return D;
}
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(lpair)==1||(type(L[0])==4&&length(L[0])>2)) L=lpair(L[0],L[1]);
if(getopt(inv)==1){
for(R=[];L!=[];L=cdr(L)) R=cons([car(L)[1],car(L)[0]],R);
L=reverse(R);
}
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);
F=iand(Opt,4)/4;Opt=iand(Opt,3);
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+F+1, S);
}
for(I = 0; I <= LL; I++){
if(T[I] == 0){
S = cons(LL-I+F, 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+F,T);
S = append(S,T);
if(Opt == 2 || Opt == 3)
S = reverse(S);
if(Opt != 1 && Opt != 3)
return S;
M+=2*F;
for(T = []; S != []; S = cdr(S))
T = cons(M-car(S),T);
return T;
}
def ndict(L)
{
Opt = getopt(opt);
if(type(L)==5) L=vtol(L);
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)
{
if(!N){
N=(A<B)?B:A;
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)
{
if(F=isint(S)) S=vtol(ldict(S,0));
if(isint(T)){
T=vtol(ldict(T,0));
F++;
}
if((L=length(S))==2&&S!=[0,1]){
S=trpos(S[0],S[1],0);
L=length(S);
}
if((R=length(T))==2&&T!=[0,1]){
T=trpos(T[0],T[1],0);
R=length(T);
}
if(L!=R){
if(L>R){
W=newvect(L);
for(I=0;I<L;I++) W[I]=(I<R)?T[I]:I;
T=W;
}
else{
W=newvect(R);
for(I=0;I<R;I++) W[I]=(I<L)?S[I]:I;
S=W;
L=R;
}
}
V = newvect(L);
while(--L >= 0) V[L] = S[T[L]];
return (F==2)?ndict(V):V;
}
def sadj(S,T)
{
return sprod(sprod(S,T),sinv(S));
}
def sinv(S)
{
if(F=isint(S)) S=ltov(ldict(S,0));
L = length(S);
if(L==2) return S;
V = newvect(L);
while(--L >= 0)
V[S[L]] = L;
return (F)?ndict(V):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 sexps(S)
{
K=length(S);S=ltov(S);
for(R=[],I=0;I<K-1;I++){
for(J=I;J>=0&&S[J]>S[J+1];J--){
T=S[J];S[J]=S[J+1];S[J+1]=T;
R=cons(J,R);
}
}
return R;
}
def sord(W,V)
{
L = length(W);
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)
{
V1=lsub(V1);V2=lsub(V2);
for(R = 0, I = length(V1)-1; I >= 0; I--)
R = radd(R, rmul(V1[I], V2[I]));
return R;
}
def dnorm(V)
{
if(type(V)<2) return ctrl("bigfloat")?abs(V):dabs(V);
if((M=getopt(max))==1||M==2){
if(type(V)==5) V=vtol(V);
for(S=0;V!=[];V=cdr(V)){
if(M==2) S+=ctrl("bigfloat")?abs(car(V)):dabs(car(V));
else{
if((T=ctrl("bigfloat")?abs(car(V)):dabs(car(V)))>S) S=T;
}
}
return S;
}
R=0;
if(type(V)!=4)
for (I = length(V)-1; I >= 0; I--) R+= real(V[I])^2+imag(V[I])^2;
else{
if(type(V[0])>3){
V=ltov(V[0])-ltov(V[1]);
return dnorm(V);
}
for(;V!=[]; V=cdr(V)) R+=real(car(V))^2+imag(car(V))^2;
}
return ctrl("bigfloat")?pari(sqrt,R):dsqrt(R);
}
def dvprod(V1,V2)
{
if(type(V1)<2) return V1*V2;
R=0;
V1=lsub(V1);
V2=lsub(V2);
if(type(V1)!=4)
for(I = length(V1)-1; I >= 0; I--)
R += V1[I]*V2[I];
else{
for(; V1!=[]; V1=cdr(V1),V2=cdr(V2))
R+=car(V1)*car(V2);
}
return R;
}
def ptline(L,R)
{
P=L[0];Q=L[1];
return (Q[1]-P[1])*(R[0]-P[0])-(Q[0]-P[0])*(R[1]-P[1]);
}
def dvangle(V1,V2)
{
if(V2==0 && type(V1)==4 && length(V1)==3 &&
(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 catalan(K)
{
if(isint(K)) return catalan([K,K]);
if(type(K)==4){
if(length(K)==2){
M=K[0];N=K[1];
if(M<N||M<0||N<0) return 0;
if(N==0) return 1;
T=fac(M+N);
return T/fac(M)/fac(N)-T/fac(M+1)/fac(N-1);
}
if(length(K)==3){
T=K[0];N=K[1];K=K[2];
if(T=="P"||T=="01"||T=="H"){
if(T=="P") return fac(N)/fac(N-K);
if(T=="H") N+=K-1;
if(K<0||K>N) return 0;
return fac(N)/fac(K)/fac(N-K);
}
if(K<1||N<1||K>N) return 0;
if(N==K) return 1;
if(T==1){
if(K==1) return fac(N-1);
return catalan([1,N-1,K-1])+(N-1)*catalan([1,N-1,K]);
}else if(T==2){
if(K==1) return 1;
return catalan([2,N-1,K-1])+ K*catalan([2,N-1,K]);
}
}
}
return 0;
}
def sort2(L)
{
if(L[0]<=L[1]) return L;
if(type(L)==4) return [L[1],L[0]];
T=L[0];L[0]=L[1];L[1]=T;
return L;
}
/* 01: 01 list
* s : 01 str
* T : tounament
* # : #lines of vertexes (vector)
* P : Polygon with tg
*/
def getCatalan(X,N)
{
if(type(To=getopt(to))!=7) To=0;
if(type(X)==7){ /* string: s or T */
X=strtoascii(X);
N=length(X);
if(X[0]==48){
if(To=="s") return R;
R=calc(X,["-",48]); /* s -> 01 */
if(To) R=getCatalan(R,0|to=To);
return R;
}
if(To=="T") return X;
if(To!="P"&&To!="#"){ /* T -> 01 */
for(R=[];X!=[];X=cdr(X)){
if(car(X)==41) R=cons(1,R);
else if(car(X)==42) R=cons(0,R);
}
R=cdr(reverse(R));
if(To!="01") R=getCatalan(R,0|to=To);
return R;
}
if(N%3!=1) return 0;
M=(N+2)/3; /* T -> # */
V=newvect(M+1);
V[0]=V[M]=-1;
for(;X!=[];X=cdr(X)){
if(car(X)==40||car(X)==41) V[I]++;
else I++;
}
V[M]+=F;
if(To!="P") return V;
X=V;
}
if(type(X)==5){ /* vector: # -> P */
if(To=="#") return X;
Y=newvect(length(X));K=dupmat(X);
M=length(X);
for(R=[],I=F=0;;I++){
if(I>=M){
if(!F) break;
F=0;I=-1;continue;
}
if(X[I]>0){
if(I+1>=M ||K[I+1]>0) continue;
for(J=I+2;J<M&&!K[J];J++);
if(J>=M||findin([I,J],R)>=0) continue;
R=cons([I,J],R);
K[I]--;K[J]--;Y[J]++;
I=J-1;
F++;
}
}
if(To&&To!="P"){
for(V=[],J=0;J<M;J++){
V=cons(0,V);
for( ; Y[J]>0; Y[J]--) V=cons(1,V);
}
V=reverse(V);
if(To!=0&&To!="01") V=getCatalan(V,0|to=To);
return V;
}
R=qsort(R);
return R;
}
if(!isint(F=getopt(opt))) F=0;
if(!isint(X)){
if(type(X)==4&&type(car(X))==4){ /* ptg */
N=length(X)+3;
V=newvect(N);R=newvect(N);
for(TX=X;TX!=[];TX=cdr(TX)){
V[car(TX)[0]]++;R[car(TX)[1]]++;
}
if(To=="#"){
for(I=0;I<N;I++) V[I]+=R[I];
return V;
}else{
for(K="(",I=0;;I){
for(J=R[I];J>0;J--) K=K+")";
for(J=V[I];J>0;J--) K=K+"(";
if(++I<N) K=K+"*";
else break;
}
K=K+")";
if(To!="T") K=getCatalan(K,0|to=To);
return K;
}
}
/* 01 list */
if(To=="s") return asciitostr(calc(X,["+",48]));
if(To=="T"||To=="#"||To=="P"){
for(R=["*"],TX=X;TX!=[];TX=cdr(TX)){
if(car(TX)==0) R=cons("*",R);
else{
T=car(R);R=cdr(R);T="("+car(R)+T+")";
R=cons(T,cdr(R));
}
}
R=car(R);
if(To=="P"||To=="#") R=getCatalan(R,0|to=To);
return R;
}
K=length(X)/2;
if(K<2) return 0;
if(F){ /* Not checked */
for(I=F=0,TX=X;TX!=[];I++,TX=cdr(TX)){
if(!car(TX)){
F++;continue;
}
F--;
if(F<=0){
for(J=1;J<I;J+=2) F+=catalan((J-1)/2)*catalan(K-(J+1)/2);
J=lcut(X,1,I-1);J=getCatalan(J,(I-1)/2|opt=1);
V=lcut(X,I+1,2*K-1);V=getCatalan(V,K-(I+1)/2|opt=1);
F+=J*catalan(K-(I+1)/2)+V;
break;
}
}
return F;
}
for(R=M=N=0,TX=X;TX!=[];TX=cdr(TX)){
if(car(TX)==0){
if(M>N) R+=catalan([K-N-1,K-M]);
M++;
}else N++;
}
return R;
}
if(!isint(X)||X++<0) return 0;
/* integer: */
if(!N){
for(Y=N=1;X>Y;N++) Y*=(4*N+2)/(N+2);
}else{
Y=catalan(N);
if(X>Y) return 0;
}
if(F){
X--;
if(N<3){
if(N==2) R=X>0?"0011":"0101";
else if(N==1) R="01";
else R="";
}
else for(I=0;I<N;I++){
V=catalan(I)*catalan(N-I-1);
if(X>=V) X-=V;
else{
J=X%catalan(N-I-1);
K=(X-J)/catalan(N-I-1);
R=(I==0)?"01":"0"+getCatalan(K,I|opt=F+1)+"1";
if(N-I>1) R=R+getCatalan(J,N-I-1|opt=F+1);
break;
}
}
if(To=="s"||F>1) return R;
R=calc(strtoascii(R),["-",48]);
}else{
for(R=[],M=N;M>0||N>0;){
Z=Y*(M-N)*(M+1)/(M-N+1)/(M+N);
if(X>Z){
N--;X-=Z;Y-=Z;R=cons(0,R);
}else{
M--;Y=Z;R=cons(1,R);
}
}
R=reverse(R);
}
if(To=="s") R=asciitostr(calc(R,["+",48]));
else if(To=="T"||To=="#"||To=="P") R=getCatalan(R,0|to=To);
return R;
}
def xypg2tg(K)
{
D=3.1416/2;Or=[0,0];Op="red";Every="";M=0.5;V=0.15;W=0.2;Num=St=Pr=F=0;Line=R=[];
if(isint(T=getopt(pg))) S=T;
if(isint(T=getopt(skip))) F=T;
if(type(T=getopt(r))==1) M=T;
else if(type(T)==4){
M=T[0];
if(length(T)>1) V=T[1];
if(length(T)>2) W=T[2];
}
if(isint(T=getopt(proc))) Pr=T;
if(type(T=getopt(org))==4) Or=T;
if(type(T=getopt(rot))==1||T==0) D=T;
if(type(T=getopt(dviout))==1) Dvi=T;
if(type(T=getopt(num))==1) Num=T;
if(type(T=getopt(every))==7) Every=T;
if(type(car(K)[0])==4){
if(type(T=getopt(line))==4) Line=T;
S=length(K);
Opt=delopt(getopt(),["Opt","skip","proc","dviout","num","line"]);
if(type(car(Or))!=4||length(Or)!=S){
Or0=[0,0]; Or1=[1.5,0]; Or2=[0,1.5]; M=10;
if(car(Or)==0&&type(Or[1])==4){
Or0=Or[1];
Or=cdr(cdr(Or));
}
if(length(Or)>1&&type(Or[1])==4){
M=Or[0]; Or1=Or[1];
}
if(length(Or)>2) Or2=Or[3];
for(R=[],I=0;I<S;I++){
J=I%M;T=ladd(Or0,Or1,J);
J=(I-J)/M;T=ladd(T,Or2,-J);
R=cons(T,R);
}
Or=reverse(R);
}
if(!Pr&&TikZ){
Tb=str_tb("%TikZ0%\n",0);
if(Line!=[]) F=ior(F,512);
for(I=0;K!=[];K=cdr(K),Or=cdr(Or),I++){
T=append([["org",car(Or)],["skip",F],["num",I+1]],Opt);
Tb=str_tb("%"+rtostr(I+1)+"%"+"\n",Tb);
Tb=str_tb(xypg2tg(car(K)|option_list=T),Tb);
F=ior(F,1);
}
if(length(Line)>0){
Tb=str_tb("%%\n",Tb);
if(type(car(Line))!=4) Line=[Line];
}
for(S="";Line!=[]; Line=cdr(Line)){
T=car(Line);
if(length(T)>2){
S=T[2];
if(S!="") S="["+S+"]";
}
Tb=str_tb("\\draw"+S+"(S"+rtostr(T[0])+")--(S"+rtostr(T[1])+");\n",Tb);
}
S=str_tb(0,Tb);
if(Dvi==1) xyproc(S|dviout=1);
else if(Dvi==-1) S=xyproc(S);
return S;
}
}
if(type(L=getopt(V))>3){
if(type(L)==4) L=ltov(L);
S=length(L);
}else{
S=length(K)+3;
L=newvect(S);
}
if(Pr==1){
if(!L[0])
for(I=0;I<S;I++) L[I]=[Or[0]+M*dcos(D+3.1416*2*I/S),Or[1]+M*dsin(D+3.1416*2*I/S)];
if(!iand(F,2)) R=[xylines(L|proc=1,close=1)];
if(!iand(F,4)){
for(TK=K;TK!=[];TK=cdr(TK))
R=append([xylines([L[car(TK)[0]],L[car(TK)[1]]]|proc=1,opt=Op)],R);
}
return R;
}
if(!TikZ) return "";
if(Op!="" && strtoascii(Op)[0]!=91) Op="["+Op+"]";
Tb=str_tb(0,0);
J=iand(F,64)?-1:1;
if(iand(F,256)){
M1=10;M2=6;
}else{
M1=6;M2=3;
}
if(!L[0]){
for(I=0;I<S;I++) L[I]=["("+rtostr(I+St)+")",
[Or[0]+M*dcos(D+3.1416*2*I*J/S),Or[1]+M*dsin(D+3.1416*2*I*J/S)]];
}else{
for(I=0;I<S;I++)
if(length(L[I])==2) L[I]=["("+rtostr(I+St)+")", L[I][0],L[I],1];
}
if(!iand(F,1)){
for(I=0;I<S;I++) Tb=str_tb("\\coordinate"+(iand(F,256)?"(P"+rtostr(I+St)+")":car(L[I]))
+" at "+xypos(L[I][1])+";\n",Tb);
if(iand(F,32)){
for(I=0;I<S;I++){
if(!iand(F,16)) VV=ladd(0,L[I][1],1+V/M);
else{
VV=ladd(L[I][1],L[(I+1)%S][1],1);
J=dnorm(VV);
VV=ladd(0,VV,1/2+V/J);
}
Tb=str_tb("\\coordinate("+(iand(F,16)?"E":"V")+rtostr(I+St)+")"
+" at "+xypos(VV)+";\n",Tb);
}
}
Tb=str_tb("%\n",Tb);
}
if(!iand(F,4)){
Tb=str_tb("\\coordinate(S) at "+xypos(Or)+";\n",Tb);
if(iand(F,512)) str_tb("\\node(S"+rtostr(Num)+
")[circle,minimum size=" +rtostr(2*(M+W))+ "cm] at (S){};\n",Tb);
if(iand(F,256)) for(I=0;I<S;I++) Tb=str_tb("\\coordinate"+L[I][0]+" at " +
"($(S)+(P"+ rtostr(I+St) +")$);\n",Tb);
if(Every!=""){
Tb=str_tb(Every,Tb);Tb=str_tb("\n",Tb);
}
}
if(!iand(F,2)){
Tb=str_tb("\\draw ",Tb);
for(I=0;I<S;I++){
if(!(I%M1)) Tb=str_tb("\n",Tb);
if(I) Tb=str_tb("--",Tb);
Tb=iand(F,256)? str_tb(car(L[I]),Tb):str_tb("($(S)+"+car(L[I])+"$)",Tb);
}
Tb=str_tb("--cycle;\n",Tb);
}
if(!iand(F,8)){
for(I=0,T=K;T!=[];T=cdr(T),I++){
if(length(car(T))>2){
if(I<=0) Tb=str_tb(";\n",Tb);
TOp="["+car(T)[2]+"]";I=-1;
}else TOp=Op;
if(!I) Tb=str_tb("\\draw "+TOp,Tb);
Tb=str_tb((I%M2)?" ":"\n",Tb);
if(!iand(F,256))
Tb=str_tb("($(S)+"+ car(L[car(T)[0]]) +"$)--($(S)+" +car(L[car(T)[1]]) +"$)",Tb);
else
Tb=str_tb(car(L[car(T)[0]])+"--"+car(L[car(T)[1]]),Tb);
}
Tb=str_tb(";\n",Tb);
}
if(iand(F,32)) for(I=0;I<S;I++)
Tb=str_tb("\\node at ($(S)+("+(iand(F,16)?"E":"V") + rtostr(I+St) +
")$) \{" +rtostr(I+St) +"\};\n",Tb);
S=str_tb(0,Tb);
if(Dvi==1) xyproc(S|dviout=1);
else if(Dvi==-1) S=xyproc(S);
return S;
}
/*
F=0 : sort
F<0 : circulate -F: [I,J] -> [I-F,J-F]
* 1 : list of circulate
* 2 : sorted above list
* 3 : minimum in the above
* 4 : minimum mirror
* 5 : minimam extend
* 6 : extend
"std" : to normal form
"#" : #lines (10)
"-#" : inverse of "#" (11)
"del": reduction points
F=[I,J] => another diagonal (flip option)
F=[I] : the other ends of diagonal starting from I
["ext",I] : [I-1,I] に頂点を付加
["del",I] : Iを潰す
["pair",I] : Iを通る対角線の他方
["pairb",I] : Iとつながった頂点（辺でのつながりを含む）
["mirror",K]：[I,J] -> [K-I,K-J]
["flip0",[I,J]] : [I,J] の他方の対角線
["flip",[I,J]] : [I,J] でフリップ
["res",I] :
*/
def pgpart(K,F)
{
S=length(K)+3;
if(type(F)==4){
if(length(F)==1){
F=car(F);
for(R=[];K!=[];K=cdr(K)){
if(car(K)[0]==F) R=cons(car(K)[1],R);
else if(car(K)[1]==F) R=cons(car(K)[0],R);
}
return R;
}
if(length(F)==2){
if(isint(F[0])){
F=sort2(F);
K0=pgpart(K,["pair",F[0]]);K0=cons((F[0]+1)%S,K0);K0=cons((F[0]+S-1)%S,K0);
K1=pgpart(K,["pair",F[1]]);K1=cons((F[1]+1)%S,K1);K1=cons((F[1]+S-1)%S,K1);
if(findin(F[1],K0)<0) return [];
R=lsort(K1,K2,"cap");
if(length(R)!=2) return [];
R=sort2(R);
if(getopt(flip)==1){
for(RR=[R];K!=[];K=cdr(K))
RR=cons((F==car(K))?R:car(K),RR);
R=pgpart(RR,0);
}
return R;
}
if(F[0]=="ext"){
if(F[1]=="all"){
for(I=0,R=[];I<S;I++) R=cons(pgpart(K,["ext",I]),R);
return R;
}
if(F[1]=="sym"){
R=pgpart(K,1);
for(K=[];R!=[];R=cdr(R)) K=cons(pgpart(car(R),["ext",0]),K);
for(R=[];K!=[];K=cdr(K)) R=cons(pgpart(car(K),3),R);
return R;
}
F=F[1];
R=[sort2([(F-1)%(S+1),(F+1)%(S+1)])];
for(;K!=[];K=cdr(K)){
I=car(K)[0];if(I>=F)I++;
J=car(K)[1];if(J>=F)J++;
R=cons([I,J],R);
}
return pgpart(R,0);
}
if(F[0]=="res"){
F1=F[1];
T=sort2([(F1-1)%S,(F1+1)%S]);
for(R=[];K!=[];K=cdr(K)){
if(car(K)==T) continue;
if((I=car(K)[0])>F1)I--;
if((J=car(K)[1])>F1)J--;
R=cons([I,J],R);
}
if(length(R)!=S-4) return 0;
return pgpart(R,0);
}
if(F[0]=="pair"||F[0]=="pairb"){
for(R=[];K!=[];K=cdr(K)){
if(car(K)[0]==F[1]) R=cons(car(K)[1],R);
if(car(K)[1]==F[1]) R=cons(car(K)[0],R);
}
if(F[0]=="pairb"){
R=cons((F[1]+1)%S,R);R=cons((F[1]-1)%S,R);
}
return qsort(R);
}
if(F[0]=="flip"||F[0]=="flip0"){
S=sort2(F[1]);
I=pgpart(K,["pairb",S[0]]);J=pgpart(K,["pairb",S[1]]);
I=lsort(I,J,"cap");
if(length(I)!=2) return 0;
if(F[0]=="flip0") return I;
for(R=[];K!=[];K=cdr(K))
R=cons((car(K)==S)?I:car(K),R);
return qsort(R);
}
if(F[0]=="mirror"){
for(R=[];K!=[];K=cdr(K))
R=cons([(F[1]-car(K)[0])%S,(F[1]-car(K)[1])%S],R);
return pgpart(R,0);
}
}
}
if(F=="check"){
K=pgpart(K,0);
for(;K!=[];){
L=pgpart(K,"res");
if(L==[]) return 0;
for(L=reverse(L);L!=[];L=cdr(L)){
R=pgpart(K,["res",car(L)]);
if(R==0) return 0;
K=R;
}
}
return 1;
}
if(F=="std") F=0;
if(type(F)==7){
S0=[7,8,12,0,13];S1=["#","-#","res","std","cat"];
I=findin(F,S1);
if(I>=0) F=S0[I];
}
if(isint(F) && F<=0){
for(R=[];K!=[];K=cdr(K)){
I=(car(K)[0]-F)%S;
J=(car(K)[1]-F)%S;
R=cons(sort2([I,J]),R);
}
return qsort(R);
}
if(F>0&&F<4){
for(R=[],I=0;I<S;I++){
TR=pgpart(K,-I);
if(!I) R0=TR;
else if(R0==TR) break;
R=cons(TR,R);
}
if(F>1) R=lsort(R,[],1);
if(F==3) R=R[0];
return R;
}
if(F==4){
for(R=[];K!=[];K=cdr(K)){
I=S-car(K)[0]-1;
J=S-car(K)[1]-1;
R=cons([J,I],R);
}
return pgpart(R,3);
}
if(F==5){
K=pgpart(K,1);
for(R=[];K!=[];K=cdr(K)){
TK=cons([0,S-1],car(K));
R=cons(pgpart(TK,3),R);
}
return lsort(R,[],1);
}
if(F==6){
K=cons([0,S-1],K);
return lsort(pgpart(K,2),[],1);
}
if(F==7||F=="#"){
/*
for(R=newvect(S);K!=[];K=cdr(K)){
R[car(K)[0]]++;
R[car(K)[1]]++;
}
return vtol(R);
*/
return vtol(getCatalan(K,0|to="#"));
}
if(F=="-#"||F==8){
if(type(K)==4) K=ltov(K);
return getCatalan(K,0|to="P");
}
if(F==10||F==11){
S=length(K);
K=ltov(K);L=newvect(S);
for(R=[],T=S-3;T>0;T--){
for(I=0;I<S;I++){
if(L[I]||K[I]) continue;
for(J=1;J<S;J++) if(K[T0=(I+J)%S]) break;
for(J=S-1;J>0;J--) if(K[T1=(I+J)%S]) break;
if(T1==T0||T0==I||T1==I) return [];
K[T0]--;K[T1]--;L[I]--;
R=cons([T1,T0],R);
break;
}
if(I==S) return [];
}
if(F==11) return reverse(pgpart(R,8));
return pgpart(R,0);
}
if(F==12||F=="res"){
K=pgpart(K,7);
for(I=0,R=[];K!=[];I++,K=cdr(K)) if(!car(K)) R=cons(I,R);
return reverse(R);
}
if(F==13||F==14||F=="0"||F=="("||(F=="T"&&type(K)==7)){
ST=(F==13||F=="0")?48:40;
S=length(K)+3;
J=newvect(S);I=newvect(S);RR=newvect(S);
for(;K!=[];K=cdr(K)){
I[car(K)[0]]++;
J[car(K)[1]]++;
}
J[S-1]++;
for(R=[],K=S-1;K>1;K--){
for(T=J[K];T>0;T--) R=cons(ST+1,R);
for(T=I[K-2];T>0;T--) R=cons(ST,R);
}
R=cons(ST,R);
if(F!="T") return asciitostr(R);
F=="TT";
}
if(F==9){
for(R=[];K!=[];K=cdr(K)){
I=S-car(K)[0]-1;
J=S-car(K)[1]-1;
R=cons([J,I],R);
}
T=pgpart(R,3);
if(imod(S,1))return T;
for(R=[];K!=[];K=cdr(K)){
I=(-car(K)[0])%S;
J=(-car(K)[1])%S;
R=cons([J,I],R);
}
R=pgpart(R,3);
return T<R?T:R;
}
if(F=="T"||F=="TT"){
if(F=="T") K=asciitostr(K);
L=length(K);
for(R=[[0]],I=0,N=1;I<L;I++){
if(K[I]==ST)
R=cons(n2a(N++|opt="[]",s=-1),R);
else{
TR=append(R[0],[41]);
TR=append(R[1],TR);
TR=cons(40,TR);
R=cons(TR,cdr(cdr(R)));
}
}
return asciitostr(car(R));
}
}
def pg2tg(K)
{
if((Bis=getopt(bis))==1||K<0) return pg2tgb(K|option_list=getopt());
if(!isint(Al=getopt(all))) Al=0;
Zig=iand(Al,64);Al=iand(Al,63);
if(K<4||!isint(K)) return [];
R=[];F=0;N=catalan(K-2)-1;
for(;N>=0;N--){
T=(Bis==2)?getCatalan(N,K-2|to="P",opt=2):getCatalan(N,K-2|to="P",opt=1);
if(Zig&&length(pgpart(T,"res"))!=2) continue;
if(Al==0||Al==2){
for(I=1;T!=0&&I<K;I++){
S=pgpart(T,-I);
if(S==T) break;
if(S<T) T=0;
}
if(!T) continue;
}
if(Al==0){
U=pgpart(T,["mirror",0]);
if(U==T) I=K;
else if(U<T) T=0;
for(I=1;T!=0&&I<K;I++){
S=pgpart(U,-I);
if(S==U) break;
if(S<T) T=0;
}
if(!T) continue;
}
R=cons(T,R);
}
if(Bis==2) R=qsort(R);
return R;
}
def pg2tgb(K)
{
if((F=getopt(verb))!=1) F=0;
if(!isint(Al=getopt(all))) Al=0;
Al=iand(Al,63);
if(!isint(M) || M<32) M=1024;
if(isint(K)){
R=[];
if(K>3){
while(K-- > 3) R=pg2tgb(R|verb=F,red=M,all=Al);
return R;
}else if(K<-3){
for(RR=[],K=-K-3;K>0;K--) RR=cons(R=pg2tgb(R|verb=F,red=M,all=Al),RR);
return reverse(RR);
}
return [];
}
if(K==[]) return (Al==1)?[[[0,2]],[[1,3]]]:[[[0,2]]];
S=length(car(K))+3;
for(R=[],I=N=0;K!=[];K=cdr(K),I++){
TR=pgpart(car(K),(Al==1)?6:5);
if(!Al){
TR=append(pgpart(pgpart(car(K),4),5),TR);
for(T=TR,TR=[];T!=[];T=cdr(T)) if(pgpart(car(T),4) >= car(T)) TR=cons(car(T),TR);
/* 4 => 9 */
TR=reverse(TR);
}
N+=length(TR);
R=append(TR,R);
if(N>M){
R=lsort(R,[],1);
M=length(R);
if(F) mycat([M,N]);
N=0;
}
}
R=lsort(R,[],1);
if(F) mycat([length(R),N]);
return R;
}
def n2a(T)
{
Opt=[40,41];M=61;
if(type(U=getopt(opt))==7){
Opt=strtoascii(U);
}
if(!isint(S=getopt(s))) S=0;
if(isint(N=getopt(m))&&N>8&&N<62) M=N;
if(T>M){
TR=[Opt[1]];
TR=append(strtoascii(rtostr(T)),TR);
TR=cons(Opt[0],TR);
if(S==1) TR=asciitostr(TR);
return TR;
}
if(T<10) T+=48;
else if(T<36) T+=87;
else if(T<62) T+=29;
if(S) T=[T];
if(S==1) T=asciitostr(T);
return T;
}
def scale(L)
{
T=F=0;LS=1;
Pr=getopt(prec);
Inv=getopt(inv);
Log10=dlog(10);
if(type(L)==7){
V=findin(L,["CI","DI","CIF","CIF'","DIF","DIF'","SI","TI1","TI2","STI"]);
if(V>=0){
L=["C","D","CF","CF'","DF","DF'","S","T1","T2","ST"];
Inv=1;L=L[V];
}
V=findin(L,["C","A","K","CF","CF'","S","T1","T2","ST","LL0","LL1","LL2","LL3","LL00",
"LL01","LL02","LL03"])+1;
if(V==0) V=findin(L,["D","B","K","DF","DF'"])+1;
if(V>0) L=V;
}
if(type(OL=L)!=4){
if(L==2){
L=(Pr==0)?
[[[1,2,1/20],[2,5,1/10],[5,10,1/5], [10,20,1/2],[20,50,1],[50,100,2]],
[[1,2,1/10],[2,5,1/2], [10,20,1],[20,50,5]],
[[1,2,1/2],[2,10,1], [10,20,5],[20,100,10]]]:
[[[1,2,1/50],[2,5,1/20],[5,10,1/10], [10,20,1/5],[20,50,1/2],[50,100,1]],
[[1,5,1/10],[5,10,1/2], [10,20,1],[50,100,5]],
[[1,5,1/2],[5,10,1], [10,50,5],[50,100,10]]];
LS=2;M2=[[1,10,1],[10,100,10]];
}else if(L==3){
L=(Pr==0)?
[[[1,2,1/20],[2,5,1/10],[5,10,1/5], [10,20,1/2],[20,50,1],[50,100,2],
[100,200,5],[200,500,10],[500,1000,20]],
[[1,2,1/10],[2,5,1/2], [10,20,1],[20,50,5], [100,200,10],[200,500,50]],
[[1,2,1/2],[2,10,1], [10,20,5],[20,100,10], [100,200,50],[200,1000,100]]]:
[[[1,2,1/50],[2,5,1/20],[5,10,1/10],[10,20,1/5],[20,50,1/2],[50,100,1],
[100,200,2],[200,500,5],[500,1000,10]],
[[1,5,1/10],[5,10,1/2], [10,50,1],[50,100,5], [100,500,10],[500,1000,50]],
[[1,5,1/2],[5,10,1],[10,50,5],[50,100,10], [100,500,50],[500,1000,100]]];
LS=3;M2=[[1,5,1],[10,50,10],[100,500,100],[500,1000,500]];
}else if(L>9&&L<18){
if(L<18){ /* LL0 - LL3, LL00 - LL03 */
if(L==10){
L=[ [[1.001,1.002,0.00001],[1.002,1.005,0.00002],[1.005,1.0105,0.00005]],
[[1.001,1.002,0.00005],[1.002,1.005,0.0001], [1.005,1.0105,0.0001]],
[[1.001,1.002,0.0001],[1.002,1.005,0.0005], [1.005,1.0105,0.0005]]];
M2=[1.001,1.0015,1.002,1.003,1.004,1.005,1.006,1.007,1.008,1.009,1.01];
}
if(L==11){
L=[ [[1.01,1.02,0.0001],[1.02,1.05,0.0002],[1.05,1.105,0.0005]],
[[1.01,1.02,0.0005],[1.02,1.05,0.001], [1.05,1.105,0.001]],
[[1.01,1.02,0.001],[1.02,1.05,0.005], [1.05,1.105,0.005]]];
M2=[1.01,1.015,1.02,1.03,1.04,1.05,1.06,1.07,1.08,1.09,1.10];
}else if(L==12){
L=[ [[1.105,1.2,0.001],[1.2,1.4,0.002],[1.4,1.8,0.005],[1.8,2.5,0.01],
[2.5,2.72,0.02]],
[[1.105,1.2,0.005],[1.2,1.4,0.01],[1.4,1.8,0.01],[1.8,2.5,0.05],
[2.5,2.72,0.1]],
[[1.105,1.2,0.01],[1.2,1.4,0.05],[1.4,1.8,0.05],[1.8,2.5,0.1],
[2.5,2.72,0.1]]];
M2=[1.11,1.15,1.2,1.3,1.4,1.5,1.6,1.7,1.8,1.9,2.0,2.2,2.5];
}else if(L==13){
L=[ [[2.72,4,0.02],[4,6,0.05],[6,10,0.1],[10,15,0.2],[15,30,0.5],[30,50,1],
[50,100,2],[100,200,5],[200,400,10],[400,500,20],[500,1000,50],
[1000,2000,100],[2000,5000,200],[5000,10000,500],[10000,22000,1000]],
[[2.7,4,0.1],[4,6,0.1],[6,10,0.5],[10,15,1],[15,30,1],[30,50,5],
[50,100,10],[100,200,10],[200,400,50],[400,500,100],[500,1000,100],
[1000,2000,500],[2000,5000,1000],[5000,10000,1000],[10000,22000,5000]],
[[3,4,0.5],[4,6,0.5],[6,10,1],[10,15,5],[15,30,5],[30,50,10],
[50,100,50],[100,200,50],[200,400,100],[400,500,100],[500,1000,500],
[1000,2000,1000],[2000,5000,3000],[5000,10000,5000],[10000,22000,10000]]];
M2=[3,4,5,6,7,8,9,10,15,20,30,40,50,100,200,500,1000,2000,5000,10000,20000];
}else if(L==14){
L=[ [[0.998,0.999,0.00001],[0.995,0.998,0.00002],[0.99,0.995,0.00005]],
[[0.998,0.999,0.00005],[0.995,0.998,0.0001],[0.99,0.995,0.0001]],
[[0.998,0.999,0.0001],[0.995,0.998,0.0005],[0.99,0.995,0.0005]]];
M2=[0.999,0.9985,0.998,0.997,0.996,0.995,0.994,0.993,0.992,0.991,0.99];
}else if(L==15){
L=[ [[0.98,0.9901,0.0001],[0.95,0.98,0.0002],[0.905,0.95,0.0005]],
[[0.98,0.99,0.0005],[0.95,0.98,0.001], [0.905,0.95,0.001]],
[[0.98,0.99,0.001],[0.95,0.98,0.005], [0.91,0.95,0.005]]];
M2=[0.99,0.985,0.98,0.97,0.96,0.95,0.94,0.93,0.92,0.91];
}else if(L==16){
L=[ [[0.8,0.906,0.001],[0.6,0.8,0.002],[0.37,0.6,0.005]],
[[0.8,0.906,0.005],[0.6,0.8,0.01],[0.37,0.6,0.01]],
[[0.8,0.9,0.01],[0.6,0.8,0.05],[0.4,0.6,0.05]]];
M2=[0.9,0.85,0.8,0.75,0.7,0.65,0.6,0.55,0.5,0.45,0.4];
}else{
L=[ [[0.05,0.37,0.002],[0.02,0.05,0.001],[0.01,0.02,0.0005],
[0.005,0.01,0.0002],[0.001,0.005,0.0001],
[0.0005,0.001,0.00002],[0.0001,0.0005,0.00001],[0.00005,0.0001,0.000002]],
[[0.05,0.37,0.01],[0.02,0.05,0.002],[0.01,0.02,0.001],
[0.005,0.01,0.001],[0.001,0.005,0.0002],
[0.0005,0.001,0.0001],[0.0001,0.0005,0.00002],[0.00005,0.0001,0.00001]],
[[0.05,0.37,0.05],[0.02,0.05,0.01],[0.01,0.02,0.005],
[0.005,0.01,0.005],[0.002,0.005,0.001],
[0.0005,0.001,0.0005],[0.0001,0.0005,0.0001],[0.00005,0.0001,0.00005]]];
M2=[0.3,0.2,0.1,0.05,0.03,0.02,0.01,0.005,0.002,0.001,0.0005,0.0002,0.0001];
}
}
}else{
if(L==6){ /* S */
L=[ [[6-3/12,15,1/12],[15,30,1/6],[30,50,1/3],[50,70,1/2],[70,80,1],[80,90,5]],
[[6-1/6,15,1/6],[15,30,1/2],[30,70,1],[70,80,5],[80,90,10]],
[[6,15,1/2],[15,30,1],[30,70,5],[70,90,10]] ];
M2=[6,7,8,9,10,15,20,30,40,50,60,70,90];
}else if(L==7){ /* T1 */
F=log(tan(x*3.1416/180))/Log10+1;
L=[ [[6-1/3,15,1/12],[15,45,1/6]],
[[6-1/3,15,1/6],[15,45,1/2]],
[[6,45,1]] ];
M2=[6,7,8,9,10,15,20,30,40,45];
}else if(L==8){ /* T2 */
L=[ [[45,75,1/6],[75,84+1/6,1/12]],
[[45,75,1],[75,84+1/6,1/6]],
[[45,84,1]] ];
M2=[45,50,60,70,75,80,81,82,83,84];
}else if(L==9){ /* ST */
L=[ [[35/60,1,1/120],[1,2,1/60],[2,5+9/12,1/30]],
[[35/60,1,1/60],[1,2,1/6],[2,5+9/12,1/6]],
[[40/60,1,1/6],[1,2,1/2],[2,5+9/12,1]] ];
M2=[1,2,3,4,5];
}else{
M2=(L==4||L==5)?[[1,2,1/2],[2,9,1]]:[[1,2,1/2],[2,10,1]];
L=(Pr==0)?
[ [[1,2,1/50],[2,5,1/20],[5,10,1/10]],
[[1,5,1/10],[5,10,1/2]],
[[1,5,1/2],[5,10,1]] ]:
[[[1,2,1/100],[2,5,1/50],[5,10,1/20]],
[[1,2,1/20],[2,10,1/10]],
[[1,2,1/10],[2,10,1/2]] ];
}
}
}else if(type(L[0])!=4){
L=[L];
if(length(L)!=3||L[0]+L[2]>L[1]) T=L;
}
if(T==0){
if(type(L[0][0])!=4) L=[L];
for(R=[];L!=[];L=cdr(L)){
for(RR=[],LT=car(L);LT!=[];LT=cdr(LT))
for(I=car(LT)[0];I<=car(LT)[1];I+=car(LT)[2]) RR=cons(I,RR);
RR=lsort(RR,[],1);
R=cons(RR,R);
}
R=reverse(R);
for(T=[];R!=[];R=cdr(R)){
if(length(R)>1) T=cons(lsort(R[0],R[1],"setminus"),T);
else T=cons(R[0],T);
}
}
V0=dlog(10);
S0=S1=1;D0=D1=0;
SC=getopt(scale);
if(type(SC)==4){
S0=SC[0];S1=SC[1];
}else if(type(SC)==1){
S0=SC;S1=0;
}else return T;
if(type(D=getopt(shift))==4){
D0=D[0];D1=D[1];
}else if(type(D)<2&&type(D)>=0){
D0=0;D1=D;
};
if(Inv==1){
D0+=S0;S0=-S0;
}
if(type(TF=getopt(f))>1) F=TF;
if(F) F=f2df(F);
if(type(I=getopt(ol))==1&&OL>3) OL=I;
for(M=M0=[],I=length(T);T!=[];T=cdr(T),I--){
for(S=car(T);S!=[];S=cdr(S)){
VS=car(S);
if(F) V=myfdeval(F,car(S));
else if(OL==4) V=frac(dlog(VS)/Log10+0.5);
else if(OL==5) V=frac(dlog(VS*3.1416)/Log10);
else if(OL>5&&OL<10){
VS=VS*3.1416/180;
if(OL==6) V=dlog(dsin(VS))/Log10+1;
else if(OL==9) V=dlog(VS)/Log10+2;
else V=dlog(dtan(VS))/Log10+8-OL;
}
else if(OL>9&&OL<14) V=dlog(dlog(VS))/Log10+13-OL;
else if(OL>13&&OL<18) V=dlog(-dlog(VS))/Log10+17-OL;
else V=dlog(VS)/Log10/LS;
V*=S0;
if(S1!=0){
M=cons([V+D0,D1],M);
M=cons([V+D0,((length(SC)>2)?SC[I]:(I*S1))+D1],M);
M=cons(0,M);
}else M0=cons(V+D0,M0);
}
if(S1==0) M=cons(reverse(M0),M);
}
if(S1!=0) M=cdr(M);
if(S1==0||getopt(TeX)!=1) return M;
M=reverse(M);
if(type(U=getopt(line))==4){
if(Inv==1) U=[U[0]+S0,U[1]+S0];
M=cons([U[0]+D0,D1],cons([U[1]+D0,D1],cons(0,M)));
}
if((VT=getopt(vert))==1){
for(N=[];M!=[];M=cdr(M)){
if(type(TM=car(M))==4) N=cons([TM[1],TM[0]],N);
else N=cons(TM,N);
}
M=reverse(N);
}
if(type(Col=getopt(col))<1) S=xylines(M);
else S=xylines(M|opt=Col);
if(type(Mes=getopt(mes))==4){
if(length(Mes)==1&&type(M2)==4) Mes=cons(car(Mes),M2);
S3=car(Mes);
if(type(S3)==4){
Col=S3[1];
S3=car(S3);
}else Col=0;
V=car(scale(cdr(Mes)));
if(!F) Mes=scale(cdr(Mes)|scale=[S0/LS,0],shift=[D0,D1],ol=OL);
else Mes=scale(cdr(Mes)|f=F,scale=[S0,0],shift=[D0,D1]);
for(M=car(Mes);M!=[];M=cdr(M),V=cdr(V)){
TV=deval(car(V));
if(Col!=0) TV=[Col,TV];
S+=(VT==1)?xyput([S3+D1,car(M),TV]):xyput([car(M),S3+D1,TV]);
}
}
if(type(Mes=getopt(mes2))==4){
if(type(car(Mes))!=4) Mes=[Mes];
for(;Mes!=[];Mes=cdr(Mes)){
TM=car(Mes);
if(!F) V=scale([car(TM)]|scale=[S0/LS,0],shift=[D0,D1],ol=OL);
else V=scale([car(TM)]|f=F,scale=[S0,0],shift=[D0,D1]);
V=car(car(V));
TM=cdr(TM);
if(type(Col=car(TM))==4){
C0=Col[0];C1=Col[1];
if(length(Col)==3){
S+=(VT==1)?xyline([D1+C0,V],[D1+C1,V]|opt=Col[2])
:xyline([V,D1+C0],[V,D1+C1]|opt=Col[2]);
}else S+=(VT==1)?xyline([D1+C0,V],[D1+C1,V]):xyline([V,D1+C0],[V,D1+C1]);
}
if(type(TM[1]<2)){
TM=cdr(TM);
S3=car(TM);
}
S+=(VT==1)?xyput([S3+D1,V,TM[1]]):xyput([V,S3+D1,TM[1]]);
}
}
return S;
}
def pluspower(P,V,N,M)
{
RR = 1;
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<S[0]; I++){
V+=M[I][I];
}
return V;
}
def mydet(M)
{
MM = matrtop(M);
if(type(MM[0]) == 6){
S = size(M);
for(Dn = 1, I = 0; I < S[0]; I++)
Dn *= MM[1][I];
return (!Dn)?0:red(det(MM[0])/Dn);
}
}
def permanent(M)
{
SS=size(M);
if((S=SS[0]) != SS[1] || S==0) return 0;
if((Red=getopt(red))!=1){
MM = matrtop(M);
for(Dn = 1, I = 0; I < S; I++)
Dn *= MM[1][I];
return (!Dn)?0:red(permanent(MM[0]|red=1)/Dn);
}
if(S<3){
if(S==1) return M[0][0];
else return M[0][0]*M[1][1]+M[0][1]*M[1][0];
}
LL=m2ll(M);
for(V=I=0;I<S;I++){
if(!(K=M[I][0])) continue;
for(TL=[],SL=LL,J=0;J<S;J++,SL=cdr(SL))
if(I!=J) TL=cons(cdr(car(SL)),TL);
if(K) V+=K*permanent(lv2m(TL));
}
return V;
}
def mperm(M,P,Q)
{
if(type(M) == 6){
S = size(M);
if(type(P) <= 1)
P=(P==1)?Q:trpos(0,0,S[0]);
if(type(P) > 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<P1;I++) P[I]=P0+I;
}else P = ltov(P);
}
if(type(Q) <= 1)
Q=(Q==1)?P:trpos(0,0,S[1]);
if(type(Q) > 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<P1;I++) Q[I]=P0+I;
}else Q = ltov(Q);
}
MM = newmat(S0=length(P),S1=length(Q));
for(I = 0; I < S0; I++){
MMI = MM[I]; MPI = M[P[I]];
for(J = 0; J < S1; J++)
MMI[J] = MPI[Q[J]];
}
return MM;
}
if((type(M) == 5 || type(M) == 4) && type(P) >= 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; I<II; I++){
if(type(MV[I])!=4) return M;
MV[I]=ltov(MV[I]);
}
for(R=[],J=0; ;J++){
for(T=[],I=F=0; I<II; I++){
if(length(MV[I])>J){
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;
if(type(Main=getopt(main))!=1) Main=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;
if(Opt>3){
for(P=[1],K=0;K<Size[1]-F;K++){
for(J=0;J<Size[0];J++)
if(type(dn(M[J][K]))==2) P=cons(dn(M[J][K]),P);
}
PC=llcm(P|poly=1);
}
for(K = JJ = 0; K < Size[1] - F; K++){
for(J = JJ; J < Size[0]; J++){
if(M[J][K] != 0){ /* search simpler element */
if(Opt>2 && (Mul=M[J][K])!=1){
for(FF=0,JT=J; JT<Size[0]; JT++){
if((Val=M[JT][K])==1){ /* 1 */
Mul=1;J=JT; break;
}
if(Val==0 || type(Val)>type(Mul)) continue;
if(type(Val)<type(Mul) || (Val==-1 && Mul!=-1)){
Mul=Val; J=JT; /* smaller type */
}
else if(Opt>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<Size[1]-F; JK++){
if(isint(M[JT][JK]/Val)!=1) break;
J=JT; FF=1; /* divisible => 1: non integer */
}
}
}
}
if(FF==0 && Opt>3 && Mul!=1 && Mul!=-1){ /* FF > 0 => divisible */
for(FF=0,J0=J; J0<Size[0]-1 && FF!=9; J0++){
VV0=M[J0][K];
if(VV0==0 || isint(VV0)==0) continue;
for(J1=J0+1;J1<Size[0] && FF!=9; J1++){
VV1=M[J1][K];
if(VV1==0 || isint(VV1)==0) continue;
for(C=FT=0,V0=VV0,V1=VV1; C<2 && FF!=10; C++,V1=V0,V0=VV1){
for(CC=0,RC=ceil(V0/V1);CC<2;CC++,RC--){
if((CD=V0-RC*V1)==0 && (RC==1 || RC==-1)){
FT=1; FF=10; /* 10: vanish by +- */
}else if(CD==1){
FV=(vars(M[J0])==[]&&vars(M[J1])==[])?1:0;
if((RC==1 || RC==-1) && FF<8+FV){
FT=1; FF=8+FV; /* 8/9: 1 by +- */
}else if(FF<6+VF){
FT=1; FF=6+FV; /* 6/7: 1 by times */
}
}else if(CD==-1){
FV=(vars(M[J0])==[]&&vars(M[J1])==[])?1:0;
if((RC==1 || RC==-1) && FF<4+FV){
FT=1; FF=4+FV; /* 4/5: 1 by +- */
}else if(FF<2+VF){
FT=1; FF=2+FV; /* 2/3: 1 by times */
}
}
if(FT==1){
FT=0; KRC=RC;
if(C==0){
KJ0=J0; KJ1=J1;
}else{
KJ0=J1; KJ1=J0;
}
}
}
}
}
}
if(FF>0){
for(I=K;I<Size[1];I++)
M[KJ0][I]=radd(M[KJ0][I],rmul(M[KJ1][I],-KRC));
if(KRC<0){
KRC=-KRC;Sgn=1;
}else
Sgn=0;
if(St&&!Main){
if(TeX){
if(KRC==1)
Lout=cons([Top+"\\xrightarrow{", Line,KJ0+1,TeXs[Sgn],
Line,KJ1+1,"}",dupmat(M)],Lout);
else
Lout=cons([Top+"\\xrightarrow{", Line,KJ0+1,TeXs[Sgn],
Line,KJ1+1,"\\times\\left(",KRC,"\\right)}",
dupmat(M)],Lout);
}else{
if(KRC==1)
mycat([Top+"line",KJ0+1,Lins[Sgn],KJ1+1,"\n",M,"\n"]); else
mycat([Top+"line",KJ0+1,Lins[Sgn],KJ1+1," * (",KRC,")\n",M,"\n"]);
}
}
Mul=M[KJ0][K]; J=KJ0;
if(FF==10){
J--; continue;
}
}
}
}
/* a parameter Var */
Var=0;
/* mycat(["start",J,K]); */
if(St && Opt>4 && length(Var=vars(nm(M[J][K])))==1){
J0=J;Jv=mydeg(nm(M[J0][K]),car(Var));
for(I=JJ;I<Size[0]; I++){
if((MIK=M[I][K])==0) continue;
if((T=vars(MIK=nm(MIK)))==[]){ /* 1/poly */
J=I;Var=[]; break;
}
if(length(T)>1) continue;
if(mydeg(MIK,T[0])<Jv){
J0=I;Jv=mydeg(MIK,T[0]);Var=T; /* search minimal degree */
}
}
if(length(Var)==1){
Var=car(Var);
Q=nm(M[J0][K]);
/* mycat(["min",Q,M[J0][K],"J0=",J0,"J=",J,"JJ=",JJ,K,M]); */
J=J0;
for(I=JJ; I<Size[0]; I++){
if(I==J0 || mydeg(nm(M[I][K]),Var)<0) continue;
T=rpdiv(nm(M[I][K]),Q,Var);
if(T[0]!=0 && (vars(T)==[] || vars(T)==[Var])) break; /* dec. deg */
}
}
}
if(type(Var)==2){ /* 1 variable */
if(I==Size[0]){
for(QF=0,Q0=1,QR=getroot(Q,Var|mult=1);QR!=[];QR=cdr(QR)){
/* mycat(["root",Q,QR,PC]); */
if(deg(T=QR[0][1],Var)>0){
QF=1;Q0*=T; continue;
}
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,main=Main),Lout);
}else{
mycat([str_times(" ",St-1)+"If",Var,"=",T,","]);
mtoupper(M0,F|step=St+1,opt=Opt,main=Main);
}
}
}
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<Size[1];II++)
M[I][II]=radd(M[I][II],rmul(M[J0][II],KRC));
if(!Main){
if(TeX)
Lout=cons([Top+"\\xrightarrow{", Line,I+1,"\\ +=\\ ",Line,
J0+1,"\\times\\left(",KRC,"\\right)}",dupmat(M)],Lout);
else
mycat([Top+"line",I+1,"+=",Line,J0+1," * (",KRC,")\n",M,"\n"]);
}
J=JJ-1;
continue;
}
}
if(J != JJ){
for(I = K; I < Size[1]; I++){
Temp = M[JJ][I];
M[JJ][I] = M[J][I];
M[J][I] = (Opt>=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,main=Main),
Lout);
}else{
mycat([str_times(" ",St-1)+"If",X,"=",T,","]);
mtoupper(M0,F|step=St+1,opt=Opt,main=Main);
}
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,main=Main),
Lout);
}else{
mycat([str_times(" ",St-1)+"If",X0,"=",T0,","]);
mtoupper(M0,F|step=St+1,opt=Opt,main=Main);
}
}
}
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; L<Size[1]; L++)
M[JJ][L]=red(M[JJ][L]/Mul);
if(St){
if(TeX)
Lout=cons([Top+"\\xrightarrow{",Line,JJ+1,
"\\ \\times=\\ \\left(",red(1/Mul),"\\right)}",
dupmat(M)],Lout);
else
mycat0([Top+"line",JJ+1, " *= (",red(1/Mul), ")\n",M,"\n\n"],0);
}
}
}
for(J = (Opt>0)?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&&!Main){
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)
{
if(getopt(vec)==1){
V=[];
if(type(M)==4&&length(M)==2&&M[0]*M[1]==M[1]*M[0]){
M0=M[0];M1=M[1];
R0=meigen(M0|mult=1);R1=meigen(M1|mult=1);
S=size(M0)[0];
for(TR0=R0;TR0!=[];TR0=cdr(TR0)){
E0=car(TR0)[1];
if(findin(zz,vars(E0))>=0) continue;
N0=M0-diagm(S,[E0]);
for(TR1=R1;TR1!=[];TR1=cdr(TR1)){
E1=car(TR1)[1];
if(findin(zz,vars(E1))>=0) continue;
N=newbmat(2,1,[[N0],[M1-diagm(S,[E1])]]);
L=mykernel(N|opt=1);
if(length(L)>0) V=cons([[E0,E1], L],V);
}
}
}
if(type(M)==6){
M=mtranspose(M);
S=size(M)[0];
R=meigen(M|mult=1);
for(TR=R;TR!=[];TR=cdr(TR)){
E=car(TR)[1];
if(findin(zz,vars(E))>=0) continue;
N=M-diagm(S,[E]);
V=cons([E,mykernel(N)],V);
}
}
V=reverse(V);
if(getopt(TeX)==1||getopt(dviout)==1){
Sp0="&:";
if(type(Sp=getopt(sep))!=7){
if(type(Sp)==4){
Sp0=Sp[0];Sp=Sp[1];
}else Sp="\\\\\n";
}
for(S="",TV=V;TV!=[];TV=cdr(TV)){
S+=my_tex_form(car(TV)[0])+Sp0+mtotex(mtranspose(lv2m(car(TV)[1])));
if(length(TV)>1) S+=Sp;
}
if(getopt(dviout)==1) dviout(texbegin("align*",S));
return S;
}
return V;
}
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 lext2(L)
{
if(length(L)==2){
for(S=0,I=1;I<L[1];I++){
S+=L[1]-I;
if(S>L[0]) break;
}
return [I-1,L[0]+L[1]-S];
}
if(L[0]==L[1]) return [0,0];
if(L[0]<L[1]){
L0=L[0];L1=L[1];S=1;
}else{
L0=L[1];L1=L[0];S=-1;
}
return [(2*L[2]-L0-3)*L0/2+L1-1,S];
}
def pf2kz(M)
{
L=length(M);
for(S=0,N=1;S<=L;N++){
S+=N;
}
if(S!=L+1) return 0;
for(L=[],I=0;I<N-2;I++){
for(S=J=0;J<N;J++)
if(I!=J) S+=M[car(lext2([I,J,N]))];
L=cons(-S,L);
}
for(S=0,K=M;K!=[];K=cdr(K)) S-=car(K);
S0=S;
for(I=0;I<N-2;I++) S+=M[car(lext2([I,N-2,N]))];
L=cons(-S,L);
for(S=0,K=L;K!=[];K=cdr(K)) S+=car(K);
L=cons(-S,L);L=reverse(L);
if(getopt(all)==1){
for(LL=[],I=0;I<N-2;I++){
for(J=I+1;J<N;J++) LL=cons(M[car(lext2([I,J,N]))],LL);
LL=cons(car(L),LL); L=cdr(L);
}
LL=cons(S0,LL); LL=cons(car(L),LL);LL=cons(L[1],LL);
return reverse(LL);
}
return cons(S0,L);
}
def mext2(M)
{
S=size(M);
if(S[0]!=S[1]) return 0;
S=S[0];
SS=S*(S-1)/2;MM=matrix(SS,SS);
for(I=0;I<S;I++){
for(J=I+1;J<S;J++){
II=lext2([I,J,S])[0];
for(I0=0;I0<S;I0++){
L=lext2([I0,J,S]);
MM[II][L[0]]+=L[1]*M[I][I0];
}
for(J0=0;J0<S;J0++){
L=lext2([I,J0,S]);
MM[II][L[0]]+=L[1]*M[J][J0];
}
}
}
return MM;
}
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] && L0[S1][J]==0;J++);
if(J<Sz[1]) S2=-L0[S0][J]/L0[S1][J];
}
if(S2!=0){
N=rowa(L0,S0,S1,S2);
if(DVI) TeX=[Line[0],S[0],"\\ +=\\ ",Line[0],
S[1],"\\ \\times\\ (",S2,")"];
}
}
}
}else{
if(S0<0 || S0>=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; I1<Sz[0] && L0[I1][J]==0; J++);
if(J<Sz[0]) S2=-L0[J][S0]/L0[J][S1];
}if(S2!=0){
N=cola(L0,S0,S1,S2);
if(DVI) TeX=[Line[1],S[0],"\\ +=\\ ",Line[1],
S[1],"\\ \\times\\ (",S2,")"];
}
}
}
}
}
}
if(N!=0){
LF=0;L=cons(N,L);
if(DVI) dviout("\\xrightarrow{"+ltotex(TeX|opt="spts0",str=1)+"}"+mtotex(N)|eq=8);
}
}
}
def vgen(V,W,S)
{
IM=length(V);
I=(getopt(opt)==0)?IM:0;
for(SS=0; I<IM && (SS==0 || V[I]<=W[I]); I++)
SS += W[I];
if(I<IM){
W[I]++;
SS--;
}else
SS=S;
for(J=0;J<I;J++){
W[J] = (SS<=V[J])?SS:V[J];
SS -= W[J];
}
if(SS>0)
return -1;
return(I==IM)?0:I;
}
def mmc(M,X)
{
if(getopt(full)==1){
M=mmc(M,X|option_list=delopt(getopt(),"full"));
if(type(M)<4) return -1;
L=length(M);
Mt=getopt(mult);
if((L>=6 && Mt!=0)||(L==3&&Mt==1)){
for(SS=2,I=3; I<L; I+=(++SS));
if(I==L) Mt=1;
else Mt=0;
}
if(Mt!=1){
for(R=[],I=S=0;I<L;I++){
S=radd(S,M[I]);
R=cons([[0,I+1],M[I]],R);
}
R=cons([[0,I+1],-S],R);
return reverse(R);
}
for(R=[],I=S=0;I<SS;I++)
for(J=I+1;J<=SS;J++,S++) R=cons([[I,J],M[S]],R);
for(I=0;I<=SS;I++){
for(J=S=0;J<=SS;J++){
if(I==J) continue;
S=radd(S,delopt(R,(I<J)?[I,J]:[J,I]|get=1));
}
R=cons([[I,SS+1],-S],R);
}
return qsort(R);
}
Mt=getopt(mult);
if(type(M)==7) M=s2sp(M);
if(type(M)!=4&&type(M)!=5) return 0;
if(type(M[0])<=3){
if(type(M)==5) M=vtol(M);
for(RR=[];M!=[];M=cdr(M)) RR=cons(mat([car(M)]),RR);
M=reverse(RR);
}
if(type(M[0])!=6){ /* spectre type -> GRS */
G=M;
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)-1;
if(Mt==1) SS=SS*(SS+1)/2;
for(M=[],I=0;I<SS;I++) M=cons(MZ,M);
for(RR=R; RR!=[]; RR=cdr(RR)){
RT=car(RR)[0];
if(type(RT)==4){
if(RT[0]!=0) M=mmc(M,[RT[0]]|simplify=Simp);
for(TT=cdr(RT);TT!=[];TT=cdr(TT)){
if(car(TT)!=0){
M=mmc(cdr(M),cdr(RT));
break;
}
}
}
}
}
if(X==0) return M;
L=length(M);
if((L>=6 && Mt!=0)||(L==3&&Mt==1)){
for(SS=2,I=3; I<L; I+=(++SS));
if(I!=L) return -1;
Mt=1;
}else{
SS=L;Mt=0;
}
if(type(X[0])==4){
for(;X!=[];X=cdr(X)) M=mmc(M,car(X));
return M;
}
if(length(X)==SS+1){
if(car(X)!=0) M=mmc(M,[car(X)]|simplify=Simp);
return mmc(M,cdr(X));
}
for(I=X;I!=[];I=cdr(I)) if(I[0]!=0) break;
if(I==[]) return M;
Simp=getopt(simplify);
if(Simp!=0 && type(Simp)!=1) Simp=2;
N=newvect(L);
for(I=0;I<L;I++) N[I]=dupmat(M[I]);
S=size(N[0])[0];
if(type(X)==4&&length(X)>=SS){ /* addition */
for(I=0;I<SS;I++,X=cdr(X)) if(car(X) != 0) N[I] = radd(N[I],diagm(S,[car(X)]));
}
if(length(X)!=1||!X[0]) return N;
X=X[0];
MZ = newmat(S,S);
MM = newvect(L);
/* convolution */
for(M1=J=0; J<SS; J++){
for(R=[],I=SS-1; 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]);
}
/* convolution of KZ */
for(P=0,Q=1;J<L;J++){ /* A_{P,Q} */
for(R=[],I=SS-1; I>=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;
}
}
if(getopt(homog)==1) MM[L-1]-=diagm(S*SS,[X]);
/* middle convolution */
for(R=[],I=SS-1; I>=0; I--){
for(RR=[N[I]],J=0; J<I; J++) RR=cons(MZ,RR);
R=cons(RR,R);
}
M0 = newbmat(SS,SS,R);
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<L;I++) MM[I] = mmod(MM[I],KK);
if(Simp!=0){
MM = mdsimplify(MM|type=Simp,show=1);
if(getopt(verb)) show([size(MM[0][0]),MM[1]]);
MM=MM[0];
}
return MM;
}
def lpgcd(L)
{
for(F=[]; L!=[]; L=cdr(L)){
if((P=car(L))==0) continue;
if(F==[]){
F=fctr(P);
S=length(F);
S--;
V=newvect(S);
M=newvect(S);
for(I=0; I<S; I++){
M[I] = F[I+1][1];
V[I] = F[I+1][0];
}
N=nm(ptozp(P|factor=1)[1]);
continue;
}
N=igcd(ptozp(P|factor=1)[1],N);
for(I=0; I<S; I++){
for(Q=P,CT=0; CT<M[I]; CT++)
if((Q=tdiv(Q,V[I])) == 0) break;
if(CT<M[I]) M[I]=CT;
}
}
if(F==[]) return 0;
for(Q=N,I=0;I<S; I++){
while(M[I]>0){
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<II;I++) V[I]=[];
N=newbmat(2,2,[[M,mgen(S[0],0,[1],0)],[mgen(S[1],0,[1],0)]]);
mdivisor(M,X|step=1,dviout=V);
L=S[0]+S[1];
if(Tr){
NN=mperm(N,Is1,Js1);
for(K=S[0];K<Is1;K++){
for(L=S[1];L<Js1;L++)
NN[K][L]=" ";
}
Out=[[mperm(NN,Is,Js)]];
}
for(I=1;I<II;I++){
I0=I-1;
if(V[I]==[]) continue;
for(T=reverse(V[I]);T!=[];T=cdr(T)){
St=[];
C=car(R=car(T));
if(C==0){
N=mperm(N,(R[1]==0)?0:[[R[1]+I0,I0]],(R[2]==0)?0:[[R[2]+I0,I0]]);
if(Tr){
if(R[2]!=0) St=append(["C",I,"\\leftrightarrow C",R[2]+I],St);
if(R[1]!=0){
if(R[2]!=0) St=cons(",\\ ",St);
St=append(["L",I,"\\leftrightarrow L",R[1]+I],St);
}
Out=cons(St,Out);
}
}else if(C==1){
P=1/N[I0][I0];N[I0][I0]=1;
if(P!=1){
for(J=I;J<L;J++)
N[I0][J]=muldo(P,N[I0][J],XX);
if(Tr){
St=append(["L",I,"\\leftarrow(",P,")","\\times L",I],St);
Out=cons(St,Out);
NN=mperm(N,Is1,Js1);
for(K=S[0];K<Is1;K++){
for(L=S[1];L<Js1;L++)
NN[K][L]=" ";
}
Out=cons(["\\to",mperm(NN,Is,Js)],Out);
}
}
for(F=0,J=I;J<S[0];J++){
if((P=N[J][I0])==0) continue;
F++;
N[J][I0]=0;
for(K=I;K<L;K++)
N[J][K]=red(N[J][K]-muldo(P,N[I0][K],XX));
}
if(F){
if(Tr){
Out=cons(["Li\\ -\\!=\\ \\circ\\times L",I,"\\quad(i>",I,")"],Out);
NN=mperm(N,Is1,Js1);
for(K=S[0];K<Is1;K++){
for(L=S[1];L<Js1;L++)
NN[K][L]=" ";
}
Out=cons(["\\to",mperm(NN,Is,Js)],Out);
}
}
for(F=0,J=I;J<S[1];J++){
if((P=N[I0][J])==0) continue;
F++;
N[I0][J]=0;
for(K=I;K<L;K++)
N[K][J]=red(N[K][J]-muldo(N[K][I0],P,XX));
}
if(F&&Tr) Out=cons(["Cj\\ -\\!=\\ C",I,"\\times\\circ\\quad(j>",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;J<L;J++){
N[I0][J]=C[0][J];N[R[1]+I0][J]=C[1][J];
}
if(Tr) Out=cons([dupmat(R[2]),"\\begin{pmatrix}L",I,"\\\\L",R[1]+I,
"\\end{pmatrix}"],Out);
}else if(C==3){
C=newmat(L,2);
for(J=0;J<L;J++){
C[J][0]=N[J][I0];C[J][1]=N[J][R[1]+I0];
}
C=muldo(C,R[2],XX);
for(J=0;J<L;J++){
N[J][I0]=C[J][0];N[J][R[1]+I0]=C[J][1];
}
if(Tr) Out=cons(["\\begin{pmatrix}C",I,"&C",R[1]+I,"\\end{pmatrix}",
dupmat(R[2])],Out);
}else if(C==4){
for(J=0;J<L;J++)
N[J][I0]=red(N[J][I0]+N[J][R[1]+I0]);
if(Tr) Out=cons(["C",I,"\\ +\\!=\\ C",R[1]+I],Out);
}else if(C==5){
for(J=0;J<L;J++)
N[I0+R[1]][J]=red(R[2]*N[I0+R[1]][J]);
if(Tr) Out=cons(["L",I+R[1],"\\leftarrow(", R[2],")\\times L",I+R[1]],
Out);
}else if(C==6){
for(J=0;J<L;J++)
N[J][I0]=N[J][I0]+muldo(N[J][I0+R[1]],R[2],XX);
if(Tr) Out=cons(["C",I,"\\ +\\!=\\ C",I+R[1],"\\times(", R[2],")"],
Out);
}else if(C==7){
mycat(["line",I+1,"\\leftrightarrow",R[1]+I]);
for(J=0;J<L;J++){
C=N[I][J];N[I][J]=N[R[1]+I0][J];N[R[1]+I0][J]=C;
}
if(Tr) Out=cons(["L",I+1,"\\leftrightarrow L",R[1]+I],Out);
}
if(Tr){
NN=mperm(N,Is,Js);
for(K=S[0];K<Is1;K++){
for(L=S[1];L<Js1;L++)
NN[K][L]=" ";
}
Out=cons(["\\to",NN],Out);
}
}
}
if(!Tr){
NN=mperm(N,Is,Js);
Out=[];
}
if(S[0]+S[1]==Is1){
N1=mperm(NN,[0,[S[0]]],[S[1],[S[0]]]);
N2=mperm(NN,[S[0],[S[1]]],[0,[S[1]]]);
N3=mperm(NN,[0,[S[0]]],[0,[S[1]]]);
R1=mdivisor(N1,X|trans=1)[1];
R2=mdivisor(N2,X|trans=1)[1];
if(Tr){
Out=cons(["\\text{As a result,}"],Out);
Out=cons([N3,"=",N1,MM,N2],Out);
if(S[0]==S[1] && N3==mgen(S[0],0,1,0)){
Out=cons(["=",muldo(N2,N1,XX),MM,"."],Out);
}else{
Out=cons([N1,"^{-1}=",R1,","],Out);
Out=cons([N2,"^{-1}=",R2,"."],Out);
}
}else{
Out=cons([N3,"=P",MM,"Q,"],Out);
Out=cons(["P=",N1,"=",R1,"^{-1},"],Out);
Out=cons(["Q=",N2,"=",R2,"^{-1}."],Out);
}
}
Out = ltotex(reverse(Out)|opt=["cr","spts0"],str=1,cr=15,var=Var);
if(S[0]+S[1]==Is1)
Out=str_subst(Out,"\\texttt{ }","");
if(VV>0){
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; I<S0; I++){
for(J=0; J<S1; J++){
if((P=abs(M[I][J]))!=0 && (K>P || 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<S1;J++){ /* (1,1) -> 1 */
if(J>0) M[0][J]= red(M[0][J]/P);
if(Tr) GC[0][J]=red(GC[0][J]/P);
}
if(S0>1 && S1>1) N=newmat(S0-1,S1-1);
else N=0;
for(I=1;I<S0;I++){
P=M[I][0]; M[I][0]=0;
for(J=1;J<S1;J++)
N[I-1][J-1]=M[I][J]=red(M[I][J] - muldo(P,M[0][J],XX));
if(Tr){
for(J=0;J<S0;J++)
GR[I][J] = red(GR[I][J] -muldo(P,GR[0][J],XX));
}
}
if(Tr){
for(J=1;J<S1; J++){
for(I=0;I<S1;I++) GC[I][J]=red(GC[I][J]-muldo(GC[I][0],M[0][J],XX));
M[0][J]=0;
}
}
if(St>0 && 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;I<S0;I++){
if(M[I][0]!=0){
/* Error! when mygcd(A,B,0) with A<=0 or B<=0 */
R=mygcd(M[I][0],M[0][0],XX); /* R[0]=R[1]*M[I][0]+R[2]*M[0][0] */
M[0][0]=R[0]; M[I][0]=0; /* 0=R[3]*M[I][0]+R[4]*M[0][0] */
for(J=1;J<S1;J++){
T=red(muldo(R[1],M[I][J],XX)+muldo(R[2],M[0][J],XX));
M[I][J]=red(muldo(R[3],M[I][J],XX)+muldo(R[4],M[0][J],XX));
M[0][J]=T;
}
if(Tr){
for(J=0;J<S0;J++){
T=red(muldo(R[1],GR[I][J],XX)+muldo(R[2],GR[0][J],XX));
GR[I][J]=red(muldo(R[3],GR[I][J],XX)+muldo(R[4],GR[0][J],XX));
GR[0][J]=T;
}
}
if(St && V==0){
mycat([" [",R[2],R[1],"]*"]);
mycat([" [",R[4],R[3],"]"]);
}
if(type(V)==5) V[St]=cons([2,I,mat([R[2],R[1]],[R[4],R[3]])],V[St]);
FF=": line 1 & "+rtostr(I+1); I=S0;
}
}
if(I>S0) continue;
for(J=1;J<S1;J++){
if(M[0][J]!=0){
R=mygcd(M[0][J],M[0][0],XX|rev=1); /* R[0]=M[0][J]*R[1]+M[0][0]*R[2] */
M[0][0]=R[0]; M[0][J]=0; /* 0=M[0][J]*R[3]+M[0][0]*R[4] */
for(I=1;I<S0;I++){
T=red(muldo(M[I][J],R[1],XX)+muldo(M[I][0],R[2],XX));
M[I][J]=red(muldo(M[I][J],R[3],XX)+muldo(M[I][0],R[4],XX));
M[I][0]=T;
}
if(Tr){
for(I=0;I<S1;I++){
T=red(muldo(GC[I][J],R[1],XX)+muldo(GC[I][0],R[2],XX));
GC[I][J]=red(muldo(GC[I][J],R[3],XX)+muldo(GC[I][0],R[4],XX));
GC[I][0]=T;
}
}
if(type(V)==5) V[St]=cons([3,J,mat([R[2],R[4]],[R[1],R[3]])],V[St]);
FF=": column 1 & "+rtostr(J+1);J=S1;
if(St && V==0){
mycat([" *[",R[2],R[4],"]"]);
mycat([" [",R[1],R[3],"]"]);
}
}
}
if(J>S1) continue;
if(S0==1 || S1==1){
P=M[0][0];
if(X==0){
if(P<0){
P=-P;
if(Tr) for(J=0;J<S0;J++) GR[0][J]=-GR[0][J];
if(type(V)==5) V[St]=cons([5,0,-1],V[St]);
}
}else{
P=nm(P);
if((R=fctr(P)[0][0])!=1){
P/=R;
if(Tr) for(J=0;J<S0;J++) GR[0][J]/=R;
if(type(V)==5) V[St]=cons([5,0,1/R],V[St]);
}
}
if(!Tr) return [P];
if(Tr==2){
GR0=mdivisor(GR,X|trans=1)[1];
GC0=mdivisor(GC,X|trans=1)[1];
return [[P],GR,GC,GR0,GC0];
}
return [[P],GR,GC];
}
if(XX==0 || (type(XX)==4 && XX[0]==0)){ /* commutative case */
P=M[0][0];
for(I=1; I<S0; I++){
for(J=1; J<S1; J++)
if(divdo(M[I][J],P,XX)[1]!=0) break;
if(J<S1){
if(type(V)==5) V[St]=cons([4,J],V[St]);
FF=": column 1 += col"+rtostr(J+1);
for(I=1;I<S0;I++) M[I][0]=M[I][J];
if(Tr) for(I=0;I<S1;I++) GC[I][0]=red(GC[I][0]+GC[I][J]);
break;
}
}
if(J<S1) continue;
N=newmat(S0-1,S1-1);
for(I=1;I<S0;I++)
for(J=1;J<S1;J++) N[I-1][J-1]=red(M[I][J]/P);
if(X==0){
if(P<0) P=-P;
if(Tr) for(J=0;J<S0;J++) GR[0][J]=-GR[0][J];
}else{
P=M[0][0];
P=nm(P);
P/=fctr(P)[0][0];
if(Tr) for(J=0;J<S0;J++) GR[0][J]/=fctr(P)[0][0];
}
R=mdivisor(N,XX|dviout=V,trans=Tr0,step=(St>0)?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; I<S0; I++){
for(J=1; J<S1; J++){
if(M[I][J] != 0){
for(T=1;I<S0;T*=XX[0]){
R=divdo(muldo(M[I][J],T,XX),M[0][0],XX);
if(R[1]!=0){
if(type(V)==5) V[St]=cons([6,J,T],V[St]);
FF=": column 1 += col"+rtostr((J+1)*T);
if(I>1){
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;I<S0;I++) M[I][0]=muldo(M[I][J],T,XX);
if(Tr)
for(I=1;I<S1;I++) GC[I][0]=red(GC[I][0]+muldo(GC[I][J],T,XX));
I=S0+1; J=S1;
break;
}
}
}
}
if(I>S0) 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;I<S;I++){
for(J=0;J<S;J++){
TN=0;TD=1;
for(PL=L;PL!=[];PL=cdr(PL)){
TM=red(car(PL)[I][J]);
TN=lgcd([TN,nm(TM)]|pol=1);
TD=llcm([TD,dn(TM)]|pol=1);
}
MN[I][J]=TM;
MD[I][J]=TN;
}
}
for(I=0;I<S;I++){
for(J=0;J<S;J++){
if(I==J||type(TD[I][J])<2||type(TN[J][I])<2) continue;
for(FC=cdr(fctr(TD[I][J]));FC!=[];){
TFC=car(FC);
if(type(red(TN[J][I]/TFC[0]))>2) continue;
}
}
}
#endif
DD=newvect(S);
for(I=0; I<S; I++){
LN=RN=[];
LD=RD=1;
for(LL=L; LL!=[]; LL=cdr(LL)){
M = car(LL);
for(J=0; J<S; J++){
if(J==I) continue;
if((MM=M[I][J]) != 0){
LN = cons(nm(MM),LN);
if(type(MM)==3 && tdiv(LD,P=dn(MM))==0)
LD=tdiv(LD*P,gcd(LD,P));
}
if((MM=M[J][I]) != 0){
RN = cons(nm(MM),RN);
if(type(MM)==3 && tdiv(RD,P=dn(MM))==0)
RD=tdiv(RD*P,gcd(RD,P));
}
}
}
if(T==1 || T==3) LQ=RD;
else{
P=lpgcd(LN);
LQ=gcd(P,RD);
if(P!=0) LQ *= nm(fctr(P)[0][0]);
}
if(T==1 || T==2) RQ=LD;
else{
P=lpgcd(RN);
RQ=gcd(P,LD);
if(P!=0) RQ *= nm(fctr(P)[0][0]);
}
if((P=gcdz(LQ,RQ))!=1){
LQ = red(LQ/P); RQ=red(RQ/P);
}
DD[I]=red(LQ/RQ);
if(LQ!=1 || RQ!=1){
for(LA=[],LL=L; LL!=[]; LL=cdr(LL)){
M = car(LL);
for(J=0; J<S; J++){
if(I!=J){
if(LQ!=1){
M[I][J] = red(M[I][J]/LQ);
M[J][I] = red(M[J][I]*LQ);
}
if(RQ!=1){
M[J][I] = red(M[J][I]/RQ);
M[I][J] = red(M[I][J]*RQ);
}
}
}
}
}
}
if(SS==2) L=ltov(L);
if(SS==1) L=L[0];
if(getopt(show)==1) L=[L,DD];
return L;
}
#if 1
def m2mc(M,X)
{
if(type(M)<2){
mycat([
"m2mc(m,t) or m2mc(m,[t,s])\t Calculation of Pfaff system of two variables\n",
" m : list of 5 residue mat. or GRS/spc for rigid 4 singular points\n",
" t : [a0,ay,a1,c], swap, GRS, GRSC, extend (eigen), sp, irreducible, pair, pairs, Pfaff, All\n",
" s : TeX, dviout, GRSC\n",
" option : swap, small, simplify, operator, int\n",
" Ex: m2mc(\"21,21,21,21\",\"All\")\n"
]);
return 0;
}
if(type(M)==7) M=s2sp(M);
if(type(M)==4&&type(M[0])==6&&length(M)==10){
N=newvect(5);
N[0]=M[1];N[1]=M[0];N[2]=M[2];N[3]=M[4];N[4]=M[5];
M=vtol(N);
}
if(type(X)==7) X=[X];
Simp=getopt(simplify);
if(Simp!=0 && type(Simp)!=1) Simp=2;
Small=(getopt(small)==1)?1:0;
if(type(M[0])==4){
if(type(M[0][0])==1){ /* spectral type */
XX=getopt(dep);
if(type(XX)!=4 || type(XX[0])>1) 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"||X[0]=="extend"){
Y=radd(-M[0],-M[1]-M[2]);
if(X[0]=="extend"){
R=[M[1],M[0],M[2],Y, M[3],M[4],radd(-M[1],-M[3]-M[4]),
radd(Y,-M[3]-M[4]),radd(M[1],M[2]+M[4]), radd(M[0],M[1]+M[3])];
if(length(X)>1){
if(X[1]=="eigen"){
L=["x,y","x,0","x,1","x,\\infty","y,0","y,1","y,\\infty",
"0,1","0,\\infty","1,\\infty"];
U="\\\\\n";S="";
for(TR=R,TL=L;TR!=[];TL=cdr(TL),TR=cdr(TR)){
if(length(TL)==1) U="\n";
S+="A_{"+car(TL)+"}&\\rightarrow\ "
+meigen(car(TR)|vec=1,TeX=1,sep=[":","\\quad"])+U;
}
return S;
}
if(type(X[1])==4){
TL=[x,y,0,1,2];
for(T=TL,TO=[];T!=[];T=cdr(TL)){
J=findin(TL[J],X[1][0]);
if(J<0) return 0;
TO=cons(X[1][1][J],TO);
}
TO=reverse(TO);
for(T=[],I=0;I<4;I++)
for(J=I+1;J<5;J++) T=cons([TL[I],TL[J]],T);
T=reverse(T);
for(R=[],I=0;I<4;I++){
for(J=I+1;J<5;J++){
K=findin([TO[I],T0[J]],T);
if(K<0) K=findin([TO[J],T0[I]],T);
R=cons(R[K],R);
}
}
return reverse(R);
}
}
if(Show){
TL=["x","y","0","1","\\infty"];
for(S="",TR=R,I=0,J=1;;TR=cdr(TR)){
S+="A_{"+TL[I]+","+TL[J]+"}&="+mtotex(car(TR));
if(length(X)>2&&X[2]=="spt")
S+="&&"+ltotex(meigen(car(TR)|mult=1)|vec=1,TeX=1,opt="spt");
if(J++==4){
if(I++==3) break;
J=I+1;
}
S+="\\\\\n";
}
return S;
}
return R;
}
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&0:1&1:\\infty&0:\\infty\\\\\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++){
if(type(T=M[I])<4) T=diagm(1,[T]);
N[I]=T;
}
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;
}
#else
def m2mc(M,X)
{
if(type(M)<2){
mycat([
"m2mc(m,t) or m2mc(m,[t,s])\t Calculation of Pfaff system of two variables\n",
" m : list of 5 residue mat. or GRS/spc for rigid 4 singular points\n",
" t : [a0,ay,a1,c], swap, GRS, GRSC, sp, irreducible, pair, pairs, Pfaff, All\n",
" s : TeX, dviout, GRSC\n",
" option : swap, small, simplify, operator, int\n",
" Ex: m2mc(\"21,21,21,21\",\"All\")\n"
]);
return 0;
}
if(type(M)==7) M=s2sp(M);
if(type(X)==7) X=[X];
Simp=getopt(simplify);
if(Simp!=0 && type(Simp)!=1) Simp=2;
Small=(getopt(small)==1)?1:0;
if(type(M[0])==4){
if(type(M[0][0])==1){ /* spectral type */
XX=getopt(dep);
if(type(XX)!=4 || type(XX[0])>1) 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,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"||X[0]=="extend"){
Y=radd(-M[0],-M[1]-M[2]);
if(X[0]=="extend")
return [M[1],M[0],M[2],Y, M[3],M[4],radd(-M[1],-M[3]-M[4]),
radd(Y,-M[3]-M[4]),radd(M[1],M[2]+M[4]), radd(M[0],M[1]+M[3])];
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(6,[M[3],M[1],M[4],M[0],M[2],M[5]]);
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(6);
for(I=0;I<6;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(6);
MM[0] = newbmat(3,3, [[N[0]+ME,N[1],N[2]], [MZ], [MZ]]); /* A01 */
MM[1] = newbmat(3,3, [[MZ], [N[0],N[1]+ME,N[2]], [MZ]]); /* A02 */
MM[2] = newbmat(3,3, [[MZ], [MZ], [N[0],N[1],N[2]+ME]]); /* A03 */
MM[3] = newbmat(3,3, [[N[3]+N[1],-N[1]], [-N[0],radd(N[0],N[3])], [MZ,MZ,N[3]]]); /* A12 */
MM[4] = newbmat(3,3, [[N[4]], [MZ,N[4]+N[2],-N[2]], [MZ,-N[1],radd(N[4],N[1])]]); /* A23 */
MM[5] = newbmat(3,3, [[MZ,N[5]+N[2],-N[2]], [N[5]], [MZ,-N[0],radd(N[5],N[0])]]); /* A13 */
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<6;I++)
MM[I] = mmod(MM[I],KK);
if(Simp!=0) MM = mdsimplify(MM|type=Simp);
return MM;
}
#endif
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;I<S;I++){
P=dn(L[I]=red(L[I]));
Dn=red(Dn*P/gcd(Dn,P));
}
if(Dn!=1){
for(I=0;I<S;I++) L[I]=red(Dn*L[I]);
}
G=diagm(S,[1]);
if(type(V)<4) V=[V];
VV=lsort(vars(L),V,1);
V=car(V);
for(I=0;I<S;I++){
P=L[I];
for(J=0,C=P;J<I;J++){
if(D[J]!=[]){
C=mycoef(C,DT,VV);
P-=C*H[J];
G=cola(G,I,J,-C);
}
}
if(P==0){
D[I]=[];continue;
}
P0=nm(red(P));
K=mymindeg(P0,V);
C=mycoef(P0,K,V);
if(K>0){
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<S;I++){
TH=red(H[I]/Dn);
F=fctr(dn(TH));F=cdr(F);
if(Lim!=1||subst(Dn,V,0)==0){
for(;F!=[];F=cdr(F)){
if(lsort(vars(car(F)[0]),VV,2)==[]){
C=car(F)[0]^car(F)[1];
TH=red(TH*C);
G=colm(G,I,C);
}
}
}
H[I]=TH;
}
}
H=vtol(H);
if(Lim==1){
H=subst(H,V,0);
return map(red,H);
}
return [H,map(red,G)];
}
def mykernel(M)
{
if(getopt(opt) == 1)
M = mtranspose(M);
S = size(M);
R = [];
MM = mtoupper(M,-1);
for(I = S[0]-1; 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; I<S; I++){
if(NE != 1 && VP[I] == 1) continue;
T = mymod(MM[I],L|opt=2);
if(D==0){
K=length(T);
MN=newmat((NE==1)?S:K,K);
}
for(J=0;J<K;J++)
MN[J][D]=T[J];
D++;
}
return MN;
}
def llsize(V)
{
for(I=J=0;V!=[];V=cdr(V),I++)
if(length(car(V))>J) 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(type(C2)==1){
for(K=I+1;K<S;K++){
if(!(C1=coef(V[K],N,X))||type(C1)!=1) continue;
if(abs(C2)>abs(C1)){
I=K;C2=C1;
}
}
}
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 rev(A,B){return A>B?-1:(A<B?1:0);}
def qsortn(X) {return qsort(X,os_md.rev);}
def rsort(L,T,K)
{
for(R=[];L!=[];L=cdr(L))
R=cons((type(car(L))==4)?rsort(car(L),T-1,K):car(L),R);
if(T>0||iand(T,iand(K,2)/2)) return reverse(R);
R=qsort(R);
return (iand(K,1))? reverse(R):R;
}
def lcut(L,M,N)
{
for(I=0,R=[];L!=[]&&I<=N;I++,L=cdr(L)){
if(I<M) continue;
R=cons(car(L),R);
}
return reverse(R);
}
def llget(L,LL,LC)
{
if(type(LL)==4){
LM=length(L);
for(R=[];LL!=[];LL=cdr(LL)){
if(isint(TL=car(LL))) R=cons(TL,R);
else{
IM=(length(TL)==1)?(LM-1):TL[1];
for(I=car(TL);I<=IM;I++) R=cons(I,R);
}
}
LL=reverse(R);
if(LC==-1){
LL=lsort(LL,[],1);
return lsort(L,"num",["sub"]|c1=LL);
}
L=lsort(L,"num",["get"]|c1=LL);
}
if(type(LC)==4){
LM=length(L[0]);
for(R=[];LC!=[];LC=cdr(LC)){
if(isint(TL=car(LC))) R=cons(TL,R);
else{
IM=(length(TL)==1)?(LM-1):TL[1];
for(I>=car(TL);I<=IM;I++) R=cons(I,R);
}
}
LC=reverse(R);
if(LL==-1){
LC=lsort(LC,[],1);
return lsort(L,"col",["setminus"]|c1=LC);
}
L=lsort(L,"col",["put"]|c1=LC);
}
if(getopt(flat)==1) L=m2l(L|flat=1);
return L;
}
def lsort(L1,L2,T)
{
C1=getopt(c1);C2=getopt(c2);
if(type(T)==4){
K=T;
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);
}
R=cons(reverse(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]<car(L2)[K1]){
if(T!=2) R=cons((T==1||T>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<S0-S1;I++) C=cons(I+S1,C);
C=reverse(C);
return lsort(R,"col",[1]|c1=C);
}
}
if(L2 == []){ /* [...] */
if(T==8||TT=="count") return [length(L1),length(lsort(L1,[],1))];
if(T==7||TT=="cut"){
K=length(L1);
if(C1<0) C1=K+C1;
for(R=[],I=0;I<C1&&L1!=[];I++,L1=cdr(L1))
R=cons(car(L1),R);
for(S=[];L1!=[];L1=cdr(L1))
S=cons(car(L1),S);
return [reverse(R),reverse(S)];
}
if(T==2) return L2;
if(T==3) return [L1,L2];
L1 = ltov(L1); qsort(L1);
if(T != 1)
return vtol(L1);
L3 = [];
for(I = length(L1)-1; 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<LY)?LX:LY;
for(I=0;;I++){
if(I==L0){
X0=LX;Y0=LY;break;
}
if(X0[I]==Y0[I]) continue;
X0=X0[I];Y0=Y0[I];break;
}
}
}
}else if(type(M)==2){
X0=(*M)(X0,Y0);Y0=0;
}else if(type(M)==4&&length(M)==1){
X0=(*car(M))(X0);Y0=(*car(M))(Y0);
}
if(X0==Y0) continue;
return (X0<Y0)?-F:F;
}
return 0;
}
def msort(L,S)
{
if(type(S)!=4) return qsort(L);
if(type(S[0])!=4) S=[S];
LQS=S;
return qsort(L,os_md.mqsub);
}
def lpair(A,B)
{
if(B==0){
for(S=T=[];A!=[];A=cdr(A)){
S=cons(car(A)[0],S);T=cons(car(A)[1],T);
}
return [reverse(S),reverse(T)];
}else{
for(R=[];A!=[];A=cdr(A),B=cdr(B))
R=cons([car(A),car(B)],R);
return reverse(R);
}
}
def lmax(L)
{
if(type(L)==4){
V=car(L);
while((L=cdr(L))!=[])
if(V < car(L)) V=car(L);
return V;
}else if(type(L)==5||type(L)==6)
return lmax(m2l(L));
return [];
}
def lmin(L)
{
if(type(L)==4){
V=car(L);
while((L=cdr(L))!=[])
if(V > 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(R)
{
if(type(R)==5||type(R)==6) R=m2l(R);
if(type(R)<4) R=[R];
if(type(R)!=4) return 0;
V=getopt(poly);
if(type(V)<1){
for(L=R;L!=[];L=cdr(L)){
if(type(car(L))>1){
V=1; break;
}
}
}
if(getopt(dn)!=1){
for(L=[];R!=[];R=cdr(R)) if(R!=0) L=cons(1/car(R),L);
R=L;
}
P=1;
if(type(V)<1){
for(;R!=[];R=cdr(R)){
if(!(TL=car(R))) continue;
else P=ilcm(P,dn(TL));
}
return P;
}
for(;R!=[];R=cdr(R)){
if(!car(R)) continue;
D=dn(red(car(R)));
N=red(P/D);
if(type(V)<2){
if(type(N)!=3) continue;
P*=dn(N);
continue;
}
if(ptype(N,V)>2){
L=fctr(dn(N));
for(;L!=[];L=cdr(L)){
if(ptype(car(L)[0],V)<2) continue;
P*=car(L)[0]^car(L)[1];
}
}
}
return P;
}
def ldev(L,S)
{
M=abs(lmax(L));N=abs(lmin(L));
if(M<N) M=N;
for(C=0,LT=L;;C++){
LT=ladd(LT,S,1);
MT=abs(lmax(LT));NT=abs(lmin(LT));
if(MT<NT) MT=NT;
if(MT>=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<NT) MT=NT;
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(Y==0){
Y=X[1];X=X[0];
}
if(type(Y)==4) Y=ltov(Y);
if(type(X)==4) X=ltov(X);
if(type(M)==4){
if(length(M)==1)
N=1-(M=car(M));
else{
N=M[0];M=M[1];
}
}else N=1;
return vtol(N*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<II; I++){
V=car(L); L=cdr(L);
for(J=length(V);--J>=0;)
M[I][J] = V[J];
if(N!=0){
for(J=length(V); J<JJ; J++)
M[I][J]=N;
}
}
return M;
}
def m2lv(M)
{
I=size(M)[0];
for(N=[],I=size(M)[0];I-->0;)
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<JJ;J++){
LT=car(L);
M[I][J]=(Pow>=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<L;I++){
N[I]=rmul(rmul(G,M[I]),H);
}
if(type(N)==4) N=vtol(N);
return N;
}
return -1;
}
def mpower(M,N)
{
if(type(M)<=3) return (red(M))^N;
S = size(M);
if(S[0] != S[1])
return 0;
if(N == 0) return mgen(S[0],0,[1],0);
if(N < 0)
return(mpower(myinv(M), -N));
R = dupmat(M);
V=1;
for(V=1;;){
if(iand(N,1)){
V=map(red,R*V);
N--;
}
if((N/=2)==0) break;
R=map(red,R*R);
}
return V;
}
def texlen(S)
{
if(type(S)!=7) return 0;
LF=I=J=0;
LM=str_len(S);
while((I=str_str(S,"\\frac{"|top=J))>=0){
if(I>J) LF+=texlen(str_cut(S,J,I-1));
I+=6;
for(F=L=0,J=I;F<2 && J<LM-1;F++){
for(C=1;C>0 && J<LM;){
if((K0=str_char(S,J,"}"))<0) K0=LM;
if((K1=str_char(S,J,"{"))<0) K1=LM;
if(K0<0 && K1<0){
J = str_len(S)-1;
break;
}
if(K0<K1){
J=K0+1; C--;
}else{
J=K1+1; C++;
}
}
T=str_cut(S,I,J-1);
if(F==0){
I=J=K1+1;C=1;
}else J=K0+1;
if(type(T)==7 && (LL=texlen(T))>L) 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; I<L; I++){
if(S[I]==92) F=1;
else if(F==1){
if((S[I]>96 && 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+2<L && S[I+2]==94) LL--; /* x_2^3 */
else if(I+6<L && S[I+1]==123 && S[I+4]==125){ /* x_{11}^2 */
if(S[I+5]==94 || (S[I+5]==125 && S[I+6]==94)) LL-- ; /* x_{11}}^2 */
}
}
}
return LL+LF;
}
def isdif(P)
{
if(type(P)<1 || type(P)>3) return 0;
for(Var=[],R=R0=vars(P);R!=[];R=cdr(R)){
V0=rtostr(car(R));
if(V0>"d" && V0<"e" && V0!="delta"){
V=sub_str(V0,1,str_len(V0)-1);
if(V>="a" && V<"{"){
V1=strtov(V);
Var=cons([V1,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;I<L&&isalpha(Q[I]);I++);
return(I==L)?P+" ":P;
}
def fctrtos(P)
{
/* extern TeXLim; */
if(!chkfun("write_to_tb", "names.rr"))
return 0;
TeX = getopt(TeX);
if(TeX != 1 && TeX != 2 && TeX != 3)
TeX = 0;
if((Dvi=getopt(dviout)==1) && TeX<2) TeX=3;
if(TeX>0){
Lim=getopt(lim);
if(Lim!=0 && TeX>1 && (type(Lim)!=1||Lim<30)) Lim=TeXLim;
else if(type(Lim)!=1) Lim=0;
CR=(TeX==2)?"\\\\\n":"\\\\\n&";
CR2="\\allowdisplaybreaks"+CR;
if(TeX==1 || Lim==0) CR=CR2="";
else if((Pages=getopt(pages))==1) CR2=CR;
if(!chkfun("print_tex_form", "names.rr"))
return 0;
Small=getopt(small);
}
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!="delta"){
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;
Rdic=0;
if((Dic=getopt(dic))==2){
Dic=Rdic=1;
}else if(Dic!=1) Dic=0;
TT=terms(P,VV|rev=Rev,dic=Dic);
if(TeX==0){
Pre="("; Post=")";
}else{
Pre="{"; Post="}";
}
Out = string_to_tb("");
for(L=C=CC=0,Tm=TT;Tm!=[];C++,Tm=cdr(Tm)){
for(I=0,PC=P,T=cdr(car(Tm)),PW="";T!=[];T=cdr(T),I++){
PC=mycoef(PC,D=car(T),VV[I]);
if(PC==0) continue;
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 ";
if(Rdic) PW=VD[I]+PT+PW;
else 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;
CD=0;
if(TeX>=1){
if(type(PC)==1 && ntype(PC)==0 && PC<0)
OC="-"+my_tex_form(-PC);
else OC=fctrtos(PC|TeX=1,br=1);
if(isint(PC)&&(PC<-1||PC>1)) CD=1;
}else OC=fctrtos(PC|br=1);
if(PW!=""){
if(OC == "1") OC = "";
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){
CC++;
LL=texlen(OC)+texlen(PW);
if(LL+L>=Lim){
if(L>0) str_tb(CR,Out);
if(LL>Lim){
if(TOC==7) OC=texlim(OC,Lim|cut=[CR,CR2]);
if(length(Tm)!=1) PW+=CR;
L=0;
}else L=LL;
}else L+=LL;
}else if(length(Tm)!=1){
CC++;
PW += CR; /* not final term */
}
if(CC>TeXPages) CR=CR2;
if(TeX){
OC=texsp(OC);
if(CD){ /* 2*3^x */
CD=strtoascii(str_cut(PW,0,1));
if(length(CD)==2&&car(CD)==123&&isnum(CD[1])) OC+="\\cdots";
}
}
if(str_chr(OC,0,"-") == 0 || C==0) str_tb([OC,PW], Out);
else{
str_tb(["+",OC,PW],Out);
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 = CD = 0; J < length(P); J++){
if(type(V=P[J][0]) <= 1){
if(V == -1){
write_to_tb("-",S);
if(length(P) == 1)
str_tb("1", S);
}else if(V != 1){
str_tb((TeX>=1)?my_tex_form(V):rtostr(V), 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++;
}
if(J==0&&isint(V=P[J][0])&&(V<-1||V>1)) CD=1;
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&&length(P)>1) SS="("+SS+")";
else if(CD&&J==1){ /* 2*3^x */
CD=strtoascii(str_cut(SS,0,1));
if(length(CD)==2&&car(CD)==123&&isnum(CD[1])) SS="\\cdot"+SS;
}
write_to_tb(SS,S);
}
}
S = str_tb(0,S);
if((Lim>0 || TP!=2) && CR!="") S=texlim(S,Lim|cut=[CR,CR2]);
}
if(TeX>0){
if(Small==1) S=str_subst(S,"\\frac{","\\tfrac{");
if(Dvi==1){
dviout(strip(S,"(",")")|eq=(Pages==1||Pages==2)?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){
if(type(Out)!=4) Out=Out2="\\\\\n&";
else{
Out2=Out[1];Out=Out[0];
}
}
if(type(Del=getopt(del))!=7) Del=Out;
if(Lim<30) Lim=TeXLim;
S=ltov(strtoascii(S));
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 && K1<K){ /* - */
if(S[K1-1]!=123 && S[K1-1]!=40) K=K1; /* {, ( */
}
if((K1=str_char(S,JJ,40))>0 && K1-JJ>6 && K1<K && S[K1-1]!=43 && S[K1-1]!=45){ /* ( */
T=str_char(S,K1-6,"\\"); /* \Big*(, \big*( */
if((T==K1-6 || T==K1-5)
&& (str_str(S,"big"|top=T+1,end=T+1)>0 || str_str(S,"Big"|top=T+1,end=T+1)>0))
K=T;
else if(K1>0 && K1<K) K=K1;
}
if(K<0 || K>II) 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);
if(length(L)>TeXPages) Out=Out2;
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 trcolor(S)
{
if(type(S)!=7) return S;
return ((I=findin(S,LCOPT))>=0)?COLOPT[I]:0;
}
def mcolor(L,P)
{
if(type(L)!=4) return L;
if(!P||(S=length(L))==1){
if(type(V=car(L))!=7) return V;
return trcolor(V);
}
P-=ceil(P)-1;
if(P==1){
if(type(V=L[S-1])!=7) return V;
return trcolor(V);
}
for(S=P*(S-1);S>1;S--,L=cdr(L));
if(getopt(disc)==1) S=0;
if(type(L0=L[0])==7) L0=trcolor(L0);
if(type(L1=L[1])==7) L1=trcolor(L1);
T=rint(iand(L0,0xff)*(1-S)+iand(L1,0xff)*S);
TT=iand(L0,0xff00)*(1-S)+iand(L1,0xff00)*S;
T+=rint(TT/0x100)*0x100;
TT=iand(L0,0xff0000)*(1-S)+iand(L1,0xff0000)*S;
return T+rint(TT/0x10000)*0x10000;
}
def drawopt(S,T)
{
if(type(S)!=7) return -1;
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 openGlib(W)
{
extern Glib_canvas_x;
extern Glib_canvas_y;
extern Glib_math_coordinate;
if(W==0){
glib_clear();
return;
}
if(type(W)==4&&length(W)==2){
Glib_canvas_x=W[0];
Glib_canvas_y=W[1];
}
Glib_math_coordinate=1;
if(getopt(null)!=1) return glib_open();
}
def execdraw(L,P)
{
if((Proc=getopt(proc))!=1) Proc=0;
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]<R[2][0][1]+(R[0][0][1]-R[0][0][0])/256) Ex1+=7*U;
else Ex1+=2*U;
if(R[0][1][1]<R[2][1][1]+(R[0][1][1]-R[0][1][0])/256) Ex2+=15;
}
R=[R[0][0],R[0][1],0,[Ex0,Ex1],[0,-Ex2]];
if(length(P)>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(T[0]==6){ /* plot */
F++;
if((T1=findin(T[1],LCOPT))>-1) T1=COLOPT(T1);
else if(type(T1)!=1 && T1!=0) T1=0xffffff;
for(T2=ptaffine(M,T[2]|option_list=Org);T2!=[];T2=cdr(T2))
draw_obj(Id,Ind,[rint(car(T2)[0]),rint(car(T2)[1])],T1);
}else if(Proc==1&&type(T[0])==2){
if(length(T)<3) call(T[0],T[1]);
else call(T[0],T[1]|option_list=T[2]);
}
}
}
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){
if(type(T2=T[3])==7) T2=[T2];
V=append(V,T2);
}
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]==6){ /* plot */
F++;
if(type(T[1])==7) T1=[T[1],"."];
else T1=".";
for(T2=ptaffine(M,T[2]|option_list=Org);T2!=[];T2=cdr(T2))
str_tb(xypos([car(T2)[0],car(T2)[1],T1]),Out);
}else if(T[0]==-2)
str_tb(["%",T[1],"\n"],Out);
else if(Proc==1&&type(T[0])==2){
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<N;I++){
V=makev(["v",I+1]);
if(findin(V,VS)>=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;
if(getopt(lpair)==1||(type(L[0])==4&&length(L[0])>2)) L=lpair(L[0],L[1]);
Inv=getopt(inv);
if(type(L[0]) == 4){
while((L0 = car(L))!=[]){
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<S; J++)
R = radd(R, call(FN, cons(P[J],cons(F[J],L)))|option_list=Opt);
return R;
}
T = size(P);
R = newvect(T[0]);
for(I = 0; I < T[0]; I++){
for(J = 0; J < S; J++)
R[I] = radd(R[I], call(FN, cons(P[I][J],cons(F[J],L))|option_list=Opt));
}
return R;
}
if(type(F) == 6){
S = size(F);
if(type(P) <= 3){
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,cons(F[I][J],L))|option_list=Opt);
}
return R;
}
if(type(P) == 5){
R = newvect(S[1]);
for(J = 0; J < S[1]; J++){
for(K = U = 0; K < S[0]; K++)
U = radd(U, call(FN, cons(P[K],cons(F[K][J],L))|option_list=Opt));
R[J] = U;
}
return R;
}
T = size(P);
R = newmat(T[0],S[1]);
for(I = 0; I < T[0]; I++){
for(J = 0; J < S[1]; J++){
for(K = U = 0; K < S[0]; K++)
U = radd(U, call(FN, cons(P[I][K],cons(F[K][J],L)|option_list=Opt)));
R[I][J] = U;
}
}
return R;
}
erno(0);
return 0;
}
def appldo(P,F,L)
{
if(getopt(Pfaff)==1){
L = vweyl(L);
X = L[0]; DX = L[1];
for(I=mydeg(P,DX);I>0;I--){
if(!(TP=mycoef(P,I,DX))) continue;
P=red(P-TP*DX^I+TP*muldo(DX^(I-1),F,L));
}
return P;
}
if(type(F) <= 3){
if(type(L) == 4 && type(L[0]) == 4)
return applpdo(P,F,L);
L = vweyl(L);
X = L[0]; DX = L[1];
J = mydeg(P,DX);
for(I = R = 0; I <= J; I++){
if(I > 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 caldo(P,L)
{
for(R=0;P!=[];P=cdr(P)){
TP=car(P);
if(type(TP)<4){
R=red(R+TP);continue;
}
for(S=1;TP!=[];TP=cdr(TP)){
S0=car(TP);
if(type(S0)==4){
TP0=S0;
for(S0=1,K=TP0[1];K>0;K--) S0=muldo(S0,TP0[0],L);
}
S=muldo(S,S0,L);
}
R=red(R+S);
}
return R;
}
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);L=length(X);
M=newmat(N,L);
for(I=0;I<N;I++)
for(J=0;J<L;J++) M[I][J]=red(diff(F[I],X[J]));
if(N!=L||getopt(mat)==1) return M;
return mydet(M);
}
def hessian(F,X)
{
X=ltov(X);
N=length(X);
M=newmat(N,N);
for(I=0;I<N;I++){
G=red(diff(F,X[I]));
for(J=0;J<N;J++) M[I][J]=red(diff(G,X[J]));
}
if(getopt(mat)==1) return M;
return mydet(M);
}
def wronskian(F,X)
{
N=length(F);
M=newmat(N,N);
for(I=0;F!=[];F=cdr(F),I++){
M[I][0]=car(F);
for(J=1;J<N;J++) M[I][J]=red(diff(M[I][J-1],X));
}
if(getopt(mat)==1) return M;
return mydet(M);
}
def adj(P,L)
{
if(type(P) == 4)
#ifdef USEMODULE
return map(os_md.adj,mtranspose(P),L);
#else
return map(adj,mtranspose(P),L);
#endif
if(type(L) == 4 && type(L[0]) == 4)
#ifdef USEMODULE
return fmult(os_md.adj,P,L,[]);
#else
return fmult(adj,P,L,[]);
#endif
L = vweyl(L);
X = L[0]; DX = L[1];
P = R = subst(P, DX, -DX);
for(I = 1; (R = mydiff(mydiff(R, X), DX)/I) != 0 && I < 100; I++)
P = radd(P,R);
return P;
}
def laplace1(P,L)
{
if(type(L) == 4 && type(L[0]) == 4)
#ifdef USEMODULE
return fmult(os_md.laplace,P,L,[]);
#else
return fmult(laplace,P,L,[]);
#endif
L = vweyl(L);
X = L[0]; DX = L[1];
P = adj(P, L);
return subst(P,X,o_1,DX,X,o_1,DX);
}
def laplace(P,L)
{
if(type(L) == 4 && type(L[0]) == 4)
#ifdef USEMODULE
return fmult(os_md.laplace1,P,L,[]);
#else
return fmult(laplace1,P,L,[]);
#endif
L = vweyl(L);
X = L[0]; DX = L[1];
P = adj(P, L);
return subst(P,X,o_1,DX,-X,o_1,-DX);
}
def mce(P,L,V,R)
{
L = vweyl(L);
X = L[0]; DX = L[1];
P=red(P);
if(findin(DX,dn(P))>=0) return 0;
PP=fctr(nm(P));
for(P=1;PP!=[];PP=cdr(PP)){
TP=car(PP);
if(findin(DX,vars(TP[0]))>=0) P*=TP[0]^TP[1];
}
P = sftexp(laplace1(P,L),L,V,R|option_list=getopt());
return laplace(P,L);
}
def mc(P,L,R)
{
return mce(P,L,0,R|option_list=getopt());
}
def mcme(P,L,V,R)
{
for(LL=[];L!=[];L=cdr(L)) LL=cons(car(L),LL);
LL=reverse(LL);
if(V==0) L=LL;
else L=delopt(LL,V|inv=1);
P=rede(P,LL);
for(Q=laplace(P,L),E=0,TL=L;TL!=[];TL=cdr(TL)){
E+=TL[0]*TL[1];
Q=toeul(Q,car(TL),0);
}
N=length(L);
for(R=[],TL=L;TL!=[];TL=cdr(TL))
R=cons([-E/car(TL),-TL[0]*TL[1]+(R-1)/N],R);
Q=transpdo(Q,L,reverse(R)|ex=1);
return rede(Q,LL);
}
def rede(P,L)
{
Q = ltov(fctr(nm(red(P))));
P = 1;
if(type(L) < 4)
L = [L];
if(type(L[0]) < 4)
L = [L];
for( ; L != []; L = cdr(L)){
DX = vweyl(car(L))[1];
for(I = 1; I < length(Q); I++){
if(mydeg(Q[I][0],DX) > 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 transppow(LL,M)
{
for(L=[];LL!=[];LL=cdr(LL))
L=cons(vweyl(car(LL)),L);
L=reverse(L);N=length(L);
if(type(M)==4) M=lv2m(M);
MM=myinv(M);
for(K=[],I=0;I<N;I++){
for(J=0,K0=1;J<N;J++) K0*=L[J][0]^M[J][I];
for(J=0,K1=0;J<N;J++) K1=red(K1+MM[I][J]*L[J][0]*L[J][1]/K0);
K=cons([K0,K1],K);
}
return reverse(K);
}
def transpdosub(P,LL,K)
{
if(type(P)>3) return
#ifdef USEMODULE
mtransbys(os_md.transpdosub,P,[LL,K]);
#else
mtransbys(transpdosub,P,[LL,K]);
#endif
Len = length(K)-1;
if(Len < 0 || P == 0)
return P;
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)==4&&type(K[0]==4)){
for(TK=K;;TK=cdr(TK)) if(!isint(car(TK))) break;
if(TK==[]) K=transppow(LL,K);
}
if(type(K)==6) K=transppow(LL,K);
Len = length(K)-1;
K1=K2=[];
if(type(LL)!=4) LL=[LL];
if(type(LL[0])!=4) LL=[LL];
if(type(car(K)) < 4 && length(LL)!=length(K)) K = [K];
if(getopt(ex)==1){
for(LT=LL, KT=K; KT!=[]; LT=cdr(LT), KT=cdr(KT)){
L = vweyl(LL[J]);
K1=cons([L[0],car(KT)[0]],K1);
K2=cons([L[1],car(KT)[1]],K2);
}
K2=append(K1,K2);
}else{
if(length(LL)==length(K) && type(car(K))!=4){
for(DV=V=TL=[],J=length(LL)-1;J>=0;J--){
TL=cons(vweyl(LL[J]),TL);
V=cons(car(TL)[0],V);
DV=cons(car(TL)[1],DV);
}
LL=TL;
if(type(RK=solveEq(K,V|inv=1))!=4) return TK;
if(!isint(Inv=getopt(inv))) Inv=0;
if(iand(Inv,1)){J=K;K=RK;RK=J;}
M=jacobian(RK,V|mat=1);
M=mulsubst(M,[V,K]|lpair=1);
RK=vtol(M*ltov(DV));
if(Inv>1) return RK;
K=lpair(K,RK);
}
for(J = length(K)-1; J >= 0; J--){
L = vweyl(LL[J]);
if(L[0]!= K[J][0]) K1=cons([L[0],K[J][0]],K1);
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<S;J++){
L = vweyl(LL[J]);
L0[J]=L[0];
L1[J]=L[1];
}
K=rmul(M,L0);
for(T=[],J=0;J<S;J++)
T=cons([L0[J],K[J]],T);
P=mulsubst(P,T);
K=rmul(myinv(M),L1);
for(T=[],J=0;J<S;J++)
T=cons([L1[J],K[J]],T);
return mulsubst(P,T);
}
/*
return [R, M, S] : R = M*P - S*Q
deg(R,X) < deg(Q,X)
*/
def rpdiv(P,Q,X)
{
if(P == 0)
return [0,1,0];
DQ = mydeg(Q,X);
CO = mycoef(Q,DQ,X);
S = 0;
while((DP = mydeg(P,X)) >= 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";
U=(str_chr(S,str_len(S)-1,"\n")<0)?"%\n":"";
return "\\begin{"+T+"}"+Opt+S+U+"\\end{"+T+"}\n";
}
def mygcd(P,Q,L)
{
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<S; I++){
if(mydeg(T[I][0],zz) > 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;J<I;J++)
R *= X-J;
return(R);
}
/*
ret: x(x+K)(x+2*k)...(x+(i-1)*k)
*/
def sftpowext(X,I,K)
{
R = 1;
for(J=0;J<I;J++)
R *= X+K*J;
return(R);
}
def polinsft(F,A)
{
R = 0;
while(F != 0){
D = mydeg(F,A);
C = mycoef(F,D,A);
R += C*A^D;
F -= C*sftpow(A,D);
}
return R;
}
def pol2sft(F,A)
{
S=getopt(sft);
if(type(S)<0 || type(S)>2) 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<N;K++){
for(T=A; T!=[]; T=cdr(T)) S0*=car(T)+K;
for(T=B; T!=[]; T=cdr(T)) S0/=car(T)+K;
S0=red(S0*X/(K+1));
DN=dn(S0);
S=red((red(S*DN)+nm(S0))/DN);
}
return S;
}
S=0;
for(K=0;K<=N;K++){
for(I=0;I<=N-K;I++){
C=1/sftpowext(1,I,1)/sftpowext(1,J,1);
for(T=A[0];T!=[];T=cdr(T)) C*=sftpowext(car(T),I+K,1);
for(T=A[1];T!=[];T=cdr(T)) C*=sftpowext(car(T),I,1);
for(T=A[2];T!=[];T=cdr(T)) C*=sftpowext(car(T),K,1);
for(T=B[0];T!=[];T=cdr(T)) C/=sftpowext(car(T),I+K,1);
for(T=B[1];T!=[];T=cdr(T)) C/=sftpowext(car(T),I,1);
for(T=B[2];T!=[];T=cdr(T)) C/=sftpowext(car(T),K,1);
S+=red(C*X[0]^I*X[1]^K);
}
}
return S;
}
def evalred(F)
{
Opt=getopt(opt);
if(type(Opt)!=4){
Opt=[];
}else if(length(Opt)==2 && type(Opt[0])!=4) Opt=[Opt];
for(;;){
G=mysubst(F,[[tan(0),0],[asin(0),0],[atan(0),0],[sinh(0),0],[tanh(0),0],
[log(1),0],[cosh(0),1],[exp(0),1]]);
for(Rep=Opt; Rep!=[]; Rep=cdr(Rep))
G=subst(G,car(Rep)[0],car(Rep)[1]);
Var=vars(G);
for(V=Var; V!=[]; V=cdr(V)){
if(!(VV=args(CV=car(V)))) continue;
if((functor(CV)==sin||functor(CV)==cos)){
P=2*red(VV[0]/@pi);
if(functor(CV)==sin) P=1-P;
if(isint(P)){
if(iand(P,1)) G=subst(G,CV,0);
else if(!iand(P,3)) G=subst(G,CV,1);
else G=subst(G,CV,-1);
continue;
}
if(isint(P*=3/2)){
if(iand(P,3)==1) G=subst(G,CV,1/2);
else G=subst(G,CV,-1/2);
}
}
for(;VV!=[];VV=cdr(VV))
if(car(VV)!=(TV=evalred(car(VV)))) G=subst(G,car(VV),TV);
if(functor(CV)!=pow || (args(CV)[0])!=1) continue;
G=subst(G,CV,1);
}
if(G==F) return F;
F=G;
}
}
def seriesMc(F,N,V)
{
if(type(V)<4) V=[V];
V=reverse(V);
L=length(V);
if(type(Opt=getopt(evalopt))!=4) Opt=[];
P=newvect(L);
G=newvect(L+1);
G[0]=F;
for(I=0;I<L;I++)
G[I+1]=eval(evalred(subst(G[I],V[I],0)|opt=Opt));
R=G[L];
for(;;){
for(M=0,I=0;I<L;I++){
M+=P[I];
if(M==N) break;
}
if(M<N){
P[L-1]++;
G[L-1]=mydiff(G[L-1],V[L-1]);
G[L]=eval(evalred(mysubst(G[L-1],[V[L-1],0])|opt=Opt));
}else{
if(I--==0) break;
P[I]++;
G[I]=mydiff(G[I],V[I]);
while(I++<L){
G[I]=eval(evalred(mysubst(G[I-1],[V[I-1],0])|opt=Opt));
if(I<L) P[I]=0;
}
}
K=1;
for(I=0;I<L;I++) K*=V[I]^P[I]/fac(P[I]);
R+=G[L]*K;
}
return R;
}
def seriesTaylor(F,N,V)
{
G=F;
if(isvar(V)) V=[V];
if(length(V)==2 && type(car(V))!=4 && !isvar(V[1])) V=[V];
for(V0=V1=[];V!=[];V=cdr(V)){
if(type(T=car(V))!=4) T=[T];
V0=cons(X=car(T),V0);
if(length(T)==1 || T[1]==0){
V1=cons(X,V1);continue;
}
S=my_tex_form(-T[1]);
if(str_char(S,0,"-")!=0) S="+"+S;
S="("+my_tex_form(X)+S+")";
V1=cons([X,S],V1);
F=red(subst(F,T[0],T[0]+T[1]));
}
V0=reverse(V0);V1=reverse(V1);
F=seriesMc(F,N,V0|option_list=getopt());
if(getopt(frac)==0) F=frac2n(F);
T=getopt(dviout);
if(type(T)!=1) T=0;
F=fctrtos(F|var=V1,rev=1,TeX=(T==0||T==2)?2:3);
if(getopt(small)==1) F=str_subst(F,"\\frac{","\\tfrac{");
if(T<0 || T==1) F="\\begin{align}\\begin{split}\n"+
my_tex_form(G)+"&="+F+"+\\cdots\n\\end{split}\\end{align}\n";
if(T==1) dviout(F);
else if(T==1) dviout(F|eq=4);
return F;
}
def mulpolyMod(P,Q,X,N)
{
Red=(type(P)>2||type(Q)>2)?1:0;
for(I=R=0;I<=N;I++){
P0=mycoef(P,I,X);
for(J=0;J<=N-I;J++){
R+=P0*mycoef(Q,J,X)*X^(I+J);
if(Red) R=red(R);
}
}
return R;
}
def solveEq(L,V)
{
Inv=0;K=length(V);
H=(getopt(h)==1)?1:0;
if(getopt(inv)==1){
if(K!=length(L)) return -5;
Inv=1;
VN=makenewv(vars(L)|num=K);
for(TL=[],I=K-1;I>=0;I--) TL=cons(VN[I]-L[I],TL);
S=solveEq(TL,V|h=H);
if(type(S)!=4) return S;
return mysubst(S,[VN,V]|lpair=1);
}
for(TL=[];L!=[];L=cdr(L)) TL=cons(nm(red(car(L))),TL);
S=gr(TL,reverse(V),2);
if(length(S)!=K) return -1;
for(R=[],I=F=0;I<K;I++){
TS=S[I];
VI=lsort(vars(TS),V,2);
if(length(VI)!=1) return -2;
if((VI=car(VI))!=V[I]) return -3;
if(mydeg(TS,VI)!=1){
F=1;R=cons([VI,TS],R);
}else R=cons(-red(mycoef(TS,0,VI)/mycoef(TS,1,VI)),R);
}
R=reverse(R);
if(!F||H==1) return R;
return -4;
}
/* Opt: f, var, ord, to, in, TeX */
def baseODE(L)
{
SV=SVORG;
if(type(TeX=getopt(TeX))!=1) TeX=0;
if(type(F=getopt(f))!=1) F=0;
if(isint(In=getopt(in))!=1) In=0;
if(type(Ord=getopt(ord))!=1&&Ord!=0) Ord=2;
Pages=getopt(pages);
if(Pages!=1&&Pages!=2) Pages=0;
if(Ord>3){
Ord-=4; Hgr=1;
}else Hgr=0;
if(type(car(L0=L))==4&&type(L[1])==7){
Tt=L[1];L=car(L);
}
M=N=length(L); SV=SVORG;
if(type(Var=getopt(var))==4&&(In>0||length(Var)==N)){
SV=Var;
M=length(SV);
if(type(car(SV))==2){
for(R=[];SV!=[];SV=cdr(SV)) R=cons(rtostr(car(SV)),R);
SV=reverse(R);
}
}else{
if(N>10){
R=[];
for(K=M-1;K>9;K++) R=cons(SV[floor(K/10)-1]+SV[K%10],R);
SV=append(SV,R);
}
for(Var=[],I=M-1;I>=0;I--) Var=cons(makev([SV[I]]),Var);
}
if(type(To=getopt(to))<2||type(To)>4) To=0;
if(Ord<0){ /* cancell y1, z1,... by baseODE0() */
if(Ord==-1) Ord=2;
if(type(To)==4||!isvar(To)){
L=L0=baseODE(L0|to=To,f=-3)[1];
To=0;
}
R=baseODE0(L|option_list=
delopt(getopt(),[["var",Var],["ord",Ord]]|inv=1));
if(TeX){
if(type(R)==4&&length(R)>1&&type(R[1])==4) R=R[1];
if(type(To)==2 && !isvar(To)){
S0=baseODE(L0|TeX=1,f=-1,to=To);
V=baseODE0(L|step=-1,to=To);
}else{
S0=baseODE(L0|TeX=1,f=-1);
V=baseODE0(L|step=-1,to=To);
}
T=eqs2tex(R,[V,2,Pages]);
S=((F==1)?(Tt+"\n"):S0)+texbegin("align*",T);
if(TeX==2) dviout(S);
return S;
}
return R;
}
if(To&&!isvar(To)){
if(type(To)!=4){
To=red(To);
for(K=0;K<length(Var);K++){
I=mydeg(nm(To),Var[K]);J=mydeg(dn(To),Var[K]);
if(I+J>0&&I<2&&J<2) break;
}
if(K==length(Var)) return -9;
J=To;
for(To=[],I=length(Var)-1;I>=0;I--)
if(I!=K) To=cons(Var[I],To);
To=cons(J,To);
}
if(type(To)==4){
if(type(car(To))==4){
R=1;To=car(To);
}else R=0;
if(type(IL=solveEq(To,Var|inv=1))!=4) return IL;
if(R==1){
R=To;To=IL;IL=R;
}
L=mulsubst(L,[Var,IL]|lpair=1);
if(!In){ /* X_i'=\sum_j(\p_{x_j}X_i)*x_j' */
for(TL=[],I=M-1;I>=0;I--){
P=To[I];Q=mydiff(P,t);
for(J=0;J<M;J++) Q=red(Q+mydiff(P,Var[J])*L[J]);
TL=cons(Q,TL);
}
L=TL;
}else{ /* x_i'=\sum_j(\p_{X_j}x_i)*X_j' */
for(I=M-1;I>=0;I--){
P=IL[I];Q=mydiff(P,t);
for(J=0;J<M;J++){
V=makev([SV[J],1]);
Q=red(Q+mydiff(P,V)*V);
}
L=mysubst(L,[makev([SV[I],1]),TL[I]]);
}
for(TL=L,L=[],I=M-1;I>=0;I--) L=cons(num(TL[I]),L);
}
}
}
if(F==-3&&!TeX) return [Var,L];
for(I=0;I<M;I++) L=subst(L,Var[I],makev([SV[I],0]));
if(TeX){
for(TL=L,I=0;I<M;I++)
TL=subst(TL,makev([SV[I],0]),Var[I]);
for(I=0;I<N;I++){
if(I) S0+=",\\\\\n";
if(In) S0+=" "+my_tex_form(TL[I])+"=0";
else S0+=" "+SV[I]+"'\\!\\!\\! &= "+my_tex_form(TL[I]);
}
S0+=".\n";
S0=texbegin("cases", S0);
S0=texbegin("align",S0);
if(type(Tt)==7) S0=Tt+"\n"+S0;
if(F<0){
if(TeX==2)dviout(S0);
return S0;
}
}
for(I=0,TL=[];L!=[];L=cdr(L),I++){
T=car(L);
if(!In) T=makev([SV[I],1])-T;
TL=cons(nm(red(T)),TL);
}
if(isvar(To)){
T=rtostr(To);
IT=findin(T,SV);
if(IT>=0 && IT<M){
R=[SV[IT]];
for(J=0;SV!=[];SV=cdr(SV),J++){
if(J==IT) continue;
R=cons(car(SV),R);
}
SV=reverse(R);
}else{
IT=0;
mycat(["Cannot find variable", T, "!\n"]);
}
}
for(S=1;S<M;S++){
L=append(TL,L);
TL=reverse(TL);
for(RL=[];TL!=[];TL=cdr(TL)){
if(In==0&&S==N-1&&length(TL)!=N-IT) continue;
T=car(TL);R=mydiff(V,t);
for(I=0;I<M;I++){
for(J=0;J<=S;J++){
V=makev([SV[I],J]|num=1);
if((DR=mydiff(T,V))!=0) R+=DR*makev([SV[I],J+1]|num=1);
}
}
RL=cons(R,RL);
}
TL=RL;
}
L=append(TL,L);
for(I=0;I<M;I++) L=subst(L,makev([SV[I],0]),Var[I]);
if(!isint(Vl=getopt(vl))) Vl=0;
if(!Vl||Vl==1){
V=[makev([SV[0]])];
for(VV=[],J=1;J<=M;J++)
V=cons(makev([SV[0],J]),V);
for(I=1;I<M;I++)
V=cons(makev([SV[I]]),V);
if(F==-2){
VV=cons(V,VV);
V=[];
}
for(I=1;I<M;I++){
for(J=1;J<M;J++) V=cons(makev((!Vl)?[SV[I],J]:[SV[J],I]),V);
if(In) V=cons(makev([SV[0],M]),V);
if(F==-2){
VV=cons(V,VV);
V=[];
}
}
}else{
for(V=VV=[],I=0;I<M;I++){
for(J=0;J<M;J++) V=cons(J?makev([SV[I],J]):makev([SV[I]]),V);
if(!I||In) V=cons(makev([SV[0],M]),V);
if(F==-2){
VV=cons(V,VV);
V=[];
}
}
}
if(F>=0&&!chkfun("gr",0)){
mycat("load(\"gr\"); /* <- do! */\n");
F=-1;
}
if(F==-2) return [VV,L];
if(F<0) return [V,L];
LL=(Hgr==1)?hgr(L,V,Ord):gr(L,V,Ord);
if(F==2) return [V,L,LL];
if(Ord==2) P=LL[0];
else{
P=LL[length(LL)-1];
for(RV=reverse(V), I=0;I<M+1;I++) RV=cdr(RV);
if(lsort(vars(P),RV,2)!=[]){
LL=tolex_tl(LL,V,Ord,V,2);P=LL[0];
}
}
if(TeX){
for(V0=[],I=1;I<=M;I++) V0=cons(makev([car(SV),I]),V0);
T=eqs2tex(P,[V0,2,Pages]);
if(!Vl||Vl==1){
for(I=1,K=0;I<length(LL);I++){
TV=makev([SV[I-K]]);
if(findin(TV,vars(LL[I]))<0){
K++;continue;
}
T+=eqs2tex(LL[I],[cons(TV,V0),2,Pages,1]);
}
}
S=((F==1)?(Tt+"\n"):S0)+texbegin("align*",T);
if(TeX==2) dviout(S);
return S;
}
return (F==1)? P:[P,V,L,LL];
}
def eqs2tex(P,L)
{
if(isvar(L)) L=[0,L];
if(type(L)!=4) L=[];
Sgn=0;
if(L!=[]){
if(car(L)==0) L=[L];
else if(length(L)>1 && isvar(L[1])) L=[L];
R=car(L);L=cdr(L);Sgn=1;
}else R=[];
if(type(R)==4&&car(R)==0){
Sgn=0;R=cdr(R);
}
if(L!=[]){
Dic=car(L);L=cdr(L);
}
if(L!=[]){
Pages=car(L);L=cdr(L);
}
if(L!=[]) Cont=car(L);
if(type(P)==4){
for(S="";P!=[];P=cdr(P)){
S+=eqs2tex(car(P),[R,Dic,Pages,Cont]);
if(!Cont) Cont=1;
}
/* S=str_subst(S,"\\\\&,\\\\",",\\\\&"); */
if(getopt(dviout)==1) dviout(S|eq=6);
return S;
}
if(type(R)==2) R=[R];
if(Sgn){
for(;R!=[];R=cdr(R))
if((Deg=mydeg(P,car(R)))>0) break;
if(Deg>0){
CP=mycoef(P,Deg,car(R));
if(cmpsimple(-CP,CP)<0) P=-P;
}
}
S="&\\!\\!\\!";
if(Cont)
S=(Pages?",\\allowdisplaybreaks":",")+"\\\\\n"+S;
S+=fctrtos(P|var=R,dic=Dic,TeX=3,pages=Pages);
if(getopt(dviout)==1) dviout(S|eq=6);
return S;
}
/* Opt: var, opt, dbg */
def res0(P,Q,X)
{
if(!isvar(X)){
if(!isvar(P)) return -1;
Y=P;P=Q;Q=X;X=Y;
}
if(isvar(Var=getopt(var))) Var=[Var];
else if(type(Var)!=4) Var=0;
if(type(W=getopt(w))!=4) W=[];
if(!isint(Opt=getopt(opt))&&type(Opt)!=4) Opt=0;
if(type(Dbg=getopt(dbg))==4){
Fct=Dbg[1];Dbg=Dbg[0];
}
if(!isint(Dbg)) Dbg=0;
P=nm(P);Q=nm(Q);
Fctr=isfctr(P)*isfctr(Q);
DP=deg(P,X);DQ=deg(Q,X);
if(DP==DQ&&nmono(coef(P,DP,X))<nmono(coef(Q,DQ,X))){
R=P;P=Q;Q=R;
R=DP;DP=DQ;DQ=R;
}
while(DQ>0){
if(DP<DQ){
R=P;P=Q;Q=R;
R=DP;DP=DQ;DQ=R;
if(Opt==-1) return [P,Q,DP,DQ];
if(DQ<1) break;
}
if(Dbg){
if(Dbg>=2) mycat([DP,"(",nmono(P), nmono(coef(P,DP,X)),") :",
DQ, "(",nmono(Q),nmono(coef(Q,DQ,X)), ")"]);
else mycat0([DP,":",DQ,","],0);
}
TQ=coef(Q,DQ,X);TP=coef(P,DP,X);
if(Fctr){
T=gcd(TP,TQ);M=red(TQ/T);
if(Var&&M!=car(W)&&type(TV=vars(M))==4&&lsort(TV,Var,2)!=[]) W=cons(M,W);
P=M*(P-coef(P,DP,X)*X^DP)-red(TP/T)*X^(DP-DQ)*(Q-coef(Q,DQ,X)*X^DQ);
if(Var){
#if 1
if(Dbg>2) mycat0(">",0);
for(S=SS=fctr(P),P=1,C=0;S!=[];S=cdr(S)){
TV=vars(S0=car(S)[0]);
if(type(TV)==4&&lsort(TV,Var,2)!=[]){
for(TW=W;TW!=[];TW=cdr(TW)){
if(gcd(car(TW),S0)!=1){
S0=1;break;
}
}
if(Dbg>1){
if(S0==1) mycat(["Reduced by :",nmono(car(TW))]);
else if(C++>0){
mycat(["Product :", nmono(P), nmono(S0)]);
if(Dbg==3){
if(!Fct||Fct==[]){
if(C>1) P=1;
}else{
if(car(Fct)==C){
C=10000;Fct=cdr(Fct);P=1;
}else S0=1;
}
}else if(Dbg==4) return [SS,Q,DP,DQ,W];
}
}
P*=S0;
}
}
#else
for(TW=W;TW!=[];TW=cdr(TW)){
if((C=gcd(P,car(TW)))!=1){
P=red(P/C);
if(Dbg>=2&&nmono(Q)>1) mycat(["Reduce :",nmono(C)]);
}
}
#endif
}
}else{
if(type(TQ)==1){
Q/=TQ;
P=P-TP*X^(DP-DQ)*Q;
}else P=TQ*P-TP*X^(DP-DQ);
if(deg(P,X)==DP) P-=coef(P,DP,X)*X^DP;
}
DP=deg(P,X);
if(Opt==-2||(type(Opt)==4&&Opt[0]==DP&&Opt[1]==DQ)) return [P,Q,DP,DQ,W];
}
if(Dbg){
if(Dbg>1) mycat([DP,"(",nmono(P), nmono(coef(P,DP,X)),") :",
DQ, "(",nmono(Q), nmono(coef(Q,DQ,X)), ")"]);
else mycat0([DP,":",DQ," "],0);
}
if(Opt==1) Q=[P,Q,DP,DQ,W];
return (DQ==0)?Q:0;
}
/* Opt : f, var, ord, ord, step, f, to */
def baseODE0(L)
{
if(!isint(Ord=getopt(ord))) Ord=-1;
if(Ord==-1) Ord=2;
if(Ord<O) Ord++;
if(!isint(F=getopt(f))) F=0;
if(!isint(Dbg=getopt(dbg))) Dbg=0;
if(type(Step=getopt(step))==4) Dstep=Step;
else Dstep=0;
if(!isint(Step)) Step=0;
if(F<0) Step=1;
if(Step>0&&Ord>0) Ord=-1;
N=length(L);
if(type(To=getopt(to))==4&&length(To)==N){
V=cdr(To);To=car(To);
}
if(!isvar(To)) To=V=0;
if(type(SV=Var=getopt(var))!=4){
SV=SVORG;
if(N>10){
R=[];
for(K=N-1;K>9;K++) R=cons(SV[floor(K/10)-1]+SV[K%10],R);
SV=append(SV,R);
}
for(Var=[],I=N-1;I>=0;I--) Var=cons(makev([SV[I]]),Var);
}
if((J=findin(To,Var))>0){
TV=TL=[];
for(I=N-1;I>=0;I--){
if(I!=J){
TV=cons(Var[I],TV);TL=cons(L[I],TL);
}
}
Var=cons(Var[J],TV);L=cons(L[J],TL);
}
if(!To) To=car(SV);
Q=car(L);
V0=makev([To,1]);
R=[V0-Q];V0=[V0];
for(I=2;I<=N;I++){
P=diff(t,Q);
if(type(P)==3) P=red(P);
for(TV=Var,TL=L;TV!=[];TV=cdr(TV),TL=cdr(TL)){
P+=diff(Q,car(TV))*car(TL);
if(type(P)==3) P=red(P);
}
Q=P;
TV=makev([To,I]);
R=cons(nm(TV-Q),R);
V0=cons(TV,V0);
}
if(Step==-1) return V0;
if(!V) V=cdr(Var);
if(Ord<0){
for(C=1,R0=[];V!=[];V=cdr(V),C++){
TR=R=reverse(R);
if(length(R)>1){ /* reduce common factor */
P=car(TR);TR=cdr(TR);
for(;TR!=[]&&P!=1;TR=cdr(TR))
P=gcd(P,car(TR));
if(P!=1){
for(TR=[];R!=[];R=cdr(R)) TR=cons(red(car(R)/P),TR);
R=reverse(TR);
}
}
TR=[];
TV=car(V);
if(length(V)==1) V0=[car(V0)];
if(C==Step) return [append(V,V0),R];
while(R!=[]&&findin(TV,vars(car(R)))<0){
TR=cons(car(R),TR);
R=cdr(R);
}
R0=(F==2)?append(R,R0):cons(car(R),R0);
if(R!=[]){
for(W=[],P=car(R),R=cdr(R); R!=[]; R=cdr(R)){
if(Dbg) mycat0(["\nStep ",C,"-",length(R)," ",TV,
(type(Dbg)==4||Dbg>=2)?"\n":" "],0);
if(findin(TV,vars(car(R)))<0){
TR=cons(car(R),TR);
continue;
}
if(Ord>-3){
if(Dstep&&Dstep[0]==C&&Dstep[1]==length(R))
return res0(P,car(R),TV|var=V0,opt=cdr(cdr(Dstep)),dbg=Dbg);
else TQ=res0(P,car(R),TV|var=V0,opt=1,dbg=Dbg,w=W);
if(Dbg==4&&type(car(TQ))==4) return TQ;
if(Ord==-2) P=car(TQ);
W=TQ[4];TQ=TQ[1];
}else{
TQ=res(TV,P,car(R));
Q=fctr(TQ); /* irreducible one */
for(TQ=1;Q!=[];Q=cdr(Q))
if(lsort(V0,vars(car(Q)[0]),2)!=[]) TQ*=car(Q)[0];
}
TR=cons(TQ,TR);
}
}
R=TR;
}
if(Dbg==1) mycat([]);
return (F==1)?car(R):(F==2?append(R,R0):cons(car(R),R0));
}
V=append(V,[makev([To,N])]);
if(Step==1) return [R,V];
R=gr(R,V,Ord);
return (F==1)?car(R):R; /* hgr(R,V,Ord); */
}
def taylorODE(D){
Dif=(getopt(dif)==1)?1:0;
if(D==0) return Dif?f:f_00;
if(type(T=getopt(runge))!=1||ntype(T)!=0) T=0;
if(type(F=getopt(f))!=7&&type(F)<2) F="f_";
if(type(D)!=1||ntype(D)!=0||D<0||D>30) return 0;
if(type(H=getopt(taylor))==4&&length(H)==2){
if(type(Lim=getopt(lim))==2) DD=D;
else if(type(Lim)==4){
DD=Lim[1];Lim=Lim[0];
}else Lim=0;
for(R=I=0;I<=D;I++){
if(I){
if(Lim) H0=mulpolyMod(H0,H[0],Lim,DD);
else H0*=H[0];
}else H0=1;
if(type(F)!=7) G=I?mydiff(G,x):F;
for(J=0;J<=D-I;J++){
if(J){
if(Lim) H1=mulpolyMod(H1,H[1],Lim,DD);
else H1*=H[1];
}else H1=H0;
if(type(F)==7) G=makev([F,I,J]);
else if(J) G=mydiff(G,y);
R+=G*H1/fac(I)/fac(J);
}
}
if(Lim) R=os_md.polcut(R,DD,Lim);
return R;
}else{
if(type(H=getopt(series))>=0||getopt(list)==1){
if(type(F)!=7){
for(PP=[F],I=1;I<D;I++)
PP=cons(mydiff(car(PP),x)+mydiff(car(PP),y)*F,PP);
if(type(H)<0) return PP;
for(R=0,DD=D;DD>=1;DD--,PP=cdr(PP)) R+=car(PP)*H^DD/fac(DD);
return red(R);
}
if(type(H)>=0) D--;
PP=taylorODE(D-1|list=1);
if(type(PP)!=4) PP=[PP];
P=car(PP);
}else P=taylorODE(D-1);
for(R=I=0;I<D;I++){
for(J=0;J<D-I;J++){
Q=diff(P,makev([F,I,J]));
if(Q!=0) R+=Q*(f_00*makev([F,I,J+1])+makev([F,I+1,J]));
}
}
if(getopt(list)==1){
R=cons(R,PP);
if(Dif!=1) return R;
}else if(type(H)>=0){
R=y+R*H^(D+1)/fac(D+1);
for(DD=D;DD>0;PP=cdr(PP),DD--) R+=car(PP)*H^(DD)/fac(DD);
if(T){
if(T<0){
Dif=0;TT=-T;
}else TT=T;
K=newvect(TT);K[0]=Dif?f:f_00;
if(getopt(c1)==1) K[0]=taylorODE(D|taylor=[c_1*H,0]);
for(I=1;I<TT;I++){
for(S=J=0;J<I;J++) S+=makev(["a_",I+1,J+1])*K[J];
K[I]=taylorODE(D|taylor=[makev(["c_",I+1])*H,S*H],lim=[H,D]);
}
for(S=I=0;I<TT;I++) S+=makev(["b_",I+1])*K[I];
S=S*H+y;
R=S-R;
if(T<0){
for(V=[H],I=0;I<=D;I++)
for(J=0;J<=D-I;J++) V=cons(makev([F,I,J]),V);
return os_md.ptol(R,reverse(V)|opt=0);
}
}else T=0;
}
}
if(Dif){
for(I=0;I<=D;I++){
for(J=0;J<=D;J++){
if(I==0&&J==0){
R=subst(R,f_00,f);
continue;
}
V=makev([F,str_times("x",I),str_times("y",J)]);
R=subst(R,makev([F,I,J]),V);
}
}
}
return R;
}
def toeul(F,L,V)
{
L = vweyl(L);
X = L[0]; DX = L[1];
I = mydeg(F,DX);
if(V=="infty"){
if(getopt(raw)!=1){
for(II=I; II>=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;
}
for(R=0 ; I >= 0; I--)
R += red(mysubst(mycoef(F,I,DX),[X,1/X])*(x*DX)^I);
return(subst(pol2sft(R,DX),DX,-DX));
}
F = subst(F,X,X+V);
if(getopt(raw)!=1){
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;
}
for(R = 0 ; 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;
}
if(getopt(raw)!=1){
R=nm(R);
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|opt_list=getopt()),[DX,DX+N]);
return fromeul(P,L,V|option_list=getopt());
}
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&&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)
{
if(isvar(V=getopt(var))&&length(P)>1&&isint(car(P))){
for(Q=[],I=car(P);I<=P[1];I++) Q=cons(makev([V,I]),Q);
P=Q;
}
R = 1;
while(length(P)){
R *= X-car(P);
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;I<N;I++){
MR[I]=mydeg(Q,V[I]);
Q=mycoef(Q,MR[I],V[I]);
}
if(type(Q)>1) return 0;
}
if(L==1){
for(I=0;I<N;I++)
P=mycoef(P,MR[I],V[I]);
return P;
}
for(I=1;I<N;I++){ /* sorted by required degrees */
for(K1=MR[I],K2=V[I],J=I-1; J>=0 && MR[J]<K1; J--);
for(II=I-1;II>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;I<NN;I++){
K=mydeg(R,V[I]);
R=mycoef(R,K,V[I]);
if(I<N) M[I]=K;
if(K>0) 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<Len;JL++){
if(L*Mon[JL][0]<MR[0]) break;
}
S[0]=L;
K0=Mon[0][0];
K=L*K0-MR[0];
for(I=II=0;II<Len && K>=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<Len; J++){
if(S[J]!=0){
if(T0==0 && J>=JL) return Coef;
JP=J;T0=1;
T+=S[J]*Mon[J][I];
}
}
if(T==MR[I]){
if(++I<N) continue;
for(TT=1,J=1; J<=L; J++) /* find a solution */
TT*=J;
for(J=0;J<Len;J++){
if(S[J]!=0){
TT*=Coe[J]^S[J];
for(II=S[J]; II>1; II--)
TT/=II;
}
}
Coef+=TT;
if(TP==1 && type(Coef)==3) Coef=red(Coef);
if(JP<Len-2 && S[JP]>1){
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(JP<Len-1)
S[JP+1]++;
else
S[JP]++;
}else{
S[JT]--;
S[JT+1]+=S[JP]+1;
S[JP]=0;
}
}
I=0;
continue;
}
if(JP<Len-1){
for(JP1=JP+1;JP1<Len-1;JP1++){
if(Mon[JP1][I]!=Mon[JP][I]) break;
}
if(I>0 && Mon[JP1][0] < Mon[JP][0]){
S[JP]--;S[Len-1]++;JP=JP-1;
}else{
S[JP]--;
if(JP1<Len){
S[JP1]++;
}else{
S[JP1-1]++;
}
}
}
if(JP==Len-1){
for(JT=JP-1;JT>=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 pmaj(P)
{
if(type(P)==4){
Opt=getopt(var);
Opt=(isvar(Opt))?[["var",Opt]]:[];
for(Q=[];P!=[];P=cdr(P)) Q=cons(pmaj(car(P)|option_list=Opt),Q);
if(Opt==[]) return reverse(Q);
X=Opt[0][1];
D=mydeg(Q,X);
for(S=0;D>=0;D--) S+=lmax(mycoef(Q,D,X))*X^D;
return S;
}
V=vars(P);
Y=getopt(var);
Abs=(Y==1)?1:0;
if(!(K=length(V))) return Y==1?1:abs(P);
for(R=0,D=deg(P,X=V[0]);D>=0;D--){
Q=coef(P,D,X);
if(Q!=0) R+=((type(Q)>1)?pmaj(Q|var=Abs):(Y==1?1:abs(Q)))*X^D;
}
if(isvar(Y)) for(;V!=[];V=cdr(V)) R=subst(R,car(V),Y);
return R;
}
def prehombf(P,Q)
{
if((Mem=getopt(mem))!=1 && Mem!=-1)
return prehombfold(P,Q);
if(Q==0) Q=P;
V=ltov(vars(P));
N=length(V);
for(I=1;I<N;I++){ /* sorted by required degrees */
for(K=mydeg(P,V[I]),K1=V[I],J=I-1; J>=0 && mydeg(P,V[J])<K; J--);
for(II=I-1;II>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;I<N;I++){ /* extreme vector */
Deg+=(S[I]=mydeg(R,V[I]));
R=mycoef(R,S[I],V[I]);
}
DR=[[-1,0]];
if((R1=N/Deg)!=1){
DR=cons([-R1,0],DR);
Sft=1;
}else Sft=0;
if(Deg%2==0) Sg=1;
else Sg=-1;
for(I=0,R=R2=1,QQ=Q; 2*I+Sft < Deg; I++){
if(Mem==-1){
print(I+1,0);print("/",0);print(idiv(Deg-Sft+1,2),0);print(" ",2);
}
Coef=0;
Q=QQ;
while(Q!=0){
for(R=Q,J=0,RR=1;J<N;J++){
T[J]=mydeg(R,V[J]);
R=mycoef(R,T[J],V[J]);
if(T[J]>0) RR*=V[J]^T[J];
}
Q-=R*RR;
for(J=0,CC=R;J<N;J++){
U[J]=I*S[J]+T[J];
for(II=0; II<T[J]; II++)
CC*=(U[J]-II);
}
CC*=pcoef(P,I+1,[V,U]);
if(Mem==-1) print("*",2);
Coef+=CC;
}
DR=cons([I,Coef],DR);
DR=cons([-R1-1-I,Sg*Coef],DR);
if(Mem==-1) print("");
}
P = polbyvalue(DR,s);
return fctr(P);
}
def prehombfold(P,Q)
{
V = vars(P);
if(Q==0) Q=P;
for(Deg=0, R=P, V1=V, DD=[]; V1!=[]; V1=cdr(V1)){
VT = car(V1);
D = mydeg(R,VT);
R = mycoef(R,D,VT);
Deg += D;
X = makev(["d",VT]);
Q = subst(Q,VT,X);
DD=cons([VT,X],DD);
}
DR=[[-1,0]];
NV=length(V);
if((R1=NV/Deg)!=1){
DR=cons([-R1,0],DR);
Sft=1;
}else
Sft=0;
if(Deg%2==0)
Sg=1;
else Sg=-1;
for(I = 0, R=R2=1; 2*I+Sft < Deg; I++){
R = R2;
R2 = R*P;
S = appldo(Q,R2,DD);
QQ = sdiv(S,R);
DR=cons([I,QQ],DR);
DR=cons([-R1-1-I,Sg*QQ],DR);
}
P = polbyvalue(DR,s);
return fctr(P);
}
def sub3e(P0,P1,P2,N0,N1,N)
{
R = x^N0*(x-1)^N1*dx^N;
for(V = I = 1, J = 1; I <= N; I++){
S = 0;
M = N-I;
if(I <= N0){
T = mycoef(P0,N0-I,x);
S += T;
R += T*x^(N0-I)*(x-1)^N1*dx^M;
K1 = N0-I+1;
}else
K1 = 0;
if(I <= N1){
T = mycoef(P1,N1-I,x);
S += T;
R += T*x^N0*(x-1)^(N1-I)*dx^M;
K2 = N0-1;
}else
K2 = N-I;
for(K = K1; K <= K2; K++){
if(K == K2){
R += (mycoef(P2,N-I,x)-S)*x^K*(x-1)^(M-K)*dx^M;
continue;
}
R += strtov("r"+rtostr(V))*x^K*(x-1)^(M-K)*dx^M;
S += strtov("r"+rtostr(V++));
}
}
if(V > 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 etos(P,L,M)
{
L=vweyl(L);
if(!(D=mydeg(P,L[1]))) return 0;
R=mgen(D,"highdiag",[1],0);
T=mycoef(P,D,L[1]);
for(I=0;I<D;I++) R[D-1][I]=-red(mycoef(P,I,L[1])/T);
if(M==1) return R;
if(type(M)==4 && length(M)==D) M=diagm(D,M);
N=red(mydiff(M,L)+M*R);
return red(N*myinv(M));
}
def stoe(M,L,N)
{
L = vweyl(L);
Size = size(M);
S = Size[0];
NN = -1;
if(type(N) == 4){
NN=N[0]; N=N[1];
if(N==NN) return 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[S]=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<M; I++){
RT=rmul(car(LL)[0],mydiff(car(LL)[1],X[I]));
R[I] = (R[I]==0)?RT:radd(R[I],RT);
}
}
Dif=getopt(dif);
for(RR=[], I=M-1; 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<M; I++){
for(J=I+1; J<M; J++, K++){
if(LL==L) S[K]=[X[I],X[J]];
LT=car(LL);
R1=mydiff(LT[2],X[J]);
R2=mydiff(-LT[2],X[I]);
if(R2==0){
if(R1==0) continue;
R1=rmul(mydiff(LT[1],X[I]),R1);
}else if(R1==0){
R1=rmul(mydiff(LT[1],X[J]),R2);
}else
R1=rmul(mydiff(LT[1],X[I]),R1)+rmul(mydiff(LT[1],X[J]),R2);
R1=rmul(LT[0],R1);
R[K] = (R[K]==0)?R1:radd(R[K],R1);
}
}
}
for(RR=[],I=N-1; 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((T=type(X))==4||T==5) return map(os_md.calc,X,L);
if(type(L)==4){
V=L[1];
if((L0=L[0])==">") X=(X>V);
else if(L0=="<") X=(X<V);
else if(L0=="=") X=(X==V);
else if(L0==">=") X=(X>=V);
else if(L0=="<=") X=(X<=V);
else if(L0=="!=") X=(X!=V);
else if(type(X)==6 || type(X)<4){
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;
}
return X;
}
if(type(L)!=7||T>7||T==4||T==5) return X;
if(L=="neg") X=-X;
else if(L=="sqr") X*=X;
else if(L=="inv"){
if(T==6) X=myinv(X);
else X=1/X;
}else if(T==6) return X;
if(L=="abs") X=abs(X);
else if(L=="sgn"){
if(X>0) X=1;
else if(X<0) X=-1;
}
return X;
}
def tobig(X)
{
if((type(X)==1 && ntype(X)==3)||type(X)>3) return X;
return eval(X*exp(0));
}
def isint(X)
{
if(X==0||(type(X)==1 && ntype(X)==0 && dn(X)==1)) return 1;
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]!="" && V<C[2][0]) break;
if(C[2][1]!="" && V>C[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;I<K;I++)
if((*FN)(M[I])==0) return 0;
}else if(type(M)==6){
K=size(M)[0];
for(I=0;I<K;I++)
if (isall(FN,M[I])==0) return 0;
}
return 1;
}
def sproot(MP,T)
{
if((I=str_chr(T,0,","))>0){
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; K<NP; K++) LM[K]=length(M1[K]);
for(I=0,TM=M; TM!=[]; I++, TM=cdr(TM)){
V=newvect(NP);
for(K=0; K<NP; K++) V[K]=newvect(LM[K]);
TP=car(TM);
if(TP[2]==0){
for(K=0;K<NP;K++) V[K][0]=1;
for(J=0; J<I; J++){
VJ=R[J][1];
for(S=K=0;K<NP;K++) S+=VJ[K][0];
for(OD=0,K=0;K<LM[0];K++) OD+=VJ[0][K];
S-=(NP-2)*OD;
for(K=0;K<NP;K++) VJ[K][0]-=S;
}
}else{
K=TP[1]; P=TP[2];
V[K][P-1]=-1; V[K][P]=1;
for(J=0; J<I; J++){
VJ=R[J][1];
S=VJ[K][P]; VJ[K][P]=VJ[K][P-1]; VJ[K][P-1]=S;
}
}
R[I]=[TP[0],V];
}
if(T=="pair"||T=="pairs"){
MV=ltov(M1);
for(K=0; K<NP; K++) MV[K] = ltov(MV[K]);
for(RR=UU=SS=[],I=0; I<length(M); I++){
V=newvect(NP); W=newvect(NP); U=newvect(NP);
for(K=0; K<NP; K++){
U[K]=newvect(LM[K]); V[K]=newvect(LM[K]); W[K]=newvect(LM[K]);
}
S=R[I][0];
if((Sym=getopt(sym))!=1||Sym!=2) Sym=0;
if(Sym){ /* symmetry */
for(K=C;K<NP;K++){
if(Sym==1 && K>0 && MV[K]==MV[K-1] && R[I][1][K]>R[I][1][K-1]){
K=NP+1;break;
}
for(J=1; J<LM[K]; J++){
if(MV[K][J]==MV[K][J-1] && R[I][1][K][J]>R[I][1][K][J-1]){
K=NP+1;break;
}
}
}
if(K>=NP+1) continue;
}
for(K=0; K<NP; K++){
for(Q=J=0; J<LM[K]; J++){
V[K][J] = S*(U[K][J] = R[I][1][K][J]);
Q+=(W[K][J] = MV[K][J] - V[K][J]);
}
}
if(Q>0 && iand(Only,1)==0) continue;
if(Q==0 && iand(Only,2)==0) continue;
if(Q<0 && iand(Only,4)==0) continue;
for(K=0; K<NP; K++){
V[K] = vtol(V[K]); W[K] = vtol(W[K]); U[K]=vtol(U[K]);
}
V=vtol(V); W=vtol(W);U=vtol(U);
if(Q<0) S=-S;
RR = cons([V,W], RR); UU = cons(U,UU); SS=cons(S,SS);
}
RR = reverse(RR); UU=reverse(UU); SS=reverse(SS);
if(getopt(dviout)==1 && (Null!=1 || RR!=[])){
Out=string_to_tb("\\begin{align}\\begin{split}"+s2sp(M1)+"&=");
for(I=0,R=RR, U=UU; R!=[]; I++, R=cdr(R), U=cdr(U)){
if(I>0) 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; I<length(M); I++){
for(K=0; K<NP; K++) R[I][1][K] = vtol(R[I][1][K]);
R[I] = [R[I][0],vtol(R[I][1])];
}
R = vtol(R);
return [M0,M1,R];
}
}
def spgen(MO)
{
Eq=(getopt(eq)==1)?1:0;
Sp=getopt(sp);
if(type(Sp)==7) Sp=s2sp(Sp);
St=getopt(str);
LP=getopt(pt);
F=getopt(std);
if(F!=1&&F!=-1) F=0;
if(type(LP)==4){
L0=LP[0]; L1=LP[1];
}else if(type(LP)==1){
L0=L1=LP;
}else{
L0=0; L1=MO+1;
}
if(M0<=0){
MO=-MO;
if(iand(MO,1)==1) return [];
MO=MO/2;
B=spbasic(-2*MO,0|str=1);
if(L1<3) L1=MO+4;
if(St!=1){
for(R=[]; B!=[]; B=cdr(B)){
RT= F?s2sp(car(B)|std=F): s2sp(car(B));
if(length(RT)<L0 || 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)<L0 || length(RT)>L1) continue;
if(F) T=s2sp(s2sp(T|std=K));
R=cons(T,R);
}
return reverse(R);
}
}
MP=(L1<MO+1)?L1:MO+1;
LL=newvect(MO+1);
R=newvect(MP+2);
R0=newvect(MP+2);
for(I=1; I<=MO; I++) LL[I]=[];
if(type(Sp)==4){
if(getopt(basic)==1) Sp=chkspt(Sp[6]);
R=chkspt(Sp);
if(R[1]>MO) return 0;
LL[R[1]]=R;
K=R[1];
}
if(K==1||type(Sp)!=4){
LL[1]=[[[1]]];
for(I=2; I<=MO && I<MP;I++){
for(T=[], J=0; J<I+1; J++)
T=cons([I-1,1],T);
LL[I]=cons(T,LL[I]);
}
K=2;
}
for(OD=K; OD<MO; OD++){
for(LT=LL[OD]; LT!=[]; LT=cdr(LT)){
for(II=0,L=car(LT); L!=[]; II++, L=cdr(L)){
R0[II]=R[II]=car(L);
}
for(; ;){
for(S=-2*OD, I=0; I<II; I++){
S += OD;
if(R[I]!=[]) S-=car(R[I]);
}
--I;
for(;S+OD<=MO && I<=MP;S+=OD,I++){
if(S<=0) continue;
for(J=0;J<=I;J++){
if(J>=II){
if(S<OD) break;
}else
if(S+((R[J]==[])?0:car(R[J]))<car(R0[J])) break;
}
if(--J>=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; K++){
if(R[K]!=[]){
S=car(R[K]);
while((R[K]=cdr(R[K]))!=[] && car(R[K])==S);
break;
}else R[K]=R0[K];
}
if(K>=II) break;
}
}
}
if(L0>0 || L1<MO+1 || St==1 || F){
for(J=1; J<=MO; J++){
for(RT=[],R=LL[J];R!=[];R=cdr(R)){
L=length(T=car(R));
if(L<L0 || L>L1) 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 spbasic(Idx,D)
{
/*
D<=3|Idx|+6, D<=|Idx|+2 (p>3), p<=|Idx|/2+4
Idx=2*D^2-(D^2-\sum m_{j,\nu}^2); \sum(D-m_{j,1})>=2*D;
\sum (m_{j,1)-m_{j,\nu})*m_{j,\nu)
0<=(2*D-\sum(D-m_{j,1})})*D=\sum_(m_{j,1}-m_{j,\mu})*m_{j,\nu} -|Idx|
(-2,0) 13個 (9+3+?)
(-4,0) 37個 (25+9+?)
(-6,0) : 8.5sec ?sec 0.05sec 69個 (46+17+?)
(-8,0) : 97 sec 1sec 0.13sec 113個 (73+29+?) <- (-2,0)
(-10,0): 4sec 0.27sec 198個 (127+50+?)
(-12,0) 28sec 4.2sec 0.64sec 291個 (182+76+?)
(-14,0) 27sec 10.2sec 1.31sec 415個 (249+115+?)
(-16,0) 34.0sec 2.47sec 647個 (395+172+?) <- (-4,0)
(-18,0) 4.42sec 883個 (521+243+?) <- (-2,0)
(-20,0) 8.17sec 1186個 (680+345+?)
*/
Idx=-Idx;
if((Str=getopt(str))!=1) Str=0;
if(!isint(Idx)||!isint(Idx/2)||Idx<0||!isint(D)||D<0||D==1||D>3*Idx+6) return [];
if(D==0){
for(R=[],D=3*Idx+6;D>=2;D--) R=append(spbasic(-Idx,D|str=Str),R);
return R;
}
if(!Idx){
R=0;
if(D==2) R="11,11,11,11";
if(D==3) R="111,111,111";
if(D==4) R="22,1111,1111";
if(D==6) R="33,222,111111";
if(!R) return [];
return [(Str==1)?R:s2sp(R)];
}
if(D>Idx+2){
L=3;
if(D==3*Idx+6){
R=[[D/2,D/2],[D/3,D/3,D/3],[D/6,D/6,D/6,D/6,D/6,D/6-1,1]];
return [(Str==1)?s2sp(R):R];
}
if(iand(D,1)&&(D-3)/2>Idx) return [];
}else L=Idx/2+4;
V=newvect(L);SV=newvect(L);
for(S1=[],I=0;I<D;I++) S1=cons(1,S1);
for(T=D-1;T>1;T--){
K=D%T;
if((T-K)*K<=Idx) break;
}
J=(T-K)*K;SJ=K^2+(D-K)*T;
TV=K?[K]:[];
for(I=(D-K)/T;I>0;I--) TV=cons(T,TV);
for(I=0;I<L;I++){
SV[I]=2*D^2-(I+1)*(D^2-J)-Idx;
V[I]=TV;
}
if(SV[2]>0) return [];
if(D>Idx+2 && V[0][0]+V[1][0]>=D && V[1][0]>1){
T=V[1][0]-1;K=D%T;TV=K?[K]:[];
for(I=(D-K)/T;I>0;I--) TV=cons(T,TV);
V[1]=V[2]=TV;
}
for(R=[];;){
if(D>Idx+2){
if(3*V[0][0]<D) break;
if(V[0][0]+V[1][0]>=D && (T=D-V[0][0]-1)>0){
K=D%T;TV=K?[K]:[];
for(I=(D-K)/T;I>0;I--) TV=cons(T,TV);
V[1]=V[2]=TV;
}
S2=V[0][0]+V[1][0]+V[2][0]-D;
if(V[0][0]+2*V[1][0]<D ||(S2<0&&V[1][0]==1) ){
V[0]=V[1]=V[2]=nextpart(V[0]);
T=V[0][0];
T=D-2*T;
if(T==0){
V[1]=[D/2-1,1];
V[2]=S1;
}else if(T>0){
J=D%T;
K=J?[J]:[];
for(J=(D-J)/T;J>0;J--) K=cons(T,K);
V[2]=K;
}
continue;
}
if(S2<0||V[2][0]<=S2){
V[1]=V[2]=nextpart(V[1]);
continue;
}else if(S2>0){
T=V[2][0]-S2;J=D%T;
K=J?[J]:[];
for(J=(D-J)/T;J>0;J--) K=cons(T,K);
V[2]=K;
}
}
for(S=-2*D,IL=0;IL<L;IL++){
S+=D-car(V[IL]);
if(S>=0) break;
}
if((I=IL)==L){ /* reducible i.e. IL=L && S<0 */
for(LL=L-1;LL>=0;LL--){
if((K=car(V[LL]))+S>0){
K+=S;
for(TV=[],TD=D;TD>=K;TD-=K) TV=cons(K,TV);
if(TD>0) V[LL]=append(TV,[TD]);
else V[LL]=TV;
break;
}else{
S+=K-1;
V[LL]=S1;
}
}
if(LL<0) break;
continue;
}
for(S0=K=0;K<=IL;K++){
ST=car(V[K]);J=V[K][length(V[K])-1];S0+=(ST-J)*J;
if(S0>Idx) break;
}
if(S0>Idx && car(V[K])!=1){
ST=car(V[K]);
S0-=(ST-J)*J;
for(ST--;ST>0;ST--){
J=D%ST;
if(S0+(ST-J)*J <= Idx) break;
}
V[K]=J?[J]:[];
for(J=D-J;J>0;J-=ST) V[K]=cons(ST,V[K]);
for(J=K+1;J<L;J++) V[J]=V[K];
continue;
}
for(K=SS=0;K<L&&SS<=Idx;K++){
ST=car(V[K]);
for(S0=0,TV=cdr(V[K]);TV!=[];TV=cdr(TV)) S0+=(ST-car(TV))*car(TV);
SS+=S0;
}
if(SS>Idx && K<=IL && K!=L){
SS0=Idx-SS+S0;
for(TV=car(V[K]);TV>1;TV--){
U=D%TV;
if((D-U)*U<=SS0) break;
}
if(TV==car(V[K])){
K=K-1;
V[K]=nextpart(V[K]); /* to be improves */
}else{
V[K]=U?[U]:[]; /* to be improved */
for(J=D-U;J>0;J-=TV) V[K]=cons(TV,V[K]);
}
for(J=K+1;J<L;J++) V[J]=V[K];
continue;
}
for(Ix=2*D^2+Idx,J=0;J<L;J++){
IxF=Ix;
for(Ix-=D^2,TV=V[J];TV!=[];TV=cdr(TV)) Ix+=car(TV)^2;
if(Ix<=0) break;
}
if(Ix==0&&(J>=I||IL==2)){
for(TR=[],K=J;K>=0;K--) TR=cons(V[K],TR);
R=cons((Str==1)?s2sp(TR):TR,R);
}
if(J>=0 && J<L && Ix<=0){
I=V[J][0];K=D%I;S0=(D-K)*I+K^2;
if(I>1&& IxF-D^2+S0<0){
for(V[J]=[],K=D-I;K>0;K--) V[J]=cons(1,V[J]);
V[J]=cons(I,V[J]);
V[J]=nextpart(V[J]);
for(I=J+1;I<L;I++) V[I]=V[J];
continue;
}
}
if(J>=0 && J<L && Ix<=0 && car(V[J])>(U=V[J][length(V[J])-1])+1){
TV=reverse(V[J]);
for(S0=0,K=[];TV!=[];TV=cdr(TV),S0++){
if((I=car(TV))<U+2||(length(TV)>1&&S0<2)){
while(I-->0) K=cons(1,K);
}else K=cons(car(TV),K);
}
V[I=J]=K;
}else{
if(J>=L) J=L-1;
for(I=J;I>=0&&length(V[I])==D;I--);
if(I<0) break;
}
V[I]=nextpart(V[I]); /* to be improved */
for(J=I+1;J<L;J++) V[J]=V[I];
}
return R;
}
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&&Opt!="idx"){
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);
}
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){
if(getopt(dumb)!=1) print("irregal partitions");
return -1;
}
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(Opt=="idx") return SSM;
if(SM > SMM && SM != 2*OD){
if(getopt(dumb)!=1) print("not realizable");
return 0;
}
if(JM==1 && Mat!=1)
Fu -= OD - SSM/2;
return [P, OD, SSM, Fu, SM, XM, fspt(M,1)];
}
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]<M || 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){ */ /* rigid */
/* 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;
if(Mat==0 && type(SM=getopt(slm))==4){
SM0=SM[0];SM1=anal2sp(SM[1],["*",-1]);
if(findin(0,SM0)>=0){
for(SM=[],I=length(G)-1;I>0;I--)
if(findin(I,SM0)<0) SM=cons(I,SM);
SM=[SM,SM1];
G=mcgrs(G,R|mat=1,slm=SM);
return [G[0],anal2sp(G[1],["*",-1])];
}
}else SM0=0;
for(R = reverse(R) ; R != []; R = cdr(R)){
GN = [];
L = length(G)-1;
RT = car(R);
if(type(RT) == 4){
if(length(RT)==L+1&&RT[0]!=0){
R=cons(cdr(RT),cdr(R));
R=cons(RT[0],R);
R=cons(0,R);
continue;
} /* addition */
RT = reverse(RT); S = ADS = 0;
for(G = reverse(G); G != []; G = cdr(G), L--, RT=cdr(RT)){
AD = car(RT);
if(L > 0){
S += AD;
if(SM && findin(L,SM0)>=0) ADS+=AD;
}else
AD = -S;
for(GTN = [], GT = reverse(car(G)); GT != []; GT = cdr(GT))
GTN = cons([car(GT)[0],car(GT)[1]+AD], GTN);
GN = cons(GTN, GN);
}
G = GN;
if(SM0){
for(ST=reverse(SM1),SM1=[]; ST!=[]; ST=cdr(ST))
SM1 = cons([car(ST)[0],car(ST)[1]+ADS], SM1);
}
continue;
}
if(RT==0) continue;
VP = newvect(L+1); GV = ltov(G); /* middle convolution */
for(I = S = OD = 0; I <= L; I++){
RTT = (I==0)?(Mat-RT):0;
VP[I] = -1;
for(J = M = K = 0, GT = GV[I]; GT != []; GT = cdr(GT), J++){
if(I == 0)
OD += car(GT)[0];
if(car(GT)[1] == RTT && car(GT)[0] > M){
S += car(GT)[0]-M;
M=car(GT)[0];
VP[I] = J;
}
}
}
S -= (L-1)*OD;
for(GN = []; L >= 0; L--){
GT = GV[L];
RTT = (L==0)?(-RT):RT;
GTN = (VP[L]>=0 || S == 0)?[]:[[-S,(L==0)?(Mat-RT):0]];
for(J = 0; GT != []; GT = cdr(GT), J++){
if(J != VP[L]){
GTN = cons([car(GT)[0],car(GT)[1]+RTT], GTN);
continue;
}
K = car(GT)[0] - S;
if(K < 0){
print("Not realizable");
return;
}
if(K>0) GTN = cons([K,(L==0)?(Mat-RT):0], GTN);
}
GN = cons(reverse(GTN), GN);
}
if(SM0&&RT!=0){
for(M0=M1=-OD,L=length(G)-1;L>=0;L--){
if(findin(L,SM0)>=0){
M0+=OD;
if(VP[L]>=0) M0-=GV[L][VP[L]][0];
}else{
M1+=OD;
if(VP[L]>=0) M1-=GV[L][VP[L]][0];
}
}
SM2=[];
if((Mx1=anal2sp(SM1,["max",1,-RT])[0])<0){
if(M1>0) SM2=cons([M1,0],SM2);
}else M1+=car(SM1[Mx1]);
if((Mx0=anal2sp(SM1,["max",1,0])[0])<0){
if(M0>0) SM2=cons([M0,RT],SM2);
}else M0+=car(SM1[Mx0]);
for(J=0;SM1!=[];J++,SM1=cdr(SM1)){
if(J==Mx0){
if(M0>0) SM2=cons([M0,-RT],SM2);
}else if(J==Mx1){
if(M1>0) SM2=cons([M1,0],SM2);
}else SM2=cons([car(SM1)[0],car(SM1)[1]+RT],SM2);
}
SM1=reverse(SM2);
}
G = cutgrs(GN);
}
return SM0?[G,SM1]:G;
}
def spslm(M,TT)
{
R=getbygrs(M,1|mat=1);
if(type(R)!=4||type(R[0])!=4||type(S=R[0][1])!=4){
errno(0);return0;
}
if(S[1]!=[[1,0]]){
print("Not rigid!");return0;
}
if((F=S[0][0][1])!=0){
for(V=vars(F);V!=[];V=cdr(V)){
if(mydeg(F,car(V))==1){
T=lsol(F,car(V));
break;
}
}
if(V==[]){
print("Violate Fuchs condition!");
return0;
}
}
for(P=[];R!=[];R=cdr(R))
P=cons(car(R)[0],P);
if(F!=0){
S=mysubst(S,[car(V),T]);P=mysubst(P,[car(V),T]);
}
return mcgrs(S,P|mat=1,slm=[TT,[[1,0]]]);
}
/*
F=0 : unify
F=["add",S] :
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=["max"] :
F=["max",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<L;J++){
for(I=0;I<J;I++){
if(cdr(R[I])==cdr(R[J])){
R[I]=cons(R[I][0]+R[J][0],cdr(R[I]));
R[J]=cons(0,cdr(R[J]));
break;
}
}
}
for(G=[],I=L-1;I>=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;I<L;I++){
for(J=I;J>0;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<S2) break;
}
S=R[J-1];R[J-1]=R[J];R[J]=S;
}
}
G=vtol(R);
}
return G;
}
if(F[0]=="add") return append(R,F[1]);
if(F[0]=="max"){
if(length(F)==3) C=1;
else C=0;
M=-10^10;K=[-1];
for(I=0;R!=[];R=cdr(R),I++){
if(C>0&&car(R)[F[1]]!=F[2]) continue;
if(M<car(R)[0]){
M=car(R)[0];K=[I,car(R)];
}
}
return K;
}
R=reverse(R);
if(F[0]=="sub"){
for(S=F[1];S!=[];S=cdr(S))
R=cons(cons(-car(S)[0],cdr(car(S))),R);
return reverse(R);
}
if(F[0]=="swap"){
for(G=[];R!=[];R=cdr(R))
G=cons([car(R)[0],car(R)[2],car(R)[1]],G);
return G;
}
if(F[0]=="+"){
L=length(F);
for(G=[];R!=[];R=cdr(R)){
for(S=[],I=L-1;I>0;I--) S=cons(car(R)[I]+F[I],S);
G=cons(cons(car(R)[0],S),G);
}
return G;
}
if(F[0]=="*"){
L=length(F);
for(G=[];R!=[];R=cdr(R)){
for(S=0,I=1;I<L;I++) S+=car(R)[I]*F[I];
G=cons([car(R)[0],S],G);
}
return G;
}
if(F[0]=="mult"){
K=F[1];
for(G=[];R!=[];R=cdr(R)) G=cons(cons(K*car(R)[0],cdr(car(R))),G);
return G;
}
if(F[0]=="get"){
for(G=[];R!=[];R=cdr(R))
if(car(R)[F[1]]==F[2]) G=cons(car(R),G);
return G;
}
if(F[0]=="put"){
if(F[1]==1){
for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],F[2],car(R)[2]],G);
}else{
for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],car(R)[1],F[2]],G);
}
return G;
}
if(F[0]=="get1"){
if(length(F)==2){
for(G=[];R!=[];R=cdr(R)) G=cons([R[0][0],car(R)[F[1]]],G);
return G;
}
for(G=[];R!=[];R=cdr(R))
if(car(R)[F[1]]==F[2]) G=cons([R[0][0],car(R)[3-F[1]]],G);
return G;
}
if(F[0]=="put1"){
if(length(F)==1)
for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],car(R)[1],car(R)[1]],G);
else if(F[1]==1)
for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],F[2],car(R)[1]],G);
else{
for(G=[];R!=[];R=cdr(R)) G=cons([car(R)[0],car(R)[1],F[2]],G);
}
return G;
}
if(F[0]=="val"){
V=(length(F)==1)?1:F[1];
for(I=J=0;R!=[];R=cdr(R)){
I+=car(R)[0];
J+=car(R)[0]*car(R)[V];
}
return [I,J];
}
return 0;
}
/*
G=0 get trivial common spct
G="..,..," spectre type of 4 singular points
P=["get"] all spct
P=["get",L]
L=n for variable x_n
L=[m,n] for residue [m,n]
L=[m,n,l] for residue [m,n,l]
L=[[m,n],[m',n']] for common spct
P=["eigen",I] decomposition of A_I
P=["get0",[m,n],[m',n']] for the sum of residues
P=["rest",[m,n]] restriction
P=["swap",[m,n]] for symmetry
P=["perm",[...]] for symmetry
P=["deg"]
P=["homog"]
P=["sort"]
P=[[[m,n],c],...] for addition
P=[c] or [[c],...] for middle convolution wrt 0
P=[m,c] or [[m,c],...] for general middle convolution
P=[[a,b,c]] for special additions
P=[[d,a,b,c]] for middle convotution and additions
P=["multi",...] multiple commands
P=0,1,3 : return sim. spectre of 4 singular points
*/
def mc2grs(G,P)
{
if(G==0){
G=[];
for(I=4;I>=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||(type(P[0])==4&&length(P[0])==2&&type(P[0][0])<4&&type(P[1])<4))
)) P=[P];
if((Dvi=getopt(dviout))!=1&&Dvi!=2&&Dvi!=-1) Dvi=0;
Keep=(Dvi==2)?1:0;
if(type(P)==4&&type(F=car(P))==7){
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"){
if(type(Fig=getopt(fig))>0){
PP=[[-1.24747,-5.86889],[1.24747,-5.86889],[3.52671,-4.8541],[5.19615,-3],
[5.96713,-0.627171],[5.70634,1.8541],[4.45887,4.01478],[2.44042,5.48127],
[0,6],[-2.44042,5.48127],[-4.45887,4.01478],[-5.70634,1.8541],
[-5.96713,-0.627171],[-5.19615,-3],[-3.52671,-4.8541]];
PL=[[1.8,-5.2],[5.7,-1.7],[3.2,5],[-3.6,4.7],[2.2,3],[-2.8,2.8],
[-1.5,-1.4],[-3.2,-2.5],[0.76,-1.4],[-2,0.2]];
PC=["black,dashed","green,dashed","red,dashed","blue,dashed",
"black","cyan","green","blue","red","magenta"];
N=["1","2","3","4","5","6","7","8","9","a","b","c","d","e","f"];
LL=[[1,2,3],[4,5,6],[7,8,9],[10,11,12],[7,10,13],[4,11,14],[5,8,15],[1,12,15],
[2,9,14],[3,6,13]];
TB=str_tb("\\draw\n",TB);
if(type(Fig)==4){
if(type(car(Fig))==1){
PP=ptaffine(car(Fig)/12,PP);PL=ptaffine(car(Fig)/12,PL);
Fig=cdr(Fig);
}
if(Fig!=[]&&length(Fig)==10) PC=Fig;
}
for(R=mc2grs(G,"show0"|dviout=-1),I=0;R!="";I++){ /* 頂点 */
J=str_chr(R,0,",");
if(J>0){
S=str_cut(R,0,J-1);
R=str_cut(R,J+1,1000);
}else{
S=R;R="";
}
T=(str_chr(S,0,"1")==0)?"":"[red]";
str_tb(["node",T,"(",N[I],") at ",xypos(PP[I]),"{$",S,"$}\n"],TB);
}
for(S=PC,P=PL,I=0;I<4;I++){
for(J=I+1;J<5;J++,S=cdr(S),P=cdr(P)){ /* 線の番号 */
SS=car(S);
if((K=str_chr(SS,0,","))>0) SS=sub_str(SS,0,K-1);
str_tb(["node[",SS,"] at ",xypos(car(P)),
"{$[",rtostr(I),rtostr(J),"]$}\n"],TB);
}
}
str_tb(";\n",TB);
for(I=0;I<10;I++){ /* 線 */
S=car(PC);P0=car(PC);L0=car(LL);PC=cdr(PC);LL=cdr(LL);
C=[N[L0[0]-1],N[L0[1]-1],N[L0[2]-1]];
str_tb(["\\draw[",S,"] (", C[0],")--(",C[1],") (",
C[0],")--(",C[2],") (",C[1],")--(",C[2],");\n"],TB);
}
R=str_tb(0,TB);
if(TikZ==1&&Dvi!=-1) dviout(xyproc(R)|dviout=1,keep=Keep);
return R;
}
for(S="",L=[];G!=[];G=cdr(G)){
for(TL=[],TG=cdr(car(G));TG!=[];TG=cdr(TG)) TL=cons(car(TG)[0],TL);
TL=msort(TL,[-1,0]);
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;I<L;I++){
S=G[I][0];
if(S[0][0]>S[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]<G[J][0]) break;
S=G[J-1];G[J-1]=G[J];G[J]=S;
}
}
return vtol(G);
}
if(F=="get"||F=="get0"){
if(Dvi!=0) F="get";
if(length(P)==1||type(P[1])<2){
L=[];
if(length(P)==1){
for(I=3;I>=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,(I<J)?[I,J]:[J,I]]),L);
}
}
if(Dvi){
if(length(L)==10){
R=ltov(L);
if(R[6][0]==[1,4]){
S=R[6];R[6]=R[7];R[7]=S;
L=vtol(R);
}
}
for(R=S=[],L=reverse(L);L!=[];L=cdr(L)){
T=car(L);
R=cons(cdr(T),R);
if(S==[]) S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}\\\\\n";
else S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}&"+S;
}
L=ltotex(R|opt="GRS",pre=S);
if(type(D=getopt(div))==1 || type(D)==4) L=divmattex(L,D);
if(Dvi>0) dviout(L|eq=0,keep=Keep);
}
return L; /* get all spct */
}
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=mc2grs(G,["get0",[I,J]]);
return anal2sp(S,[["*",1,1],0]);
}
I=lsort(K,lsort(I,J,2),1);
S=lsort([0,1,2,3,4],K,1);
D=mc2grs(G,"deg");
if(findin(4,S)<0) D=-D;
J=mc2grs(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(length(T)==3){
T0=T;T=lsort([0,1,2,3,4],T,1);
if(length(T)!=2) return [];
}else T0=0;
if(T[0]>T[1]) T=[T[1],T[0]];
for(FT=0,PG=G;PG!=[];PG=cdr(PG)){
if(car(PG)[0][0]==T){
FT=1;break;
}
if(car(PG)[0][1]==T){
FT=2;break;
}
}
if(!FT) return [];
L=anal2sp(cdr(car(PG)),[["get1",FT],0]);
if(T0!=0){
if((K=mc2grs(G,"deg"))!=0){
if(T[1]!=4) K=-K;
R=reverse(L);
for(L=[];R!=[];R=cdr(R)) L=cons([car(R)[0],car(R)[1]+K],L);
}
T=T0;
}
return (F=="get")?cons(T,L):L;
}
}
if(F=="rest"||F=="eigen"||F=="rest0"||F=="rest1"){
if((Hg=getopt(homog))!=0) Hg=1;
if(F!="eigen"&&Hg) G=mc2grs(G,"homog");
if(length(P)==1){
for(R=[],I=0;I<4;I++){
for(J=I+1;J<5;J++){
S=mc2grs(G,[F,[I,J]]|homog=Hg);
if(S!=[]) R=cons(cons([I,J],S),R);
}
}
R=reverse(R);
if(Dvi){
TB=str_tb(0,0);
if(F=="rest0"||F=="rest1"){
for(T=R;;){
TT=car(T);
S=rtostr(car(TT)[0])+rtostr(car(TT)[1]);
str_tb(["[",S,"]","&: "],TB);
for(TR=[],TT=cdr(TT);TT!=[];TT=cdr(TT))
TR=cons(car(TT)[1],TR);
for(TR=qsort(TR);TR!=[];TR=cdr(TR))
str_tb([s2sp(car(TR)|short=1,std=-1),"\\ \\ "],TB);
if((T=cdr(T))==[]) break;
str_tb("\\\\\n",TB);
}
}else{
TB=str_tb(0,0);
for(T=R;;){
TT=car(T);
S=rtostr(car(TT)[0])+rtostr(car(TT)[1]);
str_tb(["[",S,"]",":\\ "],TB);
for(TR=[],TT=cdr(TT);;){
T0=car(TT);
str_tb(["&",my_tex_form(car(T0)),"&&\\to\\ \n",
ltotex(cdr(T0)|opt="GRS")],TB);
if((TT=cdr(TT))==[]) break;
str_tb("\\\\\n",TB);
}
if((T=cdr(T))==[]) break;
str_tb("\\allowdisplaybreaks\\\\\n",TB);
}
}
R=texbegin("align*",str_tb(0,TB));
if(Dvi!=-1) dviout(R|keep=Keep);
}
return R;
}
I=P[1];
if(I[0]>I[1]) I=[I[1],I[0]];
L=lsort([0,1,2,3,4],I,1);
if(F=="rest"&&length(P)==3){
J=P[2];if(J[0]>J[1]) J=[J[1],J[0]];
L=lsort(L,J,1);
if(length(L)!=1) return 0;
return [mc2grs(G,["get0",I]),mc2grs(G,["get0",[I[0],J[0]],[I[1],J[1]]]),
mc2grs(G,["get0",[I[0],J[1]],[I[1],J[0]]]),mc2grs(G,["get0",[I[0],I[1],L[0]]])];
}
L=[[L[0],L[1]],[L[0],L[2]],[L[1],L[2]]];
if(F!="eigen"){
if(I==[0,4]) L=reverse(L);
else{
for(V=[],J=2;J>=0;J--){
if(L[J][0]==0) V=cons([L[J][1],J],V);
else{
for(K=4;K>=0;K--){
if(findin(K,L[J])<0){
V=cons([K,J],V);break;
}
}
}
}
V=qsort(V);
L=[L[V[0][1]],L[V[1][1]],L[V[2][1]]];
}
}
for(LL=[],T=L;T!=[];T=cdr(T))
LL=cons(mc2grs(G,["get0",[I,car(T)]]),LL);
LL=reverse(LL);
/* mycat(["I",I,"\nL",L,"\nLL",LL]);
mycat([I,mc2grs(G,["get0",I])]); */
for(R=[],Q=mc2grs(G,["get0",I]);Q!=[];Q=cdr(Q)){ /* Q : simultaneous spct */
/* mycat(["Q",Q,car(Q)[1]]); */
for(T=[],J=2;J>=0;J--){
V=anal2sp(LL[J],["get1",(I[0]<L[J][0])?1:2,car(Q)[1]]); /* an eigenvalue */
/* mycat(["a",V]); */
if(F=="rest"){
V=anal2sp(V,["+",-car(Q)[1]]);
if(I[0]==0){
if(I[1]!=4){
if(L[J][1]!=4) V=anal2sp(V,["+",-car(Q)[1]]);
}else if (L[J][0]!=2&&L[J][1]!=2) V=anal2sp(V,["+",-car(Q)[1]]);
}else if(L[J][0]!=0) V=anal2sp(V,["+",-car(Q)[1]]);
#endif
}
/* mycat(["b",V]); */
T=cons(V,T);
}
R=cons(cons(car(Q)[1],T),R);
}
if(F=="rest0"||F=="rest1"){
for(L=[];R!=[];R=cdr(R)){
TR=cdr(car(R));
if(F=="rest1"&&chkspt(TR|opt="idx")==2) continue;
L=cons([car(R)[0],s2sp(chkspt(TR|opt=6))],L);
}
R=reverse(L);
}
return R;
}
if(F=="deg"){
for(S=I=0;I<3;I++){
for(J=I+1;J<4;J++){
L=mc2grs(G,["get0",[I,J]]);
L=anal2sp(L,"val");
S+=L[1];
}
}
return S/L[0];
}
if(F=="spct"||F=="spct1"){
K=(F=="spct")?5:6;
G=mc2grs(G,"get");
M=newmat(5,K);
for(;G!=[];G=cdr(G)){
GT=car(G);I=GT[0][0];J=GT[0][1];
for(S=0,L=[],GT=cdr(GT);GT!=[];GT=cdr(GT)){
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(K==6){
for(S=[],J=4;J>=0;J--)
if(I!=J) S=cons(M[I][J],S);
R=chkspt(S|opt=2);
M[I][5]=((L=length(R))>1)?s2sp(R[L-2]|short=1):"";
}
}
if(Dvi){
S=[];
for(I=4;I>=0;I--){
L=(K==6)?[M[I][5]]:[];
L=cons(M[I][I],L);
for(J=4;J>=0;J--){
if(I==J) L=cons("",L);
else L=cons(s2sp([M[I][J]]),L);
}
S=cons(L,S);
}
T=(K==6)?["reduction"]:[];
S=cons(append([x0,x1,x2,x3,x4,"idx"],T),S);
M=ltotex(S|opt="tab",hline=[0,1,z],
vline=(K==6)?[0,1,z-2,z-1,z]:[0,1,z-1,z],
left=["","$x_0$","$x_1$","$x_2$","$x_3$","$x_4$"]);
if(Dvi>0) dviout(M|keep=Keep);
}
return M;
}
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]<TQ[1][0]){
L=cons(cons(TQ,cdr(car(T))),L);
continue;
}
TQ=[[TQ[1],TQ[0]]];
for(TP=cdr(car(T));TP!=[];TP=cdr(TP))
TQ=cons([car(TP)[0],car(TP)[2],car(TP)[1]],TQ);
L=cons(reverse(TQ),L);
}
return mc2grs(L,"sort");
}
if(F=="homog"){
V=mc2grs(G,"deg");
return mc2grs(G,[[[2,3],-V]]);
}else if(F=="deg"){
R=mc2grs(G,4);
for(V=0;R!=[];R++){
for(TR=cdr(R);TR!=[];TR=cdr(TR))
V+=car(TR)[0]*car(TR)[1];
}
return -V;
}
}
if(type(F)!=4) return 0;
if(type(P[0])!=4) P=[P];
for(;P!=[];P=cdr(P)){
if(type((S=P[0])[0])==4){ /* addition */
T=P[0][0];
if(T[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=(J<K)?[J,K]:[K,J];K0=[0,K];
G0=cdr(mc2grs(G,["get",[K0,I4]]));
LT=anal2sp(G0,["+",C,0]);
G0=cdr(mc2grs(G,["get",I4]));
L0=anal2sp(G0,["put1",1,0]);
LT=anal2sp(LT,["add",L0]);
G0=cdr(mc2grs(G,["get",S]));
L0=anal2sp(G0,[["put1",1,0],["+",0,-C-U]]);
LT=anal2sp(LT,["add",L0]);
G0=cdr(mc2grs(G,["get",[[0,I],S]]));
L0=anal2sp(G0,[["get",1,0],["+",0,-C-U]]);
LT=anal2sp(LT,["sub",L0]);
G0=cdr(mc2grs(G,["get",[[0,J],I4]]));
L0=anal2sp(G0,["get",1,0]);
LT=anal2sp(LT,["sub",L0]);
G0=cdr(mc2grs(G,["get",[K0,I4]]));
L0=anal2sp(G0,[["get",1,0],["+",C,0]]);
LT=anal2sp(LT,["sub",L0]);
G0=cdr(mc2grs(G,["get",[[0,4],S]]));
L0=anal2sp(G0,[["get",1,C],["+",-C,-C-U]]);
LT=anal2sp(LT,[["sub",L0],0]);
L=cons(cons([K0,I4],LT),L);
}
}
/* [[0,4],[2,3]] : [[0,4],J]=[[0,4],[i,j]] 3 cases */
for(K=3;K>0;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<N;J++){
if(I==J) continue;
for(K=J+1;K<=N;K++){
if(I==K) continue;
G=cons([[[0,I],[J,K]],[1,0,0]],G);
}
}
}
for(I=1;I<=N;I++){
for(J=1;J<I;J++) G=cons([[[0,I],[0,J,I]],[1,0,0]],G);
for(J=I+1;J<=N;J++) G=cons([[[0,I],[0,I,J]],[1,0,0]],G);
}
return reverse(G);
}
return 0;
}
if(type(G)==7) G=os_md.s2sp(G);
if(type(G)!=4||type(G[0])!=4) return 0;
if(type(G[0][0])!=4){ /* spectre type -> 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=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=(I<J)?[I,J]:[J,I];
L=cons(mcmgrs(G,[F,II]),L);
}
}
}else{
for(L=[],I=0;I<N;I++){
for(J=I+1;J<=N;J++) L=cons(mcmgrs(G,[F,[I,J]]),L);
}
}
if(Dvi){
for(R=S=[];L!=[];L=cdr(L)){
T=car(L);
R=cons(cdr(T),R);
if(S==[]) S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}\\\\\n";
else S="A_{"+rtostr(T[0][0])+rtostr(T[0][1])+"}&"+S;
}
L=ltotex(R|opt="GRS",pre=S);
if(type(V=getopt(div))!=4) V=[];
if(V==[]&&(K=length(R))>10)
for(I=9;I<K;I+=9) V=cons(I,V);
V=reverse(V);
if(V!=[]) L=divmattex(L,V);
if(Dvi>0){
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,keep=Keep);
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;I<N-1;I++){
for(J=I+1;J<N;J++){
L=mcmgrs(G,["get0",[I,J]]);
L=anal2sp(L,"val");
S+=L[1];
}
}
return S/L[0];
}
}
L=[];
if(type(F)!=4) return 0;
if(type(P[0])!=4||length(P[0])==2) P=[P];
for(;P!=[];P=cdr(P)){
if(type(T=(S=car(P))[0])==4){ /* addition */
if((K=P[0][1])!=0){
if(T[0]>T[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],(I<J)?[0,I,J]:[0,J,I]]; /* [0,I], [0,I,J] */
JK=(I<J)?[I,J]:[J,I];
if(I==N){
G0=mcmgrs(G,["get0",T]);
LT=anal2sp(G0,["+",-C,0]);
G0=mcmgrs(G,["get0",JK]);
L0=anal2sp(G0,[["put1",1,-C],["mult",N-3]]);
LT=anal2sp(LT,["add",L0]);
G0=mcmgrs(G,["get0",T[1]]);
L0=anal2sp(G0,["put1",1,-C]);
LT=anal2sp(LT,["add",L0]);
for(V=1;V<=N;V++){
if(V==J){
G0=mcmgrs(G,["get0",T]);
L0=anal2sp(G0,[["get",1,0],["+",-C,0]]);
}else if(V==N){
G0=mcmgrs(G,["get0",[[0,V],T[1]]]);
L0=anal2sp(G0,[["get",1,C],["+",-C,0]]);
}else{
G0=mcmgrs(G,["get0",[[0,V],JK]]);
L0=anal2sp(G0,[["get",1,0],["+",-C,0]]);
}
LT=anal2sp(LT,["sub",L0]);
}
LT=anal2sp(LT,["+",0,C]);
}else if(J==N){
G0=mcmgrs(G,["get0",T]);
LT=anal2sp(G0,["+",C,0]);
G0=mcmgrs(G,["get0",T[0]]);
L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]);
LT=anal2sp(LT,["add",L0]);
G0=mcmgrs(G,["get0",T[1]]);
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==N){
G0=mcmgrs(G,["get0",[[0,V],T[1]]]);
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,-C]);
}else{
G0=mcmgrs(G,["get0",T]);
LT=anal2sp(G0,["+",C,C]);
G0=mcmgrs(G,["get0",JK]);
L0=anal2sp(G0,[["put1",1,0],["mult",N-3]]);
LT=anal2sp(LT,["add",L0]);
G0=mcmgrs(G,["get0",T[1]]);
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,C]]);
}else if(V==J){
G0=mcmgrs(G,["get0",[[0,V],T[1]]]);
L0=anal2sp(G0,[["get",1,0],["+",0,C]]);
}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);
}
}
for(G0=G=[];L!=[];L=cdr(L)){
if(length(car(L)[0][1])==2) G0=cons(car(L),G0);
else G=cons(car(L),G);
}
G=append(G0,G);
}else{
if(length(S)==N-1||length(S)==N){ /* [a_1,...,a_{N-1},c] */
for(I=1;I<N;S=cdr(S),I++) G=mcmgrs(G,[[0,I],car(S)]);
if(length(S)==1) G=mcmgrs(G,[S[0]]);
}else return 0;
}
}
return G;
}
def delopt(L,S)
{
if(getopt(get)==1){
for(;L!=[];L=cdr(L)) if(car(L)[0]==S) return car(L)[1];
return [];
}
if((Inv=getopt(inv))!=1&&Inv!=2) Inv=0;
if(Inv&&type(S)==4&&type(car(S))==4){
for(R=[];L!=[];L=cdr(L)){
L0=car(L)[0];
for(F=0,TS=[];S!=[];S=cdr(S)){
if(!F&&L0==car(S)[0]){
R=cons(car(S),R);
F++;
continue;
}
TS=cons(car(S),TS);
}
if(!F) R=cons(car(L),R);
S=reverse(TS);
}
R=reverse(R);
return Inv==1?append(S,R):append(R,S);
}
for(R=[];L!=[];L=cdr(L)){
if(type(car(L))!=4) F=0;
else if(type(S)==4) F=(findin(car(L)[0],S)<0)?0:1;
else F=(car(L)[0]==S)?1:0;
if(F==Inv) R=cons(car(L),R);
}
return reverse(R);
}
def str_char(S,N,L)
{
if(type(S)==7){
if(type(L)==1) L=asciitostr([L]);
return str_chr(S,N,L);
}
if(type(L)==7) L=strtoascii(L)[0];
if(type(S)==4){
M=N;
while(M-->0) 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<K;I++)
if(S[I]==L) return I;
}
return -1;
}
def str_pair(S,N,I,J)
{
if(type(I)==7) I=(II=strtoascii(I))[0];
if(type(J)==7) J=(JJ=strtoascii(J))[0];
if(type(S)==7) S=strtoascii(S);
if(getopt(inv)==1){
if(II!=0){
I=asciitostr(reverse(II));
IL=length(II);
}else IL=1;
if(JJ!=0) J=asciitostr(reverse(JJ));
R=str_pair(reverse(S),length(S)-N-1,J,I);
if(R>=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<K && C>=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 && JJ<LE)) LE=JJ;
if(type(S)==5){
for(; J <= LE; J++){
if(S[J] != LP){
if(SJIS && (V=S[J])>128){
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=car(S))>128){
if((V<160 || (V>223 && V<240))&&S!=[]) {
J++;S=cdr(S);
}
}
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;I<N;I++){
if(type(car(S))==7){
LT=cons(car(S),LT);
S=cdr(S);
if(S==[]) S=[[""]];
}else if(type(car(S))==4){
ST=car(S);
for(J=0;I<N;I++){
if(J==length(ST)) J=0;
LT=cons(ST[J++],LT);
}
}
}
return reverse(LT);
}
return S;
}
def ssubgrs(M,L)
{
if(type(L)==7) L=s2sp(L);
for(S=0, L=L, M=M; L!=[]; L=cdr(L), M=cdr(M)){
for(LT=car(L), MT=car(M); LT!=[]; LT=cdr(LT), MT=cdr(MT)){
S += car(LT)*car(MT)[1];
}
}
return S;
}
def s2os(S)
{
return str_subst(S,[["\\","\\\\"],["\"","\\\""]],0);
}
def l2os(S)
{
if(type(S)==6)
S=m2ll(S);
else if(type(S)==5)
S=vtol(S);
else if(type(S)==7) return "\""+s2os(S)+"\"";
else if(type(S)<4) return rtostr(S);
if(type(S)==4){
for(F=0,Tb=str_tb("[",0);S!=[];S=cdr(S)){
if(F++) str_tb(", ",Tb);
str_tb(l2os(car(S)),Tb);
}
str_tb("]",Tb);
return str_tb(0,Tb);
}
return 0;
}
def r2os(S)
{
if(type(S)==6){
for(T="",S=m2ll(S);S!=[];S=cdr(S)){
if(T!="") T=T+","+r2os(car(S));
else T=r2os(car(S));
}
return "mat("+T+")\n";
}else if(type(S)==5){
for(T="",S=v2l(S);S!=[];S=cdr(S)){
if(T!="") T=T+","+r2os(car(S));
else T=r2os(car(S));
}
return "vect("+T+")\n";
}else if(type(S)<4) return rtostr(S);
else if(type(S)==4){
for(T="";S!=[];S=cdr(S)){
if(T!="") T=T+","+r2os(car(S));
else T=r2os(car(S));
}
return "["+T+"]";
}else if(type(S)==7) return "\""+s2os(S)+"\"";
return "";
}
def s2euc(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) {
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<L;I++){
if(L(I)<=32) continue;
if(isalphanum(L[I])){
if(P0<0){
if(isnum(L[I])) break;
P0=I;
}
else if(P1!=I+1) break;
P1=I;
}
}
if(I==L && P0>=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 evalcoord(L)
{
if(type(L)==7) L=strtoascii(L);
I=str_str(L,"(");
if(I>=0) J=str_pair(L,I+1,"(",")");
if(I<0 || J<I) return [0,[]];
for(F=1,K=I+1;K<J;K++){
C=L[K];
if(C>32&&(C<40||C>58)){F=0;break;}
}
S0=str_cut(L,I+1,J-1);
for(;J>=0;J--) L=cdr(L);
while(L!=[]&&car(L)<33) L=cdr(L);
if(F){
S="["+S0+"]";
return [eval_str(S),L];
}else return [[S0],L];
}
def readTikZ(L)
{
if(type(L)!=4) L=strtoascii(L);
R=[];
CMD=["draw","fill","filldraw","shade","shadedraw","clip","pattern","node","begin"];
while(L!=0&&L!=[]){
while(L!=[]&&car(L)<33) L=cdr(L);
if(L==[]) break;
if(car(L)==34){ /* % */
while(L!=[]&&car(L)!=10) L=cdr(L);
continue;
}
if(car(L)!=92) {L=0;break;} /* \ */
for(DF=0;DF<9;DF++) if(str_str(L,CMD[DF]|top=1,end=1)==1) break;
if(DF<7){
S=T=0;
I=str_str(L,"(");J=str_str(L,"[");
if(J>0&&I>J){
K=str_str(L,"]");
S=str_cut(L,J+1,K-1);
}
F0=F=0;C=[];
while(L!=0&&L!=[]){
V=evalcoord(L);
L=V[1];
if(L==[]) break;
if(F0){
if (!F) C=cons(0,C);
else if(F0!=3) C=cons(1,C);
}
C=cons(V[0],C);
F0=F;F=0;
if(L[0]==34){ /* % */
while(L!=[]&&car(L)!=10) L=cdr(L);
continue;
}
if(!str_str(L,"..")){ /* .. */
L=cdr(L);L=cdr(L);
F=1;
}else if(!str_str(L,"--")){ /* -- */
L=cdr(L);L=cdr(L);
F=2;
}
while(L!=[]&&car(L)<33) L=cdr(L);
if(L==[]){L=0; break;}
if(!str_str(L,"cycle")){
if(F==2) C=cons(1,C);
C=cons(-1,C);
F0=F=0;
continue;
}
if(!str_str(L,"and")||!str_str(L,"control"))
F=3; /* control, and */
else if(car(L)==59){ /* ; */
L=cdr(L);
break;
}else if(isalpha(car(L))){
T=[];
while(car(L)!=40 && car(L)!=59){ /* ( ; */
T=cons(car(L),T);
if((L=cdr(L))==[]){L=0;break;}
}
T=asciitostr(reverse(T));
if(car(L)==59){ /* ; */
L=cdr(L);
break;
}
F0=0;continue;
}else if(F!=1&&F!=2){
L=0;break;
}
}
if(T){
if(length(C)==1||length(C)==2) S=(!S)?["",T]:[S,T];
else{
L=0;break;
}
}
S=(!S)? []:[["opt",S]];
if(DF) S=S=cons(["cmd",CMD[DF]],S);
if(T&&length(C)) R=cons((length(C)==1)?[3,S,C[0],DF]:[3,S,C[1],C[0]],R);
else R=cons([1,S,reverse(C)],R);
}else{ /* \node */
U=0;
I=str_str(L,"(");J=str_str(L,"[");
if(J>0&&I>J){
K=str_str(L,"]");
U=str_cut(L,J+1,K-1);
}
V=evalcoord(L);
C=V[0];L=V[1];
J=str_str(L,"{");K=str_pair(L,J+1,"{","}");
S=str_cut(L,J+1,K-1);
if(U) S=[U,S];
R=cons([2,[],C,[S]],R);
for(;K>=0;K--) L=cdr(L);
K=str_str(L,";");
for(;K>=0;K--) L=cdr(L);
};
}
if(!L){
mycat("Can't understand!");
return -1;
}
return reverse(R);
}
def i2hex(N)
{
Opt=getopt();
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;I<L-1;){
J=str_char(SS,I,"(");
if(J<0) break;
if(J<L-1 && J>4 && 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<K;N++) /* + - _ { } */
if(!isalphanum(P=SS[N])&&findin(P,[32,43,45,95,123,125])<0) break;
}else N=K;
if(N==K){
I=K+1;continue;
}
}
T=T+str_cut(SS,I0,J-1)+"\\left"+str_cut(SS,J,K-1)+"\\right)";
I0=I=K+1;
}else{
T=T+str_cut(SS,I0,J-1)+"\\left("+texket(str_cut(SS,J+1,K-1)|all=F) +"\\right)";
I0=I=K+1;
}
}else break;
}
return T+str_cut(SS,I0,L);
}
def my_tex_form(S)
{
if(getopt(skip) != 1){
if(type(S)==1 && S<0) return "-"+print_tex_form(-S);
if(type(S)==6) return mtotex(S);
S = print_tex_form(S);
for(F=Top=0;(L=str_str(S,"\\verb`"|top=Top))>=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\\\\\n\\end{pmatrix}","\n\\end{pmatrix}"|raw=1);
SS=str_subst(SS,"\\\\\n\\end{pmatrix}","\n\\end{pmatrix}"|raw=1);
Subst=getopt(subst);
Sub0=["{asin}","{acos}","{atan}"];
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;
}
for(F=G=0,S=[];SS!=[];SS=cdr(SS)){ /* 22^x -> 2\cdot 2^x */
if(F==1&&G!=-1&&car(SS)==123 && length(SS)>1 && isnum(SS[1]))
S=append([116,111,100,99,92],S);
G=F;
if(car(SS)==125||car(SS)==95) F=-1;
else F=isnum(car(SS));
S=cons(car(SS),S);
}
S=asciitostr(reverse(S));
/* S=asciitostr(SS); */
if((K=getopt(ket))==1) S=texket(S);
else if(K==2) S=texket(S|all=1);
return S;
}
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<Q;J++){
if(S[J]==38){ /* & */
if(I>=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;
if(type(T)==1) T=[T];
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;I<S0;I++){
for(J=0,TT=car(T);TT!=[];TT=cdr(TT),J++){
if(J>0) St=str_tb("&",St);
if(L[I][car(TT)]!=0) St=str_tb(L[I][car(TT)],St);
}
if(I<S0-1) St=str_tb("\\\\",St);
St=str_tb("\n",St);
}
if(length(T)>1)
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","TeXPages"];
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 if(F==7) V=Canvas;
else if(F==8) V=TeXPages;
}
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;
else if(F==8) TeXPages=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(["TeXPages =", TeXPages]);
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=[];I<N;I++){
C=S[I];
if(F==0){
if(C<=32) continue;
if(C==34){F=2;continue;}
F=1;
}
if(F==2 && C==34){
if(I<N-1&& S[I+1]==34){
LT=cons(34,LT);I++;continue;
}
F=-2;
}
if(F==1){
if((C==44&&Sp!=1)||(C<=32&&Sp==1)) F=-1;
else if(C<32 && C!=9) continue;
}
if(SJIS && I<N-1 && ((C>128 && 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(++I<N && Sp!=1 && S[I]!=44);
F=0;LT=[];
}
if(I<=N && (Sp!=1 || length(LT)>0)){ /* 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 getline(ID)
{
if(isint(Maxlen=getopt(Max))>0) Maxlen=1024;
if(type(CR=getopt(CR))!=4) CR=[13];
if(type(LF=getopt(LF))!=4) LF=[10];
S=[];
for(I=0; I<1023; I++){
C=get_byte(ID);
if(C<0) return 0;
if(findin(C,CR)>=0) continue;
if(findin(C,LF)>=0) break;
S=cons(C,S);
}
return asciitostr(reverse(S));
}
def showbyshell(S)
{
Id = getbyshell(S);
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 isfctr(P)
{
if(type(P)>3) return 0;
if(type(P)==3) return (!isfctr(nm(P))||!isfctr(dn(P)))?0:1;
V=ptol(P,vars(P)|opt=0);
for(;V!=[];V=cdr(V)){
if(type(car(V))>1||ntype(car(V))>0) return 0;
}
return 1;
}
def show(P)
{
T=type(P);
S=P;
Var=getopt(opt);
if((Raw=getopt(raw))!=1) Raw=0;
if(Var=="verb"){
S="{\\tt"+verb_tex_form(T)+"}\n\n";
if(Raw) return S;
dviout(S);return;
}
if(type(Var)<0) Var=getopt(var);
if(T==6){
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)){
if(Raw) return pfrac(P,X|TeX=1);
pfrac(P,X|dviout=1);return;
}
Opt=getopt();
if(type(Var)!=2&&type(Var)!=4&&type(Var)!=7){
if(isdif(P)!=0) Opt=cons(["var","dif"],Opt);
else Opt=cons(["br",1],Opt);
}
if(!isfctr(P)){
if(Raw) return my_tex_form(P);
else{
dviout(P); return;
}
}
if(Raw) return fctrtos(P|option_list=cons(["TeX",3],Opt));
fctrtos(P|option_list=cons(["pages",2],cons(["dviout",1],Opt)));return;
}else if(T==4){
F=0;N=length(getopt());
if(Raw) N--;
if(N==1){
if(type(Var=getopt(var))>1){
if(isvar(Var)) Var=[0,Var];
else if(type(Var)==4&&Var[0]!=0) Var=cons(0,Var);
else Var=0;
}else if(type(Var=getopt(eqs))!=4) Var=0;
}else if(N==0) Var=[];
else Var=0;
if(type(Var)==4){
for(F=0,L=P;L!=[];L=cdr(L)){ /* */
if(type(car(L))==2) F+=nmono(car(L));
else{
F=0;break;
}
}
}
if(F>50){
S=texbegin("align*",eqs2tex(P,Var));
if(Raw) return S;
dviout(S);return;
}
if(type(Var)==4 || type(Var)==7){
S=ltotex(P|option_list=getopt());
if(Var=="text"){
if(Raw) return S;
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));
if(Raw) return show(M|sp=1,raw=1); /* GRS */
show(M|sp=1);return;
}else if(F==7) S=ltotex(P|opt="spts");
else{
for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){
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") S=P+"\n\n";
else if(Var != "eq" &&str_str(P,"\\begin"|end=128)<0){
if((TikZ&&str_str(P,"\\draw"|end=128)>=0)||(!TikZ&&str_str(P,"\\ar@"|end=128)>=0))
S=xyproc(P);
}else if(Var !="eq"){
if(str_str(P,"\\begin{align")>=0 || str_str(P,"\\[")>=0
|| str_str(P,"\\begin{equation")>=0
|| (str_char(P,0,"^")<0 && str_char(P,0,"_")<0 && str_char(P,0,"&")<0))
S=P+"\n\n";
}
if(P!=S){
if(Raw) return S;
dviout(S); return;
}
}
if(Raw) return "\\begin{align}\\begin{split}\n &"+S+"\\end{split}\\end{align}";
else 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 togreek(P,T)
{
R0=[a,b,c,d,e,i,k,l,m,n,o,p,r,s,t,u,x,z];
R1=[alpha,beta,gamma,delta,epsilon,iota,kappa,lambda,
mu,nu,omega,pi,rho,sigma,theta,tau,xi,zeta];
if(T==0||T==[]) T=[a,b,c];
for(S=[],TR=T;TR!=[];TR=cdr(TR)){
if(type(TR[0])!=4){
if((I=findin(car(TR),R0))>=0) S=cons([car(TR),R1[I]],S);
}else if((I=findin(car(TR)[0],R0))>=0){
for(U=car(TR)[1];U!=[];U=cdr(U))
S=cons([makev([R0[I],car(U)]),makev([R1[I],car(U)])],S);
}
}
if(getopt(raw)==1) return S;
if(getopt(inv)==1) return mysubst(P,S|inv=1);
else return mysubst(P,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; I<S[0]; I++){
for(J=0; J<S[1]; J++){
if(type(P=M[I][J])<=3){
if(P!=0 || Null == 0 || (Null==2 && I==J)){
if(type(V=getopt(pfrac))==2)
SS[I][J]=pfrac(P,V|TeX=1);
else{
SS[I][J]=(type(Var)>1)?
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; J<S[1];J++){
for(I=K=0; I<S[0];I++){
if(K<L[I][J]) K=L[I][J];
}
LLL+=(LL[J]=K);
}
}
if(Lim>0){
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<S[0]){
K=LL[II]+(2-F);
if(I==II){
LT+=K;
continue;
}
if(LT+K<Lim-2) continue;
LT=K;
}
for(I0=I; I<II; I++){
if(I==I0){
str_tb((I==0)?
"\n ":
"\\right.\\\\\n \\allowdisplaybreaks\\\\\n &\\ \\left.\\begin{"+Mat+"\n ", Out);
if(Idx==1||Idx==0||type(Idx)==5){
for(J=I; J<II; J++){
if(type(Idx)!=4)
str_tb("("+rtostr(J+Idx)+")",Out);
else{
JJ=length(Idx)-1;
if(J<JJ) JJ=J;
str_tb(my_tex_form(Idx[JJ]),Out);
}
if(J<II) str_tb(" & ",Out);
}
str_tb("\\\\\n ",Out);
}
}
else str_tb("\\\\\n ",Out);
for(J=0; J<S[1]; J++){
if(J!=0) str_tb(" & ",Out);
if(type(SS[I][J])==7) str_tb(SS[I][J],Out);
}
}
Out=str_tb("\n\\end{", Out);
if(II==S[0]) Out=str_tb((Lim==0&&F!=1)?MT[2]+Mat:Mat+"\\right"+MT[1],Out);
else Out=str_tb(Mat+"\\right.",Out);
}
SS = str_tb(0,Out);
if(FL!=1) return SS;
if(F==1) LLL=idiv((LLL+S[1])*5+13,6);
else LLL+=2*(1+S[1]);
return [SS,LLL];
}
def sint(N,P)
{
if( type(N)==1 || N==0 ) {
NT=ntype(N);
if((type(Opt=getopt(str))==1 || Opt==0) && Opt>=0 && P>=0){
if(Opt==2 || Opt==4 || Opt==0){
if(N==0) return (Opt>0)?"0":0;
Pw=0;
if(NT==4){
NN=abs(real(N));N1=abs(imag(N));
if(NN<N1) NN=N1;
}else NN=abs(N);
while(NN<1 && 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
}
/* Option : opt */
def ptconvex(L)
{
if(!(isint(Opt=getopt(opt)))) Opt=0;
L0=car(L);X=L0[0];Y=L0[1];
for(TL=cdr(L);TL!=[];TL=cdr(TL)){ /* find the most left pt L0 */
if(X<car(TL)[0]||(X==car(TL)[0]&&Y<car(TL)[1])) continue;
L0=car(TL);X=car(L0);
}
if(Opt==3) return L0;
R=[]; /* find a polygone through all points */
X0=L0[0];Y0=L0[1];
for(TL=L;TL!=[];TL=cdr(TL)){
L0=car(TL);
X=L0[0]-X0;Y=L0[1]-Y0;S=X^2+Y^2;
L0=(!S)? append([-8,0],L0):append([(Y>0?Y^2:-Y^2)/S,S],L0);
R=cons(L0,R);
}
L=qsort(R);
if(Opt==2) return L;
for(R=[],TL=L;TL!=[];TL=cdr(TL)){
if(Opt==4){
L0=car(TL);
V=car(L0);
L0=append(cdr(cdr(L0)),[V]);
}else L0=cdr(cdr(car(TL)));
R=cons(L0,R);
}
L=reverse(R);
if(Opt==1) return L;
R=[cons(V0=-8,L0=car(L))];
for(TL=cdr(L);TL!=[];TL=cdr(TL)){
V=darg(L0,L1=car(TL));
if(V<-4) continue;
while(V<V0){
R=cdr(R);
V0=car(car(R));
V=darg(cdr(car(R)),L1);
}
if(V==V0) R=cdr(R);
R=cons(cons(V0=V,L0=L1),R);
}
for(L=[],TL=R;TL!=[];TL=cdr(TL)) L=cons(cdr(car(TL)),L);
return L;
}
def darg(P,Q)
{
if(type(car(P))==4){
if((V=darg(Q[0],Q[1]))<-1) return -8;
if((V-=darg(P[0],P[1]))>2){
if((V-=4)>4) return -4;
}else if(V<=-2) V+=4;
return V;
}
X=Q[0]-P[0];Y=Q[1]-P[1];
if(!(S=X^2+Y^2)) return -8;
V=Y^2/S;
if(Y<0) V=-V;
return X<=0?2-V:V;
}
def dwinding(P,Q)
{
V=V0=V1=darg(P,Q0=car(Q));
Q=cons(Q0,reverse(Q));
for(Q=cdr(Q);Q!=[];Q=cdr(Q)){
if((V2=darg(P,car(Q)))<-4) return 1/3;
V1=V2-V1;
if(V1==2||V1==-2) return 1/2;
if(V1<-2) V1+=4;
else if(V1>2) V1-=4;
V+=V1;
V1=V2;
}
return floor((V0-V+1/2)/4);
}
def xyproc(F)
{
if(type(Opt=getopt(opt))!=7) Opt="";
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(T=car(P))==4||type(car(P)==5)){
P=cdr(P);P=cons(T[1],P);P=cons(T[0],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 xylabel(P,S)
{
if(type(P[0])==4){
if(type(S)==4){
if(type(Put=getopt(put))!=7) Put="";
if(type(Opt=getopt(opt))!=7) Opt=0;
for(R="";P!=[];P=cdr(P),S=cdr(S)){
T=car(S);
if(Opt) T=[Opt,T];
R+=xyput([car(P),Put,T]|option_list=getopt());
}
return R;
}
if(type(S)==7){
B=getopt(base);
if(!isint(B)) B=0;
for(SS=[],I=length(P)-1;I>=0;I--) SS=cons(S+rtostr(I+B),SS);
return xylabel(P,SS);
}
}
if(P[0]==0||type(P[0])==1){
if(type(S)==7) return xylabel([P],[S]|option_list=getopt());
}
}
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;J<U;J+=UU) R=cons(J,R);
}
if(V==1/10) L=[U/2];
else L=[];
R=cons(R,cons(L,[[0,U]]));
}
}else if(type(Z[1])==4){
R=Z[1];
if(length(R)==0||type(R[0])!=4) R=[[],[],R];
}else return 0;
K=length(R);
S=newvect(K);
for(J=0;J<K;J++){
for(S[J]=[],JJ=0;JJ<=Z[0];JJ+=U){
for(P=R[J];P!=[];P=cdr(P))
if(car(P)+JJ<=Z[0]) S[J]=cons(car(P)+JJ,S[J]);
}
}
for(J=0;J<K;J++) S[J]=lsort(S[J],[],1);
for(U=[],J=K-1;J>0;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(I<JJ) R=cons([I,JJ],R);
return reverse(R);
}else{
for(;L!=[];L=cdr(L)){
if(car(L)[0]>I) 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(I1<car(L)[0]){
R=cons([I0,I1],R);
for( ;L!=[];L=cdr(L)) R=cons(car(L),R);
F=1;
break;
}
I1=lmax([I1,car(L)[1]]);
}
}
if(!F) R=cons([I0,I1],R);
return reverse(R);
}
def xy2curve(F,N,Lx,Ly,Lz,A,B)
{
Raw=getopt(raw);
if(type(Gap=getopt(gap))==4){
MG=Gap[1];Gap=car(Gap);
}else MG=3;
if(type(Gap)!=1 && Gap!=0) Gap=0.7;
if(type(Dvi=getopt(dviout))<1) Dvi=0;
OL=[["dviout",Dvi]];
if(type(Opt=getopt(opt))<1) Opt=0;
else OL=cons(["opt",Opt],OL);
if(type(Sc=getopt(scale))!=1 && type(Sc)!=4) Sc=[1,1,1];
else if(type(Sc)!=4) Sc=[Sc,Sc,Sc];
else if(length(Sc)!=3) Sc=[Sc[0],Sc[1],Sc[1]];
M=diagm(3,Sc);
if(A!=0||B!=0){
if(type(A)==6) M=A;
else M=mrot([0,-B,-A]|deg=1)*M;
V=M*newvect(3,[x,y,z]);
Fx=compdf(V[0],[x,y,z],F);Fy=compdf(V[1],[x,y,z],F);Fz=compdf(V[2],[x,y,z],F);
}else{
for(I=0;I<3;I++){
if(type(T=F[I])!=4) T=f2df(T);
if(type(T)==4) T=cons(car(T)*Sc[I],cdr(T));
else T*=Sc[I];
if(I==0) Fx=T;
else if(I==1) Fy=T;
else Fz=T;
}
}
if(Raw==5||!Gap)
return (Dvi||!Gap)? xygraph([Fy,Fz],N,Lx,Ly,Lz|option_list=OL):[Fx,Fy,Fz];
R=xygraph([Fy,Fz],N,Lx,Ly,Lz|raw=2);
R0=cdr(car(R));R1=R[1];
for(LT=[];R0!=[];R0=cdr(R0),R1=cdr(R1))
if(car(R0)!=0) LT=cons([R1[0],R1[1]],LT);
LT=reverse(LT);
if(N<0){
Be=xylines(car(R)|curve=1,proc=3,close=-1);
LT=reverse(cdr(LT));
LT=reverse(cdr(LT));
}
else Be=xylines(car(R)|curve=1,proc=3);
Be=cdr(cdr(Be));
Be=lbezier(car(Be));
if(Raw==4) return [Be,LT,Lx];
X=ptcombz(Be,0,0);
Var=(length(Lx)==3)?car(Lx):x;
if(type(Eq=getopt(eq))!=1) Eq=0.01;
if(TikZ==1){
Gap/=10;Eq/=10;
}
for(R=[],XT=X;XT!=[];XT=cdr(XT)){
V=car(XT);
U=LT[V[0][0]];
T=U[0]*V[1][0]+U[1]*(1-V[1][0]);
VV=myfdeval(Fx,[Var,T]);
U=LT[V[0][1]];
T=U[0]*V[1][1]+U[1]*(1-V[1][1]);
VV-=myfdeval(Fx,[Var,T]);
if(abs(VV)<Eq) continue;
I=(VV<0)?0:1;
R=cons([V[0][I],V[1][I],V[0][1-I],V[1][1-I]],R);
}
R=qsort(R);
if(Raw==3) return [Be,R];
Db=newvect(L=length(Be));
for(I=0;I<L;I++) Db[I]=[];
for(TR=R;TR!=[];TR=cdr(TR)){
V1=ptbezier(Be,[I=car(TR)[0],P=car(TR)[1]])[1];
V2=ptbezier(Be,[car(TR)[2],car(TR)[3]])[1];
T=dsqrt(1-dvangle(V1,V2)^2);
if(T<1/MG) T=MG;
GP=Gap/T;
W=GP/dnorm(V1);
Db[I]=addIL([P-W,P+W],Db[I]);
if(P-W<0 && I>0) Db[I-1]=addIL([P-W+1,1],Db[I-1]);
if(P+W>1 && I+1<L) Db[I+1]=addIL([0,P+W-1],Db[I+1]);
}
Db=vtol(Db);
for(Bf=[];Be!=[];Be=cdr(Be),Db=cdr(Db)){
if(car(Db)==[]) Bf=cons(car(Be),Bf);
else{
D=addIL([0,1],car(Db)|in=-1);
for(;D!=[];D=cdr(D))
Bf=cons(tobezier(car(Be)|inv=car(D)),Bf);
}
}
Bf=reverse(Bf);
if(Raw==2) return Bf;
OL=[];
if(Opt){
if(type(Opt)==4&&length(Opt)>1) OL=[["opt",Opt[0]],["cmd",Opt[1]]];
else OL=[["opt",Opt]];
}else OL=[];
S=xybezier(lbezier(Bf|inv=1)|option_list=OL);
if(Raw==1||!Dvi) return S;
return xyproc(S|dviout=Dvi);
}
def rungeKutta(F,N,Lx,Y,IY)
{
if((Pr=getopt(prec))==1){
One=eval(exp(0));
}else{
One=deval(exp(0));Pr=0;
}
if(!isint(FL=getopt(mul))||!FL) FL=1;
if(length(Lx)>2){
V=car(Lx);Lx=cdr(Lx);
}else V=x;
if(Pr==1) Lx=[eval(Lx[0]),eval(Lx[1])];
else Lx=[deval(Lx[0]),deval(Lx[1])];
if(type(Y)==4){
if((Sing=getopt(single))==1||type(F)!=4)
F=append(cdr(Y),[F]);
L=length(Y);
for(TF=[];F!=[];F=cdr(F))
TF=cons(f2df(car(F)),TF);
F=reverse(TF);
}else{
L=1;
F=f2df(F);
}
if(getopt(val)==1) V1=1;
else V1=0;
if(FL>0) N*=FL;
H=(Lx[1]-Lx[0])/N*One;H2=H/2;
FV=findin(V,vars(F));
K=newvect(4);
if(L==1){
R=[[T=Lx[0],S=IY]];
if(!H) return R;
for(C=0;C<N;C++){
for(I=0;I<4;I++){
if(I==0) W=[[V,T],[Y,S]];
else if(I==3) W=[[V,T+H],[Y,S+H*K[2]]];
else W=[[V,T+H2],[Y,S+H2*K[I-1]]];
if(FV<0) W=cdr(W);
K[I]=Pr?myfeval(F,W)*One:myfdeval(F,W);
}
S+=(K[0]+2*K[1]+2*K[2]+K[3])*H/6;T+=H;
if(FL>0&&!((C+1)%FL)) R=cons([deval(T),S],R);
}
}else{
T=Lx[0];
R=[cons(T,V1?[car(IY)]:IY)];
S=ltov(IY);
if(!H) return R;
for(C=0;C<N;C++){
for(I=0;I<4;I++){
if(I==0) W=cons([V,T ],lpair(Y,vtol(S)));
else if(I==3) W=cons([V,T+H ],lpair(Y,vtol(S+H*K[2])));
else W=cons([V,T+H2],lpair(Y,vtol(S+H2*K[I-1])));
if(FV<0) W=cdr(W);
for(TK=[],TF=F;TF!=[];TF=cdr(TF)){
TK=cons(Pr?myfeval(car(TF),W)*One:myfdeval(car(TF),W),TK);
}
K[I]=ltov(reverse(TK));
}
S+=(K[0]+2*K[1]+2*K[2]+K[3])*H/6;T+=H;
TS=vtol(S);
if(FL<0||(C+1)%FL) continue;
if(V1) TS=[car(TS)];
R=cons(cons(deval(T),TS),R);
}
}
L=(FL<0)?(V1?S[0]:S):reverse(R);
return L;
}
def pwTaylor(F,N,Lx,Y,Ly,M)
{
/* Pr:bigfloat, V1:last, Sf: single, Tf: autonomous, */
if(!isint(FL=getopt(mul))||!FL) FL=1;
if(getopt(val)==1) V1=1;
else V1=0;
if(length(Lx)>2){
V=car(Lx);Lx=cdr(Lx);
}else V=t;
if(!isvar(T=getopt(var))) V=t;
if(isint(Pr=getopt(prec))&&Pr>0){
One=eval(exp(0));
if(Pr>9){
setprec(Pr);
ctrl("bigfloat",1);
}
Pr=1;
}else{
One=deval(exp(0));Pr=0;
}
if(Pr==1) Lx=[eval(Lx[0]),eval(Lx[1])];
else Lx=[deval(Lx[0]),deval(Lx[1])];
Sf=(type(F)!=4)?1:0;
if(type(Y)==4){
if(type(F)!=4) F=append(cdr(Y),[F]);
}else Y=[Y];
if(type(Ly)!=4) Ly=[Ly];
if(findin(V,vars(F))>=0){
if(type(F)!=4) F=[F];
Tf=1;F=cons(1,subst(F,V,z_z));Y=cons(z_z,Y);Ly=cons(car(Lx),Ly);
}else Tf=0; /* Tf: autonomous */
ErF=0;
if(type(Er=getopt(err))==4){
if(length(Er)==2) ErF=Er[1]; /* ErF&1: Raw, ErF&2: relative, ErF&4: add Sol */
Er=car(Er);
};
if(!isint(Er)||Er<0) Er=0; /* 基準解を返す */
if(FL>0) N*=FL;
S=vtol(pTaylor(F,Y,M|time=V));
FM=pmaj(F|var=x);
LS=length(S);
if(type(Vw=getopt(view))==4){ /* Dislay on Canvas */
Glib_math_coordinate=1;
glib_window(car(Vw)[0], car(Vw)[2],car(Vw)[1],car(Vw)[3]);
if(length(car(Vw))==6) Vr=[car(Vw)[4],car(Vw)[5]];
else Vr=0;
if(length(Vw)>1){
if(type(Cl=Vw[1])==4) Cl=map(os_md.trcolor,Cl);
else Cl=trcolor(Cl);
}else Cl=0;
if(length(Vw)>2){
Mt=Vw[2];
if(LS==1){
if(type(Mt)>1) Mt=0;
}else{
if(type(Mt)!=6||((Ms=size(Mt)[0])!=2&&Ms!=3)) Mt=0;
if(Ms!=3) Vr=0;
}
if(Tf&&type(Mt)==6) Mt=newbmat(2,2,[[1,0],[0,Mt]]);
}else Mt=0;
if(!Mt){
if(LS>1+Tf){
if(Vr){
Mt=newmat(3,LS);Mt[2+Tf][2+Tf]=1;
}
else Mt=newmat(2,LS);
Mt[Tf][Tf]=Mt[Tf+1][Tf+1]=1;
}else Mt=1;
if(LS==1+Tf||Sf) glib_putpixel(Lx[0],Mt*Ly[Tf]|color=mcolor(Cl,0));
else{
YT=Mt*ltov(Ly);
glib_putpixel(YT[0],YT[1]|color=mcolor(Cl,0));
}
}
if(isint(W=getopt(wait))) sleep(W*100);
}else Vw=0;
T=Lx[0];
RE=R=(Tf)?[Ly]:[cons(T,Ly)];
H=(Lx[1]-Lx[0])/N*One;
Ck=N+1;CB=10;Ckm=2;MM=2;C1=1;
if(Ck<5) Ck=100;
if(type(Inf=getopt(Inf))==4&&length(Inf)>1&&Inf[0]>4){ /* explosion */
Ck=Inf[0];Ckm=Inf[1];
if(length(Inf)>2) MM=Inf[2];
if(!isint(MM)||MM<1) MM=2;
if(length(Inf)>3) C1=Inf[3];
if(type(C1)!=1||C1<0) C1=1;
if(length(Inf)>4) CB=Inf[4];
}else if(isint(Inf)&&Inf>0&&Inf<100){
MM=Inf+1;Ck=100;
}else Inf=0;
Ckm*=Ck;
SS=subst(S,V,H);N0=N;
if(Er>0){
HE=H/(Er+1);SSE=subst(S,V,HE);LyE=Ly;
}
for(C=CC=CF=0;C<N;C++,CC++){
if(CC>=Ck){ /* check explosion */
CC=0;
D0=dnorm(Ly|max=1);
if(Er&&CF){
DE=dnorm(ladd(LyE,Ly,-1)|max=1);
if(CB*DE>D0) break;
}
for(Dy=F,TY=Y,TL=Ly;TY!=[];TY=cdr(TY),TL=cdr(TL))
Dy=subst(Dy,car(TY),One*car(TL));
D1=dnorm(Dy|max=1);D2=subst(FM,x,2*D0+C1);D3=D1+D2;
HH=2*(D0+C1)/Ckm;
if(HH<H*D3){
HH/=D3;
while(H>HH) H/=2;
if(H*7/5<HH) H*=7/5;
if(H*6/5<HH) H*=6/5;
SS=subst(S,V,H);
if(Er){
CF++;
HE=H/(Er+1);
SSE=subst(S,V,HE);
}
if(MM>1) N*=MM;
MM=0;
}
CC=0;
}
T+=H;
for(Dy=SS,TY=Y,TL=Ly;TY!=[];TY=cdr(TY),TL=cdr(TL))
Dy=subst(Dy,car(TY),One*car(TL));
Ly=Dy;
if(Er>0){ /* estimate error */
for(CE=0;CE<=Er;CE++){
for(Dy=SSE,TY=Y,TL=LyE;TY!=[];TY=cdr(TY),TL=cdr(TL))
Dy=subst(Dy,car(TY),One*car(TL));
LyE=Dy;
}
}
if(FL<0||(C+1)%FL) continue;
if(Vw){
if(LS==1+Tf||Sf) CR=CC/N0;
else{
YT=Mt*ltov(Ly);
CR=(!Vr)?CC/N0:(YT[2]-Vr[0])/(Vr[1]-Vr[0]);
}
if(LS==1+Tf||Sf) glib_putpixel(deval(T),Mt*Ly[Tf]|color=mcolor(Cl,CR));
else glib_putpixel(YT[0],YT[1]|color=mcolor(Cl,CR));
continue;
}
TR=(V1)?[car(Ly)]:Ly;
if(!Tf) TR=cons((Inf)?eval(T):deval(T),TR);
R=cons(TR,R);
if(Er){
TRE=(V1)?[car(LyE)]:LyE;
if(!Tf) TRE=cons((Inf)?eval(T):deval(T),TRE);
RE=cons(TRE,RE);
}
}
if(Vw) return 1;
L=(FL<0)?((V1)?car(Ly):Ly):reverse(R);
if(Er){ /* Estimate error */
LE=(FL<0)?((V1)?car(LyE):LyE):reverse(RE);
if(FL>0){
for(S=L,T=LE,D=[];S!=[];S=cdr(S),T=cdr(T)) D=cons(os_md.ladd(car(S),car(T),-1),D);
F=map(os_md.dnorm,reverse(D));
if(iand(ErF,2)){ /* relative error */
G=llget(LE,-1,[0]);
G=map(os_md.dnorm,G);
for(R=[];G!=[];G=cdr(G),F=cdr(F)){
if(car(G)) R=cons(car(F)/car(G),R);
else R=cons(0,R);
}
F=reverse(R);
}
if(!iand(ErF,1)) F=map(os_md.nlog,F);
if(!iand(ErF,8)) F=map(deval,F);
}else if(V1){
D=ladd(L,LE,-1);F=dnorm(D);
if(iand(ErF,2)){
G=dnorm(cdr(L));
if(!G) D/=G;
else D=1;
}
F=(!iand(ErF,1))?nlog(D):D;
if(!iand(ErF,8)) F=deval(F);
}else{
D=abs(L-LE);
if(iand(ErF,2)){
G=abs(L);
if(!G) D/=G;
else D=1;
}
F=(!iand(ErF,1))?nlog(D):D;
if(!iand(ErF,8)) F=deval(F);
}
return iand(ErF,4)?[L,F,LE]:[L,F];
}
return L;
}
def xy2graph(F0,N,Lx,Ly,Lz,A,B)
{
/* (x,y,z) -> (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<J1){
J0=ceil(J0); J1=floor(J1); JD=1; /* fixed x: y: dec => (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 || PPy<Z0[J] || PPy>Z1[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 || PPy<Z0[J] || PPy>Z1[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;I<N;I++) X=cons(makev([V,N-I]),X);
}
M=newmat(N,N);
for(I=0;I<N;I++)
for(J=0;J<N;J++) M[I][J]=X[I]^L[J];
P=det(M);
for(I=0;I<N;I++)
for(J=I+1;J<N;J++) P=sdiv(P,X[I]-X[J]);
return P;
}
def fouriers(A,B,X)
{
if((Y=getopt(y))==0||type(Y)>0) 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(imag(Z)==0&&Z>=0) return dlog(Z);
return dlog(dabs(Z))+@i*myarg(Z);
}
def nlog(X)
{
return mylog(X)/dlog(10);
}
def dlog10(X)
{
if(X==0||imag(Z)!=0) return [];
if(X<0) X=-X;
Neg=1;
if(X<1){X=1/X;Neg=-1;}
C=10^(2000);
for(V=0;X>10^(2000);X/=C, V+=2000);
C=10^(200);
for(;X>10^(200);X/=C, V+=200);
V+=nlog(X);
return Neg*V;
}
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||type(Z)==5){
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 issquare(X)
{
if(X==0) return 1;
if(type(X)==1&&ntype(X)==0){
for(N=nm(X),I=0;I<2;N=dn(X),I++){
if(isqrt(N)^2!=N) return 0;
}
return 1;
}
}
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(issquare(R)) return pari(isqrt,nm(R))/pari(isqrt,dn(R));
}else{
R=-R;
if(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; I<Dev; I++){
/* mycat([D,X1,V1,X2,V2]) ; */
if(iand(I,1)) X0=(X1+X2)/2;
else X0=(V2*X1-V1*X2)/(V2-V1);
V0=myeval(mysubst(F,[V,X0]));
if(V0==0||V0==V1||V0==V2) return [X0,V0];
if(V0<0){
if(!CT && V0+D<0) return [];
V1=V0;X1=X0;
}else{
if(!CT && V0>D) 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]<Mi[1]) Mi=car(R);
}
return [Mi,Ma];
}
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;
for(I=V2=V3=0;I<=Div;I++){
X1=X2;X2=X3;X3=LX1+I*W;V1=V2;V2=V3;
V3=myeval(mysubst(FT,[V,X3]));
if(I==0) L=[[X3,V3]];
if(I<2) continue;
if((V1-V2)*(V2-V3)<0){
X02=X2;V02=V2;X03=X3;V03=V3;
for(J=0; J<Dev && X1!=X3; J++){
X12=(X1+X2)/2;V12=myeval(mysubst(FT,[V,X12]));
if((V1-V12)*(V12-V2)<=0){
X3=X2;V3=V2;X2=X12;V2=V12;continue;
}
X23=(X2+X3)/2;V23=myeval(mysubst(FT,[V,X23]));
if((V12-V2)*(V2-V23)<=0){
X1=X12;V1=V12;X3=X23;V3=V23;continue;
}
if((V2-V23)*(V23-V3)<=0){
X1=X2;V1=V2;X2=X23;V2=V23;continue;
}
}
L=cons([X2,V2],L);
X2=X02;V2=V02;X3=X03;V3=V03;
}
}
L=cons([LX2,myeval(mysubst(FT,[V,LX2]))],L);
if(getopt(mmx)!=1) return L;
for(Mi=Ma=car(L);L!=[];L=cdr(L)){
if(car(L)[1]>Ma[1]) Ma=car(L);
else if(car(L)[1]<Mi[1]) Mi=car(L);
}
return [Mi,Ma];
}
def flim(F,L)
{
FD=f2df(F);
Lim0=4;Lim=12;FS=1;
if(type(Pc=getopt(prec))==1){
if((Pc>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;I<Lim;I++){
D1=FS*8^I;D2=8*D1;
if(FI==0){
D1=1/D1;D2=1/D2;
}
if(D1>D2){
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(DF<K[1][1]-K[0][1]&&DF>10^(-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 xyplot(L,LX,LY)
{
Vw=getopt(view);
if(type(Vw)!=1 && type(Vw)!=7 && Vw!=0) Vw=-1;
if(!LX){
L0=llget(L,1,[0]|flat=1);
LX=[lmin(L0),LXm=lmax(L0)];
S=SX=LX[1]-LX[0];
if(S>0){
if(Vw) LX=[LX[0]-S/32,LX[1]+S/32];
}else LX=[LX[0]-1,LX[0]+1];
}
LX=map(deval,LX);
if(!LY){
L0=llget(L,1,[1]|flat=1);
LY=[lmin(L0),LYm=lmax(L0)];
S=SY=LY[1]-LY[0];
if(S>0){
if(Vw) LY=[LY[0]-S/32,LY[1]+S/32];
}else LY=[LY[0]-1,LY[0]+1];
}
LY=map(deval,LY);
if(getopt(raw)==1) mycat([LX,LY]);
if(Vw!=-1){
if(Vw!=1){
if(type(Vw)==7) Vw=trcolor(Vw);
Opt=[["color",Vw]];
}else Opt=[];
Glib_math_coordinate=1;
glib_window(LX[0],LY[0],LX[1],LY[1]);
for(; L!=[];L=cdr(L))
glib_putpixel(car(L)[0],car(L)[1]|option_list=Opt);
if((AX=getopt(ax))==1||AX==2){
if(LY[0]<0&&LY[1]>0){
glib_line(LX[0],0,LX[1],0);
if(AX==2&&LXm>0){
E=floor(dlog(LXm)/dlog(10));
V=floor(LXm*10^(-E)+1/128)*10^E;
glib_line(V,0,V,SY/64);
glib_print(V,-SY/128,rtostr(V));
}
}
if(LX[0]<0&&LX[1]>0){
glib_line(0,LY[0],0,LY[1]);
if(AX==2&&LYm>0){
E=floor(dlog(LYm)/dlog(10)+1/64);
V=floor(LYm*10^(-E)+1/128)*10^E;
glib_line(0,V,SX/64,V);
glib_print(SX/96,V,rtostr(V));
}
}
}
return [LX,LY];
}
Opt=getopt();Opt0=delopt(Opt,["dviout","proc"]);
if(type(R=getopt(to))!=4) To=[12,8];
R=[To[0]/(LX[1]-LX[0]),RY=To[1]/(LY[1]-LY[0])];
R=[sint(R[0],4|str=0),sint(R[1],4|str=0)];
S="% ";
if(type(C=getopt(scale))!=1&&type(C)!=4){
Opt0=cons(["scale",R],Opt0);
S+="scale="+rtostr(R)+", ";
}
S+=rtostr(LX)+", "+rtostr(LY)+"\n";
for(L0=[],TL=L;TL!=[];TL=cdr(TL)){
TTL=map(deval,car(TL));
if(TTL[0]<LX[0]||TTL[0]>LX[1]||TTL[1]<LY[0]||TTL[1]>LY[1]){
S+=xylines(reverse(L0)|option_list=Opt0);
L0=[];
}else{
L0=cons(TTL,L0);
}
}
if(length(L0)>1) S+=xylines(reverse(L0)|option_list=Opt0);
AX=getopt(ax);Opt=delopt(Opt0,"opt");
if(type(AX)==4) S+="% axis\n"+xygraph([0,0],0,LX,LX,LY|option_list=Opt);
else if((LX[0]<=0&&LX[1]>=0)||(LY[0]<=0&&LY[1]>=0))
S+="% axis\n"+xygraph([0,0],0,LX,LX,LY|option_list=cons(["ax",[0,0]],Opt));
if(getopt(dviout)!=1) return S;
xyproc(S|dviout=1);
return [LX,LY];
}
def xyaxis(A,X,Y)
{
if(isint(Vw=getopt(view))&&Vw!=0){
CL=getopt(opt);
if(type(CL)==7) CL=trcolor(CL);
if(type(CL)!=0) CL=0;
if(CL) Opt=[[color,CL]];
else Opt=[];
Glib_math_coordinate=1;
UX=(X[1]-X[0])/50;UY=(Y[1]-Y[0])/50;
glib_window(X[0],Y[0],X[1],Y[1]);
glib_line(A[0],Y[0],A[0],Y[1]|option_list=Opt);
glib_line(X[0],A[1],X[1],A[1]|otpion_list=Opt);
if(length(A)>2&&A[2]){
I0=-floor((A[0]-X[0])/A[2]);I1=floor((X[1]-A[0])/A[2]);
for(I=I0;I<=I1;I++){
IX=A[0]+A[2]*I;
if(iand(Vw,2)) glib_print(IX-UX,A[1]-UY/2,rtostr(IX));
glib_line(IX,A[1],IX,A[1]+UY);
}
}
if(length(A)>3&&A[3]){
I0=-floor((A[1]-Y[0])/A[3]);I1=floor((Y[1]-A[1])/A[3]);
for(I=I0;I<=I1;I++){
IY=A[1]+A[3]*I;
if(iand(Vw,4)) glib_print(A[0]-UX*2,IY+UY,rtostr(IY));
glib_line(A[0],IY,A[0]+UX,IY);
}
}
return;
}
Opt=getopt();
Opt=cons(["ax",A],Opt);
return xygraph([0,0],0,[0,1],X,Y|option_list=Opt);
}
def xygraph(F,N,LT,LX,LY)
{
if((Proc=getopt(proc))!=1&&Proc!=2&&Proc!=3) Proc=0;
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)) && (X<LX[0]||X>LX[1]||Y<LY[0]||Y>LY[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;I<Level;I++){
for(F=K=G=0,NV=NLT=[],PLT=LT,PV=V;PLT!=[];K++,PLT=cdr(PLT),PV=cdr(PV)){
TG=0;D0=D1;CLT0=CLT;CV0=CV;CV=car(PV);CLT=car(PLT);
if(length(PV)>1){
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)<SL ||
(Gap>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)&&(X<LX[0]||X>LX[1]||Y<LY[0]||Y>LY[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)&&(X<LX[0]||X>LX[1]||Y<LY[0]||Y>LY[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[1])/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;J<NY;Y+=DY,J++){
for(I=0,X=X0;I<NX;I++,X+=DX){
PX=myf2eval(PQ[0],X,Y);PY=myf2eval(PQ[1],X,Y);
VX=myf2eval(PQ[2],X,Y);VY=myf2eval(PQ[3],X,Y);
if(L>0){
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[0]||real(C)>Lim[1])) continue;
if(Lim2!=[]&&(imag(C)<Lim2[0]||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)<CF+6){
if(Lim!=[]&&(real(C)<Lim[0]||real(C)>Lim[1])) continue;
if(Lim2!=[]&&(imag(C)<Lim2[0]||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[0]||real(C)>Lim[1])) continue;
if(Lim2!=[]&&(imag(C)<Lim2[0]||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[0]||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;I<N;I++){
Res=res(V[0],L[I-1],L[I]);
if(type(Res)<2) return Res;
L1=cons(res(V[0],L[I-1],L[I]),L1);
}
R=polroots(L1,V1=cdr(V)|option_list=OL);
if(type(R)<2) return R;
for(SS=[];R!=[];R=cdr(R)){
RS=(N==2)?[car(R)]:car(R);
for(I=0,L0=L[0];I<N-1;I++) L0=mysubst(L0,[V1[I],RS[I]]);
if(L0==0) return 0;
S0=polroots(L0,V[0]|option_list=OL);
if(type(S0)<2) return S0;
for(S=S0;S!=[];S=cdr(S)){
S0=cons(car(S),RS);
for(LT=cdr(L);LT!=[];LT=cdr(LT)){
for(I=0,TV=car(LT);I<N;I++) TV=mysubst(TV,[V[I],S0[I]]);
if(abs(TV)>C) break;
}
if(LT==[]) SS=cons(S0,SS);
}
}
return reverse(SS);
}
def lsub(P)
{
if((T=type(P[0]))==4){
Q=reverse(P[1]);P=reverse(P[0]);
for(R=[];P!=[];P=cdr(P),Q=cdr(Q)) R=cons(car(Q)-car(P),R);
return R;
}else if(T==5){
L=length(P[0]);Q=P[1];P=P[0];
R=newvect(L);
for(V=[],L--;L>=0;L--) R[L]=Q[L]-P[L];
return R;
}
return P;
}
def dext(P,Q)
{
P=lsub(P);Q=lsub(Q);
return P[0]*Q[1]-P[1]*Q[0];
}
def ptinversion(P)
{
if(type(P)==4&&type(P[1])==4){
for(R=[];P!=[];P=cdr(P))
R=cons(ptinversion(car(P)|option_list=getopt()),R);
return reverse(R);
}
if(type(V=getopt(org))!=0) V=[0,0];
if(P==[0,0]) return 0;
if(type(P[0])==4){
R=P[1];P=P[0];
}
X=P[0]-V[0];Y=P[1]-V[1];N=X^2+Y^2;
if(type(T=getopt(sc))==1||T==0){
S=(T<0)?(-T^2):T^2;
}else S=-1;
if(!R){
if(!N) return 0;
return [X/N+V[0],S*Y/N+V[1]];
}
N-=R^2;
if(!N){
if(X+R!=0) X0=X+R;
else X0=X-R;
S=[];
S=cons(ptinversion([X0,Y]|option_list=getopt()),S);
if(Y+R!=0) Y0=Y+R;
else Y0=Y-R;
return cons(ptinversion([X,Y0]|option_list=getopt()),S);
}
return [[X/N+V[0],S*Y/N+V[1]],T^2*R/N];
}
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=feval(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_){
/* unique sol of parameters */
if(In && (R[0][1]<0||R[0][1]>1||R[1][1]<0||R[1][1]>1) ) return 0;
return subst(S,x_,R[0][1],y_,R[1][1]);
}
if((type(R[0])>0&&type(R[0])<4)||(type(R[1])>0&&type(R[1])<4)) return 0; /* no solution */
F=0;
if(X[0]==X[1]) F=1;
else if(Y[0]==Y[1]) F=2;
if(!In){
if(!F) return 1;
else if(F==1) return X[0];
else if(F==2) return Y[0];
}
X0=X[0];X1=X[1];
if(X0>X1){R=X0;X0=X1;X1=R;}
Y0=Y[0];Y1=Y[1];
if(Y0>Y1){R=Y0;Y0=Y1;Y1=R;}
if(X0<Y0) X0=Y0;
if(Y0>Y1) X1=Y1;
if(X0>X1) return 0;
if(X0<X1) return [X0,X1];
return X0;
}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 ptcontain(P,L)
{
if(type(car(P))==4){
if((C=getopt(common))!=1) C=0;
if((F0=ptcontain(P[0])&&!C)) return F0;
if((F1=ptcontain(P[1])&&!C)) return F1;
if(F0&&F1) return P; /* include */
L=cons(L[2],L); /* outside part exists */
for(I=1,R=[];I<4;I++,L=cdr(L)){
if(!(F[I]=ptcotain(P,[L[0],L[1]]))){
if(C) continue;
return -1;
}
if(type(F[I])==4&&length(F[I])==2) /* infinite points */
return F[I];
else R=cons(F[I],R);
}
if(R==[]) return 0; /* no intersection */
if(F1==1) return [P[0],car(R)];
if(F2==1) return [P[1],car(R)];
if(length(R)>1 && R[0]==R[1]) R=cdr(R);
return R;
}
if(dext([L[0],L[1]],[L[0],L[2]])<0) L=[L[0],L[2],L[1]];
L=cons(L[2],L);
for(I=F=1;I<4;I++,L=cdr(L)){
if((V=dext([L[0],L[1]],[L[0],P])) < 0) return 0;
if(!V) F++;
}
return F;
}
def tobezier(L)
{
if((Div=getopt(div))==1||Div==2){
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)!=[] && X<car(V)[0]) return myfeval(car(V)[1],Y);
for(V=cdr(V); ;V=R){
if((R=cdr(V))==[]){
if(car(V)!=[] && car(V)[0]<X) return myfeval(car(V)[1],Y);
return myfeval(F,Y);
}
if(car(V)==[]||X>car(V)[0]) continue;
if(X==car(V)[0]) return car(V)[1];
return myfeval(F,Y);
}
}
def fsum(F,L)
{
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==3||Int==4){
R=newvect(V1);
Opt=delopt(getopt(),[["int",7-2*Int]]|inv=1);
for(I=0;I<V1;I++) R[I]=areabezier([V[0],2^I,V[2]]|option_list=Opt);
for(I=1;I<V1;I++){
P=4^I;
for(J=V1-1;J>=I;J--) R[J]=(P*R[J]-R[J-1])/(P-1);
}
return R[V1-1];
}
if(Int==2&&iand(V1,1)) V1++;
if(!V1) V1=32;
Opt=cons(["raw",1],getopt());
VV=eval(V[2][1]-V[2][0]);
if(Int==-1)
V=[V[0],V[1]-1,[V[2][0]+VV/V[1]/2,V[2][1]-VV/V[1]/2]];
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==3&&(getopt(Acc)==1||(isint(Prec=getopt(prec))&&Prec>10))){
S0=tobig(S0);S1=tobig(S1);
}
if (I==V1) SS+=car(L)[1];
}
if(getopt(Acc)==1) VV=tobig(VV);
if(Int==2)
return (2*S0+4*S1-SS)*VV/(3*V1);
else if(Int==-1){
return V1==1? S0:(S0+S1)/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 isroot(P,Q,I)
{
if(subst(P,X,X0=I[0])*subst(P,X,I[1])<=0) return 1;
XM=(I[1]+I[0])/2;W=XM-X0;
if(W<0) W=-W;
X=var(P);
if(!Q) Q=diff(P,X);
Q=subst(Q,X,X+I2);D=deg(Q,X);
for(M=0,P=1,I=deg(Q,X);I<=D;I++){
V=coef(Q,I,X);
M+=(V<0?-V:V)*P;
P*=W;
}
V=subst(P,X,X0);
if(V<0) V=-V;
return (V-M<=0) 2:0;
}
*/
def sgnstrum(L,V)
{
X=var(car(L));
if(X==0) X=var(L[1]);
for(F=N=0;L!=[];L=cdr(L)){
P=car(L);
if(type(V)==7){
C=coef(P,D=deg(P,X),X);
if(V=="-"&&iand(D,1)) C=-C;
}else C=subst(P,X,V);
if(!C) continue;
if(C*F<0) N++;
F=C;
}
return N;
}
def polstrum(P)
{
X=vars(P0=P);
if(!length(X)) return [];
X=car(X);
if(isfctr(P)){
D=gcd(P,Q=diff(P,X));
P=sdiv(P,D);
if(getopt(mul)==1&&type(getopt(num))<0)
return append(polstrum(D|mul=1),[P]);
}
D=deg(P,X);
P=P/coef(P,deg(P,X),X);
Q=diff(P,X)/D;
for(L=[Q,P];D>0;){
R=urem(P,Q);
if((D=deg(R,X))<0) break;
C=coef(R,D,X);
if(C>0) C=-C;
R/=C;
L=cons(R,L);
P=Q;Q=R;
}
if(type(N=getopt(num))>0){
if(getopt(mul)!=1){
if(type(N)==1) N=["-","+"];
return sgnstrum(L,N[0])-sgnstrum(L,N[1]);
}
if(!isfctr(P0)) return -1;
R=polstrum(P0|mul=1);
for(C=0;R!=[];R=cdr(R)) C+=polstrum(car(R)|num=N);
return C;
}
return reverse(L);
}
def iceil(X)
{
S=(X>0)?1:-1;
X*=S;
if(X>1) X=ceil(X);
else if(X>1/2) X=1;
else if(X) X=1/floor(1/X);
return S*X;
}
def polradiusroot(P)
{
X=var(P);D=deg(P,X);
if(D<1) return -1;
C=coef(P,D,X);
P/=-C;
Int=getopt(int);
if(getopt(comp)==1){
for(ND=0,TD=0;TD<D;TD++) if(coef(P,TD,X)!=0) ND++;
for(V=0,TD=0;TD<D;TD++){
TV=eval((abs(coef(P,TD,X))*ND)^(1/(D-TD)));
if(V<TV) V=TV;
}
return (Int==1)? iceil(X):X;
}
for(N0=N1=0,TD=0;TD<D;TD++){
if(!(C=coef(P,TD,X))) continue;
if(C>0){
N2++;
if(!iand(D-TD,1)) N1++;
}else if(iand(D-TD,1)) N1++;
}
for(V1=V2=0,TD=0;TD<D;TD++){
if(!(C=C1=coef(P,TD,X))) continue;
if(C>0){
TV=eval((C*N2)^(1/(D-TD)));
if(V2<TV) V2=TV;
}
if(iand(D-TD,1)) C=-C;
if(C>0){
TV=eval((C*N1)^(1/(D-TD)));
if(V1<TV) V1=TV;
}
}
return Int?[-iceil(V1),iceil(V2)]:[-V1,V2];
}
/* step, num, strum */
def polrealroots(P)
{
if(type(MC=getopt(step))==4){
MC1=MC[1];MC=car(MC);
}else if(isint(MC)&&MC>1&&MC<10001) MC1=MC;
else MC1=MC=32;
if(type(I=getopt(in))!=4){
I=polradiusroot(P);
W=(I[1]-I[0])/1024;
I=[I[0]-W,I[1]+W];
}
if(type(L=type(getopt(strum)))!=4) L=polstrum(P);
N0=sgnstrum(L,I[0]);N1=sgnstrum(L,I[1]);
P=car(L);X=var(P);
if(N0<=N1) return []; /* [L,I,N0,N1]; */
LT=[[0,I[0],I[1],N0,N1]];R=[];
Z=eval(exp(0));
while(LT!=[]){
T=car(LT);LT=cdr(LT);
C=T[0];X0=T[1];X1=T[2];N0=T[3];N1=T[4];
if(N0<=N1)continue;
if(N0==N1+1){
V0=subst(P,X,X0);
V1=subst(P,X,X1);
while(C++<MC1){
V2=subst(P,X,X2=(X0+X1)/2*Z);
if((V0>0&&V2>0)||(V0<0&&V2<0)) X0=X2;
else X1=X2;
}
R=cons([X0,X1,1],R);
continue;
}
while(++C<MC){
N2=sgnstrum(L,X2=(X0+X1)/2*Z);
if(N0>N2){
if(N2>N1) LT=cons([C,X2,X1,N2,N1],LT);
X1=X2;
N1=N2;
if(N0==N1+1){
LT=cons([C,X0,X1,N0,N1],LT);
C=MC+1;
}
}else{
X0=X2;
N0=N2;
}
}
if(C!=MC+2) R=cons([X0,X1,N0-N1],R);
}
if(isint(Nt=getopt(nt)) && Nt>0){
if(Nt>256) Nt=256;
Q=diff(P,X);
for(S=[],TR=R;TR!=[];TR=cdr(TR)){
if(car(TR)[2]>1) continue;
V0=subst(P,X,car(TR)[0]);
V1=subst(P,X,car(TR)[1]);
if(abs(V0)<abs(V1))
X0=car(TR)[0];
else{
X0=car(TR)[1];V0=V1;
}
for(Tn=Nt;Tn>0;Tn--){
X1=X0-V0/subst(Q,X,X0);
V1=subst(P,X,X1);
if(abs(V1)>=abs(V0)) break;
X0=X1;V0=V1;
}
S=cons(X0,S);
}
for(TR=R;TR!=[];TR=cdr(TR))
if(car(TR)[2]>1) S=cons(car(TR),S);
return reverse(S);
}
return reverse(cons(P,R));
}
/*
def ptcombezier0(P,Q)
{
PB=subst(tobezier(P|div=1),t,s);
QB=tobezier(Q|Div=1);
Z=res(PB[0]-QB[0],PB[1]-QB[1],s);
D=pmaj(diff(Z,t)|val=t);
}
*/
def ptcombezier(P,Q,T)
{
if(type(T)<2){
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])<VV&&abs(car(LN)[1]-car(LT)[1])<VV) break;
}
}
}
if(length(L)>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&&I<J+2) break;
if((RT=ptcombezier(car(P),car(Q),T))!=[]){
RT=cons([I,J],RT);
R=cons(RT,R);
}
}
}
if((Red=getopt(red))==1||Red==2){
if(type(M=getopt(prec))!=1) M=12;
for(F=0,T=P0;T!=[];T=cdr(T)){
for(S=car(T);S!=[];S=cdr(S)){
if(type(ST=car(S))==4 && type(ST[0])<2){
if(F++==0){
X0=X1=ST[0];Y0=Y1=ST[1];
}else{
if(ST[0]<X0) X0=ST[0];
if(ST[0]>X1) X1=ST[0];
if(ST[1]<Y0) Y0=ST[1];
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<L;I++)
for(K=1,J=I+1;K!=0&&J<L;J++)
if(abs(RR[I][0]-RR[J][0])<V0 && abs(RR[I][1]-RR[J][1])<V1) RR[I]=K=0;
R0=[];
I=L-1;
if(Red==2){
for(;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 redbezier(L)
{
V=newvect(4);ST=0;
for(R=[],I=0,T=L;T=[];T=cdr(T){
if(type(car(T))<4){
F=0;
if(I==3)
if(car(T)==0){
}else if(car(T)==1){
}else if(car(T)==-1){
if(I<3) V[I++]=ST;
}
}else if(I==3){
if(R==[] || car(R)!=1){
R=cons(V[0],R);
if(ST==0) ST=V[0];
}
for(J=1;J<3;J++) R=cons(V[J],R);
while((T=cdr(T))!=[]){
R=cons(car(T),R);
if(type(car(R))<4)
}
}else{
if(ST==0) ST=car(T);
V[I++]= car(T);
}
}
}
*/
def lbezier(L)
{
if((In=getopt(inv))==1||In==2||In==3){
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(type(L)==4&&type(car(L))==4&&type(car(L)[0])==4) L=lbezier(L|inv=1);
if(L==0 || (LS=length(L))==0) return "";
Out=str_tb(0,0);
if(type(VF=getopt(verb))==4){
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-1 && type(L[I+1])<2){
if(L[I+1]==-1){
str_tb("{"+xypos(P)+";"+xypos(L00)+T+"}};\n",Out);
}
if(VF) str_tb(xyput([P[0][0],P[0][1],VFS[0]]),Ob);
F=0;
}
}
while(++I<LS && type(L[I])<2);
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(I<LS-1) VF=0; */
if(Q==0||Q==1){
PP=xypos(P);
if(Rel==1) PP="+"+PP;
str_tb(((F==0)?" ":((F==1)?" -- ":" .. "))+PP,Out);
if(VF) str_tb(xyput([P[0],P[1],VFS[0]]),Ob);
F=Q;
}else if(Q==-1){
PP=xypos(P);
if(Rel==1) PP="+"+PP;
if(F==1)
str_tb("..controls "+PP+" .. cycle",Out);
else if(F==2)
str_tb(" and "+PP+" .. cycle",Out);
if(VF&&length(VFS)>1) str_tb(xyput([P[0],P[1],VFS[1]]),Ob);
F=0;
}
if(F==1){
if(I<LS-1){
if(L[I+1]==-1){
str_tb(" -- cycle",Out);
I=I+1;
F=0;
}
else if(type(L[I+1])<2) F=0;
}
}
while(++I<LS && type(L[I])<2);
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=delopt(getopt(),"ar");
if(type(S)>2) S=dnorm([S,P]);
if(type(Prec=getopt(prec))!=1) Prec=0;
if(type(Q)>2){
if(isint(S)&&S<0&&S>-8){
if((S=-S)==6||S==7){
H=ptcommon([Q,R],[P,0]);
if(S==6) return xyang(H,P,0,0|option_list=getopt()); /* 円 */
return xylines([P,H]|option_list=getopt()); /* 垂線 */
}
O=pt5center(P,Q,R);
if(S==2) H=P; /* 外心 */
else{
if(S>2) S++; /* 内心，傍心 */
H=ptcommon([P,Q],[O[S],0]);
}
return xyang(H,O[S],0,0|option_list=getopt());
}
if(type(Ar=getopt(ar))!=1) Ar=0;
if(isint(R)){
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||AR>=10){ /* 矢印 */
Ang=myarg([Q[0]-P[0],Q[1]-P[1]]);
if(R<0) Ang+=3.14159;
if(AR>10) X=deval(@pi/180*AR);
else{
ANG=[0.7854,0.5236,1.0472];
X=(AR==0)?1.5708:ANG[AR-2];
}
U=[P[0]+S*dcos(Ang+X),P[1]+S*dsin(Ang+X)];
V=[P[0]+S*dcos(Ang-X),P[1]+S*dsin(Ang-X)]; /* 矢先 */
L=(X==0)?[U,V]:[U,P,V];
if(X&&iand(Ar,2)){
L=append([V],L);
if((X=ptcommon([P,Q],[U,V]|in=1))!=0) P=X;
}
if(iand(Ar,1))
L=append([Q,P,0],L); /* 心棒 */
return xylines(L|option_list=Opt);
}else if(AR>4&&AR<9){
Ang=myarg([Q[0]-P[0],Q[1]-P[1]]);
ANG=[0.7854,0.5236,0.3927,0.2618];
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=iand(Ar,2)?[V,U,1,W1,P,1,W2,V]:[U,W1,P,1,W2,V];
if(iand(Ar,1)){
if(iand(Ar,2)) P=ptcommon([P,Q],[U,V]);
L=append([Q,P,0],L);
};
if(type(Sc=getopt(scale))>0){
if(type(Sc)==1) Sc=[Sc,Sc];
L=ptaffine(diagm(2,Sc),L);
}
Opt=delopt(Opt,"proc");
if(getopt(proc)==1) return append([2,Opt],L);
S=xybezier(L|option_list=Opt);
if(getopt(dviout)!=1) return S;
dviout(xyproc(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(Arg1<Arg0 || Arg0<-7) return 0;
}
if(type(Prec=getopt(prec))!=0) Prec=0;
if((Ar=getopt(ar))!=1) Ar=0;
L=xyang(L,[0,0],Arg0,Arg1|prec=Prec,opt=0,ar=Ar);
Sc=getopt(scale);
if(type(Sc=getopt(scale))<1) Sc=[1,1];
else if(type(Sc)==1) Sc=[Sc,Sc];
M=mat([1,0],[0,R]);
L=ptaffine(M,L|shift=P);
M=mat([Sc[0],0],[0,Sc[1]]);
L=ptaffine(M,L|arg=Arg2);
if((Opt=getopt(opt))==0) return L;
Opt=(type(Opt)>1)? [["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 xypoch(W,H,R1,R2)
{
if(H>R1||2*H>R2){
errno(0);
return;
}
if(type(Ar=getopt(ar))!=1) Ar=TikZ?0.25:2.5;
T1=dasin(H/R1);S1=R1*dcos(T1);
T2=dasin(H/R2);S2=R2*dcos(T2);
T3=dasin(2*H/R2);S3=R2*dcos(T3);
S=xyline([R1,0],[W-R1,0]);
S+=xyang(R1,[W,0],-@pi,@pi-T1);
S+=xyline([S2,H],[W-S1,H]);
S+=xyang(R2,[0,0],T2,2*@pi-T3);
S+=xylines([[S3,-2*H],[W-H-R2,-2*H],[W-H-R2,2*H],[W-S3,2*H]]);
S+=xyang(R2,[W,0],-@pi+T2,@pi-T3);
S+=xyline([W-T2,-H],[W-T2,-H]);
S+=xyang(R1,[0,0],0,2*@pi-T1);
S+=xyline([W-S2,-H],[S1,-H]);
if(Ar>0){
S+=xyang(Ar,[W/2,0],[0,0],8);
S+=xyang(Ar,[W/2,-2*H],[0,-2*H],8);
S+=xyang(Ar,[W/2-Ar,-H],[W,-H],8);
S+=xyang(Ar,[W/2-Ar,H],[W,H],8);
S+=xyang(Ar,[W-S3,2*H],[W-H-R2,2*H],8);
}
S+=xyput([R1,0,"$\\bullet$"]);
S+=xyput([0,0,"$\\times$"]);
S+=xyput([W,0,"$\\times$"]);
if(TikZ) S=str_subst(S,";\n\\draw","\n");
return S;
}
def xycircuit(P,S)
{
if(type(Sc=getopt(scale))!=1) Sc=1;
if(type(Opt0=getopt(opt))!=7) Opt0="";
if(type(At=getopt(at))!=1) At=(S=="E"||S=="EE")?1:1/2;
Rev=(getopt(rev)==1)?-1:1;
if(type(P)==4&&type(car(P))==4&&P[0][0]==P[1][0]) Rev=-Rev;
W=R=B2=B3=0;Opt=Opt2=Opt3="";
if(S=="L"||S=="VL"||S=="LT"){
G=[1/8*x-2/5*cos(x)+2/5,1/2*sin(x)+1/2];
B=xygraph(G,-21,[0,7*@pi],[-1,10],[-2,2]|scale=0.3/1.06466,opt=0);
B=append(B,[1,[1,0]]);
B=append([[0,0],car(B),1],cdr(B));
W=1;Opt="thick";
if(S=="VL"){
B2=xyang(0.2,[0.5+0.4*Rev,0.45],[0.5-0.435*Rev,-0.3],3|ar=3,opt=0);
Opt2="thick,fill";
}else if(S=="LT"){
B2=[[0.5+0.4*Rev,0.45],[0.5-0.435*Rev,-0.3],0,[0.45+0.4*Rev,0.394],[0.55+0.4*Rev,0.506]];
Opt2="thick";
}
}else if(S=="C"||S=="VC"||S=="C+"||S=="C-"||S=="CT"){
B=[[0,-0.2],[0,0.2],0,[0.15,-0.2],[0.15,0.2]];
W=0.15;Opt="very thick";
if(S=="VC"){
B2=xyang(0.2,[1/3+0.075,0.3*Rev],[-1/3+0.075,-0.3*Rev],3|ar=3,opt=0);
Opt2="thick,fill";
}else if(S=="CT"){
B2=[[1/3+0.075,0.3*Rev],[-1/3+0.075,-0.3*Rev],0,[1/3+0.125,0.244*Rev],
[1/3+0.025,0.356*Rev]];
Opt2="thick";
}else if(S=="C+")
B2=[[0,0.05],[0.15,-0.05],0,[0,0.15],[0.15,0.05],0,[0,-0.05],[0.15,-0.15],
0,[0.29,0.04*Rev],[0.29,0.24*Rev],0,[0.19,0.14*Rev],[0.39,0.14*Rev]];
else if(S=="C-")
B2=[[0,0.05],[0.15,-0.05],0,[0,0.15],[0.15,0.05],0,[0,-0.05],[0.15,-0.15]];
}else if(S=="R"||S=="VR"||S=="VR3"||S=="RT"){
for(I=0,B=[[0,0]];I<12;I++)
if(iand(I,1)) B=cons([I,(-1)^((I+1)/2)],B);
B=reverse(cons([12,0],B));
B=xylines(B|scale=[1/18,0.15],opt=0);
W=2/3;Opt="thick";
if(S=="VR"){
B2=xyang(0.2,[2/3,0.3*Rev],[0,-0.3*Rev],3|ar=3,opt=0);
Opt2="thick,fill";
}else if(S=="RT"){
B2=[[2/3,0.3*Rev],[0,-0.3*Rev],0,[0.717,0.244*Rev],[0.617,0.357*Rev]];
Opt2="thick";
}else if(S=="RN3"){
B2=xyang(0.2,[1/3,0.2*Rev],[1/3,0.5*Rev],3|ar=3,opt=0);
Opt2="thick,fill";
}
}else if(S=="RN"||S=="VRN"||S=="RN3"||S=="NRT"){
B=xylines([[0,0.1],[2/3,0.1],[2/3,-0.1],[0,-0.1],[0,0.1]]|opt=0);
W=2/3;Opt="thick";
if(S=="VRN"){
B2=xyang(0.2,[2/3,0.3*Rev],[0,-0.3*Rev],3|ar=3,opt=0);
Opt2="thick,fill";
}else if(S=="RN3"){
B2=xyang(0.2,[1/3,0.2*Rev],[1/3,0.5*Rev],3|ar=3,opt=0);
Opt2="thick,fill";
}else if(S=="NRT"){
B2=[[2/3,0.3*Rev],[0,-0.3*Rev],0,[0.717,0.244*Rev],[0.617,0.357*Rev]];
Opt2="thick";
}
}else if(S=="circle"){
W=1;
B=xyang(0.5,[0.5,0],0,0|opt=0);
}else if(S=="gap"){
W=0.3;
B=xyang(0.15,[0.15,0],0,3.1416|opt=0);
}else if(S=="E"){
W=0.1;
B=[[0,0.2],[0,-0.2],0,[0,0.05],[0.1,-0.05],0,[0,0.15],[0.1,0.05],0,[0,-0.05],[0.1,-0.15]];
}else if(S=="EE"){
W=0.15;
B=[[0,0.2],[0,-0.2],0,[0.075,0.13],[0.075,-0.13],0,[0.15,-0.06],[0.15,0.06]];
}else if(S=="Cell"){
W=0.1;
B=[[0,-0.2],[0,0.2]];
B2=[[0.1,-0.1],[0.1,0.1]];Opt2="very thick";
}else if(S=="Cell2"){
W=0.3;
B=[[0,-0.2],[0,0.2],0,[0.2,-0.2],[0.2,0.2]];
B2=[[0.1,-0.1],[0.1,0.1],0,[0.3,-0.1],[0.3,0.1]];Opt2="very thick";
}else if(S=="Cells"){
W=0.6;
B=[[0,-0.2],[0,0.2],0,[0.5,-0.2],[0.5,0.2],0,[0.1,0],[0.18,0],0,
[0.24,0],[0.34,0],0,[0.40,0],[0.5,0]];
B2=[[0.1,-0.1],[0.1,0.1],0,[0.6,-0.1],[0.6,0.1]];Opt2="very thick";
}else if (S=="Sw"){
W=0.5;
B=xyang(0.05,[0.05,0],0,0|opt=0);
B0=ptaffine(1,B|shift=[0.4,0]);
B=ptaffine("union",[B,B0]);
B=ptaffine("union",[B,[[0.0908,0.025*Rev],[0.45,0.17*Rev]]]);
}else if(S=="D"){
W=0.3;Opt="thick";
B=[[0,0],[0.3,0.173],0,[0.3,0.173],[0.3,-0.173],0,[0.3,-0.173],[0,0],0,
[0,0.173],[0,-0.173]];
}else if(S=="NPN"||S=="PNP"||S=="NPN0"||S=="PNP0"){
W=0.6;
C=[[0.6,0],[0.37,0.23],[0,0],[0.23,0.23]];
if(Rev==-1) C=[C[2],C[3],C[0],C[1]];
if(S=="PNP"||S=="PNP0") C=[C[1],C[0],C[2],C[3]];
B=[[0,0],[0.23,0.23],0,[0.6,0],[0.37,0.23],0,[0.3,0.23],[0.3,0.6]];
B=ptaffine("union",[xyang(0.15,C[0],C[1],18|ar=1,opt=0),B]);
if(S=="PNP"||S=="NPN") B=ptaffine("union",[xyang(0.3354,[0.3,0.15],0,0|opt=0),B]);
B2=[[0.07,0.23],[0.53,0.23]];
Opt2="very thick";
}else if(S=="JN"||S=="JP"){
W=0.6;
B=[[0,0],[0.2,0],1,[0.2,0.23],0,[0.6,0],[0.4,0],1,[0.4,0.23],0,[0.3,0.23],[0.3,0.6]];
C=[[0.3,0.23],[0.3,0.4854]];
if(S=="JP") C=reverse(C);
B=ptaffine("union",[B,xyang(0.15,C[0],C[1],18|opt=0)]);
B=ptaffine("union",[B,xyang(0.3354,[0.3,0.15],0,0|opt=0)]);
B2=[[0.07,0.23],[0.53,0.23]];
Opt2="very thick";
}else if(S=="") R=(Opt0=="")?xyline(P[0],P[1]):xyline(P[0],P[1]|opt=Opt0);
else if(S=="arrow") R=xyang(0.2*Sc,P[1],P[0],3|ar=1,opt=Opt0);
else if(type(S)==4&&type(car(S))==7){
if(type(car(P))!=4) P=[P];
for(R="";P!=[];P=cdr(P)) R+=xyput([car(P)[0],car(P)[1],car(S)]);
}
if(W){
R="";
if(type(P)==4){
if(type(car(P))==4){
T=ptcommon([[0,0],[1,0]],P|in=2);
L=dnorm(P);
W*=Sc;
L1=L*At-W/2;L2=L*(1-At)-W/2;
if(L1>0){
P1=[P[0][0]+L1*dcos(T),P[0][1]+L1*dsin(T)];
R+=xyline(P[0],P1);
}
if(L2>0){
P2=[P[1][0]-L2*dcos(T),P[1][1]-L2*dsin(T)];
R+=xyline(P2,P[1]);
}
B=ptaffine(Sc,B|shift=P1,arg=T);
if(B2) B2=ptaffine(Sc,B2|shift=P1,arg=T);
if(B3) B3=ptaffine(Sc,B3|shift=P1,arg=T);
}else{
B=ptaffine(Sc,B|shift=P1);
if(B2) B2=ptaffine(Sc,B2|shift=P1);
if(B3) B3=ptaffine(Sc,B3|shift=P1);
}
}else{
B=ptaffine(Sc,B);
if(B2) B2=ptaffine(Sc,B2);
if(B3) B3=ptaffine(Sc,B3);
}
if(Opt=="") Opt=Opt0;
else if(Opt0!="") Opt=Opt+","+Opt0;
R+=(Opt=="")?xybezier(B):xybezier(B|opt=Opt);
if(B2){
if(Opt2=="") Opt2=Opt0;
else if(Opt0!="") Opt2=Opt2+","+Opt0;
R+=(Opt2=="")?xybezier(B2):xybezier(B2|opt=Opt2);
}
if(B3){
if(Opt3=="") Opt3=Opt0;
else if(Opt0!="") Opt3=Opt3+","+Opt0;
R+=(Opt3=="")?xybezier(B3):xybezier(B3|opt=Opt3);
}
}
return R;
}
def ptaffine(M,L)
{
if(type(L)!=4&&type(L)!=5){
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)){
TC=car(C);
if(type(TC)<4)
if(subst(TC,x,P[0],y,P[1])<0) break;
else{
for(;TC!=[];TC=cdr(TC))
if(subst(car(TC),x,P[0],y,P[1])>=0) break;
if(TC==[]) 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<T0){
L=cons(vtol(S*(Org+I*X+T0*Y)), L);
L=cons(vtol(S*(Org+I*X+T1*Y)), L);
L=cons(0,L);
}
T0=0; T1=N-1;
}
}
}
for(J=N-1;J>=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<T0){
L=cons(vtol(S*(Org+T0*X+J*Y)), L);
L=cons(vtol(S*(Org+T1*X+J*Y)), L);
L=cons(0,L);
}
T0=0; T1=M-1;
}
}
}
return cdr(L);
}
def ptpolygon(N,R)
{
if(type(S=getopt(scale))!=1) S=1;
if(type(Org=getopt(org))!=4) Org=[0,0];
Pi=deval(@pi);
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) Arg=0;
Arg -= Pi*(1/2+1/N);
D=Pi*2/N;
for(L=[],I=N-1; I>=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[0] || P[0]>X[1] || P[1]<Y[0] || P[1]>Y[1])
R=cons(0,R);
else R=cons(P,R);
}
return reverse(R);
}
def pt5center(P,Q,R)
{
/* P=[1,[0,0]];Q=[[0,0],[1,0]];R=[[0,0],[0,1]]; */
if(length(P)==2&&type(P[0])==4){ /* circle */
if(type(Q)==4&&type(Q[1])==4){ /* line */
A=myarg(lsub(Q));B=myarg(lsub(R));X0=ptcommon(Q,R);
M=mrot(-A);N=mrot(A);X=M*ltov(X0);O=M*ltov(P[0]);
if(!(L=B-A)) return 0;
Pi=deval(@pi);for(;L<0;L+=Pi);for(;L>Pi;L-=Pi);
XX=X[0]+y*deval(cos(L/2))/deval(sin(L/2));
XY=X[1]+y;
if(getopt(neg)==1){
XX=subst(XX,y,-y);XY=subst(XY,y,-y);
}
/* mycat([[P[0],O],XX,XY]); */
V=(XX-O[0])^2+(XY-O[1])^2;
/* mycat(V-(y+P[0])^2); */
S=polroots(V-(y+P[1])^2,y);
S=append(polroots(V-(y-P[1])^2,y),S);
S=qsort(S);V=ltov([XX,XY]);
/* mycat([S,V,M,N,M*N]); */
for(R0=[],ST=S;ST!=[];ST=cdr(ST)) R0=cons([vtol(N*subst(V,y,car(ST))), car(ST)],R0);
/* mycat(R0); */
for(R=[],F=1;R0!=[];R0=cdr(R0)){
if(car(R0)[1]>=0) R=cons(car(R0),R);
else{
if(F){
F=0; R=reverse(R);
}
R=cons(car(R0),R);
}
}
/* mycat(R); */
if(!F) R=reverse(R);
return R;
}
}
L=newvect(7);
L[2]=ptcommon([P,Q],[P,R]|in=-1);
Q1=ptcommon([P,R],[Q,0]);R1=ptcommon([P,Q],[R,0]);
L[3]=ptcommon([Q,Q1],[R,R1]);
P=ltov(P);Q=ltov(Q);R=ltov(R);
A=dnorm([Q,R]);B=dnorm([P,R]);C=dnorm([P,Q]);
L[0]=vtol((P+Q+R)/3);
L[1]=vtol((A*P+B*Q+C*R)/(A+B+C));
L[4]=vtol((-A*P+B*Q+C*R)/(-A+B+C));
L[5]=vtol((A*P-B*Q+C*R)/(A-B+C));
L[6]=vtol((A*P+B*Q-C*R)/(A+B-C));
if((V=getopt(opt))==0){
H1=ptcommon([Q,R],[1,1]|in=1);
H2=ptcommon([R,P],[1,1]|in=1);
H3=ptcommon([P,Q],[1,1]|in=1);
return [L(0),H1,H2,H3];
}else if(V==1||V==4||V==5||V==6){
H1=ptcommon([Q,R],[L[1],0]);
H2=ptcommon([R,P],[L[1],0]);
H3=ptcommon([P,Q],[L[1],0]);
return [[L[1],dnorm(L[1],H1)],H1,H2,H3];
}else if(V==2){
return [L[2],dnorm([L[2],P])];
}else if(V==3){
H1=ptcommon([Q,R],[P,0]);
H2=ptcommon([R,P],[Q,0]);
H3=ptcommon([P,Q],[R,0]);
return [L[3],H1,H2,H3];
}
return vtol(L);
}
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]<R[1][0])?R[1][0]:R[0][0];
S1=(R[0][1]<R[1][1])?R[0][1]:R[1][1];
if(getopt(in)==1){
if(S0<0) S0=0;
if(S1>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;I<J;I++){
P=car(LT=L)[I][0];Q=car(LT)[I][1];
for(;LT!=[];LT=cdr(LT)){
if((type(T=car(LT))==4 || type(T)==5) && length(T)==J){
if(T[I][0]<P) P=T[I][0];
if(T[I][1]>Q) 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;I<J;I++){
P=Q=car(LT=L)[I];LT=cdr(LT);
for(;LT!=[];LT=cdr(LT)){
if((type(T=car(LT))==4||type(T)==5) && type(T[0])<2 && length(T)==J){
if((V=T[I])<P) P=V;
else if(V>Q) 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]<car(T)[0]) return 0;
return 1;
}
def ptcopy(L,V)
{
if(type(V[0])!=4) V=[V];
for(F=0,LL=[]; V!=[]; V=cdr(V)){
if(F) LL=append(LL,[0]);
F++;
LL=append(LL,ptaffine(1,L|shift=car(V)));
}
}
def regress(L)
{
E=deval(exp(0));
for(S0=T0=0,S=L;S!=[];S=cdr(S)){
S0+=car(S)[0]*E;T0+=car(S)[1]*E;
}
K=length(L);S0/=K;T0/=K;
for(SS=TT=0,S=L;S!=[];S=cdr(S)){
SS+=(car(S)[0]-S0)^2*E;TT+=(car(S)[1]-T0)^2*E;
ST+=(car(S)[0]-S0)*(car(S)[1]-T0)*E;
}
if(!SS||!TT) return [];
A=ST/SS;
L=[A,A*S0-T0,ST/dsqrt(SS*TT),S0,dsqrt(SS/K),T0,dsqrt(TT/K)];
if(isint(N=getopt(sint))){
R=reverse(L);
for(L=[];R!=[];R=cdr(R)) L=cons(sint(car(R),N|str=0),L);
}
return L;
}
def average(L)
{
if(getopt(opt)=="co"){
S0=average(L[0]);V0=car(S0);
S1=average(L[1]);V1=car(S1);
L0=os_md.m2l(L[0]|flat=1);
L1=os_md.m2l(L[1]|flat=1);
for(S=0;L0!=[];L0=cdr(L0),L1=cdr(L1))
S+=(car(L0)-V0)*(car(L1)-V1);
S/=S0[1]*S1[1]*S0[2];
S=[S,S0,S1];
}else{
L=os_md.m2l(L|flat=1);
M0=M1=car(L);
for(I=SS=0, LT=L; LT!=[]; LT=cdr(LT), I++){
S+=(V=car(LT));
SS+=V^2;
if(V<M0) M0=V;
else if(V>M1) M1=V;
}
SS=dsqrt(SS/I-S^2/I^2);
S=[deval(S/I),SS,I,M0,M1];
}
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; I<T0; I++){
for(K=0; K<W; K++){
II=K*T0+I;
for(J=0; J<S[1]; J++)
N[I][S[1]*K+J]=(II<S[0])?M[II][J]:Null;
}
}
}else{
T1=W;
T0=S[0]*(D=ceil(S[1]/T1));
N=newmat(T0,T1);
for(K=0; K<D; K++){
for(J=0; J<W;J++){
JJ=W*K+J;
for(I=0; I<S[0]; I++)
N[S[0]*K+I][J]=(JJ<S[1])?M[I][JJ]:Null;
}
}
}
return N;
}
def texcr(N)
{
if(!isint(N) || N<0 || N>127) 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<ML; I++){
for(CC=J=0; J<MC; J++, CC++){
if(length(M[J]) <= I){
if(CC > 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((I<ML-1)?"\\\\\n":"\n", Out);
}
str_tb("\\end{Bmatrix}",Out);
}else if(Op==2){ /* Pfaff */
V=monototex(Opt[0]);
Out = string_to_tb("d"+V+"= \\Biggl(");
Opt=cdr(Opt);
II=length(Opt);
for(I=0; I<II; I++){
str_tb([(I>0)?" + ":" ",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; I<II; I++){
str_tb([(I>0)?" +":"\\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;I<S;I++){
L=cons(cons(car(T),LV[I]),L);
T=cdr(T);
}
LV=reverse(L);
}
if(type(T=getopt(right))==4){
T=str_times(T,S);
for(L=[],I=0;I<S;I++){
L=cons(append(LV[I],[car(T)]),L);
T=cdr(T);
}
LV=reverse(L);
}
for(I=CS=0; I<S; I++)
if(length(LV[I])>CS) 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; I<S; I++)
if(length(LV[I])>CS) 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<S;I++){
L=cons(cons(car(T),LV[I]),L);
T=cdr(T);
}
LV=reverse(L);
}
if(type(T=getopt(right))==4){
T=str_times(T,S);
for(L=[],I=0;I<S;I++){
L=cons(append(LV[I],[car(T)]),L);
T=cdr(T);
}
LV=reverse(L);
}
*/
for(I=0; I<S; I++){
for(C=0,LT=LV[I];C<CS; C++){
if(LT!=[]){
P=car(LT);
if(type(P)!=7) P="$"+my_tex_form(P)+"$";
if(P!="") str_tb(P,Out);
LT=cdr(LT);
}
if(C<CS-1) str_tb("& ",Out);
}
str_tb("\\\\",Out);
while(Hline!=[] && car(Hline)==I+1){
str_tb(" \\hline",Out);
Hline=cdr(Hline);
}
str_tb("\n",Out);
}
str_tb("\\end{tabular}\n",Out);
}else if(Op==11){ /* graph */
if(type(Strip=getopt(strip))!=1) Strip=0;
if(type(MX=getopt(max))!=1) MX=0;
if(type(ML=getopt(mult))!=1) ML=0;
if((REL=getopt(relative))!=1) REL=0;
CL=getopt(color);
OL=delopt(getopt(),["color","strip","mult"]);
if(ML==1&&type(CL)==4){
LL=L[1];L=L[0];K=length(L);S=T="";
if(!MX){
MX=vector(length(L[0]));
for(LT=L;LT!=[];LT=cdr(LT)){
for(I=0,LTT=car(LT);LTT!=[];I++,LTT=cdr(LTT)){
if(REL==1) MX[I]+=car(LTT);
else if(MX[I]<car(LTT)) MX[I]=car(LTT);
}
}
MX=lmax(MX);
OL=cons(["max",MX],OL);
}
if(REL==1) MX=newvect(length(L[0]));
for(I=0;I<K;I++){
for(R=[],J=length(L[I]);--J>=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]<car(LTT)) MX[I]=car(LTT);
}
}
MX=lmax(MX);
OL=cons(["max",MX],OL);
}
for(I=0;I<K;I++)
S+=ltotex([L[I],LL]|option_list
=cons(["line",Line[I]],cons(["strip",(!I)?1:2],OL)));
return(!Strip)?xyproc(S):S;
}
}else Line=0;
}else Opt="@{-}";
Width=8; Hight=3; WRet=1/2; HMerg=(getopt(horiz)==1)?0.3:0.2;
if(!TikZ){
Width*=10; Hight*=10; HMerg*=10;
}
VMerg=HMerg;
if(type(Shift=getopt(shift))!=1)
Shift=0;
if(type(V=getopt(size))==4){
Width=V[0];Hight=V[1];
if(length(V)>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!=[]&&I<length(LL)&&Strip<2) str_tb(xyput([-VMerg,XPM+WS2,LL[I]]),Out);
}else{
if(Line!=0){
if(I>0)
str_tb(xyarrow([XPM-WStep,YPP],[XPM,YP]|opt=Opt),Out);
if(Val!=0)
str_tb(xyput([XPM,YP+HMerg,car(LT)]),Out);
if(Line==2)
str_tb(xyput([XPM,YP,"$\\bullet$"]),Out);
YPP=YP;
}else if(YP!=0 || Val==1){
if(Strip!=3){
if(CL) str_tb(xybox([[XP,YP0],[XP+WWStep,YP]]|color=CL),Out);
else str_tb(xybox([[XP,YP0],[XP+WWStep,YP]]),Out);
}
if(Val!=0) str_tb(xyput([XPM,(YP<0||REL==1)?(YP-HMerg):(YP+HMerg),VL]),Out);
}
if(LL!=[]&&I<length(LL)&&Strip<2) str_tb(xyput([XPM+WS2,-VMerg,LL[I]]),Out);
}
}
if(!Strip)str_tb(xyproc(0),Out);
}else if(Op==12){ /* coord */
Out=str_tb("(",0);
for(LT=L;;){
X=car(LT);
if(type(X)>3 || 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;
Con=(M[1][0]==1)?1:0;
M = sp2grs(M,R,Sft|mat=Mat,con=Con);
}
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<NP; I++){
L = length(M[I]);
if(L > 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(["\\mathrm{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 Out;
}
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<LN; K++){
RRT = RR[K];
if(type(RRT) != 4) continue;
R = mysubst(R,RRT);
P = mysubst(P,RRT);
}
}
}else /* Rigid case */
P = dx^(AL[0][1][0][0][0]);
/* additions and middle convolutions */
for(ALT = AL; ALT != []; ALT = cdr(ALT)){
AI = car(ALT)[0];
if(type(AI) != 4) continue;
V = ltov(AI);
if(V[0] != 0) P = mc(P,x,V[0]);
for(I = 1; I < NP; I++){
if(V[I] != 0)
P = sftexp(P,x,L[I],-V[I]);
}
}
P = (Simp>=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; I<NP; I++){
for(J=F=0; J<length(M[I]); J++){
if(I==0 && J==length(M[0])-1) break;
if((U=S[I][J])!=0){
if(isint(U)!=1){
mycat("Error in shift!"); return 0;
}
VT=RS[I][J][1];
SS=cons([VT,VT+U],SS);
}else if(I>0 && 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<NP; I++) Pre = Pre+"& "+rtostr(L[I]);
Pre = Pre+"\\\\\n";
PW=str_tb(ltotex(RS|opt="GRS",pre=Pre),0);
str_tb(
"=\\{u\\mid Pu=0\\}\\\\\n&\\underset{Q_2}{\\overset{Q_1}{\\rightleftarrows}}\n",PW);
str_tb([ltotex(RS1|opt="GRS",pre=Pre),"\\\\\n"],PW);
R=fctrtos(QQ[0]|TeX=3,var=[dx,"\\partial"]);
if(type(R)==4) R="\\frac1{"+R[1]+"}"+R[0];
str_tb(["Q_1&=",R,"\\\\\n"],PW);
R=fctrtos(QQ[2]|TeX=3,var=[dx,"\\partial"]);
if(type(R)==4) R="\\frac1{"+R[1]+"}"+R[0];
str_tb(["Q_2&=",R,"\\\\\n"],PW);
str_tb(["Q_2Q_1&\\equiv ",fctrtos(QQ[1]|TeX=3),"\\mod W(x)P"],PW);
if(F==1)
str_tb(["\\\\\nP&=",fctrtos(P|TeX=3,var=[dx,"\\partial"])],PW);
dviout(str_tb(0,PW)|eq=0,title="Shift Operator");
}
if(F==1) return [QQ,P,RS,P1,RS1];
else if(F==0) return QQ;
return [QQ,P,RS];
}
def shiftPfaff(A,B,G,X,M)
{
if(type(G)==4){
G0=G[1];G1=G[0];
}
if(type(G)==6){
G=map(red,G);
G0=llcm(G);G1=map(red,G0*G);
}
if(type(G)==3){
G=red(G);G0=dn(G);G1=nm(G);
}
if(type(M)==4){
M0=M[0];M1=M[1];
}else{
M0=M;M1=0;
}
X=vweyl(X);
D0=mydeg(G0,X[0]);D1=mydeg(G1,X[0]);
if(M1>=0){
D=(D1-M1>D0)?D1-M1:D0;
G0=muldo(X[1]^D,G0,X);G1=muldo(X[1]^(D+M1),G1,X);
}else{
D=(D0+M1>D1)?D0+M1:D1;
G0=muldo(X[1]^(D-M1),G0,X);G1==muldo(X[1]^D,G1,X);
}
G0=map(mc,G0,X,M0);G1=map(mc,G1,X,M0+M1);
G0=appldo(G0,A,X|Pfaff=1);
G1=sppldo(G1,B,X|Pfaff=1);
return rmul(myinv(G0),G1);
}
def conf1sp(M)
{
if(type(M)==7) M=s2sp(M);
L0 = length(M);
L1 = length(M[L0-1]);
X2 = getopt(x2);
Conf= getopt(conf);
if(Conf != 0)
Conf = -1;
if((X2==1 || X2==-1) && Conf != 0){
X1 = 0;
X = x_1;
}else{
X1 = 1;
X = x_2;
}
G = sp2grs(M,a,[L0,L1]);
for(I = 0; I < L0-1; I++){
V = makev([a,I-Conf,0]);
G = subst(G,V,0);
}
L2 = length(M[1]);
for(I=J=S0=S1=0; I < L2; I++){
S1 += G[1][I][0];
while(S0 < S1){
S0 += G[0][J][0];
if((V=G[0][J][1]) != 0)
G = mysubst(G,[V,V-G[1][I][1]]);
J++;
}
if(S0 > 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<L0; I++){
V=makev(["x_",I]); VC=makev([c,I]);
P = nm(mysubst(P,[V,1/VC]));
}
}
}
for(I = 1; I < L2; I++){
X = G[1][I][1];
P = nm(mysubst(P,[X,X/c]));
}
VS = vars(P);
while(VS!=[]){
V = car(VS);
if(str_chr(rtostr(V),0,"r")==0){
CV = mycoef(P,1,V);
D = mymindeg(CV,c);
if(D > 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 s2cspb(L)
{
Sub=(getopt(sub));
if(Sub!=1&&Sub!=2&&Sub!=-1) Sub=0;
if(type(L)==7){
if(Sub>0){
I=str_char(L,0,"(");
if(I<0) return car(s2sp(L));
for(R=[];;){
J=str_char(L,I,"(");
if(J<0) return reverse(R);
K=str_pair(L,J+1,"(",")");
if(K<0) return reverse(R);
R=cons(s2cspb(str_cut(L,J+1,K-1)|sub=1),R);
I=K;
}
}else{
K=str_len(L);
for(R=[],I=0;I<K;){
J=str_char(L,I,",");
if(J<0) J=str_len(L)+1;
R=cons(s2cspb(str_cut(L,I,J-1)|sub=1),R);
I=J+1;
}
L=reverse(R);
}
if(Sub==-1) return L;
}
if(!Sub){
for(R=[];L!=[];L=cdr(L)) R=cons(s2cspb(car(L)|sub=1),R);
return reverse(R);
}
if(type(car(L))<2){
if(Sub==1) return L;
else for(N=0,TL=L;TL!=[];TL=cdr(TL)) N+=car(TL);
return [N,L];
}
for(R=[];L!=[];L=cdr(L)) R=cons(s2cspb(car(L)|sub=2),R);
if(Sub==2){
for(N=0,T=R;T!=[];T=cdr(T)) N+=car(T[0]);
R=[R,N];
}
return reverse(R);
}
/* ((1)(1)) ((1)) 111|21|21 [[ [2,[ [1,[1]],[1,[1]] ]], [1,[[1,[1]]]] ]] */
/* (11)(1),111 111|21,111 [[[2,[1,1]],[1,[1]]],[1,1,1]] */
def s2csp(S)
{
if(type(S)!=7){
U="";
if(type(N=getopt(n))>0){
if(N==-1) S=s2cspb(S);
for(D=0,S=reverse(S);S!=[];S=cdr(S),D++){
if(D) U=","+U;
T=str_subst(rtostr(car(S)),","," ");
U=str_cut(T,1,str_len(T)-2)+U;
}
V=strtoascii(U);
for(R=[];V!=[];V=cdr(V)){
if((CC=car(V))==91){ /* [ */
if(length(V)>1 && V[1]==91) V=cdr(V);
for(I=1;(CC=V[I])!=91&&CC!=93;I++);
if(CC==91){
R=cons(40,R); /* ( */
while(I--) V=cdr(V);
}else{
V=cdr(V);
while(--I) R=cons(car(V),R);
}
}else if(CC==93){ /* ] */
R=cons(41,R);
if(length(V)>1 && V[1]==93) V=cdr(V);
}else R=cons(CC,R);
}
return asciitostr(reverse(R));
}
for(;S!=[];S=cdr(S)){
if(U!="") U=U+",";
for(D=0,TU="",T=car(S);T!=[];D++){
if(type(car(T))==4){
R=lpair(T,0);
T=R[0];R1=m2l(R[1]|flat=1);
}else R1=[];
if(D) TU="|"+TU;
TU=s2sp([T])+TU;
T=R1;
}
U=U+TU;
}
return U;
}
if(type(N=getopt(n))>0){
if(N==-1) return s2cspb(S|sub=-1);
else{
S=s2cspb(S);
if(N==1) S=s2csp(S);
return S;
}
}
S=strtoascii(S);
for(P=TS=[],I=D=0; S!=[]; S=cdr(S)){
if((C=car(S))==44){ /* , */
P=cons(D,P);D=0;
}else if(C==124){ /* | */
D++;C=44;
}
TS=cons(C,TS);
}
S=reverse(TS);
P=reverse(cons(D,P));
U=s2sp(asciitostr(S));
for(R=[];P!=[];P=cdr(P),U=cdr(U)){
D=car(P);R0=car(U);
while(D--){
U=cdr(U);
for(U0=car(U),R2=[];U0!=[];U0=cdr(U0)){
for(R1=[],N=car(U0);N>0;R0=cdr(R0)){
R1=cons(car(R0),R1);
if(type(car(R0))==4) N-=car(R0)[0];
else N-=car(R0);
}
R2=cons([car(U0),reverse(R1)],R2);
}
R0=reverse(R2);
}
R=cons(R0,R);
}
return reverse(R);
}
/*
def confspt(S)
{
if(!isint(F=getopt(sub))) F=0;
N=length(S);
P=newmat(N,N);
for(I=0;I<N;I++){
if(S[I][I]) continue;
for(J=0;J<N;J++){
if(I==J) continue;
if(S[I]==S[J]){
P[I][I]++; P[J][J]--;
}
R=partsp(S[I],S[J]|opt=2);
if(R!=[]) P[I][J]=R;
}
}
for(TT=[];I=N-1;I--){
for(R=[],J=0;J<N;J++){
if(I==J) continue;
if(S[I][J]!=0) R=cons(J,R);
}
TT=cons(R,TT);
}
for(TP=I=0;I<N;I++) if(S[I][I]>=0) TP=cons([I],TP);
for(F=1;F;){
for(T=TP,F=0,S=length(car(TP));T!=[];T=cdr(T)){
if(length(T0=car(T))<S) break;
for(TT0=TT[car(T0)];TT0!=[];TT0=cdr(TT0)){
TP=cons(cons(car(TT0),T0),TP);
F=1;
}
}
}
*/
def partspt(S,T)
{
if(length(S)>length(T)) return [];
if(type(Op=getopt(opt))!=1) Op=0;
VS=ltov(S);
L=length(S)-1;
VT=ltov(qsort(T));
if(length(S)==length(T)){
if((R=S)==T|| (R=qsort(S))==qsort(T)){
for(S=[];R!=[];R=cdr(R)) S=cons([car(R),[car(R)]],S);
return S;
}
else return [];
}else if(getopt(sort)==1){
S0=S1=[];
for(;S!=[]&&car(S)==car(T);S=cdr(S),T=cdr(T))
S0=cons(car(S),S0);
if(S!=[]&&car(S)<car(T)) return [];
S0=reverse(S0);
for(S=reverse(S),T=reverse(T);S!=[],car(S)==car(T);S=cdr(S),T=cdr(T))
S1=cons(car(S),S1);
if(car(S)!=[]&&car(S)<cat(T)) return [];
R=partspt(reverse(S),reverse(T));
if(S1!=[]){
for(R0=[];R!=[];R=cdr(R))
R0=cons(append(car(R),S1),R0);
R=reverse(R0);
}
if(S0!=[]){
for(R0=[];R!=[];R=cdr(R))
R0=cons(append(S0,car(R)),R0);
R=reverse(R0);
}
}else{
for(R=[];;){
for(I=J=P=0;I<L;I++){
P=VS[I];
X=100000;
while((P-=(Y=VT[J++]))>0){
if(X<Y) break;
X=Y;
}
if(X<Y||P<0) break;
}
if(!P&&X>=Y) R=cons(vtol(VT),R);
if(!vnext(VT)) break;
}
}
if(Op){
for(W=[];R!=[];R=cdr(R)){
for(I=0,S=VS[0],K=U=[],TR=car(R);TR!=[];TR=cdr(TR)){
K=cons(car(TR),K);
if(!(S-=car(K))){
U=cons([VS[I],reverse(K)],U);
K=[];
S=VS[++I];
if(I==L){
U=cons([S,cdr(TR)],U);
break;
}
}
}
W=cons(reverse(U),W);
}
R=W;
if(iand(Op,1)){
for(R=[];W!=[];W=cdr(W))
R=cons(reverse(qsort(car(W))),R);
R=lsort(R,[],1);
}
if(Op==3){
for(W=[];R!=[];R=cdr(R)){
for(S=[],TR=car(R);TR!=[];TR=cdr(TR))
S=append(S,car(TR)[1]);
W=cons(S,W);
}
R=reverse(W);
}
}
return R;
}
#if 0
def confspt(S,T)
{
R=[];
LS=length(S);LT=length(T);
if(LS<LT) return R;
if(LS==LT){
return(S==T)? return [[S,T]]:R;
}
R=[];
for(ST=S,S0=T0=[],TT=T;ST!=[];ST=cdr(ST),TT=cdr(TT)){
if(car(ST)>car(TT)) return R;
if(car(ST)==car(TT){
S0=cons(car(ST));T0=cons(car(TT));
LS--;LT--;continue;
}
V=car(TT);D=LS-LT;
for(P=[ST],DD=D;DD>0;){
VD=V-car(car(ST));
}
}
}
#endif
def vConv(K,I,J)
{
if(type(X=getopt(var))!=7) X="a";
if(getopt(e)==2) return subst(vConv(K,I+1,J+1),makev([X,1]),0);
if(J>K){L=J;J=K;K=L;}
if(K>I||J<1||K+J<I+1) return 0;
if(K+J==I+1) return 1;
else
#if 1
L=I-K<J-2?I-K+1:J;
for(S=0,M=0;M<L;M++) S+=(makev([X,K+M])-makev([X,J-M-1]))*vConv(K+M,I,J-M-1|var=X);
return S;
#else
return vConv(K+1,I,J-1|var=X)+(makev([X,K])-makev([X,J-1]))*vConv(K,I,J-1|var=X);
#endif
}
def mcvm(N)
{
X=getopt(var);
if((Z=getopt(z))!=1) Z=0;
if(type(N)==4){
if((K=length(N))==1&&isvar(X)) X=[X];
if(type(X)!=4){
for(X=[],I=0;I<K;I++) X=cons(asciitostr([97+I]),X); /* a,b,... */
X=reverse(X);
}
if((E=getopt(e))==1||E==2){
if(length(N)==4) N=cdr(N);
if(length(N)==3) return vConv(N[0],N[1],N[2]|var=X,e=E);
}
for(M=[],I=S=0;I<K;Z=0,I++){
M=cons(mcvm(N[I]|var=X[I],z=Z),M);
S+=N[I];
}
M=newbmat(K,K,reverse(M));
NR=N;
N=S;
}else{
if(type(X)==7) X=strtov(X);
if(!isvar(X)) X=a;
M=newmat(N,N);
for(I=0;I<N;I++){
V=makev([X,I+1]);
for(J=0;J<=I;J++){
R=polbyroot([1,J],V|var=X);
if(Z==1) R*=V;
M[I][J]=R;
}
}
}
if((Get=getopt(get))==1){
for(R=[],I=0;I<N;I++){
U=newmat(N,N);
for(J=0;J<N;J++) U[J][J]=M[J][I];
R=cons(rmul(rmul(myinv(M),U),M),R);
}
return reverse(R);
}else if(Get==2||Get==3||Get==4){
for(V=[],I=N;I>0;I--) V=cons(makev(["a0",I]),V);
MI=myinv(M);
V=ltov(V)*MI;
for(R=[],I=0;I<N;I++){
for(J=I+1;J<N;J++){
K=newmat(N,N);
K[I][I]=V[J];K[I][J]=-V[J];K[J][J]=V[I];K[J][I]=-V[I];
R=cons(rmul(rmul(MI,K),M),R);
}
}
R=reverse(R);
if(Get==2||length(NR)!=2||Z==1) return R;
for(V1=[],I=NR[0];I>0;I--) V1=cons(os_md.makev([X[0],I]),V1);
for(V2=[],I=NR[1];I>0;I--) V2=cons(os_md.makev([X[1],I]),V2);
R=subst(R,car(V1),0,car(V2),0);
V1=subst(V1,car(V1),0);
V2=subst(V2,car(V2),0);
for(V=[],S=V1;S!=[];S=cdr(S)) for(T=V2;T!=[];T=cdr(T)) V=cons(car(T)-car(S),V);
V=reverse(V);
Mx=length(V);
for(A0=[],I=J=NR[0]-1;J>=0;I+=--J) for(K=0;K<NR[1];K++,I++) A0=cons(R[I],A0);
A0=reverse(A0);
for(F0=[],T=1,I=Mx-1;I>=0;I--) F0=cons(1/(x-V[I]), F0);
MV=confexp([F0,V]|sym=3);
RR=newvect(Mx);
for(K=0;K<Mx;K++) for(RR[K]=0,I=0;I<Mx;I++) RR[K]=map(red,RR[K]+MV[I][K]*A0[I]);
for(RR0=RR,VV=append(cdr(V1),cdr(V2));VV!=[];VV=cdr(VV)) RR0=subst(RR0,car(VV),0);
RR0=vtol(RR0);
return (Get==3)?[RR,RR0]:RR0;
}
return M;
}
def confexp(S)
{
if((Sym=getopt(sym))==1||Sym==2||Sym==3){
D=polbyroot(S[1],x);
for(R=[],T=S[0];T!=[];T=cdr(T)){
M=D*car(T);
if(type(M)>3) M=map(red,M);
else M=red(M);
R=cons(M,R);
}
R=reverse(R);
if(Sym==2) return R;
M=length(R);N=length(S[1]);
E=newmat(M,N);
for(I=0;I<M;I++){
for(J=0;J<N;J++) E[I][J]=mycoef(R[I],N-J-1,x);
}
if(Sym==3){
for(R=[],P=1,T=S[1];T!=[];T=cdr(T)) R=cons(P/=(x-car(T)),R);
R=confexp([reverse(R),S[1]]|sym=1);
return E*myinv(R);
}
return E;
}
if(type(S[0])==4){
for(E=[];S!=[];S=cdr(S)) E=cons(confexp(car(S),E));
return reverse(E);
}
V=x;E=[];
for(P=0,Q=[],ST=S;ST!=[];ST=cdr(ST)){
Q=cons(car(ST)[0],Q);
P+=car(ST)[1]/(V-car(ST)[0]);
P=red(P);
}
P=red(P*polbyroot(Q,V));
Q=cdr(reverse(Q));
for(I=(length(W=Q));I>=0;I--){
C=mycoef(P,I,V);
P-=C*polbyroot(W,V);
W=cdr(W);
E=cons(red(C),E);
}
return reverse(E);
}
def pgen(L,VV)
{
if(type(L[0])<4) L=[L];
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;I<K;){
if(++V[I]<=L[I][1]){
if(Sum>0){
for(S=II=0;II<K;) S+=V[II++];
if(S>Sum){
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<M;I++,A=cdr(A)) NM[I][car(A)-S]=1;
return NM;
}
if(type(A) == 4)
L = length(A)-1;
else
L = -1;
if(N <= 0 && N >= -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);
if(type(car(R))!=4 && M==N && M==IM){
for(RR=TR=[],I=0;I<M;I++){
for(TR=[R[I]],J=0;J<I;J++) TR=cons(0,TR);
RR=cons(TR,RR);
}
R=reverse(RR);
}
for(I = 0; I < IM; I++){
RI = R[I];
JM = length(RI);
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;I<K;I++){
for(J=0;J<L;J++) M[I][J]=Null;
}
}
for(I0 = II = 0; II < IM; I0 += S[II++]){
RI = R[II];
JM = length(RI);
for(J0 = JJ = 0; JJ < JM; J0 += T[JJ++]){
if((RIJ = RI[JJ]) == 0)
continue;
Type = type(RIJ);
for(I = 0; I < S[II]; I++){
for(J = 0; J < T[JJ]; J++){
if(Type == 6)
M[I0+I][J0+J] = RIJ[I][J];
else if(Type == 4 || Type == 5)
M[I0+I][J0+J] = (I>0)?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;I<Rk;){
P=random()%(S[1]+Wt)-Wt;
if(P<=0) P=1;
if(findin(P,L)!=0){
L=cons(P,L);
I++;
}
}
}
L=ltov(qsort(L));
M[0][L[0]]=1;
for(I=1;I<Rk;I++){
P=Int?1:U[random()%length(U)];
if(P>Xa) P=Xa;
M[I][L[I]]=(random()%2)?P:(-P);
}
for(I=0;I<Rk;I++){
if(I!=0&&abs(M[I][L[I]])>1) 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;J<I1;J++){
for(K=1;K<=Xa;K++){
P=random()%(I+1);
if((random()%2)==1) M[P][J]++;
else M[P][J]--;
}
}
}
S=M;
Res=(getopt(res)==1)?dupmat(S):0;
}
Conj=0;
if(type(S)<2){
if(S<2||S>20) return 0;
if(getopt(conj)==1){
M=S+Wt;
if(M>15) M=10;
M0=floor((M-1)/2);
for(R=[],I=0;I<S;I++) R=cons(random()%M-M0,R);
R=qsort(R);
M=diagm(S,R);
if(getopt(diag)!=1){
for(I=1;I<S;I++)
if(M[I-1][I-1]==M[I][I] && random()%2) M[I-1][I]=1;
}
if(M[0][0]==M[S-1][S-1]){
for(I=1;I<S;I++) if(M[I-1][I]==1) break;
if(I==S){
if(M[0][0]>0) 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;I<S1;I++){
if(S[I][I]>L && 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<S1-1;I++){
if(iand(S[I][I],1)&&S[I][I+1]==1){
for(J=I+2;J<S1&&S[I][J]==0;J++);
if(J<S1) continue;
for(J=I-1;J>=0&&S[J][I]==0;J--);
if(J>=0) continue;
S[I][I+1]=2;
for(J=0;J<S1;J++) RR[I][J]*=2;
break;
}
}
}
}
}else{
M=diagm(S,[1]);
S1=S;
}
}
if(type(S)==6){
M=dupmat(S);
S=size(S);
S1=S[1];S=S[0];
Nt=1;
if(getopt(conj)==1&&S==S1) Conj=1;
}
if(!isint(Ct=getopt(time)))
Ct=(S>3||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;I<Ct+Mx;I++){
P=random()%S;Q=random()%S;
if(3*K>Ct) T=random()%Xaa-Xh;
else if(5*K<Ct) T=random()%2-1;
else T=random()%4-2;
if(T>=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(K<Mx&&!Conj) G=igcd(G,H);
}
if(K<Mx && G>1) 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;F<S;F++){
if((V=lgcd(M[F]))>1){
for(L=0;L<S1;L++) M[F][L]/=V;
}
}
}
}
if(I>Ct){
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<S1;I++){
V=Res[I][I];
for(J=I+1;J<S1;J++){
if(Res[J][J]!=V) break;
for(LP=0;LP<2;LP++){
if(J==S1-1||Res[J][J+1]==0){
if(I==0||Res[I-1][I]==0){
for(VL=VS=[],K=0;K<S1;K++){
VL=cons(RR[K][J],VL);VS=cons(RR[K][I],VS);
}
VR=ldev(VL,VS);
if(VR[0]){
for(K=S1-1,VN=VR[1];K>=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;I<S1;I++) if(lgcd(M[I])>1||lgcd(N[I])>1) F++;
if(F){
for(F=I=0;I<S1;I++){
if(Res[I][I]==-1) F=ior(F,1);
else if(Res[I][I]==1) F=ior(F,2);
}
C=0;
if(!iand(F,1)) C=1;
else if(!iand(F,2)) C=-1;
if(C){
for(I=0;I<S1;I++){
M[I][I]+=C;Res[I][I]+=C;
}
}
}
}
if(getopt(rep)!=1){
for(Lp=0;Lp<5;Lp++){
F=(M==Res||abs(lmax(RR))>Xa*10||abs(lmin(RR))>Xa*10)?1:0;
for(I=0;!F&&I<S1&&Lp<4;I++){
for(K=L=J=0;J<S1;J++){
if(M[I][J]) K++;
if(M[J][I]) L++;
}
if(K<2||L<2) F=1;
}
if(!F) break;
R=unim(S0|option_list=cons(["rep",1],getopt()));
M=R[0];Res=R[1];RR=R[3];
}
}
}
if(Res==0) return M;
if(RR){
for(I=K=V=0;I<S1;I++){
for(J=0;J<S1;J++){
if(RR[J][I]>0) V++;
else if(RR[J][I]<0) V--;
}
if(I<S1-1&&Res[I][I+1]!=0) continue;
if(V<0){
for(;K<=I;K++) RR=colm(RR,K,-1);
}
K=I+1;V=0;
}
}
if(getopt(rep)!=1){
if((F=getopt(dviout))==1){
if(getopt(conj)==1){
if(RR) show([Res,"=",myinv(RR),M,RR]|opt="spts0",str=1,lim=200);
}else{
if(type(Lim=getopt(lim))==1)
mtoupper(M,0|step=1,opt=7,dviout=1,pages=1,lim=Lim);
else mtoupper(M,0|step=1,opt=7,dviout=1,pages=1);
}
}else if(F==-1){
if(getopt(conj)==1){
if(RR) return ltotex([Res,"=",myinv(RR),M,RR]|opt="spts0",str=1,lim=200);
}else{
if(type(Lim=getopt(lim))==1)
return mtoupper(M,0|step=1,opt=7,pages=1,lim=Lim,dviout=-1);
else return mtoupper(M,0|step=1,opt=7,pages=1,dviout=-1);
}
}
}
if(RR==0) return[M,Res];
return [M,Res,myinv(RR),RR];
}
def pfrac(F,X)
{
if(type(F)==6){
F=mtransbys(os_md.pfrac,F,[X]);
S=size(F);
for(L=[],I=0;I<S[0];I++)
for(J=0;J<S[1];J++)
for(T=F[I][J];T!=[];T=cdr(T)) L=cons(cdr(car(T)),L);
L=lsort(L,[],1);
for(RR=[],U=L;U!=[];U=cdr(U)){
K=newmat(S[0],S[1]);
for(I=0;I<S[0];I++)
for(J=0;J<S[1];J++)
for(T=F[I][J];T!=[];T=cdr(T)){
if(cdr(car(T))==car(U))
K[I][J]=car(T)[0];
break;
};
RR=cons([K,car(U)[0],car(U)[1]],RR);
}
R=reverse(RR);
T=car(R)[0];
for(K=0,I=0;I<S[0];I++)
for(J=0;J<S[1];J++)
if(T[I][J]!=0) K=1;
if(!K) R=cdr(R);
if(getopt(TeX)==1||getopt(dviout)==1){
for(S="",TR=R;TR!=[];TR=cdr(TR)){
mycat(TR);
if(S!="") S+="+";
M=mtotex(car(TR)[0]);
if(car(TR)[1]==1){
S+=M;
continue;
}
N=my_tex_form(car(TR)[1]);
if(car(TR)[2]>1) N="("+N+")^{"+m_to_tex(car(TR)[2])+"}";
S+="\\frac{"+ M + "}{" + N + "}";
}
if(getopt(dviout)==1){
dviout(S|eq=1);
return 1;
}
return S;
}
return R;
}
F = red(F);
FN = nm(F);
FD = dn(F);
TeX=getopt(TeX);Dvi=getopt(dviout);
if(mydeg(FD,X) == 0){
if(TeX==1||Dvi==1){
if(TeX!=1) fctrtos(F|var=X,dviout=1);
return fctrtos(F|var=X,TeX=1);
}
return [[F,1,1]];
}
R = rpdiv(FN,FD,X);
FN = R[0]/R[1];
R0 = R[2]/R[1];
FC = fctr(FD);
RT=[];
if(getopt(root)==2){
for(FE=[],FT=FC;FT!=[];FT=cdr(FT)){
if(mydeg(P=car(FT)[0],X)==4 && vars(P)==[X] && issquare(C=mycoef(P,4,X))){
if((S=mycoef(P,3,X)/4/C)!=0) P=subst(P,X,X-S);
if(mycoef(P,1,X)==0 && issquare,C0=mycoef(P,0,X)){
C=sqrtrat(C);C0=sqrtrat(C0);C1=2*C*C0-mycoef(P,2,X);
if(C1>0){
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]);
}
if(Dvi==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,lim=0);
}
return reverse(R);
}
def cfrac(X,N)
{
if(!ntype(X)&&N==0) N=2*dn(X)+1;
if(N<0) Max=N=-N;
Ng=(getopt(neg)==1)?1:0;
F=[Ng?ceil(X):floor(X)];
X=Ng?F[0]-X: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=Ng?ceil(X):floor(X),F);
X=Ng?Y-X: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(((Q=getopt(q))==1||Q==-1)&&isall(os_md.isint,X)){ /* q-def */
F=car(X);
R=[red((1-q^F)/(1-q))];X=cdr(X);
for(SQ=1/q;X!=[];SQ=1/SQ,X=cdr(X)){
G=car(X);
V=(Q==1)?[(1/SQ)^F,(1-SQ^G)/(1-SQ)]:[-q^(F-1),(1-q^G)/(1-q)];
R=cons(red(V),R);
F=G;
}
return cfrac2n(reverse(R)|ex=1);
}
if((Ex=getopt(ex))!=1) Ex=0;
/*
if(!isint(Fn=getopt(dn))) Dn=0;
else{
RD=[];V=0;
}
*/
if(isvar(car(X))&&length(X)==4&&isint(X[1])){ /* [x,n,g(x),f(x)] */
A=newmat(2,2);B=mgen(2,"diag",[1],0);
for(I=1;I<=X[1];I++){
A[1][1]=0;A[0][1]=1;
A[1][0]=Ex?myfeval(X[2],[X[0],I]):subst(X[2],X[0],I);
A[0][0]=Ex?myfeval(X[3],[X[0],I]):subst(X[3],X[0],I);
if(vars(A)!=[]) A=red(A);
B=B*A;
if(vars(B)!=[]) B=red(B);
}
if(getopt(var)==1) return [B[1][0],B[0][0]];
B=B[1][0]/B[0][0];
if(vars(B)!=[]) B=red(B);
return B;
}
if(Ex||(type(car(X))==4&&length(car(X))==2)){
if(type(car(X))!=4){
N=car(X);X=cdr(X);
}
if(getopt(reg)==1){ /* normal */
for(R=[N], F=1;X!=[];X=cdr(X)) {
if(type(car(X))==4){
F=car(X)[0]/F;
R=cons(car(X)[1]/F,R);
}else{
F=1/F;
R=cons(car(X)/F,R);
}
}
return reverse(R);
}
A=newmat(2,2);B=mgen(2,"diag",[1],0);
for(I=0,TX=X;TX!=[];TX=cdr(TX),I++){
A[1][1]=0;A[0][1]=1;
if(type(car(TX))!=4){
A[1][0]=1;A[0][0]=car(TX);
}else{
A[1][0]=car(TX)[0];A[0][0]=car(TX)[1];
}
if(vars(A)!=[]) A=red(A);
B=B*A;
if(vars(B)!=[]) B=red(B);
}
if(getopt(var)==1) return [N,B[1][0],B[0][0]];
B=N+B[1][0]/B[0][0];
if(vars(B)!=[]) B=red(B);
return B;
}
if(type(L=getopt(loop))==1&&L>0)
C=x;
else{
C=0;L=0;
}
Sg=getopt(neg)==1?-1:1;
if(L>1){ /* circulate */
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)+Sg/V);
return V;
}else{
C=0;X=reverse(Y);
}
}
for(V=C,X=reverse(X);X!=[];X=cdr(X)){
if(V!=0) V=Sg/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);
Con=getopt(con);
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 && Con==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))<str_len(fctrtos(Q))) Q=R;
Var=pfargs(Q,X|level=1);
for(C=F=0,R=1,V=Var;V!=[];V=cdr(V)){
if(findin(car(V)[1],[cos,sin,tan])>=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(K<L){
Q=R;L=K;
}
}
}
return Q;
}
def isshortneg(P)
{
return(str_len(rtostr(P))>str_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)<str_len(S)) S=SV0;
}else S=monototex(P);
if(Dvi!=-2) S="\\int "+S+S1;
else S="";
for(L=[],V=cdr(V);V!=[];V=cdr(V)){
CL=car(V);S0=["="]; /* a line */
for(FL=0;CL!=[];CL=cdr(CL),FL++){
CT=car(CL); /* a term */
if((Y=CT[0])==0){ /* a variable */
CT=cdr(CT);
if(length(CT)>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)<str_len(SV)) SV=SV0;
if(FL||FT||(F&&type(Y)<2)) SV=minustos(SV);
S2=append(["+",SV],S2);
}
S2=reverse(cdr(S2));
if(type(Y)>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<L-1&&S0[N+1]==94){ /* log(x)^2 -> (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]) */
/* (x_0,x_1,x_2,x_3,...,x_{q+3})=(x,0,1,y_1,...,y_q,\infty)
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 (1/x_1,x_2/x_1,x_3/x_1,x_4/x_1,...)
...
*/
def lft01(X,T)
{
S=0;
if(type(X)==4){
if(type(car(X))==4){
S=X[1];X=car(X);
}
K=length(X);
if(K>=1) D=1;
}
if(D==0) return 0;
if(type(T)==4&&type(car(T))==4&&length(T)==2){
U=newvect(K+3);
for(I=0;I<K+3;I++) U[I]=I;
for(S0=T[0],S1=T[1];S1!=[];S0=cdr(S0),S1=cdr(S1)){
for(J=0,TU=car(S0);;J++){
if(TU=="infty") T0=K+2;
else if(TU==0) T0=1;
else if(TU==1) T0=2;
else {
if((I=findin(TU,X))<0) return 0;
if(I==0) T0=0;
else T0=I+2;
}
if(J){
U[T1]=T0;
break;
}
T1=T0;
TU=car(S1);
}
}
T=vtol(U);
for(I=0;I<K+3;I++) if(findin(I,U)<0) return 0;
}
if(type(T)==4&&(length(T)==K+3||length(T)==2)){
for(U=[],I=K+2;I>=0;I--) U=cons(I,U);
if(length(T)==2) T=mperm(U,[T],0);
L=sexps(T);
for(R=[X,S];L!=[];L=cdr(L)){
if(!(I=car(L))) I=4;
/* else if(I==1) I=1; */
else if(I==2) I=5;
else if(I==K+1) I=6;
else if(I>2) I=2-I;
R=lft01(R,I);
}
return R;
}
if(!S) S=getopt(tr);
if(type(S)==4&&length(S)==K+3){
D=2;
}else if(S==1) for(S=[],I=K+2;I>=0;I--) S=cons(I,S);
else S=0;
if(T<=0){ /* y_i <-> y_{i+1}, y_0=x=x_0, y_i=x_{i+2} */
R=mperm(X,[[-T,1-T]],0);
if(S){
if(!T) S=mperm(S,[[0,3]],0);
else S=mperm(S,[[2-T,3-T]],0); /* : J J=3,...,K; */
R=[R,S];
}
return R;
}else if(T==1){ /* (x_1=0, x_2=1) : 1 */
for(R=[];X!=[];X=cdr(X)) R=cons(1-car(X),R);
if(S) S=mperm(S,[[1,2]],0);
}else if(T==2){ /* (x_1=0, x_{K+2}=infty) */
for(R=[]; X!=[]; X=cdr(X)) R=cons(red(1/car(X)),R);
if(S) S=mperm(S,[[1,K+2]],0);
}else if(T==3){ /* (x_0=x, x_2=1) */
T=car(X);
for(R=[red(1/T)],X=cdr(X); X!=[]; X=cdr(X)) R=cons(red(car(X)/T),R);
if(S) S=mperm(S,[[0,2]],0);
}else if(T==4){ /* (x_0=x,x_1=0) : 0 */
T=car(X);
for(R=[red(T/(T-1))],X=cdr(X); X!=[]; X=cdr(X)) R=cons(red((T-car(X))/(T-1)),R);
if(S) S=mperm(S,[[0,1]],0);
}else if(T==5){ /* (x_2=1,x_3=y) : 2 */
T=X[1];
for(R=[1/T,red(X[0]/T)],X=cdr(cdr(X));X!=[]; X=cdr(X)) R=cons(red(car(X)/T),R);
if(S) S=mperm(S,[[2,3]],0);
}else if(T==6){ /* (x_{K+1}=y_{K-1}, x_{K+2}=infty) : K+1 */
T=X[K-1];
for(R=[];length(X)>1;X=cdr(X)) R=cons(red(car(X)*(1-T)/(car(X)-T)),R);
R=cons(1-T,R);
if(S) S=mperm(S,[[K+1,K+2]],0);
}else if(T==7){ /* x_2=1 <-> x_{K+2}=infty */
for(R=[];X!=[];X=cdr(X)) R=cons(red(car(X)/(car(X)-1)),R);
if(S) S=mperm(S,[[2,K+2]],0);
}else if(T==8) { /* x_0=x <-> x_{K+2}=infty */
T=car(X);
for(R=[1-car(X)], X=cdr(X); X!=[]; X=cdr(X)) R=cons(red((T-1)*car(X)/(T-car(X))),R);
if(S) S=mperm(S,[[0,K+2]],0);
}else return 0;
R=reverse(R);
return S?[R,S]:R;
}
def linfrac01(X)
{
if(type(X)==4){
K=length(X)-2;
if(type(car(X))==4){
for(U=[],I=K+4;I>=0;I--) U=cons(I,U);
X=[car(X),U];
}else U=0;
}
if(K>3 && getopt(over)!=1) return(-1);
II=(K==-1)?3:4;
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; I<II; I++){
S=lft01(P,I);
if(findin(S,L) < 0){
C++; L=cons(S,L);
}
}
}
}
return reverse(L);
}
def varargs(P)
{
if((All=getopt(all))!=1&&All!=2) All=0;
V=vars(P);
for(Arg=FC=[];V!=[];V=cdr(V)){
if(vtype(CV=car(V))==0&&All!=0){
Arg=lsort([CV],Arg,0);
}
if(vtype(CV)!=2) continue;
if(findin(F=functor(CV),FC)<0) FC=cons(F,FC);
for(AT=vars(args(CV));AT!=[];AT=cdr(AT)){
if(vtype(X=car(AT))<2){
if(findin(X,Arg)<0) Arg=cons(X,Arg);
}else if(vtype(X)==2){
R=varargs(X);
if(R[1]!=[]){
Arg=lsort(R[1],Arg,0);
FC=lsort(R[0],FC,0);
}
}
}
}
Arg=reverse(Arg);
return (All==2)?Arg:[reverse(FC),Arg];
}
def pfargs(P,X)
{
if(type(L=getopt(level))!=1) L=0;
for(Var=[],V=vars(P);V!=[];V=cdr(V)){
if(vtype(car(V))==2){
VT=funargs(car(V));
if(length(VT)>1){
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<P2; I++)
if(nthmodp(I,N,P)==X) R=cons(I,R);
return qsort(R);
}
Y=primroot(P);
if(Y==0) return 0;
Z=nthmodp(Y,N,P);
G=igcd(N,P2);
P3=P2/G;
for(I=0, W=1; I<P3;I++){
if(W==X) break;
W=(W*Z)%P;
}
if(I==P3) return [];
W=nthmodp(Y,I,P);
Z=nthmodp(Y,P3,P);
for(I=0,R=[];;){
R=cons(W,R);
if(++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; I<P2; I++)
if((S = (S*Z)%P) == Ind) return I;
return 0;
}
if(getopt(all)==1){
I=primroot(P);
P2=P0^(P1-1)*(P0-1);
for(L=[],J=1; J<P2; J++){
if(P1>1 && 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; I<P; I++){
for(J=0; J<SF; J++)
if(nthmodp(I,(P-1)/F[J][0],P)==1) break;
if(J==SF) return I;
}
}
def rabin(P,X)
{
for(M=0,Q=P-1;iand(Q,1)==0;M++,Q/=2);
Z=nthmodp(X,Q,P);
for(N=M;M>0&&Z!=1&&Z!=P-1;M--,Z=(Z*Z)%P);
return (M<N&&(M==0||Z==1))?0:1;
}
def powprimroot(P,N)
{
if(P<3) P=3;
FE=getopt(exp);
if(FE!=1) FE=0;
if((Log=getopt(log))==1||Log==2) FE=-1;
else if(Log==3){
FE=-2;
for(PP=1, L0=["$r$","$p/a$"];;){
PP=pari(nextprime,PP+1);
if(PP>=P) break;
L0=cons(PP, L0);
}
L0=reverse(L0);
}
if(FE==0) All=getopt(all);
for(I=0, PP=P, LL=[]; I<N; I++,PP++){
PP=pari(nextprime,PP);
if(All==1){
PR=primroot(PP|all=1);
LL=cons(cons(PP,PR),LL);
continue;
}
PR=primroot(PP);
if(FE==-2){ /* log=3 */
LT=cdr(L0);LT=cdr(L0);
for(L=[PP];LT!=[];LT=cdr(LT))
L=cons(primroot(PP|ind=car(LT)),L);
LL=cons(reverse(L),LL);
if(I<N-1) L0=append(L0,[PP]);
}else if(FE){
for(J=1, L=[PP], K=1; J<PP; J++){
if(FE==-1){ /* log=1,2 */
K=primroot(PP|ind=J);
if(K==0 && Log==2) K=PP-1;
}
else K=(K*PR)%PP; /* exp=1 */
L=cons(K,L);
}
LL=cons(reverse(L),LL);
}else
LL=cons([PP,PR],LL); /* default */
}
LL=reverse(LL);
if(!FE) return LL;
PP--;
if(FE==-2) return append(LL,[L0]);
for(I=1,L=["$p$"];I<PP; I++) L=cons(I,L);
return cons(reverse(L),LL);
}
def ntable(F,II,D)
{
F=f2df(F|opt=-1);
Df=getopt(dif);
Str=getopt(str);
if(Df!=1) Df=0;
L=[];
if(type(D)==4){
if(type(II[0])==4){
T1=II[0][1]-II[0][0];T2=II[1][1]-II[1][0];
for(L0=[],I=0;I<D[0];I++){
for(R=[],J=0;J<D[1];J++)
R=cons(myf2eval(F,II[0][0]+I*T1/D[0],II[1][0]+J*T2/D[1]),R);
L=cons(reverse(R),L);L0=cons(II[0][0]+I*T1/D[0],L0);
}
}else{
for(T=II[1]-II[0],L0=[],I=0;I<D[0];I++){
for(R=[],J=0;J<D[1];J++)
R=cons(myfdeval(F,II[0]+I*T/D[0]+J*T/D[0]/D[1]),R);
L=cons(reverse(R),L);L0=cons(II[0]+I*T/D[0],L0);
}
}
L=reverse(L);L0=reverse(L0);
if(type(Str)==4){
L0=mtransbys(os_md.sint,L0,[Str[0]]|str=1,zero=0);
L=mtransbys(os_md.sint,L,[Str[1]]|str=1,zero=0);
if(Df==1){
for(DT=[],RT=L,I=0;RT!=[];){
for(LT=[],TT=car(RT);TT!=[];TT=cdr(TT)){
VV=car(TT);
if((J=str_char(VV,0,"."))>=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)
{
mycat0(S,0);
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<P0+2) mycat(["Error! Definiton of", LS[P[0]],
"in .muldif"]);
}else{
SV=eval_str(str_cut(S,P0+1,str_len(S)-1));
if(P[0]==5) TeXLim=SV;
else if(P[0]==6) TeXEq=SV;
else if(P[0]==7) TikZ=SV;
else if(P[0]==8) XYPrec=SV;
else if(P[0]==9) XYcm=SV;
else if(P[0]==10) Canvas=SV;
}
}
}
close_file(Id);
}
chkfun(1,0);
}
#ifdef USEMODULE
endmodule;
os_md.init()$
#else
init()$
#endif
end$
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to os_muldif.rr CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / asir-contrib / packages / src