[BACK]Return to os_muldif.rr CVS log [TXT][DIR] Up to [local] / OpenXM / src / asir-contrib / packages / src

Diff for /OpenXM/src/asir-contrib/packages/src/os_muldif.rr between version 1.48 and 1.50

version 1.48, 2019/03/06 02:41:30 version 1.50, 2019/06/27 02:53:26
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.47 2019/03/05 01:52:51 takayama Exp $ */  /* $OpenXM: OpenXM/src/asir-contrib/packages/src/os_muldif.rr,v 1.49 2019/05/23 01:47:53 takayama Exp $ */
 /* The latest version will be at ftp://akagi.ms.u-tokyo.ac.jp/pub/math/muldif  /* The latest version will be at ftp://akagi.ms.u-tokyo.ac.jp/pub/math/muldif
  scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs   scp os_muldif.[dp]* ${USER}@lemon.math.kobe-u.ac.jp:/home/web/OpenXM/Current/doc/other-docs
 */  */
Line 355  localf shiftop$
Line 355  localf shiftop$
 localf conf1sp$  localf conf1sp$
 localf confexp$  localf confexp$
 localf confspt$  localf confspt$
   localf mcvm$
 localf s2csp$  localf s2csp$
 localf partspt$  localf partspt$
 localf pgen$  localf pgen$
Line 474  extern  SV=SVORG$
Line 475  extern  SV=SVORG$
 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="00190304"$  Muldif.rr="00190620"$
 AMSTeX=1$  AMSTeX=1$
 TeXEq=5$  TeXEq=5$
 TeXLim=80$  TeXLim=80$
Line 2249  def vgen(V,W,S)
Line 2250  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 5452  def mulpdo(P,Q,L);
Line 5457  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 5477  def transpdosub(P,LL,K)
Line 5488  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 5491  def transpdo(P,LL,K)
Line 5501  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 6265  def baseODE(L)
Line 6290  def baseODE(L)
         }          }
         if(type(To=getopt(to))<2||type(To)>4) To=0;          if(type(To=getopt(to))<2||type(To)>4) To=0;
         else if(!isvar(To)){          else if(!isvar(To)){
                 if(type(To)!=4) To=cons(red(To),cdr(Var));                  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(To)==4){
                         if(type(car(To))==4){                          if(type(car(To))==4){
                                 R=1;To=car(To);                                  R=1;To=car(To);
Line 6947  def expat(F,L,V)
Line 6983  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 17680  def confspt(S,T)
Line 17720  def confspt(S,T)
 }  }
 #endif  #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);
         X=reverse(X);
       }
           if(getopt(e)==1){
             if(length(N)==4){
                   N=ltov(N);
                   if(N[1]<N[3]){
                           I=N[1];N[1]=N[3];N[3]=I;
                   }
                   if(N[2]<N[3]||N[2]>=N[1]+N[3]) return 0;
                   X=X[0];
                   for(R=[],I=1;I<N[3];I++) R=cons(makev([X[0],I]),R);
                   for(L=[],I=N[1];I<=N[2];I++) L=cons(makev([X[0],I]),L);
                   for(S=0,I=N[1];I<=N[2];I++){
                     V=makev([X[0],I]);
             S+=polbyroot(R,V)/polbyroot(lsort(L,V,1),V);
                     S=red(S);
                   }
                   return S;
         }
           }
           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));
           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(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(map(red,myinv(M)*U*M),R);
       }
       return reverse(R);
     }
     return M;
   }
   
 def confexp(S)  def confexp(S)
 {  {
Line 17825  def newbmat(M,N,R)
Line 17922  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);
Legend:
Removed from v.1.48  
changed lines
  Added in v.1.50
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>