| version 1.39, 2018/10/17 01:37:10 |
version 1.77, 2020/11/06 00:01:40 |
|
|
| /* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.38 2018/10/10 07:02:22 takayama Exp $ */
|
/* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.76 2020/10/13 02:58:16 takayama Exp $ */
|
| /* The latest version will be at ftp://akagi.ms.u-tokyo.ac.jp/pub/math/muldif |
/* 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 |
scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs |
| */ |
*/ |
| #define USEMODULE 1 |
#define USEMODULE 1 |
| /* #undef USEMODULE */ |
/* #undef USEMODULE */ |
| |
|
| /* os_muldif.rr (Library for Risa/Asir) |
/* os_muldif.rr (Library for Risa/Asir) |
| * Toshio Oshima (Nov. 2007 - Sep. 2018) |
* Toshio Oshima (Nov. 2007 - Nov. 2020) |
| * |
* |
| * For polynomials and differential operators with coefficients |
* For polynomials and differential operators with coefficients |
| * in rational funtions (See os_muldif.pdf) |
* in rational funtions (See os_muldif.pdf) |
|
|
| static Muldif.rr$ |
static Muldif.rr$ |
| static TeXEq$ |
static TeXEq$ |
| static TeXLim$ |
static TeXLim$ |
| |
static TeXPages$ |
| static DIROUT$ |
static DIROUT$ |
| static DIROUTD$ |
static DIROUTD$ |
| static DVIOUTL$ |
static DVIOUTL$ |
|
|
| static ID_PLOT$ |
static ID_PLOT$ |
| static Rand$ |
static Rand$ |
| static LQS$ |
static LQS$ |
| |
static SVORG$ |
| localf spType2$ |
localf spType2$ |
| localf erno$ |
localf erno$ |
| localf chkfun$ |
localf chkfun$ |
|
|
| localf mycoef$ |
localf mycoef$ |
| localf mydiff$ |
localf mydiff$ |
| localf myediff$ |
localf myediff$ |
| |
localf mypdiff$ |
| |
localf pTaylor$ |
| |
localf pwTaylor$ |
| localf m2l$ |
localf m2l$ |
| localf m2ll$ |
localf m2ll$ |
| localf mydeg$ |
localf mydeg$ |
|
|
| localf sprod$ |
localf sprod$ |
| localf sinv$ |
localf sinv$ |
| localf slen$ |
localf slen$ |
| |
localf sexps$ |
| localf sord$ |
localf sord$ |
| localf vprod$ |
localf vprod$ |
| localf dvangle$ |
localf dvangle$ |
| localf dvprod$ |
localf dvprod$ |
| localf dnorm$ |
localf dnorm$ |
| |
localf dext$ |
| localf mulseries$ |
localf mulseries$ |
| localf pluspower$ |
localf pluspower$ |
| localf vtozv$ |
localf vtozv$ |
|
|
| localf matrtop$ |
localf matrtop$ |
| localf mytrace$ |
localf mytrace$ |
| localf mydet$ |
localf mydet$ |
| |
localf permanent$ |
| localf mperm$ |
localf mperm$ |
| localf mtranspose$ |
localf mtranspose$ |
| localf mtoupper$ |
localf mtoupper$ |
|
|
| localf mymod$ |
localf mymod$ |
| localf mmod$ |
localf mmod$ |
| localf ladd$ |
localf ladd$ |
| |
localf lsub$ |
| localf lchange$ |
localf lchange$ |
| localf llsize$ |
localf llsize$ |
| localf llbase$ |
localf llbase$ |
| |
localf llget$ |
| localf lsort$ |
localf lsort$ |
| |
localf rsort$ |
| localf lpair$ |
localf lpair$ |
| localf lmax$ |
localf lmax$ |
| localf lmin$ |
localf lmin$ |
|
|
| localf mrot$ |
localf mrot$ |
| localf texlen$ |
localf texlen$ |
| localf isdif$ |
localf isdif$ |
| |
localf isfctr$ |
| localf fctrtos$ |
localf fctrtos$ |
| localf texlim$ |
localf texlim$ |
| localf fmult$ |
localf fmult$ |
|
|
| localf ptol$ |
localf ptol$ |
| localf rmul$ |
localf rmul$ |
| localf mtransbys$ |
localf mtransbys$ |
| |
localf trcolor$ |
| |
localf mcolor$ |
| localf drawopt$ |
localf drawopt$ |
| localf execdraw$ |
localf execdraw$ |
| localf execproc$ |
localf execproc$ |
|
|
| localf myacos$ |
localf myacos$ |
| localf myatan$ |
localf myatan$ |
| localf mylog$ |
localf mylog$ |
| |
localf nlog$ |
| localf mypow$ |
localf mypow$ |
| localf scale$ |
localf scale$ |
| |
localf iceil$ |
| localf arg$ |
localf arg$ |
| localf sqrt$ |
localf sqrt$ |
| localf gamma$ |
localf gamma$ |
| Line 235 localf sftpowext$ |
|
| Line 251 localf sftpowext$ |
|
| localf polinsft$ |
localf polinsft$ |
| localf pol2sft$ |
localf pol2sft$ |
| localf polroots$ |
localf polroots$ |
| |
localf sgnstrum$ |
| |
localf polstrum$ |
| |
localf polrealroots$ |
| |
localf polradiusroot$ |
| localf fctri$ |
localf fctri$ |
| localf binom$ |
localf binom$ |
| localf expower$ |
localf expower$ |
| Line 242 localf seriesHG$ |
|
| Line 262 localf seriesHG$ |
|
| localf seriesMc$ |
localf seriesMc$ |
| localf seriesTaylor$ |
localf seriesTaylor$ |
| localf mulpolyMod$ |
localf mulpolyMod$ |
| |
localf solveEq$ |
| |
localf res0$ |
| |
localf eqs2tex$ |
| |
localf baseODE$ |
| |
localf baseODE0$ |
| localf taylorODE$ |
localf taylorODE$ |
| localf evalred$ |
localf evalred$ |
| localf toeul$ |
localf toeul$ |
|
|
| localf polbyroot$ |
localf polbyroot$ |
| localf polbyvalue$ |
localf polbyvalue$ |
| localf pcoef$ |
localf pcoef$ |
| |
localf pmaj$ |
| localf prehombf$ |
localf prehombf$ |
| localf prehombfold$ |
localf prehombfold$ |
| localf sub3e$ |
localf sub3e$ |
|
|
| localf iscombox$ |
localf iscombox$ |
| localf sproot$ |
localf sproot$ |
| localf spgen$ |
localf spgen$ |
| |
localf spbasic$ |
| localf chkspt$ |
localf chkspt$ |
| localf cterm$ |
localf cterm$ |
| localf terms$ |
localf terms$ |
|
|
| localf s2sjis$ |
localf s2sjis$ |
| localf r2ma$ |
localf r2ma$ |
| localf evalma$ |
localf evalma$ |
| |
localf evalcoord$ |
| |
localf readTikZ$ |
| localf ssubgrs$ |
localf ssubgrs$ |
| localf verb_tex_form$ |
localf verb_tex_form$ |
| localf tex_cuteq$ |
localf tex_cuteq$ |
| Line 333 localf divmattex$ |
|
| Line 362 localf divmattex$ |
|
| localf dviout0$ |
localf dviout0$ |
| localf myhelp$ |
localf myhelp$ |
| localf isMs$ |
localf isMs$ |
| |
localf getline$ |
| localf showbyshell$ |
localf showbyshell$ |
| localf readcsv$ |
localf readcsv$ |
| localf tocsv$ |
localf tocsv$ |
|
|
| localf getbygrs$ |
localf getbygrs$ |
| localf mcop$ |
localf mcop$ |
| localf shiftop$ |
localf shiftop$ |
| |
localf shiftPfaff; |
| localf conf1sp$ |
localf conf1sp$ |
| localf confexp$ |
localf confexp$ |
| localf confspt$ |
localf confspt$ |
| |
localf vConv$ |
| |
localf mcvm$ |
| |
localf s2csp$ |
| localf partspt$ |
localf partspt$ |
| localf pgen$ |
localf pgen$ |
| localf diagm$ |
localf diagm$ |
| Line 385 localf primroot$ |
|
| Line 419 localf primroot$ |
|
| localf varargs$ |
localf varargs$ |
| localf ptype$ |
localf ptype$ |
| localf pfargs$ |
localf pfargs$ |
| |
localf regress$ |
| localf average$ |
localf average$ |
| localf tobig$ |
localf tobig$ |
| localf sint$ |
localf sint$ |
| localf frac2n$ |
localf frac2n$ |
| |
localf openGlib$ |
| localf xyproc$ |
localf xyproc$ |
| localf xypos$ |
localf xypos$ |
| localf xyput$ |
localf xyput$ |
| Line 409 localf periodicf$ |
|
| Line 445 localf periodicf$ |
|
| localf cmpf$ |
localf cmpf$ |
| localf areabezier$ |
localf areabezier$ |
| localf saveproc$ |
localf saveproc$ |
| |
localf xyplot$ |
| |
localf xyaxis$ |
| localf xygraph$ |
localf xygraph$ |
| localf xy2graph$ |
localf xy2graph$ |
| localf addIL$ |
localf addIL$ |
| Line 419 localf xyarrows$ |
|
| Line 457 localf xyarrows$ |
|
| localf xyang$ |
localf xyang$ |
| localf xyoval$ |
localf xyoval$ |
| localf xypoch$ |
localf xypoch$ |
| |
localf xycircuit$ |
| |
localf ptline$ |
| localf ptcommon$ |
localf ptcommon$ |
| |
localf ptcontain$ |
| localf ptcopy$ |
localf ptcopy$ |
| localf ptaffine$ |
localf ptaffine$ |
| localf ptlattice$ |
localf ptlattice$ |
| localf ptpolygon$ |
localf ptpolygon$ |
| localf ptwindow$ |
localf ptwindow$ |
| |
localf ptconvex$ |
| localf ptbbox$ |
localf ptbbox$ |
| |
localf darg$ |
| |
localf dwinding$ |
| localf lninbox$ |
localf lninbox$ |
| localf ptcombezier$ |
localf ptcombezier$ |
| localf ptcombz$ |
localf ptcombz$ |
|
|
| extern Muldif.rr$ |
extern Muldif.rr$ |
| extern TeXEq$ |
extern TeXEq$ |
| extern TeXLim$ |
extern TeXLim$ |
| |
extern TeXPages$ |
| extern DIROUT$ |
extern DIROUT$ |
| extern DIROUTD$ |
extern DIROUTD$ |
| extern DVIOUTL$ |
extern DVIOUTL$ |
|
|
| extern XYcm$ |
extern XYcm$ |
| extern TikZ$ |
extern TikZ$ |
| extern XYLim$ |
extern XYLim$ |
| |
extern TeXPages$ |
| extern Canvas$ |
extern Canvas$ |
| extern ID_PLOT$ |
extern ID_PLOT$ |
| extern Rand$ |
extern Rand$ |
| extern LQS$ |
extern LQS$ |
| |
extern SV=SVORG$ |
| #endif |
#endif |
| static S_Fc,S_Dc,S_Ic,S_Ec,S_EC,S_Lc$ |
static S_Fc,S_Dc,S_Ic,S_Ec,S_EC,S_Lc$ |
| static S_FDot$ |
static S_FDot$ |
| extern AMSTeX$ |
extern AMSTeX$ |
| Muldif.rr="00181008"$ |
extern Glib_math_coordinate$ |
| |
extern Glib_canvas_x$ |
| |
extern Glib_canvas_y$ |
| |
Muldif.rr="00201103"$ |
| AMSTeX=1$ |
AMSTeX=1$ |
| TeXEq=5$ |
TeXEq=5$ |
| TeXLim=80$ |
TeXLim=80$ |
| |
TeXPages=20$ |
| TikZ=0$ |
TikZ=0$ |
| XYcm=0$ |
XYcm=0$ |
| XYPrec=3$ |
XYPrec=3$ |
| Line 487 LCOPT=["red","green","blue","yellow","cyan","magenta", |
|
| Line 538 LCOPT=["red","green","blue","yellow","cyan","magenta", |
|
| COLOPT=[0xff,0xff00,0xff0000,0xffff,0xffff00,0xff00ff,0,0xffffff,0xc0c0c0]$ |
COLOPT=[0xff,0xff00,0xff0000,0xffff,0xffff00,0xff00ff,0,0xffffff,0xc0c0c0]$ |
| LPOPT=["above","below","left","right"]$ |
LPOPT=["above","below","left","right"]$ |
| LFOPT=["very thin","thin","dotted","dashed"]$ |
LFOPT=["very thin","thin","dotted","dashed"]$ |
| |
SVORG=["x","y","z","w","u","v","p","q","r","s"]$ |
| Canvas=[400,400]$ |
Canvas=[400,400]$ |
| LQS=[[1,0]]$ |
LQS=[[1,0]]$ |
| |
|
|
|
| Do = 1; |
Do = 1; |
| } |
} |
| if(CR) print(""); |
if(CR) print(""); |
| |
else print("",2); |
| } |
} |
| |
|
| def fcat(S,X) |
def fcat(S,X) |
|
|
| [getenv("HOME"),get_rootdir(),"/"])+"/"; |
[getenv("HOME"),get_rootdir(),"/"])+"/"; |
| if(isMs()) DIROUTD=str_subst(DIROUTD,"/","\\"|sjis=1); |
if(isMs()) DIROUTD=str_subst(DIROUTD,"/","\\"|sjis=1); |
| } |
} |
| if(S==-1) return; |
|
| T="fcat"; |
T="fcat"; |
| if(S>=2&&S<=9) T+=rtostr(S); |
if(S>=2&&S<=9) T+=rtostr(S); |
| T=DIROUTD+T+".txt"; |
T=DIROUTD+T+".txt"; |
|
|
| Do = 1; |
Do = 1; |
| } |
} |
| if(T) print(""); |
if(T) print(""); |
| |
else print("",2); |
| } |
} |
| |
|
| def findin(M,L) |
def findin(M,L) |
| Line 773 def myediff(P,X) |
|
| Line 826 def myediff(P,X) |
|
| return red(X*diff(P,X)); |
return red(X*diff(P,X)); |
| } |
} |
| |
|
| |
def mypdiff(P,L) |
| |
{ |
| |
if(type(P)>3) return map(os_md.mypdiff,P,L); |
| |
for(Q=0;L!=[];L=cdr(L)){ |
| |
Q+=mydiff(P,car(L))*L[1]; |
| |
L=cdr(L); |
| |
} |
| |
return red(Q); |
| |
} |
| |
|
| |
def pTaylor(S,X,N) |
| |
{ |
| |
if(!isvar(T=getopt(time))) T=t; |
| |
if(type(S)<4) S=[S]; |
| |
if(type(X)<4) X=[X]; |
| |
if(findin(T,varargs(S|all=2))>=0){ |
| |
S=cons(z_z,S);X=cons(z_z,X);FT=1; |
| |
}else FT=0; |
| |
LS=length(S); |
| |
FR=(getopt(raw)==1)?1:0; |
| |
if(!FR) R=newvect(LS); |
| |
else R=R1=[]; |
| |
for(L=[],I=0,TS=S,TX=X;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) |
def m2l(M) |
| { |
{ |
| if(type(M) < 4) |
if(type(M) < 4) |
|
|
| |
|
| def mydeg(P,X) |
def mydeg(P,X) |
| { |
{ |
| if(type(P) < 3) |
if(type(P) < 3 && type(X)==2) |
| return deg(P,X); |
return deg(P,X); |
| II = -1; |
II=(type(X)==4)?-100000:-1; |
| Opt = getopt(opt); |
Opt = getopt(opt); |
| if(type(P) >= 4){ |
if(type(P) >= 4){ |
| S=(type(P) == 6)?size(P)[0]:0; |
S=(type(P) == 6)?size(P)[0]:0; |
| P = m2l(P); |
P = m2l(P); |
| for(I = 0, Deg = -3; P != []; P = cdr(P), I++){ |
for(I = 0, Deg = -100000; P != []; P = cdr(P), I++){ |
| if( (DT = mydeg(car(P),X)) == -2) |
if( (DT = mydeg(car(P),X)) == -2&&type(X)!=4) |
| return -2; |
return -2; |
| if(DT > Deg){ |
if(DT > Deg){ |
| Deg = DT; |
Deg = DT; |
|
|
| return (Opt==1)?([Deg,(S==0)?II:[idiv(II,S),irem(II,S)]]):Deg; |
return (Opt==1)?([Deg,(S==0)?II:[idiv(II,S),irem(II,S)]]):Deg; |
| } |
} |
| P = red(P); |
P = red(P); |
| if(deg(dn(P),X) == 0) |
if(type(X)==2){ |
| return deg(nm(P),X); |
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; |
return -2; |
| } |
} |
| |
|
| Line 891 def mulsubst(F,L) |
|
| Line 1010 def mulsubst(F,L) |
|
| if(N == 0) |
if(N == 0) |
| return F; |
return F; |
| if(type(L[0])!=4) L=[L]; |
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){ |
if(getopt(inv)==1){ |
| for(R=[];L!=[];L=cdr(L)) R=cons([car(L)[1],car(L)[0]],R); |
for(R=[];L!=[];L=cdr(L)) R=cons([car(L)[1],car(L)[0]],R); |
| L=reverse(R); |
L=reverse(R); |
|
|
| return 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) |
def sord(W,V) |
| { |
{ |
| L = length(W); |
L = length(W); |
|
|
| |
|
| def vprod(V1,V2) |
def vprod(V1,V2) |
| { |
{ |
| |
V1=lsub(V1);V2=lsub(V2); |
| for(R = 0, I = length(V1)-1; I >= 0; I--) |
for(R = 0, I = length(V1)-1; I >= 0; I--) |
| R = radd(R, rmul(V1[I], V2[I])); |
R = radd(R, rmul(V1[I], V2[I])); |
| return R; |
return R; |
| Line 1206 def vprod(V1,V2) |
|
| Line 1339 def vprod(V1,V2) |
|
| |
|
| def dnorm(V) |
def dnorm(V) |
| { |
{ |
| if(type(V)<2) return dabs(V); |
if(type(V)<2) return ctrl("bigfloat")?abs(V):dabs(V); |
| |
if((M=getopt(max))==1||M==2){ |
| |
if(type(V)==5) V=vtol(V); |
| |
for(S=0;V!=[];V=cdr(V)){ |
| |
if(M==2) S+=ctrl("bigfloat")?abs(car(V)):dabs(car(V)); |
| |
else{ |
| |
if((T=ctrl("bigfloat")?abs(car(V)):dabs(car(V)))>S) S=T; |
| |
} |
| |
} |
| |
return S; |
| |
} |
| R=0; |
R=0; |
| if(type(V)!=4) |
if(type(V)!=4) |
| for (I = length(V)-1; I >= 0; I--) R+= V[I]^2; |
for (I = length(V)-1; I >= 0; I--) R+= real(V[I])^2+imag(V[I])^2; |
| else{ |
else{ |
| if(type(V[0])>3){ |
if(type(V[0])>3){ |
| V=ltov(V[0])-ltov(V[1]); |
V=ltov(V[0])-ltov(V[1]); |
| return dnorm(V); |
return dnorm(V); |
| } |
} |
| for(;V!=[]; V=cdr(V)) R+=car(V)^2; |
for(;V!=[]; V=cdr(V)) R+=real(car(V))^2+imag(car(V))^2; |
| } |
} |
| return dsqrt(R); |
return ctrl("bigfloat")?pari(sqrt,R):dsqrt(R); |
| } |
} |
| |
|
| def dvprod(V1,V2) |
def dvprod(V1,V2) |
| { |
{ |
| if(type(V1)<2) return V1*V2; |
if(type(V1)<2) return V1*V2; |
| R=0; |
R=0; |
| |
V1=lsub(V1); |
| |
V2=lsub(V2); |
| if(type(V1)!=4) |
if(type(V1)!=4) |
| for(I = length(V1)-1; I >= 0; I--) |
for(I = length(V1)-1; I >= 0; I--) |
| R += V1[I]*V2[I]; |
R += V1[I]*V2[I]; |
| Line 1234 def dvprod(V1,V2) |
|
| Line 1379 def dvprod(V1,V2) |
|
| return R; |
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) |
def dvangle(V1,V2) |
| { |
{ |
| if(V2==0 && type(V1)==4 && length(V1)==3 && |
if(V2==0 && type(V1)==4 && length(V1)==3 && |
|
|
| } |
} |
| } |
} |
| |
|
| |
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) |
def mperm(M,P,Q) |
| { |
{ |
| if(type(M) == 6){ |
if(type(M) == 6){ |
| Line 1688 def mtoupper(MM, F) |
|
| Line 1864 def mtoupper(MM, F) |
|
| if(type(St = getopt(step))!=1) St=0; |
if(type(St = getopt(step))!=1) St=0; |
| Opt = getopt(opt); |
Opt = getopt(opt); |
| if(type(Opt)!=1) Opt=0; |
if(type(Opt)!=1) Opt=0; |
| |
if(type(Main=getopt(main))!=1) Main=0; |
| TeX=getopt(dviout); |
TeX=getopt(dviout); |
| if(type(Tab=getopt(tab))!=1 && Tab!=0) Tab=2; |
if(type(Tab=getopt(tab))!=1 && Tab!=0) Tab=2; |
| Line="\\text{line}"; |
Line="\\text{line}"; |
| Line 1718 def mtoupper(MM, F) |
|
| Line 1895 def mtoupper(MM, F) |
|
| Top+=(TeX)?"\\ ":" "; |
Top+=(TeX)?"\\ ":" "; |
| } |
} |
| PC=IF=1; |
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(K = JJ = 0; K < Size[1] - F; K++){ |
| for(J = JJ; J < Size[0]; J++){ |
for(J = JJ; J < Size[0]; J++){ |
| if(M[J][K] != 0){ /* search simpler element */ |
if(M[J][K] != 0){ /* search simpler element */ |
| Line 1798 def mtoupper(MM, F) |
|
| Line 1982 def mtoupper(MM, F) |
|
| KRC=-KRC;Sgn=1; |
KRC=-KRC;Sgn=1; |
| }else |
}else |
| Sgn=0; |
Sgn=0; |
| if(St){ |
if(St&&!Main){ |
| if(TeX){ |
if(TeX){ |
| if(KRC==1) |
if(KRC==1) |
| Lout=cons([Top+"\\xrightarrow{", Line,KJ0+1,TeXs[Sgn], |
Lout=cons([Top+"\\xrightarrow{", Line,KJ0+1,TeXs[Sgn], |
| Line 1823 def mtoupper(MM, F) |
|
| Line 2007 def mtoupper(MM, F) |
|
| } |
} |
| /* a parameter Var */ |
/* a parameter Var */ |
| Var=0; |
Var=0; |
| |
/* mycat(["start",J,K]); */ |
| if(St && Opt>4 && length(Var=vars(nm(M[J][K])))==1){ |
if(St && Opt>4 && length(Var=vars(nm(M[J][K])))==1){ |
| J0=J;Jv=mydeg(nm(M[J0][K]),car(Var)); |
J0=J;Jv=mydeg(nm(M[J0][K]),car(Var)); |
| for(I=JJ;I<Size[0]; I++){ |
for(I=JJ;I<Size[0]; I++){ |
| Line 1838 def mtoupper(MM, F) |
|
| Line 2023 def mtoupper(MM, F) |
|
| if(length(Var)==1){ |
if(length(Var)==1){ |
| Var=car(Var); |
Var=car(Var); |
| Q=nm(M[J0][K]); |
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++){ |
for(I=JJ; I<Size[0]; I++){ |
| if(I==J0 || mydeg(nm(M[I][K]),Var)<0) continue; |
if(I==J0 || mydeg(nm(M[I][K]),Var)<0) continue; |
| T=rpdiv(nm(M[I][K]),Q,Var); |
T=rpdiv(nm(M[I][K]),Q,Var); |
| Line 1848 def mtoupper(MM, F) |
|
| Line 2035 def mtoupper(MM, F) |
|
| if(type(Var)==2){ /* 1 variable */ |
if(type(Var)==2){ /* 1 variable */ |
| if(I==Size[0]){ |
if(I==Size[0]){ |
| for(QF=0,Q0=1,QR=getroot(Q,Var|mult=1);QR!=[];QR=cdr(QR)){ |
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){ |
if(deg(T=QR[0][1],Var)>0){ |
| QF=1;Q0*=T; continue; |
QF=1;Q0*=T; continue; |
| } |
} |
| Line 1858 def mtoupper(MM, F) |
|
| Line 2046 def mtoupper(MM, F) |
|
| if(TeX){ |
if(TeX){ |
| Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", |
Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", |
| Var,"=",T,","] ,Lout); |
Var,"=",T,","] ,Lout); |
| Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab),Lout); |
Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab,main=Main),Lout); |
| }else{ |
}else{ |
| mycat([str_times(" ",St-1)+"If",Var,"=",T,","]); |
mycat([str_times(" ",St-1)+"If",Var,"=",T,","]); |
| mtoupper(M0,F|step=St+1,opt=Opt); |
mtoupper(M0,F|step=St+1,opt=Opt,main=Main); |
| } |
} |
| } |
} |
| } |
} |
| Line 1878 def mtoupper(MM, F) |
|
| Line 2066 def mtoupper(MM, F) |
|
| KRC=-red((T[2]*dn(M[J0][K]))/(T[1]*dn(M[I][K]))); |
KRC=-red((T[2]*dn(M[J0][K]))/(T[1]*dn(M[I][K]))); |
| for(II=K;II<Size[1];II++) |
for(II=K;II<Size[1];II++) |
| M[I][II]=radd(M[I][II],rmul(M[J0][II],KRC)); |
M[I][II]=radd(M[I][II],rmul(M[J0][II],KRC)); |
| if(TeX) |
if(!Main){ |
| Lout=cons([Top+"\\xrightarrow{", Line,I+1,"\\ +=\\ ",Line, |
if(TeX) |
| J0+1,"\\times\\left(",KRC,"\\right)}",dupmat(M)],Lout); |
Lout=cons([Top+"\\xrightarrow{", Line,I+1,"\\ +=\\ ",Line, |
| else |
J0+1,"\\times\\left(",KRC,"\\right)}",dupmat(M)],Lout); |
| mycat([Top+"line",I+1,"+=",Line,J0+1," * (",KRC,")\n",M,"\n"]); |
else |
| |
mycat([Top+"line",I+1,"+=",Line,J0+1," * (",KRC,")\n",M,"\n"]); |
| |
} |
| J=JJ-1; |
J=JJ-1; |
| continue; |
continue; |
| } |
} |
| Line 1917 def mtoupper(MM, F) |
|
| Line 2107 def mtoupper(MM, F) |
|
| if(TeX){ |
if(TeX){ |
| Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", |
Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", |
| X,"=",T,","] ,Lout); |
X,"=",T,","] ,Lout); |
| Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab), |
Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab,main=Main), |
| Lout); |
Lout); |
| }else{ |
}else{ |
| mycat([str_times(" ",St-1)+"If",X,"=",T,","]); |
mycat([str_times(" ",St-1)+"If",X,"=",T,","]); |
| mtoupper(M0,F|step=St+1,opt=Opt); |
mtoupper(M0,F|step=St+1,opt=Opt,main=Main); |
| } |
} |
| break; |
break; |
| } |
} |
| Line 1948 def mtoupper(MM, F) |
|
| Line 2138 def mtoupper(MM, F) |
|
| if(TeX){ |
if(TeX){ |
| Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", |
Lout=cons(["\\hspace{",Tab*(St-3)-1,"mm}\\text{If }", |
| X0,"=",T0,","] ,Lout); |
X0,"=",T0,","] ,Lout); |
| Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab), |
Lout=append(mtoupper(M0,F|step=St+1,opt=Opt,dviout=-2,tab=Tab,main=Main), |
| Lout); |
Lout); |
| }else{ |
}else{ |
| mycat([str_times(" ",St-1)+"If",X0,"=",T0,","]); |
mycat([str_times(" ",St-1)+"If",X0,"=",T0,","]); |
| mtoupper(M0,F|step=St+1,opt=Opt); |
mtoupper(M0,F|step=St+1,opt=Opt,main=Main); |
| } |
} |
| } |
} |
| |
|
| Line 1996 def mtoupper(MM, F) |
|
| Line 2186 def mtoupper(MM, F) |
|
| for(I = K+1; I < Size[1]; I++) |
for(I = K+1; I < Size[1]; I++) |
| M[J][I] = radd(M[J][I],rmul(M[JJ][I],Mul)); |
M[J][I] = radd(M[J][I],rmul(M[JJ][I],Mul)); |
| M[J][K] = 0; |
M[J][K] = 0; |
| if(St){ |
if(St&&!Main){ |
| if(Mul<0){ |
if(Mul<0){ |
| Mul=-Mul;Sgn=0; |
Mul=-Mul;Sgn=0; |
| }else Sgn=1; |
}else Sgn=1; |
| Line 2225 def vgen(V,W,S) |
|
| Line 2415 def vgen(V,W,S) |
|
| def mmc(M,X) |
def mmc(M,X) |
| { |
{ |
| Mt=getopt(mult); |
Mt=getopt(mult); |
| if(type(M)==7) M=os_md.s2sp(M); |
if(type(M)==7) M=s2sp(M); |
| if(type(M)!=4||type(M[0])!=6) return 0; |
if(type(M)!=4) return 0; |
| |
if(type(M[0])<=3){ |
| |
for(RR=[];M!=[];M=cdr(M)) RR=cons(mat([car(M)]),RR); |
| |
M=reverse(RR); |
| |
} |
| if(type(M[0])!=6){ /* spectre type -> GRS */ |
if(type(M[0])!=6){ /* spectre type -> GRS */ |
| G=s2sp(M|std=1); |
G=s2sp(M|std=1); |
| L=length(G); |
L=length(G); |
| Line 3335 def llbase(VV,L) |
|
| Line 3529 def llbase(VV,L) |
|
| return V; |
return V; |
| } |
} |
| |
|
| |
def rsort(L,T,K) |
| |
{ |
| |
for(R=[];L!=[];L=cdr(L)) |
| |
R=cons((type(car(L))==4)?rsort(car(L),T-1,K):car(L),R); |
| |
if(T>0||iand(T,iand(K,2)/2)) return reverse(R); |
| |
R=qsort(R); |
| |
return (iand(K,1))? reverse(R):R; |
| |
} |
| |
|
| |
def llget(L,LL,LC) |
| |
{ |
| |
if(type(LL)==4){ |
| |
LM=length(L); |
| |
for(R=[];LL!=[];LL=cdr(LL)){ |
| |
if(isint(TL=car(LL))) R=cons(TL,R); |
| |
else{ |
| |
IM=(length(TL)==1)?(LM-1):TL[1]; |
| |
for(I=car(TL);I<=IM;I++) R=cons(I,R); |
| |
} |
| |
} |
| |
LL=reverse(R); |
| |
if(LC==-1){ |
| |
LL=lsort(LL,[],1); |
| |
return lsort(L,"num",["sub"]|c1=LL); |
| |
} |
| |
L=lsort(L,"num",["get"]|c1=LL); |
| |
} |
| |
if(type(LC)==4){ |
| |
LM=length(L[0]); |
| |
for(R=[];LC!=[];LC=cdr(LC)){ |
| |
if(isint(TL=car(LC))) R=cons(TL,R); |
| |
else{ |
| |
IM=(length(TL)==1)?(LM-1):TL[1]; |
| |
for(I>=car(TL);I<=IM;I++) R=cons(I,R); |
| |
} |
| |
} |
| |
LC=reverse(R); |
| |
if(LL==-1){ |
| |
LC=lsort(LC,[],1); |
| |
return lsort(L,"col",["setminus"]|c1=LC); |
| |
} |
| |
L=lsort(L,"col",["put"]|c1=LC); |
| |
} |
| |
if(getopt(flat)==1) L=m2l(L|flat=1); |
| |
return L; |
| |
} |
| |
|
| |
|
| def lsort(L1,L2,T) |
def lsort(L1,L2,T) |
| { |
{ |
| C1=getopt(c1);C2=getopt(c2); |
C1=getopt(c1);C2=getopt(c2); |
| Line 3379 def lsort(L1,L2,T) |
|
| Line 3621 def lsort(L1,L2,T) |
|
| }else{ |
}else{ |
| for(I=0;LT!=[];I++,LT=cdr(LT)) |
for(I=0;LT!=[];I++,LT=cdr(LT)) |
| if(findin(I,C1)<0) RT=cons(car(LT),RT); |
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); |
return reverse(R); |
| } |
} |
|
|
| return []; |
return []; |
| } |
} |
| |
|
| def llcm(L) |
def llcm(R) |
| { |
{ |
| if(type(L)==4){ |
if(type(R)==5||type(R)==6) R=m2l(R); |
| F=getopt(poly); |
if(type(R)<4) R=[R]; |
| V=car(L); |
if(type(R)!=4) return 0; |
| while((L=cdr(L))!=[]){ |
V=getopt(poly); |
| if(V!=0){ |
if(type(V)<1){ |
| if((V0=car(L))!=0) |
for(L=R;L!=[];L=cdr(L)){ |
| V=(F==1)?red(V*V0/gcd(V,V0)):ilcm(V,V0); |
if(type(car(L))>1){ |
| |
V=1; break; |
| } |
} |
| else V=car(L); |
|
| } |
} |
| if(F!=1&&V<0) V=-V; |
|
| return V; |
|
| } |
} |
| else if(type(L)==5||type(L)==6) |
if(getopt(dn)!=1){ |
| return llcm(m2l(L)|option_list=getopt()); |
for(L=[];R!=[];R=cdr(R)) if(R!=0) L=cons(1/car(R),L); |
| return []; |
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) |
def ldev(L,S) |
| Line 3831 def lnsol(VV,L) |
|
| Line 4097 def lnsol(VV,L) |
|
| |
|
| def ladd(X,Y,M) |
def ladd(X,Y,M) |
| { |
{ |
| |
if(Y==0){ |
| |
Y=X[1];X=X[0]; |
| |
} |
| if(type(Y)==4) Y=ltov(Y); |
if(type(Y)==4) Y=ltov(Y); |
| if(type(X)==4) X=ltov(X); |
if(type(X)==4) X=ltov(X); |
| return vtol(X+M*Y); |
return vtol(X+M*Y); |
|
|
| def fctrtos(P) |
def fctrtos(P) |
| { |
{ |
| /* extern TeXLim; */ |
/* extern TeXLim; */ |
| |
|
| if(!chkfun("write_to_tb", "names.rr")) |
if(!chkfun("write_to_tb", "names.rr")) |
| return 0; |
return 0; |
| |
|
| TeX = getopt(TeX); |
TeX = getopt(TeX); |
| if(TeX != 1 && TeX != 2 && TeX != 3) |
if(TeX != 1 && TeX != 2 && TeX != 3) |
| TeX = 0; |
TeX = 0; |
| if((Dvi=getopt(dviout)==1) && TeX<2) TeX=3; |
if((Dvi=getopt(dviout)==1) && TeX<2) TeX=3; |
| if(TeX>0){ |
if(TeX>0){ |
| Lim=getopt(lim); |
Lim=getopt(lim); |
| if(Lim!=0 && TeX>1 && (type(Lim)!=1||Lim<30)) Lim=TeXLim; |
if(Lim!=0 && TeX>1 && (type(Lim)!=1||Lim<30)) Lim=TeXLim; |
| else if(type(Lim)!=1) Lim=0; |
else if(type(Lim)!=1) Lim=0; |
| CR=(TeX==2)?"\\\\\n":"\\\\\n&"; |
CR=(TeX==2)?"\\\\\n":"\\\\\n&"; |
| if(TeX==1 || Lim==0) CR=""; |
CR2="\\allowdisplaybreaks"+CR; |
| else if((Pages=getopt(pages))==1) CR="\\allowdisplaybreaks"+CR; |
if(TeX==1 || Lim==0) CR=CR2=""; |
| |
else if((Pages=getopt(pages))==1) CR2=CR; |
| if(!chkfun("print_tex_form", "names.rr")) |
if(!chkfun("print_tex_form", "names.rr")) |
| return 0; |
return 0; |
| Small=getopt(small); |
Small=getopt(small); |
|
|
| } |
} |
| VV=reverse(VV);VD=reverse(VD); |
VV=reverse(VV);VD=reverse(VD); |
| Rev=(getopt(rev)==1)?1:0; |
Rev=(getopt(rev)==1)?1:0; |
| Dic=(getopt(dic)==1)?1:0; |
Rdic=0; |
| |
if((Dic=getopt(dic))==2){ |
| |
Dic=Rdic=1; |
| |
}else if(Dic!=1) Dic=0; |
| TT=terms(P,VV|rev=Rev,dic=Dic); |
TT=terms(P,VV|rev=Rev,dic=Dic); |
| if(TeX==0){ |
if(TeX==0){ |
| Pre="("; Post=")"; |
Pre="("; Post=")"; |
|
|
| Pre="{"; Post="}"; |
Pre="{"; Post="}"; |
| } |
} |
| Out = string_to_tb(""); |
Out = string_to_tb(""); |
| for(L=C=0,Tm=TT;Tm!=[];C++,Tm=cdr(Tm)){ |
for(L=C=CC=0,Tm=TT;Tm!=[];C++,Tm=cdr(Tm)){ |
| for(I=0,PC=P,T=cdr(car(Tm)),PW="";T!=[];T=cdr(T),I++){ |
for(I=0,PC=P,T=cdr(car(Tm)),PW="";T!=[];T=cdr(T),I++){ |
| PC=mycoef(PC,D=car(T),VV[I]); |
PC=mycoef(PC,D=car(T),VV[I]); |
| if(PC==0) continue; |
if(PC==0) continue; |
|
|
| else PT="^"+rtostr(D); |
else PT="^"+rtostr(D); |
| } |
} |
| if(Dif>0) PW+=(Dif==1)?"d":"\\partial "; |
if(Dif>0) PW+=(Dif==1)?"d":"\\partial "; |
| PW+=VD[I]+PT; |
if(Rdic) PW=VD[I]+PT+PW; |
| |
else PW+=VD[I]+PT; |
| } |
} |
| } |
} |
| D=car(Tm)[0]; |
D=car(Tm)[0]; |
|
|
| if(D>1) Op+="^"+((D>9)?(Pre+rtostr(D)+Post):rtostr(D)); |
if(D>1) Op+="^"+((D>9)?(Pre+rtostr(D)+Post):rtostr(D)); |
| PW=Op+Add+"}{"+PW+"}"; |
PW=Op+Add+"}{"+PW+"}"; |
| }else if(Add!=0) PW=PW+Add; |
}else if(Add!=0) PW=PW+Add; |
| |
CD=0; |
| if(TeX>=1){ |
if(TeX>=1){ |
| if(type(PC)==1 && ntype(PC)==0 && PC<0) |
if(type(PC)==1 && ntype(PC)==0 && PC<0) |
| OC="-"+my_tex_form(-PC); |
OC="-"+my_tex_form(-PC); |
| else OC=fctrtos(PC|TeX=1,br=1); |
else OC=fctrtos(PC|TeX=1,br=1); |
| |
if(isint(PC)&&(PC<-1||PC>1)) CD=1; |
| }else OC=fctrtos(PC|br=1); |
}else OC=fctrtos(PC|br=1); |
| if(PW!=""){ |
if(PW!=""){ |
| if(OC == "1") OC = ""; |
if(OC == "1") OC = ""; |
|
|
| } |
} |
| } |
} |
| if(Lim>0){ |
if(Lim>0){ |
| |
CC++; |
| LL=texlen(OC)+texlen(PW); |
LL=texlen(OC)+texlen(PW); |
| if(LL+L>=Lim){ |
if(LL+L>=Lim){ |
| if(L>0) str_tb(CR,Out); |
if(L>0) str_tb(CR,Out); |
| if(LL>Lim){ |
if(LL>Lim){ |
| if(TOC==7) OC=texlim(OC,Lim|cut=CR); |
if(TOC==7) OC=texlim(OC,Lim|cut=[CR,CR2]); |
| PW+=CR; L=0; |
if(length(Tm)!=1) PW+=CR; |
| |
L=0; |
| }else L=LL; |
}else L=LL; |
| }else L+=LL; |
}else L+=LL; |
| }else if(length(Tm)!=1) PW += CR; /* not final term */ |
}else if(length(Tm)!=1){ |
| if(TeX) OC=texsp(OC); |
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); |
if(str_chr(OC,0,"-") == 0 || C==0) str_tb([OC,PW], Out); |
| else{ |
else{ |
| str_tb(["+",OC,PW],Out); |
str_tb(["+",OC,PW],Out); |
|
|
| if(imag(P)==0) P = fctr(P); /* usual polynomial */ |
if(imag(P)==0) P = fctr(P); /* usual polynomial */ |
| else P=[[P,1]]; |
else P=[[P,1]]; |
| S = str_tb(0,0); |
S = str_tb(0,0); |
| for(J = N = 0; J < length(P); J++){ |
for(J = N = CD = 0; J < length(P); J++){ |
| if(type(P[J][0]) <= 1){ |
if(type(V=P[J][0]) <= 1){ |
| if(P[J][0] == -1){ |
if(V == -1){ |
| write_to_tb("-",S); |
write_to_tb("-",S); |
| if(length(P) == 1) |
if(length(P) == 1) |
| str_tb("1", S); |
str_tb("1", S); |
| }else if(P[J][0] != 1){ |
}else if(V != 1){ |
| str_tb((TeX>=1)?my_tex_form(P[J][0]):rtostr(P[J][0]), S); |
str_tb((TeX>=1)?my_tex_form(V):rtostr(V), S); |
| N++; |
N++; |
| }else if(length(P) == 1) |
}else if(length(P) == 1) |
| str_tb("1", S); |
str_tb("1", S); |
|
|
| str_tb((TeX>=1)?my_tex_form(P[1][0]):rtostr(P[1][0]), S); |
str_tb((TeX>=1)?my_tex_form(P[1][0]):rtostr(P[1][0]), S); |
| J++; |
J++; |
| } |
} |
| |
if(J==0&&isint(V=P[J][0])&&(V<-1||V>1)) CD=1; |
| continue; |
continue; |
| } |
} |
| if(N > 0 && TeX != 1 && TeX != 2 && TeX != 3) |
if(N > 0 && TeX != 1 && TeX != 2 && TeX != 3) |
|
|
| if(nmono(P[J][0])>1|| |
if(nmono(P[J][0])>1|| |
| (!isvar(P[J][0])||vtype(P[J][0]))&&str_len(SS)>1) SS="("+SS+")"; |
(!isvar(P[J][0])||vtype(P[J][0]))&&str_len(SS)>1) SS="("+SS+")"; |
| write_to_tb(SS,S); |
write_to_tb(SS,S); |
| str_tb(["^", (TeX>1)?rtotex(P[J][1]):monotos(P[J][1])],S); |
str_tb(["^", (TeX>=1)?rtotex(P[J][1]):monotos(P[J][1])],S); |
| }else{ |
}else{ |
| if(nmono(P[J][0])>1) SS="("+SS+")"; |
if(nmono(P[J][0])>1&&length(P)>1) SS="("+SS+")"; |
| |
else if(CD&&J==1){ /* 2*3^x */ |
| |
CD=strtoascii(str_cut(SS,0,1)); |
| |
if(length(CD)==2&&car(CD)==123&&isnum(CD[1])) SS="\\cdot"+SS; |
| |
} |
| write_to_tb(SS,S); |
write_to_tb(SS,S); |
| } |
} |
| } |
} |
| S = str_tb(0,S); |
S = str_tb(0,S); |
| if((Lim>0 || TP!=2) && CR!="") S=texlim(S,Lim|cut=CR); |
if((Lim>0 || TP!=2) && CR!="") S=texlim(S,Lim|cut=[CR,CR2]); |
| } |
} |
| if(TeX>0){ |
if(TeX>0){ |
| if(Small==1) S=str_subst(S,"\\frac{","\\tfrac{"); |
if(Small==1) S=str_subst(S,"\\frac{","\\tfrac{"); |
| if(Dvi==1){ |
if(Dvi==1){ |
| dviout(strip(S,"(",")")|eq=(Pages==1)?6:0); S=1; |
dviout(strip(S,"(",")")|eq=(Pages==1||Pages==2)?6:0); S=1; |
| } |
} |
| } |
} |
| return S; |
return S; |
| Line 4362 def texlim(S,Lim) |
|
| Line 4654 def texlim(S,Lim) |
|
| mycat(["Set TeXLim =",Lim]); |
mycat(["Set TeXLim =",Lim]); |
| return 1; |
return 1; |
| } |
} |
| if(type(Out=getopt(cut))!=7) Out="\\\\\n&"; |
if(type(Out=getopt(cut))!=7){ |
| |
if(type(Out)!=4) Out=Out2="\\\\\n&"; |
| |
else{ |
| |
Out2=Out[1];Out=Out[0]; |
| |
} |
| |
} |
| if(type(Del=getopt(del))!=7) Del=Out; |
if(type(Del=getopt(del))!=7) Del=Out; |
| if(Lim<30) Lim=TeXLim; |
if(Lim<30) Lim=TeXLim; |
| S=ltov(strtoascii(S)); |
S=ltov(strtoascii(S)); |
| Line 4393 def texlim(S,Lim) |
|
| Line 4690 def texlim(S,Lim) |
|
| SS=str_tb(0,0); |
SS=str_tb(0,0); |
| L=cons(length(S),L); |
L=cons(length(S),L); |
| L=reverse(L); |
L=reverse(L); |
| |
if(length(L)>TeXPages) Out=Out2; |
| for(I=0; L!=[]; I=J,L=cdr(L)){ |
for(I=0; L!=[]; I=J,L=cdr(L)){ |
| str_tb((I==0)?"":Out,SS); |
str_tb((I==0)?"":Out,SS); |
| J=car(L); |
J=car(L); |
| Line 4540 def mtransbys(FN,F,LL) |
|
| Line 4838 def mtransbys(FN,F,LL) |
|
| return call(FN, cons(F,LL)|option_list=Opt); |
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) |
def drawopt(S,T) |
| { |
{ |
| if(type(S)!=7) return -1; |
if(type(S)!=7) return -1; |
| Line 4571 def drawopt(S,T) |
|
| Line 4898 def drawopt(S,T) |
|
| return -1; |
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) |
def execdraw(L,P) |
| { |
{ |
| if((Proc=getopt(proc))!=1) Proc=0; |
if((Proc=getopt(proc))!=1) Proc=0; |
| Line 4823 def execdraw(L,P) |
|
| Line 5168 def execdraw(L,P) |
|
| LOut=cons(T[2],Out); |
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){ |
}else if(Proc==1&&type(T[0])==2){ |
| if(length(T)<3) call(T[0],T[1]); |
if(length(T)<3) call(T[0],T[1]); |
| else call(T[0],T[1]|option_list=T[2]); |
else call(T[0],T[1]|option_list=T[2]); |
| Line 4872 def execdraw(L,P) |
|
| Line 5223 def execdraw(L,P) |
|
| } |
} |
| } |
} |
| if(MM) V=ptaffine(MM,V|option_list=Org); |
if(MM) V=ptaffine(MM,V|option_list=Org); |
| if(length(T)>3) V=append(V,T[3]); |
if(length(T)>3){ |
| |
if(type(T2=T[3])==7) T2=[T2]; |
| |
V=append(V,T2); |
| |
} |
| str_tb(xyput(V),Out); |
str_tb(xyput(V),Out); |
| }else if(T[0]==3){ |
}else if(T[0]==3){ |
| F++; |
F++; |
| Line 4902 def execdraw(L,P) |
|
| Line 5256 def execdraw(L,P) |
|
| if(P[0]==2) dviout(T[2]|option_list=T[1]); |
if(P[0]==2) dviout(T[2]|option_list=T[1]); |
| else LOut=cons(T[2],Out); |
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) |
}else if(T[0]==-2) |
| str_tb(["%",T[1],"\n"],Out); |
str_tb(["%",T[1],"\n"],Out); |
| else if(Proc==1&&type(T[0])==2){ |
else if(Proc==1&&type(T[0])==2){ |
| if(length(T)<3) call(T[0],T[1]); |
if(length(T)<3) call(T[0],T[1]); |
| else call(T[0],T[1]|option_list=T[2]); |
else call(T[0],T[1]|option_list=T[2]); |
| } |
} |
| Line 5071 def mmulbys(FN,P,F,L) |
|
| Line 5431 def mmulbys(FN,P,F,L) |
|
| |
|
| def appldo(P,F,L) |
def appldo(P,F,L) |
| { |
{ |
| |
if(getopt(Pfaff)==1){ |
| |
L = vweyl(L); |
| |
X = L[0]; DX = L[1]; |
| |
for(I=mydeg(P,DX);I>0;I--){ |
| |
if(!(TP=mycoef(P,D,DX))) continue; |
| |
P=red(P+TP*(muldo(D^(I-1),F,L)-D^I)); |
| |
} |
| |
return P; |
| |
} |
| if(type(F) <= 3){ |
if(type(F) <= 3){ |
| if(type(L) == 4 && type(L[0]) == 4) |
if(type(L) == 4 && type(L[0]) == 4) |
| return applpdo(P,F,L); |
return applpdo(P,F,L); |
| Line 5235 def mce(P,L,V,R) |
|
| Line 5604 def mce(P,L,V,R) |
|
| { |
{ |
| L = vweyl(L); |
L = vweyl(L); |
| X = L[0]; DX = L[1]; |
X = L[0]; DX = L[1]; |
| P = sftexp(laplace1(P,L),L,V,R); |
P = sftexp(laplace1(P,L),L,V,R|option_list=getopt()); |
| return laplace(P,L); |
return laplace(P,L); |
| } |
} |
| |
|
| def mc(P,L,R) |
def mc(P,L,R) |
| { |
{ |
| return mce(P,L,0,R); |
return mce(P,L,0,R|option_list=getopt()); |
| } |
} |
| |
|
| def rede(P,L) |
def rede(P,L) |
| Line 5418 def mulpdo(P,Q,L); |
|
| Line 5787 def mulpdo(P,Q,L); |
|
| |
|
| def transpdosub(P,LL,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; |
Len = length(K)-1; |
| if(Len < 0 || P == 0) |
if(Len < 0 || P == 0) |
| return P; |
return P; |
| Line 5443 def transpdosub(P,LL,K) |
|
| Line 5818 def transpdosub(P,LL,K) |
|
| |
|
| def transpdo(P,LL,K) |
def transpdo(P,LL,K) |
| { |
{ |
| if(type(K[0]) < 4) |
|
| K = [K]; |
|
| Len = length(K)-1; |
Len = length(K)-1; |
| K1=K2=[]; |
K1=K2=[]; |
| if(type(LL)!=4) LL=[LL]; |
if(type(LL)!=4) LL=[LL]; |
| if(type(LL[0])!=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){ |
if(getopt(ex)==1){ |
| for(LT=LL, KT=K; KT!=[]; LT=cdr(LT), KT=cdr(KT)){ |
for(LT=LL, KT=K; KT!=[]; LT=cdr(LT), KT=cdr(KT)){ |
| L = vweyl(LL[J]); |
L = vweyl(LL[J]); |
| Line 5457 def transpdo(P,LL,K) |
|
| Line 5831 def transpdo(P,LL,K) |
|
| } |
} |
| K2=append(K1,K2); |
K2=append(K1,K2); |
| }else{ |
}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--){ |
for(J = length(K)-1; J >= 0; J--){ |
| L = vweyl(LL[J]); |
L = vweyl(LL[J]); |
| if(L[0] != K[J][0]) |
if(L[0]!= K[J][0]) K1=cons([L[0],K[J][0]],K1); |
| K1 = cons([L[0],K[J][0]],K1); |
|
| K2 = cons(K[J][1],K2); |
K2 = cons(K[J][1],K2); |
| } |
} |
| P = mulsubst(P, K1); |
P = mulsubst(P, K1); |
| Line 5513 def texbegin(T,S) |
|
| Line 5902 def texbegin(T,S) |
|
| { |
{ |
| if(type(Opt=getopt(opt))==7) Opt="["+Opt+"]\n"; |
if(type(Opt=getopt(opt))==7) Opt="["+Opt+"]\n"; |
| else Opt="\n"; |
else Opt="\n"; |
| return "\\begin{"+T+"}"+Opt+S+"%\n\\end{"+T+"}\n"; |
U=(str_chr(S,str_len(S)-1,"\n")<0)?"%\n":""; |
| |
return "\\begin{"+T+"}"+Opt+S+U+"\\end{"+T+"}\n"; |
| } |
} |
| |
|
| def mygcd(P,Q,L) |
def mygcd(P,Q,L) |
| Line 5843 def divdo(P,Q,L) |
|
| Line 6233 def divdo(P,Q,L) |
|
| } |
} |
| P -= muldo(SR*(DX)^(J-I),Q,L); |
P -= muldo(SR*(DX)^(J-I),Q,L); |
| S += SR*(DX)^(J-I); |
S += SR*(DX)^(J-I); |
| } |
} |
| return [S,P,M]; |
return [S,P,M]; |
| } |
} |
| |
|
| Line 6168 def mulpolyMod(P,Q,X,N) |
|
| Line 6558 def mulpolyMod(P,Q,X,N) |
|
| return 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){ |
def taylorODE(D){ |
| Dif=(getopt(dif)==1)?1:0; |
Dif=(getopt(dif)==1)?1:0; |
| if(D==0) return Dif?f:f_00; |
if(D==0) return Dif?f:f_00; |
| Line 6264 def toeul(F,L,V) |
|
| Line 7158 def toeul(F,L,V) |
|
| L = vweyl(L); |
L = vweyl(L); |
| X = L[0]; DX = L[1]; |
X = L[0]; DX = L[1]; |
| I = mydeg(F,DX); |
I = mydeg(F,DX); |
| if(V == "infty"){ |
if(getopt(raw)!=1){ |
| for(II=I; II>=0; II--){ |
for(II=I; II>=0; II--){ |
| J = mydeg(P=mycoef(F,I,DX),X); |
J = mydeg(P=mycoef(F,II,DX),X); |
| if(II==I) S=II-J; |
if(II==I) S=II-J; |
| else if(P!=0 && II-J>S) S=II-J; |
else if(P!=0 && II-J>S) S=II-J; |
| } |
} |
| F *= X^S; |
F *= X^S; |
| R = 0; |
} |
| for( ; I >= 0; I--) |
if(V == "infty"){ |
| |
for(R=0; I >= 0; I--) |
| R += red((mysubst(mycoef(F,I,DX),[X,1/X])*(x*DX)^I)); |
R += red((mysubst(mycoef(F,I,DX),[X,1/X])*(x*DX)^I)); |
| return(subst(pol2sft(R,DX),DX,-DX)); |
return(subst(pol2sft(R,DX),DX,-DX)); |
| } |
} |
| F = subst(F,X,X+V); |
for(R=0; I >= 0; I--) |
| for(II=I; II>=0; II--){ |
|
| J = mymindeg(P=mycoef(F,II,DX),X); |
|
| if(II==I) S=II-J; |
|
| else if(P!=0 && II-J>S) S=II-J; |
|
| } |
|
| F *= X^S; |
|
| R = 0; |
|
| for( ; I >= 0; I--) |
|
| R += (red(mycoef(F,I,DX)/X^I))*DX^I; |
R += (red(mycoef(F,I,DX)/X^I))*DX^I; |
| return pol2sft(R,DX); |
return pol2sft(R,DX); |
| } |
} |
| Line 6320 def fromeul(P,L,V) |
|
| Line 7207 def fromeul(P,L,V) |
|
| S = DX*(S*X + mydiff(S,DX)); |
S = DX*(S*X + mydiff(S,DX)); |
| R += mycoef(P,J,DX)*S; |
R += mycoef(P,J,DX)*S; |
| } |
} |
| while(mycoef(R,0,X) == 0) |
if(getopt(raw)!=1){ |
| R = tdiv(R,X); |
while(mycoef(R,0,X) == 0) |
| |
R = tdiv(R,X); |
| |
} |
| if(V != "infty" && V != 0) |
if(V != "infty" && V != 0) |
| R = mysubst(R,[X,X-V]); |
R = mysubst(R,[X,X-V]); |
| return R; |
return R; |
| Line 6330 def fromeul(P,L,V) |
|
| Line 7219 def fromeul(P,L,V) |
|
| def sftexp(P,L,V,N) |
def sftexp(P,L,V,N) |
| { |
{ |
| L = vweyl(L); DX = L[1]; |
L = vweyl(L); DX = L[1]; |
| P = mysubst(toeul(P,L,V),[DX,DX+N]); |
P = mysubst(toeul(P,L,V|opt_list=getpt()),[DX,DX+N]); |
| return fromeul(P,L,V); |
return fromeul(P,L,V|option_list=getopt()); |
| } |
} |
| |
|
| |
|
| Line 6726 def expat(F,L,V) |
|
| Line 7615 def expat(F,L,V) |
|
| |
|
| def polbyroot(P,X) |
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; |
R = 1; |
| while(length(P)){ |
while(length(P)){ |
| R *= X-car(P); |
R *= X-car(P); |
| Line 6914 def pcoef(P,L,Q) |
|
| Line 7807 def pcoef(P,L,Q) |
|
| return Coef; |
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) |
def prehombf(P,Q) |
| { |
{ |
| if((Mem=getopt(mem))!=1 && Mem!=-1) |
if((Mem=getopt(mem))!=1 && Mem!=-1) |
|
|
| }else{ |
}else{ |
| L0=0; L1=MO+1; |
L0=0; L1=MO+1; |
| } |
} |
| if(MO<=0){ |
if(M0<=0){ |
| MO=-MO; |
MO=-MO; |
| if(iand(MO,1)==1) return []; |
if(iand(MO,1)==1) return []; |
| if(MO>1){ |
MO=MO/2; |
| if(isMs()==0) return []; |
B=spbasic(-2*MO,0|str=1); |
| Cmd="okubo "+rtostr(-MO); |
if(L1<3) L1=MO+4; |
| MO/=2; |
|
| if(L1>0) Cmd=Cmd+"+"+rtostr(L0)+"-"+rtostr(L1); |
|
| else L1=MO+4; |
|
| Cmd=Cmd+" B"; |
|
| Id=getbyshell(Cmd); |
|
| if(Id<0) return []; |
|
| B=[]; |
|
| while((S=get_line(Id)) !=0){ |
|
| P0=str_chr(S,1,":")+1; |
|
| if(P0>1){ |
|
| P1=str_chr(S,P,"\n"); |
|
| if(P1<0) P1=str_len(S); |
|
| B=cons(sub_str(S,P0,P1-1),B); |
|
| } |
|
| } |
|
| close_file(Id); |
|
| }else{ |
|
| MO/=2; |
|
| if(L1<=1) L1=MO+4; |
|
| BB=[ |
|
| ["11,11,11,11","111,111,111","1^4,1^4,22","1^6,222,33"], |
|
| ["11,11,11,11,11","1^4,1^4,211","211,22,22,22","1^6,2211,33", |
|
| "2211,222,222","22211,2^4,44","2^511,444,66","1^4,22,22,31", |
|
| "2^5,3331,55","1^5,1^5,32","1^8,332,44","111,111,21,21","1^5,221,221"], |
|
| ["11,11,11,11,11,11","1^4,1^4,1^4","1^4,22,22,22","111,111,111,21", |
|
| "1^6,21^4,33","21^4,222,222","221^4,2^4,44","2^41^4,444,66", |
|
| "1^5,1^5,311","1^8,3311,44","1^6,222,321","321,33,33,33", |
|
| "3321,333,333","33321,3^4,66","3^721,666,99","2^5,3322,55", |
|
| "1^6,1^6,42","222,33,33,42","1^a,442,55","1^6,33,33,51", |
|
| "222,222,33,51","1^9,333,54","2^7,554,77","1^5,2111,221", |
|
| "2^41,333,441","1^7,2221,43","211,211,22,22","2211,2211,222", |
|
| "22211,22211,44","1^4,211,22,31","2^411,3331,55","1^4,1^4,31,31", |
|
| "22,22,22,31,31","1^7,331,331","2221,2221,331","111,21,21,21,21"], |
|
| ["11,11,11,11,11,11,11","111,111,111,111","1^6,1^6,33", |
|
| "1^6,222,222","222,33,33,33","1^5,1^5,221", |
|
| "1^4,211,22,22","1^4,1^4,22,31","22,22,22,22,31", |
|
| "111,111,21,21,21","21^6,2^4,44","2221^6,444,66", |
|
| "1^6,222,3111","3111,33,33,33","33111,333,333", |
|
| "333111,3^4,66","3^5111,666,99","2^5,33211,55", |
|
| "1^8,3221,44","3222,333,333","33222,3^4,66", |
|
| "3^4222,666,99","1^6,1^6,411","222,33,33,411", |
|
| "1^a,4411,55","2^4,2^4,431","431,44,44,44", |
|
| "2^6,4431,66","4431,444,444","44431,4^4,88", |
|
| "4^531,888,cc","1^a,433,55","1^7,1^7,52", |
|
| "1^c,552,66","3^4,444,552","1^8,2^4,53", |
|
| "1^8,44,44,71","3^5,555,771","21^4,2211,222", |
|
| "221^4,22211,44","2221^4,3331,55","1^6,2211,321", |
|
| "2^411,3322,55","1^7,322,331","2211,33,33,42", |
|
| "3^42,4442,77","2211,222,33,51","3^51,5551,88", |
|
| "2^611,554,77","2221,2221,322","2^41,2^41,54", |
|
| "1^5,2111,2111","222111,333,441","1^7,22111,43", |
|
| "1^5,1^5,41,41","1^9,441,441","22111,2221,331", |
|
| "1^5,221,32,41","221,221,221,41","211,211,211,22", |
|
| "2211,2211,2211","1^4,211,211,31","211,22,22,31,31", |
|
| "1^4,22,31,31,31","1^5,32,32,32","221,221,32,32","21,21,21,21,21,21"], |
|
| ["11,11,11,11,11,11,11,11","1^4,1^4,22,22","1^8,2^4,44", |
|
| "1^6,2211,222","2211,33,33,33","111,111,111,21,21", |
|
| "1^5,1^5,2111","1^4,211,211,22","1^4,1^4,211,31", |
|
| "211,22,22,22,31","1^4,22,22,31,31","111,21,21,21,21,21", |
|
| "221^8,444,66","2^5,331^4,55","1^8,32111,44", |
|
| "32211,333,333","332211,3^4,66","3^42211,666,99", |
|
| "2^5,32221,55","1^7,1^7,511","1^c,5511,66", |
|
| "3^4,444,5511","541,55,55,55","5541,555,555", |
|
| "55541,5^4,aa","5^541,aaa,ff","1^8,1^8,62", |
|
| "1^a1^4,662,77","1^a,55,55,91","2^71,555,87", |
|
| "21^6,22211,44","221^6,3331,55","1^6,2211,3111", |
|
| "2^411,33211,55","1^7,3211,331","2211,33,33,411", |
|
| "3^42,44411,77","22211,2^4,431","2^511,4431,66", |
|
| "1^8,332,431","3^42,4433,77","1^8,22211,53", |
|
| "2221,2221,3211","221^5,333,441","1^7,21^5,43", |
|
| "1^b,443,65","21^5,2221,331","2^51,3332,65", |
|
| "21^4,21^4,222","221^4,221^4,44","1^6,21^4,321", |
|
| "2221^4,3322,55","21^4,33,33,42","21^4,222,33,51", |
|
| "2^51^4,554,77","2^4,3311,3311","3^411,4442,77", |
|
| "321,321,33,33","3321,3321,333","33321,33321,66", |
|
| "222,321,33,42","1^6,321,33,51","222,222,321,51", |
|
| "1^9,3321,54","1^7,322,322","3^422,5551,88", |
|
| "1^6,33,42,42","1^6,222,42,51","33,33,33,42,51", |
|
| "1^6,1^6,51,51","222,33,33,51,51","1^b,551,551", |
|
| "1^5,221,311,41","2^41,3321,441","22111,2221,322", |
|
| "2^51,443,551","222111,2^41,54","21^4,2211,2211", |
|
| "1^5,311,32,32","3331,3331,442","2211,2211,33,51", |
|
| "221,221,311,32","22111,22111,331","1^5,2111,32,41", |
|
| "2111,221,221,41","2111,221,32,32","211,211,211,211", |
|
| "211,211,22,31,31","1^4,211,31,31,31","22,22,31,31,31,31"], |
|
| ["11,11,11,11,11,11,11,11,11","1^5,1^5,1^5","2^5,2^5,55", |
|
| "111,111,111,111,21","2^41,333,333","1^4,1^4,211,22", |
|
| "211,22,22,22,22","1^8,22211,44","1^4,1^4,1^4,31", |
|
| "1^4,22,22,22,31","1^7,1^7,43","1^7,2221,331", |
|
| "2221,2221,2221","1^6,21^4,222","21^4,33,33,33", |
|
| "1^6,1^6,321","222,321,33,33","1^6,33,33,42", |
|
| "222,222,33,42","1^6,222,33,51","222,222,222,51", |
|
| "33,33,33,33,51","1^6,2211,2211","111,111,21,21,21,21", |
|
| "1^5,1^5,32,41","1^5,221,221,41","1^5,221,32,32", |
|
| "221,221,221,32","1^4,211,211,211","211,211,22,22,31", |
|
| "1^4,211,22,31,31","1^4,1^4,31,31,31","22,22,22,31,31,31", |
|
| "21,21,21,21,21,21,21","21^a,444,66","1^8,31^5,44", |
|
| "321^4,333,333","3321^4,3^4,66","3^421^4,666,99", |
|
| "2^5,322111,55","32^41,3^4,66","3332^41,666,99", |
|
| "1^8,1^8,611","2^4,44,44,611","1^d,6611,77", |
|
| "4^5,66611,aa","2^6,444,651","3^4,3^4,651", |
|
| "651,66,66,66","3^6,6651,99","6651,666,666", |
|
| "66651,6^4,cc","6^551,ccc,ii","2^8,655,88", |
|
| "1^9,1^9,72","1^g,772,88","1^c,444,75", |
|
| "2^6,3^4,75","1^c,66,66,b1","3^4,444,66,b1", |
|
| "3^7,777,ba","1^7,2221,4111","2^41,333,4311", |
|
| "1^9,2^41,63","21^8,3331,55","2^411,331^4,55", |
|
| "1^7,31^4,331","2^411,32221,55","22211,2^4,422", |
|
| "2^511,4422,66","1^8,332,422","2^5,3331,541", |
|
| "22211,44,44,62","2^411,2^5,64","2^711,664,88", |
|
| "1^a,3331,64","2221,2221,31^4","21^7,333,441", |
|
| "333,333,441,81","2^6111,555,87","21^6,221^4,44", |
|
| "221^6,3322,55","2^41^6,554,77","1^6,21^4,3111", |
|
| "3111,321,33,33","33111,3321,333","333111,33321,66", |
|
| "222,3111,33,42","1^6,3111,33,51","222,222,3111,51", |
|
| "1^9,33111,54","2221^4,33211,55","1^7,3211,322", |
|
| "3^4211,5551,88","2^4,3221,3311","333221,4442,77", |
|
| "3222,3321,333","33222,33321,66","1^9,3222,54", |
|
| "21^4,33,33,411","3^411,44411,77","222,321,33,411", |
|
| "1^6,33,411,42","1^6,222,411,51","33,33,33,411,51", |
|
| "221^4,2^4,431","2^41^4,4431,66","1^8,3311,431", |
|
| "3^411,4433,77","33321,444,552","1^8,221^4,53", |
|
| "3311,44,44,53","4^42,5553,99","2^4,3311,44,71", |
|
| "3^421,555,771","4^52,7771,bb","3^611,776,aa", |
|
| "2^41,33111,441","22111,2221,3211","2^41,3222,441", |
|
| "2^61,4441,76","3331,3331,4411","22211,22211,431", |
|
| "3331,3331,433","3^41,3^41,76","1^7,1^7,61,61", |
|
| "1^d,661,661","21^5,2221,322","221^5,2^41,54", |
|
| "2^51,33311,65","21^5,22111,331","3^41,4441,661", |
|
| "1^7,331,43,61","2221,2221,43,61","2221,331,331,61", |
|
| "21^4,21^4,2211","21^4,2211,33,51","22211,3311,3311", |
|
| "1^5,311,311,32","2211,321,33,42","2211,222,321,51", |
|
| "3322,3331,442","2211,222,42,42","2^411,442,442", |
|
| "1^6,2211,42,51","2211,33,33,51,51","221,221,311,311", |
|
| "1^5,2111,311,41","222111,3321,441","22111,22111,322", |
|
| "222111,222111,54","2111,221,311,32","2111,2111,221,41", |
|
| "1^5,221,41,41,41","2221,43,43,43","1^5,32,32,41,41", |
|
| "331,331,43,43","221,221,32,41,41","221,32,32,32,41", |
|
| "211,211,211,31,31","211,22,31,31,31,31","1^4,31,31,31,31,31"]]; |
|
| B=BB[MO]; |
|
| } |
|
| if(St!=1){ |
if(St!=1){ |
| for(R=[]; B!=[]; B=cdr(B)){ |
for(R=[]; B!=[]; B=cdr(B)){ |
| RT=F?s2sp(car(B)|std=F):s2sp(car(B)); |
RT= F?s2sp(car(B)|std=F): s2sp(car(B)); |
| if(length(RT)<L0 || length(RT)>L1) continue; |
if(length(RT)<L0 || length(RT)>L1) continue; |
| R=cons(RT,R); |
R=cons(RT,R); |
| } |
} |
|
|
| return LL; |
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) |
def spType2(L) |
| { |
{ |
| C=0;R=[]; |
C=0;R=[]; |
| Line 9263 def mc2grs(G,P) |
|
| Line 10231 def mc2grs(G,P) |
|
| T=(K==6)?["reduction"]:[]; |
T=(K==6)?["reduction"]:[]; |
| S=cons(append([x0,x1,x2,x3,x4,"idx"],T),S); |
S=cons(append([x0,x1,x2,x3,x4,"idx"],T),S); |
| M=ltotex(S|opt="tab",hline=[0,1,z], |
M=ltotex(S|opt="tab",hline=[0,1,z], |
| vline=(K==6)?[0,1,z-2,z-1,z]:[0,1,z-2,z-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$"]); |
left=["","$x_0$","$x_1$","$x_2$","$x_3$","$x_4$"]); |
| if(Dvi>0) dviout(M|keep=Keep); |
if(Dvi>0) dviout(M|keep=Keep); |
| } |
} |
| Line 9640 def mcmgrs(G,P) |
|
| Line 10608 def mcmgrs(G,P) |
|
| L=cons(TL,L); |
L=cons(TL,L); |
| } |
} |
| if(Dvi){ |
if(Dvi){ |
| if(Dvi!=-1) dviout(S|eq=0); |
if(Dvi!=-1) dviout(S|eq=0,keep=Keep); |
| return S; |
return S; |
| } |
} |
| return reverse(L); |
return reverse(L); |
| Line 9901 def mcmgrs(G,P) |
|
| Line 10869 def mcmgrs(G,P) |
|
| |
|
| def delopt(L,S) |
def delopt(L,S) |
| { |
{ |
| if((Inv=getopt(inv))!=1) Inv=0; |
if((Inv=getopt(inv))!=1&&Inv!=2) Inv=0; |
| |
if(Inv&&type(S)==4&&type(car(S))==4){ |
| |
for(R=[];L!=[];L=cdr(L)){ |
| |
L0=car(L)[0]; |
| |
for(F=0,TS=[];S!=[];S=cdr(S)){ |
| |
if(!F&&L0==car(S)[0]){ |
| |
R=cons(car(S),R); |
| |
F++; |
| |
continue; |
| |
} |
| |
TS=cons(car(S),TS); |
| |
} |
| |
if(!F) R=cons(car(L),R); |
| |
S=reverse(TS); |
| |
} |
| |
R=reverse(R); |
| |
return Inv==1?append(S,R):append(R,S); |
| |
} |
| for(R=[];L!=[];L=cdr(L)){ |
for(R=[];L!=[];L=cdr(L)){ |
| if(type(car(L))!=4) F=0; |
if(type(car(L))!=4) F=0; |
| else if(type(S)==4) F=(findin(car(L)[0],S)<0)?0:1; |
else if(type(S)==4) F=(findin(car(L)[0],S)<0)?0:1; |
| Line 10051 def str_str(S,T) |
|
| Line 11036 def str_str(S,T) |
|
| }else if(type(S)==4){ |
}else if(type(S)==4){ |
| for(; J<=LE; S=cdr(S),J++){ |
for(; J<=LE; S=cdr(S),J++){ |
| if(car(S) != LP){ |
if(car(S) != LP){ |
| if(SJIS && (V=S[J])>128){ |
if(SJIS && (V=car(S))>128){ |
| if(V<160 || (V>223 && V<240)) J++; |
if((V<160 || (V>223 && V<240))&&S!=[]) { |
| |
J++;S=cdr(S); |
| |
} |
| } |
} |
| continue; |
continue; |
| } |
} |
|
|
| return S; |
return S; |
| } |
} |
| |
|
| |
def evalcoord(L) |
| |
{ |
| |
if(type(L)==7) L=strtoascii(L); |
| |
I=str_str(L,"("); |
| |
if(I>=0) J=str_pair(L,I+1,"(",")"); |
| |
if(I<0 || 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) |
def i2hex(N) |
| { |
{ |
| Opt=getopt(); |
Opt=getopt(); |
| Line 10555 def my_tex_form(S) |
|
| Line 11668 def my_tex_form(S) |
|
| } |
} |
| SS = cons(S[I], SS); |
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); |
SS=str_subst(SS,"\\\\\n\\end{pmatrix}","\n\\end{pmatrix}"|raw=1); |
| Subst=getopt(subst); |
Subst=getopt(subst); |
| Sub0=["{asin}","{acos}","{atan}"]; |
Sub0=["{asin}","{acos}","{atan}"]; |
| Line 10629 def my_tex_form(S) |
|
| Line 11743 def my_tex_form(S) |
|
| S=cons(123,S); |
S=cons(123,S); |
| if(F==2) SS=cdr(SS); |
if(F==2) SS=cdr(SS); |
| else if(F==0) S=cons(car(SS),S); |
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); |
SS=cdr(SS);SS=cdr(SS); |
| S=cons(123,S);S=cons(car(SS),S);S=cons(125,S); |
S=cons(123,S);S=cons(car(SS),S);S=cons(125,S); |
| SS=cdr(SS);SS=cdr(SS); |
SS=cdr(SS);SS=cdr(SS); |
| Line 10650 def my_tex_form(S) |
|
| Line 11764 def my_tex_form(S) |
|
| SS=reverse(S); |
SS=reverse(S); |
| Top=P; |
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); |
if((K=getopt(ket))==1) S=texket(S); |
| else if(K==2) S=texket(S|all=1); |
else if(K==2) S=texket(S|all=1); |
| return S; |
return S; |
| Line 10807 def str_subst(S, L0, L1) |
|
| Line 11930 def str_subst(S, L0, L1) |
|
| |
|
| def dviout0(L) |
def dviout0(L) |
| { |
{ |
| Cmd=["TikZ","TeXLim","TeXEq","DVIOUT","XYPrec","XYcm","XYLim","Canvas"]; |
Cmd=["TikZ","TeXLim","TeXEq","DVIOUT","XYPrec","XYcm","XYLim","Canvas","TeXPages"]; |
| if(type(Opt=getopt(opt))==7){ |
if(type(Opt=getopt(opt))==7){ |
| if((F=findin(Opt,Cmd)) < 0) return -1; |
if((F=findin(Opt,Cmd)) < 0) return -1; |
| if(L==-1){ |
if(L==-1){ |
| Line 10820 def dviout0(L) |
|
| Line 11943 def dviout0(L) |
|
| if(F==4) V=XYPrec; |
if(F==4) V=XYPrec; |
| else if(F==5) V=XYcm; |
else if(F==5) V=XYcm; |
| else if(F==6) V=XYLim; |
else if(F==6) V=XYLim; |
| else V=Canvas; |
else if(F==7) V=Canvas; |
| |
else if(F==8) V=TeXPages; |
| } |
} |
| return V; |
return V; |
| } |
} |
| Line 10838 def dviout0(L) |
|
| Line 11962 def dviout0(L) |
|
| else if(F==4) XYPrec=L; |
else if(F==4) XYPrec=L; |
| else if(F==5) XYcm=L; |
else if(F==5) XYcm=L; |
| else if(F==6) XYLim=L; |
else if(F==6) XYLim=L; |
| |
else if(F==8) TeXPages=L; |
| } |
} |
| mycat0([Cmd[F],"=",L],1); |
mycat0([Cmd[F],"=",L],1); |
| return 1; |
return 1; |
| Line 10872 def dviout0(L) |
|
| Line 11997 def dviout0(L) |
|
| mycat0(["DVIOUTL=\"", DVIOUTL,"\""],1); |
mycat0(["DVIOUTL=\"", DVIOUTL,"\""],1); |
| mycat(["Canvas =", Canvas]); |
mycat(["Canvas =", Canvas]); |
| mycat(["TeXLim =", TeXLim]); |
mycat(["TeXLim =", TeXLim]); |
| |
mycat(["TeXPages =", TeXPages]); |
| mycat(["TeXEq =", TeXEq]); |
mycat(["TeXEq =", TeXEq]); |
| mycat(["AMSTeX =", AMSTeX]); |
mycat(["AMSTeX =", AMSTeX]); |
| mycat(["TikZ =", TikZ]); |
mycat(["TikZ =", TikZ]); |
|
|
| if(type(LT)==5) LT=vtol(LT); |
if(type(LT)==5) LT=vtol(LT); |
| if(type(LT)<4) LT=[LT]; |
if(type(LT)<4) LT=[LT]; |
| for(N=0; LT!=[]; LT=cdr(LT),N++){ |
for(N=0; LT!=[]; LT=cdr(LT),N++){ |
| if(N) str_tb(", ",Tb); |
if(N) str_tb(",",Tb); |
| if((T=car(LT))==Null) continue; |
if((T=car(LT))==Null) continue; |
| if(type(T)==7){ |
if(type(T)==7){ |
| K=str_len(T); |
K=str_len(T); |
| Line 11059 def readcsv(F) |
|
| Line 12185 def readcsv(F) |
|
| return 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) |
def showbyshell(S) |
| { |
{ |
| Id = getbyshell(S); |
Id = getbyshell(S); |
| Line 11085 def getbyshell(S) |
|
| Line 12227 def getbyshell(S) |
|
| return open_file(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) |
def show(P) |
| { |
{ |
| T=type(P); |
T=type(P); |
| S=P; |
S=P; |
| Var=getopt(opt); |
Var=getopt(opt); |
| |
if((Raw=getopt(raw))!=1) Raw=0; |
| if(Var=="verb"){ |
if(Var=="verb"){ |
| dviout("{\\tt"+verb_tex_form(T)+"}\n\n"); |
S="{\\tt"+verb_tex_form(T)+"}\n\n"; |
| return; |
if(Raw) return S; |
| |
dviout(S);return; |
| } |
} |
| if(type(Var)<0) Var=getopt(var); |
if(type(Var)<0) Var=getopt(var); |
| if(T==6){ |
if(T==6){ |
|
|
| if(Var=="pfrac") X=var(P); |
if(Var=="pfrac") X=var(P); |
| else X=getopt(pfrac); |
else X=getopt(pfrac); |
| if(isvar(X)){ |
if(isvar(X)){ |
| pfrac(P,X|dviout=1); |
if(Raw) return pfrac(P,X|TeX=1); |
| return; |
pfrac(P,X|dviout=1);return; |
| } |
} |
| Opt=cons(["dviout",1],getopt()); |
Opt=getopt(); |
| if(type(Var)==2||type(Var)==4||type(Var)==7) fctrtos(P|option_list=Opt); |
if(type(Var)!=2&&type(Var)!=4&&type(Var)!=7){ |
| else{ |
|
| if(isdif(P)!=0) Opt=cons(["var","dif"],Opt); |
if(isdif(P)!=0) Opt=cons(["var","dif"],Opt); |
| else Opt=cons(["br",1],Opt); |
else Opt=cons(["br",1],Opt); |
| fctrtos(P|option_list=Opt); |
|
| } |
} |
| return; |
if(!isfctr(P)){ |
| |
if(Raw) return my_tex_form(P); |
| |
else{ |
| |
dviout(P); return; |
| |
} |
| |
} |
| |
if(Raw) return fctrtos(P|option_list=cons(["TeX",3],Opt)); |
| |
fctrtos(P|option_list=cons(["pages",2],cons(["dviout",1],Opt)));return; |
| }else if(T==4){ |
}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){ |
if(type(Var)==4 || type(Var)==7){ |
| S=ltotex(P|option_list=getopt()); |
S=ltotex(P|option_list=getopt()); |
| if(Var=="text"){ |
if(Var=="text"){ |
| dviout(S); |
if(Raw) return S; |
| return; |
dviout(S);return; |
| } |
} |
| }else{ |
}else{ |
| for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ |
for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ |
|
|
| if(F==1) S=ltotex(P|opt="spt"); |
if(F==1) S=ltotex(P|opt="spt"); |
| else if(F==2){ |
else if(F==2){ |
| M=mtranspose(lv2m(S)); |
M=mtranspose(lv2m(S)); |
| show(M|sp=1); /* GRS */ |
if(Raw) return show(M|sp=1,raw=1); /* GRS */ |
| return; |
show(M|sp=1);return; |
| }else if(F==7) S=ltotex(P|opt="spts"); |
}else if(F==7) S=ltotex(P|opt="spts"); |
| else{ |
else{ |
| for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ |
for(F=0,L=P;L!=[] && F!=-1;L=cdr(L)){ |
|
|
| } |
} |
| } |
} |
| }else if(T==7){ |
}else if(T==7){ |
| if(Var=="raw" || |
if(Var=="raw") S=P+"\n\n"; |
| (Var !="eq" && str_chr(P,0,"\\")<0 && str_char(P,0,"^")<0 && str_char(P,0,"_")<0 |
else if(Var != "eq" &&str_str(P,"\\begin"|end=128)<0){ |
| && str_char(P,0,"&")<0)){ |
if((TikZ&&str_str(P,"\\draw"|end=128)>=0)||(!TikZ&&str_str(P,"\\ar@"|end=128)>=0)) |
| dviout(P+"\n\n"); |
S=xyproc(P); |
| return; |
}else if(Var !="eq"){ |
| |
if(str_str(P,"\\begin{align")>=0 || str_str(P,"\\[")>=0 |
| |
|| str_str(P,"\\begin{equation")>=0 |
| |
|| (str_char(P,0,"^")<0 && str_char(P,0,"_")<0 && str_char(P,0,"&")<0)) |
| |
S=P+"\n\n"; |
| } |
} |
| |
if(P!=S){ |
| |
if(Raw) return S; |
| |
dviout(S); return; |
| |
} |
| } |
} |
| dviout(S|eq=5); |
if(Raw) return "\\begin{align}\\begin{split}\n &"+S+"\\end{split}\\end{align}"; |
| |
else dviout(S|eq=5); |
| } |
} |
| |
|
| |
|
|
|
| #endif |
#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) |
def xyproc(F) |
| { |
{ |
| if(type(Opt=getopt(opt))!=7) Opt=""; |
if(type(Opt=getopt(opt))!=7) Opt=""; |
| Line 12175 def rungeKutta(F,N,Lx,Y,IY) |
|
| Line 13447 def rungeKutta(F,N,Lx,Y,IY) |
|
| if((Pr=getopt(prec))==1){ |
if((Pr=getopt(prec))==1){ |
| One=eval(exp(0)); |
One=eval(exp(0)); |
| }else{ |
}else{ |
| One=1;Pr=0; |
One=deval(exp(0));Pr=0; |
| } |
} |
| if((FL=getopt(last))!=1) FL=0; |
if(!isint(FL=getopt(mul))||!FL) FL=1; |
| if(length(Lx)>2){ |
if(length(Lx)>2){ |
| V=car(Lx);Lx=cdr(Lx); |
V=car(Lx);Lx=cdr(Lx); |
| }else V=x; |
}else V=x; |
| if(Pr==0) Lx=[deval(Lx[0]),deval(Lx[1])]; |
if(Pr==1) Lx=[eval(Lx[0]),eval(Lx[1])]; |
| else Lx=[eval(Lx[0]),eval(Lx[1])]; |
else Lx=[deval(Lx[0]),deval(Lx[1])]; |
| if(type(Y)==4){ |
if(type(Y)==4){ |
| if((Sing=getopt(single))==1||type(F)!=4) |
if((Sing=getopt(single))==1||type(F)!=4) |
| F=append(cdr(Y),[F]); |
F=append(cdr(Y),[F]); |
| Line 12196 def rungeKutta(F,N,Lx,Y,IY) |
|
| Line 13468 def rungeKutta(F,N,Lx,Y,IY) |
|
| } |
} |
| if(getopt(val)==1) V1=1; |
if(getopt(val)==1) V1=1; |
| else V1=0; |
else V1=0; |
| H=(Lx[1]-Lx[0])/N;H2=H/2; |
if(FL>0) N*=FL; |
| |
H=(Lx[1]-Lx[0])/N*One;H2=H/2; |
| FV=findin(V,vars(F)); |
FV=findin(V,vars(F)); |
| K=newvect(4); |
K=newvect(4); |
| if(L==1){ |
if(L==1){ |
| R=[[T=Lx[0],S=IY]]; |
R=[[T=Lx[0],S=IY]]; |
| if(!H) return R; |
if(!H) return R; |
| for(;;){ |
for(C=0;C<N;C++){ |
| for(I=0;I<4;I++){ |
for(I=0;I<4;I++){ |
| if(I==0) W=[[V,T],[Y,S]]; |
if(I==0) W=[[V,T],[Y,S]]; |
| else if(I==3) W=[[V,T+H],[Y,S+H*K[2]]]; |
else if(I==3) W=[[V,T+H],[Y,S+H*K[2]]]; |
| Line 12211 def rungeKutta(F,N,Lx,Y,IY) |
|
| Line 13484 def rungeKutta(F,N,Lx,Y,IY) |
|
| K[I]=Pr?myfeval(F,W)*One:myfdeval(F,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; |
S+=(K[0]+2*K[1]+2*K[2]+K[3])*H/6;T+=H; |
| if(!FL) R=cons([deval(T),S],R); |
if(FL>0&&!((C+1)%FL)) R=cons([deval(T),S],R); |
| if((T+H-Lx[1])*H>0) break; |
|
| } |
} |
| }else{ |
}else{ |
| T=Lx[0]; |
T=Lx[0]; |
| R=[cons(T,V1?[car(IY)]:IY)]; |
R=[cons(T,V1?[car(IY)]:IY)]; |
| S=ltov(IY); |
S=ltov(IY); |
| if(!H) return R; |
if(!H) return R; |
| for(;;){ |
for(C=0;C<N;C++){ |
| for(I=0;I<4;I++){ |
for(I=0;I<4;I++){ |
| if(I==0) W=cons([V,T ],lpair(Y,vtol(S))); |
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 if(I==3) W=cons([V,T+H ],lpair(Y,vtol(S+H*K[2]))); |
| Line 12232 def rungeKutta(F,N,Lx,Y,IY) |
|
| Line 13504 def rungeKutta(F,N,Lx,Y,IY) |
|
| } |
} |
| S+=(K[0]+2*K[1]+2*K[2]+K[3])*H/6;T+=H; |
S+=(K[0]+2*K[1]+2*K[2]+K[3])*H/6;T+=H; |
| TS=vtol(S); |
TS=vtol(S); |
| |
if(FL<0||(C+1)%FL) continue; |
| if(V1) TS=[car(TS)]; |
if(V1) TS=[car(TS)]; |
| if(!FL) R=cons(cons(deval(T),TS),R); |
R=cons(cons(deval(T),TS),R); |
| if((T+H-Lx[1])*H>0) break; |
|
| } |
} |
| } |
} |
| return FL?(V1?S[0]:S):reverse(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)); |
| |
} |
| |
} |
| |
}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) |
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,y,z) -> (z sin B + x cos A cos B + y sin A cos B, |
|
|
| def mylog(Z) |
def mylog(Z) |
| { |
{ |
| if(type(Z=eval(Z))>1) return todf(os_md.mylog,[Z]); |
if(type(Z=eval(Z))>1) return todf(os_md.mylog,[Z]); |
| if((Im=imag(Z))==0) return dlog(Z); |
if(imag(Z)==0&&Z>=0) return dlog(Z); |
| return dlog(dabs(Z))+@i*myarg(Z); |
return dlog(dabs(Z))+@i*myarg(Z); |
| } |
} |
| |
|
| |
def nlog(X) |
| |
{ |
| |
return mylog(X)/dlog(10); |
| |
} |
| |
|
| def mypow(Z,R) |
def mypow(Z,R) |
| { |
{ |
| if(type(Z=eval(Z))>1||type(R=eval(R))>1) return todf(os_md.mypow,[Z,R]); |
if(type(Z=eval(Z))>1||type(R=eval(R))>1) return todf(os_md.mypow,[Z,R]); |
| Line 13593 def fcont(F,LX) |
|
| Line 15073 def fcont(F,LX) |
|
| return reverse(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) |
def xygraph(F,N,LT,LX,LY) |
| { |
{ |
| if((Proc=getopt(proc))!=1&&Proc!=2&&Proc!=3) Proc=0; |
if((Proc=getopt(proc))!=1&&Proc!=2&&Proc!=3) Proc=0; |
| Line 13905 def xygraph(F,N,LT,LX,LY) |
|
| Line 15505 def xygraph(F,N,LT,LX,LY) |
|
| if(length(Ax)>3){ |
if(length(Ax)>3){ |
| D=Ax[3]; |
D=Ax[3]; |
| if(type(D)==1 && D>0){ |
if(type(D)==1 && D>0){ |
| I0=ceil((LY[0]-Ax[1])/D); I1=floor((LY[1]-Ax[0])/D); |
I0=ceil((LY[0]-Ax[1])/D); I1=floor((LY[1]-Ax[1])/D); |
| for(DD=[],I=I0; I<=I1; I++){ |
for(DD=[],I=I0; I<=I1; I++){ |
| if(length(Ax)<5) DD=cons(I*D,DD); |
if(length(Ax)<5) DD=cons(I*D,DD); |
| else if(I!=0){ |
else if(I!=0){ |
| Line 14143 def polroots(L,V) |
|
| Line 15743 def polroots(L,V) |
|
| return reverse(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 ptcommon(X,Y) |
def ptcommon(X,Y) |
| { |
{ |
| if(length(X)!=2 || length(Y)!=2) return 0; |
if(length(X)!=2 || length(Y)!=2) return 0; |
| Line 14185 def ptcommon(X,Y) |
|
| Line 15806 def ptcommon(X,Y) |
|
| T=[Y[0][0]+(Y[1][0]-Y[0][0])*y_-S[0], |
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]]; |
Y[0][1]+(Y[1][1]-Y[0][1])*y_-S[1]]; |
| R=lsol(T,[x_,y_]); |
R=lsol(T,[x_,y_]); |
| if(type(R[0])==4&&type(R[1])==4&&R[0][0]==x_&&R[1][0]==y_){ |
if(type(R[0])==4&&type(R[1])==4&&R[0][0]==x_&&R[1][0]==y_){ |
| if(!In || (R[0][1]>=0&&R[0][1]<=1&&R[1][1]>=0&&R[1][1]<=1) ) |
/* unique sol of parameters */ |
| return subst(S,x_,R[0][1],y_,R[1][1]); |
if(In && (R[0][1]<0||R[0][1]>1||R[1][1]<0||R[1][1]>1) ) return 0; |
| |
return subst(S,x_,R[0][1],y_,R[1][1]); |
| } |
} |
| if((type(R[0])>0&&type(R[0])<4)||(type(R[1])>0&&type(R[1])<4)) return 0; |
if((type(R[0])>0&&type(R[0])<4)||(type(R[1])>0&&type(R[1])<4)) return 0; /* no solution */ |
| if(!In) return 1; |
F=0; |
| I=(X[0][0]==X[1][0]&&Y[0][0]==Y[1][0]&&X[0][0]==Y[0][0])?1:0; |
if(X[0]==X[1]) F=1; |
| if(X[0][I]<=X[1][I]){ |
else if(Y[0]==Y[1]) F=2; |
| X0=X[0][I];X1=X[1][I]; |
if(!In){ |
| }else{ |
if(!F) return 1; |
| X1=X[0][I];X0=X[1][I]; |
else if(F==1) return X[0]; |
| |
else if(F==2) return Y[0]; |
| } |
} |
| return ((Y[0][I]<X0 && Y[1][I]<X0)||(Y[0][I]>X1&&Y[1][I]>X1))?0:1; |
X0=X[0];X1=X[1]; |
| |
if(X0>X1){R=X0;X0=X1;X1=R;} |
| |
Y0=Y[0];Y1=Y[1]; |
| |
if(Y0>Y1){R=Y0;Y0=Y1;Y1=R;} |
| |
if(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 */ |
}else if(Y[1]==0){ /* orth */ |
| T=[Y[0][0]+(X[1][1]-X[0][1])*y_-S[0], |
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]]; |
Y[0][1]-(X[1][0]-X[0][0])*y_-S[1]]; |
| Line 14254 def ptcommon(X,Y) |
|
| Line 15885 def ptcommon(X,Y) |
|
| return 0; |
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) |
def tobezier(L) |
| { |
{ |
| if((Div=getopt(div))==1||Div==2){ |
if((Div=getopt(div))==1||Div==2){ |
| Line 14590 def ptbezier(V,L) |
|
| Line 16254 def ptbezier(V,L) |
|
| return [subst(B,t,L[1]),subst(BB,t,L[1])]; |
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) |
def ptcombezier(P,Q,T) |
| { |
{ |
| if(type(T)<2){ |
if(type(T)<2){ |
| Line 14798 def lbezier(L) |
|
| Line 16669 def lbezier(L) |
|
| else{ |
else{ |
| if(R!=[]&&F!=0) R=cons(0,R); |
if(R!=[]&&F!=0) R=cons(0,R); |
| R=cons(G=car(LT),R); |
R=cons(G=car(LT),R); |
| if(In==3) In==2; |
if(In==3) In=2; |
| } |
} |
| for(LT=cdr(LT);LT!=[];LT=cdr(LT)) |
for(LT=cdr(LT);LT!=[];LT=cdr(LT)) |
| R=cons(car(LT),R); |
R=cons(car(LT),R); |
| Line 14817 def lbezier(L) |
|
| Line 16688 def lbezier(L) |
|
| } |
} |
| RT=cons(T,RT); |
RT=cons(T,RT); |
| }else if(T==0){ |
}else if(T==0){ |
| if(RT==[]) R=cons(reverse(RT),R); |
if(RT!=[]) R=cons(reverse(RT),R); |
| RT=[];F=0; |
RT=[];F=0; |
| }else if(T==1){ |
}else if(T==1){ |
| if(RT!=[]){ |
if(RT!=[]){ |
| Line 14839 def lbezier(L) |
|
| Line 16710 def lbezier(L) |
|
| |
|
| def xybezier(L) |
def xybezier(L) |
| { |
{ |
| |
if(type(L)==4&&type(car(L))==4&&type(car(L)[0])==4) L=lbezier(L|inv=1); |
| if(L==0 || (LS=length(L))==0) return ""; |
if(L==0 || (LS=length(L))==0) return ""; |
| Out=str_tb(0,0); |
Out=str_tb(0,0); |
| if(type(VF=getopt(verb))==4){ |
if(type(VF=getopt(verb))==4){ |
|
|
| |
|
| def xyang(S,P,Q,R) |
def xyang(S,P,Q,R) |
| { |
{ |
| Opt=getopt(); |
Opt=delopt(getopt(),"ar"); |
| if(type(Prec=getopt(prec))!=1) Prec=0; |
if(type(Prec=getopt(prec))!=1) Prec=0; |
| if(type(Q)>2){ |
if(type(Q)>2){ |
| |
if(type(Ar=getopt(ar))!=1) Ar=0; |
| if(R==1||R==-1){ /* ’¼Šp */ |
if(R==1||R==-1){ /* ’¼Šp */ |
| P1=ptcommon([Q,P],[-S,0]); |
P1=ptcommon([Q,P],[-S,0]); |
| S*=R; |
S*=R; |
| P2=ptcommon([P,P1],[S,@pi/2]); |
P2=ptcommon([P,P1],[S,@pi/2]); |
| P3=ptcommon([P1,P2],[S,@pi/2]); |
P3=ptcommon([P1,P2],[S,@pi/2]); |
| return xylines([P1,P2,P3]|option_list=Opt); |
return xylines([P1,P2,P3]|option_list=Opt); |
| }else if((AR=abs(R))==0||AR==2||AR==3||AR==4){ /* –îˆó */ |
}else if((AR=abs(R))==0||AR==2||AR==3||AR==4||AR>=10){ /* –îˆó */ |
| Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); |
Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); |
| if(R<0) Ang+=3.14159; |
if(R<0) Ang+=3.14159; |
| ANG=[0.7854,0.5236,1.0472]; |
if(AR>10) X=deval(@pi/180*AR); |
| X=(AR==0)?1.5708:ANG[AR-2]; |
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)]; |
U=[P[0]+S*dcos(Ang+X),P[1]+S*dsin(Ang+X)]; |
| V=[P[0]+S*dcos(Ang-X),P[1]+S*dsin(Ang-X)]; /* –îæ */ |
V=[P[0]+S*dcos(Ang-X),P[1]+S*dsin(Ang-X)]; /* –îæ */ |
| V=(X==0)?[U,V]:[U,P,V]; |
L=(X==0)?[U,V]:[U,P,V]; |
| if(getopt(ar)==1) V=append([Q,P,0],V); /* S–_ */ |
if(X&&iand(Ar,2)){ |
| return xylines(V|option_list=Opt); |
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); /* S–_ */ |
| |
return xylines(L|option_list=Opt); |
| }else if(AR>4&&AR<9){ |
}else if(AR>4&&AR<9){ |
| Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); |
Ang=myarg([Q[0]-P[0],Q[1]-P[1]]); |
| ANG=[0.7854,0.5236,0.3927,0.2618]; |
ANG=[0.7854,0.5236,0.3927,0.2618]; |
| Line 15034 def xyang(S,P,Q,R) |
|
| Line 16915 def xyang(S,P,Q,R) |
|
| W=ptcommon([P,U],[P,Q]|in=-2); |
W=ptcommon([P,U],[P,Q]|in=-2); |
| W1=[(U[0]+P[0]+W[0])/3,(U[1]+P[1]+W[1])/3]; |
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]; |
W2=[(V[0]+P[0]+W[0])/3,(V[1]+P[1]+W[1])/3]; |
| L=[U,W1,P,1,W2,V]; |
L=iand(Ar,2)?[V,U,1,W1,P,1,W2,V]:[U,W1,P,1,W2,V]; |
| if(getopt(ar)==1) L=append([Q,P,0],L); |
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=getopt(scale))>0){ |
| if(type(Sc)==1) Sc=[Sc,Sc]; |
if(type(Sc)==1) Sc=[Sc,Sc]; |
| L=ptaffine(diagm(2,Sc),L); |
L=ptaffine(diagm(2,Sc),L); |
| } |
} |
| Opt=getopt(opt); |
Opt=delopt(Opt,"proc"); |
| if(type(Opt)>0) OL=[["opt",Opt]]; |
if(getopt(proc)==1) return append([2,Opt],L); |
| else OL=[]; |
S=xybezier(L|option_list=Opt); |
| if(getopt(proc)==1) return append([2,OL],L); |
|
| S=xybezier(L|optilon_list=OL); |
|
| if(getopt(dviout)!=1) return S; |
if(getopt(dviout)!=1) return S; |
| dviout(S); |
dviout(xyproc(S)); |
| return 1; |
return 1; |
| } |
} |
| } |
} |
| Line 15210 def xypoch(W,H,R1,R2) |
|
| Line 17092 def xypoch(W,H,R1,R2) |
|
| return S; |
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) |
def ptaffine(M,L) |
| { |
{ |
| if(type(L)!=4&&type(L)!=5){ |
if(type(L)!=4&&type(L)!=5){ |
| Line 15496 def ptcopy(L,V) |
|
| Line 17550 def ptcopy(L,V) |
|
| } |
} |
| } |
} |
| |
|
| |
def regress(L) |
| |
{ |
| |
E=deval(exp(0)); |
| |
for(S0=T0=0,S=L;S!=[];S=cdr(S)){ |
| |
S0+=car(S)[0]*E;T0+=car(S)[1]*E; |
| |
} |
| |
K=length(L);S0/=K;T0/=K; |
| |
for(SS=TT=0,S=L;S!=[];S=cdr(S)){ |
| |
SS+=(car(S)[0]-S0)^2*E;TT+=(car(S)[1]-T0)^2*E; |
| |
ST+=(car(S)[0]-S0)*(car(S)[1]-T0)*E; |
| |
} |
| |
if(!SS||!TT) return []; |
| |
A=ST/SS; |
| |
L=[A,A*S0-T0,ST/dsqrt(SS*TT),S0,dsqrt(SS/K),T0,dsqrt(TT/K)]; |
| |
if(isint(N=getopt(sint))){ |
| |
R=reverse(L); |
| |
for(L=[];R!=[];R=cdr(R)) L=cons(sint(car(R),N|str=0),L); |
| |
} |
| |
return L; |
| |
} |
| |
|
| def average(L) |
def average(L) |
| { |
{ |
| if(getopt(opt)=="co"){ |
if(getopt(opt)=="co"){ |
| Line 17166 def shiftop(M,S) |
|
| Line 19241 def shiftop(M,S) |
|
| return [QQ,P,RS]; |
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) |
def conf1sp(M) |
| { |
{ |
| if(type(M)==7) M=s2sp(M); |
if(type(M)==7) M=s2sp(M); |
| Line 17255 def conf1sp(M) |
|
| Line 19363 def conf1sp(M) |
|
| return P; |
return P; |
| } |
} |
| |
|
| |
/* ((1)(1)) ((1)) 111|11|21 [[ [2,[ [1,[1]],[1,[1]] ]], [1,[[1,[1]]]] ]] */ |
| |
/* (11)(1),111 111|21,111 [[[2,[1,1]],[1,[1]]],[1,1,1]] */ |
| |
def s2csp(S) |
| |
{ |
| |
if(type(S)!=7){ |
| |
U=""; |
| |
if(type(N=getopt(n))>0){ |
| |
for(D=0,S=reverse(S);S!=[];S=cdr(S),D++){ |
| |
if(D) U=","+U; |
| |
T=str_subst(rtostr(car(S)),","," "); |
| |
U=str_cut(T,1,str_len(T)-2)+U; |
| |
} |
| |
V=strtoascii(U); |
| |
for(R=[];V!=[];V=cdr(V)){ |
| |
if((CC=car(V))==91){ /* [ */ |
| |
if(length(V)>1 && V[1]==91) V=cdr(V); |
| |
for(I=1;(CC=V[I])!=91&&CC!=93;I++); |
| |
if(CC==91){ |
| |
R=cons(40,R); /* ( */ |
| |
while(I--) V=cdr(V); |
| |
}else{ |
| |
V=cdr(V); |
| |
while(--I) R=cons(car(V),R); |
| |
} |
| |
}else if(CC==93){ /* ] */ |
| |
R=cons(41,R); |
| |
if(length(V)>1 && V[1]==93) V=cdr(V); |
| |
}else R=cons(CC,R); |
| |
} |
| |
return asciitostr(reverse(R)); |
| |
} |
| |
for(;S!=[];S=cdr(S)){ |
| |
if(U!="") U=U+","; |
| |
for(D=0,TU="",T=car(S);T!=[];D++){ |
| |
if(type(car(T))==4){ |
| |
R=lpair(T,0); |
| |
T=R[0];R1=m2l(R[1]|flat=1); |
| |
}else R1=[]; |
| |
if(D) TU="|"+TU; |
| |
TU=s2sp([T])+TU; |
| |
T=R1; |
| |
} |
| |
U=U+TU; |
| |
} |
| |
return U; |
| |
} |
| |
S=strtoascii(S); |
| |
if(type(N=getopt(n))>0){ |
| |
S=ltov(S); |
| |
L=length(S); |
| |
R=""; |
| |
for(I=J=N=0, V=[];J<L;J++){ |
| |
if(S[J]==72) I=J; /* ( */ |
| |
else if(S[J]>47&&S[J]<58) N=N*10+S[J]-48; |
| |
else{ |
| |
if(N>0){ |
| |
V=cons(N,V); |
| |
N=0; |
| |
} |
| |
if(S[J]==41){ /* ) */ |
| |
|
| |
}else if(S[J]==44){ /* , */ |
| |
|
| |
} |
| |
} |
| |
} |
| |
} |
| |
for(P=TS=[],I=D=0; S!=[]; S=cdr(S)){ |
| |
if((C=car(S))==44){ /* , */ |
| |
P=cons(D,P);D=0; |
| |
}else if(C==124){ /* | */ |
| |
D++;C=44; |
| |
} |
| |
TS=cons(C,TS); |
| |
} |
| |
S=reverse(TS); |
| |
P=reverse(cons(D,P)); |
| |
U=s2sp(asciitostr(S)); |
| |
|
| |
for(R=[];P!=[];P=cdr(P),U=cdr(U)){ |
| |
D=car(P);R0=car(U); |
| |
while(D--){ |
| |
U=cdr(U); |
| |
for(U0=car(U),R2=[];U0!=[];U0=cdr(U0)){ |
| |
for(R1=[],N=car(U0);N>0;R0=cdr(R0)){ |
| |
R1=cons(car(R0),R1); |
| |
if(type(car(R0))==4) N-=car(R0)[0]; |
| |
else N-=car(R0); |
| |
} |
| |
R2=cons([car(U0),reverse(R1)],R2); |
| |
} |
| |
R0=reverse(R2); |
| |
} |
| |
R=cons(R0,R); |
| |
} |
| |
return reverse(R); |
| |
} |
| |
|
| |
|
| def partspt(S,T) |
def partspt(S,T) |
| { |
{ |
| if(type(Op=getopt(opt))!=1) Op=0; |
|
| if(length(S)>length(T)) return []; |
if(length(S)>length(T)) return []; |
| |
if(type(Op=getopt(opt))!=1) Op=0; |
| |
else{ |
| |
VS=ltov(S); |
| |
L=length(S)-1; |
| |
VT=ltov(qsort(T)); |
| |
} |
| if(length(S)==length(T)){ |
if(length(S)==length(T)){ |
| if(qsort(S)==qsort(T)) R=S; |
if(S==T||qsort(S)==qsort(T)) R=S; |
| else return []; |
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{ |
}else{ |
| VS=ltov(S); |
|
| L=length(S)-1; |
|
| VT=ltov(qsort(T)); |
|
| for(R=[];;){ |
for(R=[];;){ |
| for(I=J=P=0;I<L;I++){ |
for(I=J=P=0;I<L;I++){ |
| P=VS[I]; |
P=VS[I]; |
| Line 17298 def partspt(S,T) |
|
| Line 19527 def partspt(S,T) |
|
| } |
} |
| R=W; |
R=W; |
| if(iand(Op,1)){ |
if(iand(Op,1)){ |
| for(W=R,R=[];W!=[];W=cdr(W)) |
for(R=[];W!=[];W=cdr(W)) |
| R=cons(reverse(qsort(car(W))),R); |
R=cons(reverse(qsort(car(W))),R); |
| R=lsort(R,[],1); |
R=lsort(R,[],1); |
| } |
} |
| Line 17338 def confspt(S,T) |
|
| Line 19567 def confspt(S,T) |
|
| } |
} |
| #endif |
#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) |
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){ |
if(type(S[0])==4){ |
| for(E=[];S!=[];S=cdr(S)) |
for(E=[];S!=[];S=cdr(S)) E=cons(confexp(car(S),E)); |
| E=cons(confexp(car(S),E)); |
|
| return reverse(E); |
return reverse(E); |
| } |
} |
| V=x;E=[]; |
V=x;E=[]; |
| Line 17483 def newbmat(M,N,R) |
|
| Line 19824 def newbmat(M,N,R) |
|
| S = newvect(M); |
S = newvect(M); |
| T = newvect(N); |
T = newvect(N); |
| IM = length(R); |
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++){ |
for(I = 0; I < IM; I++){ |
| RI = R[I]; |
RI = R[I]; |
| JM = length(RI); |
JM = length(RI); |
| Line 19476 def bernoulli(N) |
|
| Line 21824 def bernoulli(N) |
|
| } |
} |
| |
|
| /* linfrac01([x,y]) */ |
/* linfrac01([x,y]) */ |
| /* linfrac01(newvect(10,[0,1,2,3,4,5,6,7,8,9]) */ |
/* (x_0,x_1,x_2,x_3,...,x_{q+3})=(x,0,1,y_1,...,y_q,\infty) |
| /* 0:x=0, 1:x=y, 2:x=1, 3:y=0, 4:y=1, 5:x=\infty, 6:y=\infty, 7:x=y=0, 8:x=y=1, 9:x=y=\infty |
|
| 10:y_2=0, 11:y_2=x, 12:y_2=y, 13: y_2=1, 14: y_2=\infty |
|
| 15:y_3=0, 16:y_3=x, 17:y_3=y, 18: y_3=y_2, 19: y_3=1, 20:y_3=\infty |
|
| X[0],X[11],X[2],X[10],X[13],X[5],X[14],X[7],X[8],X[9], |
|
| X[3],X[1],X[12],X[4],X[6] |
|
| |
|
| T=0 (x_2,x_1,x_3,x_4,...) |
T=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=-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=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=2 (1/x_1,1/x_2,1/x_3,1/x_4,...) |
| T=3 (x_1,x_1/x_2,x_1/x_3,x_1/x_4,...) |
T=3 (1/x_1,x_2/x_1,x_3/x_1,x_4/x_1,...) |
| */ |
*/ |
| |
|
| def lft01(X,T) |
def lft01(X,T) |
| { |
{ |
| MX=getopt(); |
S=0; |
| if(type(X)==4){ |
if(type(X)==4){ |
| |
if(type(car(X))==4){ |
| |
S=X[1];X=car(X); |
| |
} |
| K=length(X); |
K=length(X); |
| if(K>=1) D=1; |
if(K>=1) D=1; |
| } |
} |
| if(type(X)==5){ |
|
| K=length(X); |
|
| for(J=5, F=K-10; F>0; F-=J++); |
|
| if(F==0) D=2; |
|
| } |
|
| if(D==0) return 0; |
if(D==0) return 0; |
| if(T==0){ /* x <-> y */ |
if(type(T)==4&&(length(T)==K+3||length(T)==2)){ |
| if(D==1){ |
for(U=[],I=K+2;I>=0;I--) U=cons(I,U); |
| R=cdr(X); R=cdr(R); |
if(length(T)==2) T=mperm(U,[T],0); |
| R=cons(X[0],R); |
L=sexps(T); |
| return cons(X[1],R); |
for(R=[X,S];L!=[];L=cdr(L)){ |
| |
if(!(I=car(L))) I=4; |
| |
/* else if(I==1) I=1; */ |
| |
else if(I==2) I=5; |
| |
else if(I==K+1) I=6; |
| |
else if(I>2) I=2-I; |
| |
R=lft01(R,I); |
| } |
} |
| R=newvect(K,[X[3],X[1],X[4],X[0],X[2],X[6],X[5]]); |
|
| for(I=7;I<K;I++) R[I]=X[I]; |
|
| for(I=11,J=5; I<K; I+=J++){ |
|
| R[I]=X[I+1]; R[I+1]=X[I]; |
|
| } |
|
| return R; |
return R; |
| } |
} |
| if(T==1){ |
if(!S) S=getopt(tr); |
| if(D==1){ |
if(type(S)==4&&length(S)==K+3){ |
| for(R=[];X!=[];X=cdr(X)) R=cons(1-car(X),R); |
D=2; |
| return reverse(R); |
}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]; |
| } |
} |
| R=newvect(K,[X[2],X[1],X[0],X[4],X[3],X[5],X[6],X[8],X[7],X[9]]); |
|
| for(I=11;I<K;I++) R[I]=X[I]; |
|
| for(I=10, J=5; I<K; I+=J++){ |
|
| R[I]=X[I+J-2]; R[I+J-2]=X[I]; |
|
| } |
|
| return R; |
return R; |
| } |
}else if(T==1){ /* (x_1=0, x_2=1) : 1 */ |
| if(T==2){ |
for(R=[];X!=[];X=cdr(X)) R=cons(1-car(X),R); |
| if(D==1){ |
if(S) S=mperm(S,[[1,2]],0); |
| for(R=[]; X!=[]; X=cdr(X)) R=cons(red(1/car(X)),R); |
}else if(T==2){ /* (x_1=0, x_{K+2}=infty) */ |
| return reverse(R); |
for(R=[]; X!=[]; X=cdr(X)) R=cons(red(1/car(X)),R); |
| } |
if(S) S=mperm(S,[[1,K+2]],0); |
| R=newvect(K,[X[5],X[1],X[2],X[6],X[4],X[0],X[3],X[9],X[8],X[7]]); |
}else if(T==3){ /* (x_0=x, x_2=1) */ |
| for(I=11;I<K;I++) R[I]=X[I]; |
T=car(X); |
| for(I=10,J=5; I<K; I+=J++){ |
for(R=[red(1/T)],X=cdr(X); X!=[]; X=cdr(X)) R=cons(red(car(X)/T),R); |
| R[I]=X[I+J-1]; R[I+J-1]=X[I]; |
if(S) S=mperm(S,[[0,2]],0); |
| } |
}else if(T==4){ /* (x_0=x,x_1=0) : 0 */ |
| return R; |
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(T==3){ |
if(S) S=mperm(S,[[0,1]],0); |
| if(D==1){ |
}else if(T==5){ /* (x_2=1,x_3=y) : 2 */ |
| T=car(X); |
T=X[1]; |
| for(R=[T],X=cdr(X); X!=[]; X=cdr(X)) |
for(R=[1/T,red(X[0]/T)],X=cdr(cdr(X));X!=[]; X=cdr(X)) R=cons(red(car(X)/T),R); |
| R=cons(red(T/car(X)),R); |
if(S) S=mperm(S,[[2,3]],0); |
| return reverse(R); |
}else if(T==6){ /* (x_{K+1}=y_{K-1}, x_{K+2}=infty) : K+1 */ |
| } |
T=X[K-1]; |
| R=newvect(K,[X[7],X[4],X[2],X[6],X[1],X[9],X[3],X[0],X[8],X[5]]); |
for(R=[];length(X)>1;X=cdr(X)) R=cons(red(car(X)*(1-T)/(car(X)-T)),R); |
| for(I=10,J=5; I<K; I+=J++){ |
R=cons(1-T,R); |
| R[I]=X[I+J-1]; R[I+1]=X[I+J-2]; R[I+J-2]=X[I+1]; R[I+J-1]=X[I]; |
if(S) S=mperm(S,[[K+1,K+2]],0); |
| } |
}else if(T==7){ /* x_2=1 <-> x_{K+2}=infty */ |
| return R; |
for(R=[];X!=[];X=cdr(X)) R=cons(red(car(X)/(car(X)-1)),R); |
| } |
if(S) S=mperm(S,[[2,K+2]],0); |
| if(T==-1){ |
}else return 0; |
| if(D==1){ |
R=reverse(R); |
| return append([X[1],X[2],X[0]],cdr(cdr(cdr(X)))); |
return S?[R,S]:R; |
| } |
|
| R=newvect(K,[X[0],X[11],X[2],X[10],X[13],X[5],X[14],X[7],X[8],X[9], |
|
| X[3],X[1],X[12],X[4],X[6]]); |
|
| for(I=11;I<K;I++) R[I]=X[I]; |
|
| for(I=17,J=5; I<K; I+=J++){ |
|
| R[I]=X[I+1]; R[I+1]=X[I]; |
|
| } |
|
| return R; |
|
| } |
|
| if(T<0){ |
|
| if(D==1){ |
|
| for(R=[],I=0; X!=[]; X=cdr(X),I--){ |
|
| if(I==T){ |
|
| R=cons(X[1],R); |
|
| R=cons(X[0],R); |
|
| X=cdr(X); |
|
| } |
|
| else R=cons(car(X),R); |
|
| } |
|
| return reverse(R); |
|
| } |
|
| T=3-T; |
|
| R=newvect(K); |
|
| for(I=0;I<K;I++) R[I]=X[I]; |
|
| for(I=10,J=5;J<T;I+=J++); |
|
| for(II=0; II<J-2; II++){ |
|
| R[I]=X[I+J]; R[I+J]=R[I]; |
|
| } |
|
| for( ; II<J; II++){ |
|
| R[I]=X[I+J+1]; R[I+J+1]=X[I]; |
|
| } |
|
| return R; |
|
| } |
|
| return 0; |
|
| } |
} |
| |
|
| def linfrac01(X) |
def linfrac01(X) |
| { |
{ |
| if(type(X)==4) K=length(X)-2; |
if(type(X)==4){ |
| else if(type(X)==5){ |
K=length(X)-2; |
| L=length(X); |
if(type(car(X))==4){ |
| for(K=0,I=10,J=5; I<L; K++,I+=J++); |
for(U=[],I=K+4;I>=0;I--) U=cons(I,U); |
| if(I!=L) return 0; |
X=[car(X),U]; |
| |
}else U=0; |
| } |
} |
| if(K>3 && getopt(over)!=1) return(-1); |
if(K>3 && getopt(over)!=1) return(-1); |
| II=(K==-1)?3:4; |
II=(K==-1)?3:4; |
| Line 19613 def linfrac01(X) |
|
| Line 21923 def linfrac01(X) |
|
| } |
} |
| } |
} |
| } |
} |
| return L; |
return reverse(L); |
| } |
} |
| |
|
| |
|
| Line 20033 def distpoint(L) |
|
| Line 22343 def distpoint(L) |
|
| |
|
| def keyin(S) |
def keyin(S) |
| { |
{ |
| print(S,2); |
mycat0(S,0); |
| purge_stdin(); |
purge_stdin(); |
| S=get_line(); |
S=get_line(); |
| L=length(S=strtoascii(S)); |
L=length(S=strtoascii(S)); |
![[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