=================================================================== RCS file: /home/cvs/OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v retrieving revision 1.58 retrieving revision 1.69 diff -u -p -r1.58 -r1.69 --- OpenXM/src/asir-contrib/packages/src/os_muldif.rr 2020/02/25 02:47:35 1.58 +++ OpenXM/src/asir-contrib/packages/src/os_muldif.rr 2020/05/17 23:15:26 1.69 @@ -1,4 +1,4 @@ -/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.57 2020/02/21 05:36:17 takayama Exp $ */ +/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.68 2020/05/16 05:40:32 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 */ @@ -6,7 +6,7 @@ /* #undef USEMODULE */ /* os_muldif.rr (Library for Risa/Asir) - * Toshio Oshima (Nov. 2007 - Feb. 2020) + * Toshio Oshima (Nov. 2007 - May. 2020) * * For polynomials and differential operators with coefficients * in rational funtions (See os_muldif.pdf) @@ -119,6 +119,7 @@ localf ladd$ localf lchange$ localf llsize$ localf llbase$ +localf llget$ localf lsort$ localf rsort$ localf lpair$ @@ -142,6 +143,7 @@ localf mpower$ localf mrot$ localf texlen$ localf isdif$ +localf isfctr$ localf fctrtos$ localf texlim$ localf fmult$ @@ -151,6 +153,7 @@ localf ptol$ localf rmul$ localf mtransbys$ localf trcolor$ +localf mcolor$ localf drawopt$ localf execdraw$ localf execproc$ @@ -427,6 +430,7 @@ localf cmpf$ localf areabezier$ localf saveproc$ localf xyplot$ +localf xyaxis$ localf xygraph$ localf xy2graph$ localf addIL$ @@ -490,7 +494,7 @@ extern AMSTeX$ extern Glib_math_coordinate$ extern Glib_canvas_x$ extern Glib_canvas_y$ -Muldif.rr="00200223"$ +Muldif.rr="00200515"$ AMSTeX=1$ TeXEq=5$ TeXLim=80$ @@ -1298,13 +1302,13 @@ def vprod(V1,V2) def dnorm(V) { - if(type(V)<2) return dabs(V); + if(type(V)<2) return ctrl("bigfloat")?abs(V):dabs(V); if((M=getopt(max))==1||M==2){ if(type(V)==5) V=vtol(V); for(S=0;V!=[];V=cdr(V)){ - if(M==2) S+=dabs(car(V)); + if(M==2) S+=ctrl("bigfloat")?abs(car(V)):dabs(car(V)); else{ - if((T=dabs(car(V)))>S) S=T; + if((T=ctrl("bigfloat")?abs(car(V)):dabs(car(V)))>S) S=T; } } return S; @@ -1319,7 +1323,7 @@ def dnorm(V) } for(;V!=[]; V=cdr(V)) R+=real(car(V))^2+imag(car(V))^2; } - return dsqrt(R); + return ctrl("bigfloat")?pari(sqrt,R):dsqrt(R); } def dvprod(V1,V2) @@ -3464,7 +3468,45 @@ def rsort(L,T,K) return (iand(K,1))? reverse(R):R; } +def llget(L,LL,LC) +{ + if(type(LL)==4){ + LM=length(L); + for(R=[];LL!=[];LL=cdr(LL)){ + if(isint(TL=car(LL))) R=cons(TL,R); + else{ + IM=(length(TL)==1)?(LM-1):TL[1]; + for(I=car(TL);I<=IM;I++) R=cons(I,R); + } + } + LL=reverse(R); + if(LC==-1){ + LL=lsort(LL,[],1); + return lsort(L,"num",["sub"]|c1=LL); + } + L=lsort(L,"num",["get"]|c1=LL); + } + if(type(LC)==4){ + LM=length(L[0]); + for(R=[];LC!=[];LC=cdr(LC)){ + if(isint(TL=car(LC))) R=cons(TL,R); + else{ + IM=(length(TL)==1)?(LM-1):TL[1]; + for(I>=car(TL);I<=IM;I++) R=cons(I,R); + } + } + LC=reverse(R); + if(LL==-1){ + LC=lsort(LC,[],1); + return lsort(L,"col",["setminus"]|c1=LC); + } + L=lsort(L,"col",["put"]|c1=LC); + } + if(getopt(flat)==1) L=m2l(L|flat=1); + return L; +} + def lsort(L1,L2,T) { C1=getopt(c1);C2=getopt(c2); @@ -3509,9 +3551,8 @@ def lsort(L1,L2,T) }else{ for(I=0;LT!=[];I++,LT=cdr(LT)) if(findin(I,C1)<0) RT=cons(car(LT),RT); - RT=reverse(RT); } - R=cons(RT,R); + R=cons(reverse(RT),R); } return reverse(R); } @@ -3867,30 +3908,9 @@ def lgcd(L) return []; } -#if0 -def llcm(L) -{ - if(type(L)==5||type(L)==6) L=m2l(L); - if(type(L)<4) L=[L]; - if(type(L)==4){ - F=getopt(poly); - V=car(L); - while((L=cdr(L))!=[]){ - if(V!=0){ - if((V0=car(L))!=0) - V=(F==1)?red(V*V0/gcd(V,V0)):ilcm(V,V0); - } - else V=car(L); - } - if(F!=1&&V<0) V=-V; - return V; - } - return []; -} -#else def llcm(R) { - if(type(R)==4||type(R)==5) R=m2l(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); @@ -3932,7 +3952,6 @@ def llcm(R) } return P; } -#fi def ldev(L,S) { @@ -4417,10 +4436,12 @@ def fctrtos(P) if(D>1) Op+="^"+((D>9)?(Pre+rtostr(D)+Post):rtostr(D)); PW=Op+Add+"}{"+PW+"}"; }else if(Add!=0) PW=PW+Add; + CD=0; if(TeX>=1){ if(type(PC)==1 && ntype(PC)==0 && PC<0) OC="-"+my_tex_form(-PC); else OC=fctrtos(PC|TeX=1,br=1); + if(isint(PC)&&(PC<-1||PC>1)) CD=1; }else OC=fctrtos(PC|br=1); if(PW!=""){ if(OC == "1") OC = ""; @@ -4451,7 +4472,13 @@ def fctrtos(P) }else L=LL; }else L+=LL; }else if(length(Tm)!=1) PW += CR; /* not final term */ - if(TeX) OC=texsp(OC); + 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); @@ -4481,14 +4508,14 @@ def fctrtos(P) if(imag(P)==0) P = fctr(P); /* usual polynomial */ else P=[[P,1]]; S = str_tb(0,0); - for(J = N = 0; J < length(P); J++){ - if(type(P[J][0]) <= 1){ - if(P[J][0] == -1){ + for(J = N = CD = 0; J < length(P); J++){ + if(type(V=P[J][0]) <= 1){ + if(V == -1){ write_to_tb("-",S); if(length(P) == 1) str_tb("1", S); - }else if(P[J][0] != 1){ - str_tb((TeX>=1)?my_tex_form(P[J][0]):rtostr(P[J][0]), S); + }else if(V != 1){ + str_tb((TeX>=1)?my_tex_form(V):rtostr(V), S); N++; }else if(length(P) == 1) str_tb("1", S); @@ -4496,6 +4523,7 @@ def fctrtos(P) str_tb((TeX>=1)?my_tex_form(P[1][0]):rtostr(P[1][0]), S); J++; } + if(J==0&&isint(V=P[J][0])&&(V<-1||V>1)) CD=1; continue; } if(N > 0 && TeX != 1 && TeX != 2 && TeX != 3) @@ -4509,6 +4537,10 @@ def fctrtos(P) str_tb(["^", (TeX>1)?rtotex(P[J][1]):monotos(P[J][1])],S); }else{ if(nmono(P[J][0])>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); } } @@ -4726,6 +4758,29 @@ def trcolor(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; @@ -4769,7 +4824,7 @@ def openGlib(W) } if(type(W)==4&&length(W)==2){ Glib_canvas_x=W[0]; - Glib_canvax_y=W[1]; + Glib_canvas_y=W[1]; } Glib_math_coordinate=1; if(getopt(null)!=1) return glib_open(); @@ -7359,12 +7414,13 @@ def pcoef(P,L,Q) def pmaj(P) { if(type(P)==4){ - Opt=delopt(getopt(),"var"|inv=1); - P=mtransbys(os_md.pmaj,P,[]|optilon_list=Opt); - if(Opt==[]) return P; + 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(P,X); - for(S=0;D>=0;D--) S+=lmax(mycoef(P,D,X))*X^D; + D=mydeg(Q,X); + for(S=0;D>=0;D--) S+=lmax(mycoef(Q,D,X))*X^D; return S; } V=vars(P); @@ -11146,7 +11202,7 @@ def my_tex_form(S) S=cons(123,S); if(F==2) SS=cdr(SS); else if(F==0) S=cons(car(SS),S); - }else if(F==2&&P-Q==3){ /* (2)^x -> 2^x*/ + }else if(F==2&&P-Q==3){ /* (2)^x -> 2^x */ SS=cdr(SS);SS=cdr(SS); S=cons(123,S);S=cons(car(SS),S);S=cons(125,S); SS=cdr(SS);SS=cdr(SS); @@ -11167,7 +11223,16 @@ def my_tex_form(S) SS=reverse(S); Top=P; } - S=asciitostr(SS); + for(F=G=0,S=[];SS!=[];SS=cdr(SS)){ /* 22^x -> 2\cdot 2^x */ + if(F==1&&G!=-1&&car(SS)==123 && length(SS)>1 && isnum(SS[1])) + S=append([116,111,100,99,92],S); + G=F; + if(car(SS)==125||car(SS)==95) F=-1; + else F=isnum(car(SS)); + S=cons(car(SS),S); + } + S=asciitostr(reverse(S)); +/* S=asciitostr(SS); */ if((K=getopt(ket))==1) S=texket(S); else if(K==2) S=texket(S|all=1); return S; @@ -11618,14 +11683,27 @@ def getbyshell(S) return open_file(F); } +def isfctr(P) +{ + if(type(P)>3) return 0; + if(type(P)==3) return (!isfctr(nm(P))||!isfctr(dn(P)))?0:1; + V=ptol(P,vars(P)|opt=0); + for(;V!=[];V=cdr(V)){ + if(type(car(V))>1||ntype(car(V))>0) return 0; + } + return 1; +} + def show(P) { T=type(P); S=P; Var=getopt(opt); + if((Raw=getopt(raw))!=1) Raw=0; if(Var=="verb"){ - dviout("{\\tt"+verb_tex_form(T)+"}\n\n"); - return; + S="{\\tt"+verb_tex_form(T)+"}\n\n"; + if(Raw) return S; + dviout(S);return; } if(type(Var)<0) Var=getopt(var); if(T==6){ @@ -11643,23 +11721,28 @@ def show(P) if(Var=="pfrac") X=var(P); else X=getopt(pfrac); if(isvar(X)){ - pfrac(P,X|dviout=1); - return; + if(Raw) return pfrac(P,X|TeX=1); + pfrac(P,X|dviout=1);return; } - Opt=cons(["dviout",1],getopt()); - if(type(Var)==2||type(Var)==4||type(Var)==7) fctrtos(P|option_list=Opt); - else{ + Opt=getopt(); + if(type(Var)!=2&&type(Var)!=4&&type(Var)!=7){ if(isdif(P)!=0) Opt=cons(["var","dif"],Opt); else Opt=cons(["br",1],Opt); - fctrtos(P|option_list=Opt); } - return; + if(!isfctr(P)){ + if(Raw) return my_tex_form(P); + else{ + dviout(P); return; + } + } + if(Raw) return fctrtos(P|option_list=cons(["TeX",3],Opt)); + fctrtos(P|option_list=cons(["dviout",1],Opt));return; }else if(T==4){ if(type(Var)==4 || type(Var)==7){ S=ltotex(P|option_list=getopt()); if(Var=="text"){ - dviout(S); - return; + if(Raw) return S; + dviout(S);return; } }else{ for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ @@ -11687,8 +11770,8 @@ def show(P) if(F==1) S=ltotex(P|opt="spt"); else if(F==2){ M=mtranspose(lv2m(S)); - show(M|sp=1); /* GRS */ - return; + if(Raw) return show(M|sp=1,raw=1); /* GRS */ + show(M|sp=1);return; }else if(F==7) S=ltotex(P|opt="spts"); else{ for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ @@ -11723,11 +11806,13 @@ def show(P) if(Var=="raw" || (Var !="eq" && str_chr(P,0,"\\")<0 && str_char(P,0,"^")<0 && str_char(P,0,"_")<0 && str_char(P,0,"&")<0)){ - dviout(P+"\n\n"); - return; + S=P+"\n\n"; + if(Raw) return S; + dviout(S); return; } } - dviout(S|eq=5); + if(Raw) return "\\begin{align}\\begin{split}\n &"+S+"\\end{split}\\end{align}"; + else dviout(S|eq=5); } @@ -12776,84 +12861,202 @@ def rungeKutta(F,N,Lx,Y,IY) 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(isint(Er=getopt(er))&&Er>0){ - Opt=delopt(getopt(),["er","mul"]); - L0=pwTaylor(F,N,Lx,Y,Ly,M|option_list=cons(["mul",FL*(Er+1)],Opt)); - }else Er=0; if(length(Lx)>2){ V=car(Lx);Lx=cdr(Lx); }else V=t; if(!isvar(T=getopt(var))) V=t; - if((Pr=getopt(prec))==1){ + 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; - H=(Lx[1]-Lx[0])/N*One; S=vtol(pTaylor(F,Y,M|time=V)); + FM=pmaj(F|var=x); LS=length(S); - if(type(Vw=getopt(view))==4){ - glib_window(car(Vw)[0], car(Vw)[1],car(Vw)[2],car(Vw)[3]); - if(length(Vw)>1 && (C=trcolor(Vw[1]))!=0) Opt=[["color",C]]; - else Opt=[]; + + 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||size(Mt)!=[]) Mt=0; + 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){ - Mt=newmat(2,LS);Mt[0][0]=Mt[1][1]=1; + 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) glib_putpixel(Lx[0],Mt*Ly[0]|option_list=Opt); + if(LS==1+Tf||Sf) glib_putpixel(Lx[0],Mt*Ly[Tf]|color=mcolor(Cl,0)); else{ - YT=ptaffine(Mt,Ly); - glib_putpixel(YT[0],YT[1]|option_list=Opt); + YT=Mt*ltov(Ly); + glib_putpixel(YT[0],YT[1]|color=mcolor(Cl,0)); } } }else Vw=0; - R=[cons(T=Lx[0],Ly)]; - for(C=0,T+=H;C1&&Inf[0]>4){ /* explosion */ + Ck=Inf[0];Ckm=Inf[1]; + if(length(Inf)>2) MM=Inf[2]; + if(!isint(MM)||MM<1) MM=2; + if(length(Inf)>3) C1=Inf[3]; + if(type(C1)!=1||C1<0) C1=1; + if(length(Inf)>4) CB=Inf[4]; + }else if(isint(Inf)&&Inf>0&&Inf<100){ + MM=Inf+1;Ck=100; + }else Inf=0; + Ckm*=Ck; + + SS=subst(S,V,H);N0=N; + if(Er>0){ + HE=H/(Er+1);SSE=subst(S,V,HE);LyE=Ly; + } + for(C=CC=CF=0;C=Ck){ /* check explosion */ + CC=0; + D0=dnorm(Ly|max=1); + if(Er&&CF){ + DE=dnorm(ladd(LyE,Ly,-1)|max=1); + if(CB*DE>D0) break; + } + for(Dy=F,TY=Y,TL=Ly;TY!=[];TY=cdr(TY),TL=cdr(TL)) + Dy=subst(Dy,car(TY),One*car(TL)); + D1=dnorm(Dy|max=1);D2=subst(FM,x,2*D0+C1);D3=D1+D2; + HH=2*(D0+C1)/Ckm; + if(HHHH) H/=2; + if(H*7/51) N*=MM; + MM=0; + } + CC=0; + } + + T+=H; for(Dy=SS,TY=Y,TL=Ly;TY!=[];TY=cdr(TY),TL=cdr(TL)) Dy=subst(Dy,car(TY),One*car(TL)); -/* Ly=subst(Dy,V,H); */ 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) glib_putpixel(deval(T),Mt*Ly[0]|option_list=Opt); + if(LS==1+Tf||Sf) CR=CC/N0; else{ - YT=ptaffine(Mt,Ly); - glib_putpixel(YT[0],YT[1]|option_list=Opt); + 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=cons(deval(T),(V1)?[car(Ly)]:Ly); + 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){ + if(Er){ /* Estimate error */ + LE=(FL<0)?((V1)?car(LyE):LyE):reverse(RE); if(FL>0){ - for(S=L,T=L0,D=[];S!=[];S=cdr(S),T=cdr(T)) D=cons(os_md.ladd(car(S),car(T),-1),D); - E=map(os_md.dnorm,reverse(D));F=map(os_md.nlog,E); + 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,L0,-1);F=nlog(dnorm(D)); - }else F=nlog(abs(L-L0)); - return [L,F]; + 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; } @@ -14218,9 +14421,49 @@ def fcont(F,LX) def xyplot(L,LX,LY) { - LX=map(deval,LX);LY=map(deval,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),lmax(L0)]; + S=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),lmax(L0)]; + S=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); + return [LX,LY]; + } Opt=getopt();Opt0=delopt(Opt,["dviout","proc"]); - for(S="",L0=[],TL=L;TL!=[];TL=cdr(TL)){ + if(type(R=getopt(to))!=4) To=[12,8]; + R=[To[0]/(LX[1]-LX[0]),RY=To[1]/(LY[1]-LY[0])]; + R=[sint(R[0],4|str=0),sint(R[1],4|str=0)]; + S="% "; + if(type(C=getopt(scale))!=1&&type(C)!=4){ + Opt0=cons(["scale",R],Opt0); + S+="scale="+rtostr(R)+", "; + } + S+=rtostr(LX)+", "+rtostr(LY)+"\n"; + for(L0=[],TL=L;TL!=[];TL=cdr(TL)){ TTL=map(deval,car(TL)); if(TTL[0]LX[1]||TTL[1]LY[1]){ S+=xylines(reverse(L0)|option_list=Opt0); @@ -14230,9 +14473,49 @@ def xyplot(L,LX,LY) } } if(length(L0)>1) S+=xylines(reverse(L0)|option_list=Opt0); - if(type(AX=getopt(ax))==4) S+=xygraph([0,0],0,LX,LX,LY|option_list=delopt(Opt0,"opt")); + 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)