Return to RU.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / engine

Annotation of OpenXM_contrib2/asir2000/engine/RU.c, Revision 1.1.1.1

1.1       noro        1: /* $OpenXM: OpenXM/src/asir99/engine/RU.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */
                      2: #include "ca.h"
                      3:
                      4: int qcoefr(r)
                      5: Obj r;
                      6: {
                      7:        if ( !r )
                      8:                return 1;
                      9:        else
                     10:                switch ( OID(r) ) {
                     11:                        case O_N:
                     12:                                return RATN(r)?1:0; break;
                     13:                        case O_P:
                     14:                                return qcoefp(r); break;
                     15:                        default:
                     16:                                return qcoefp((Obj)NM((R)r))&&qcoefp((Obj)DN((R)r)); break;
                     17:                }
                     18: }
                     19:
                     20: int qcoefp(p)
                     21: Obj p;
                     22: {
                     23:        DCP dc;
                     24:
                     25:        if ( !p )
                     26:                return 1;
                     27:        else
                     28:                switch ( OID(p) ) {
                     29:                        case O_N:
                     30:                                return RATN(p)?1:0; break;
                     31:                        default:
                     32:                                for ( dc = DC((P)p); dc; dc = NEXT(dc) )
                     33:                                        if ( !qcoefp((Obj)COEF(dc)) )
                     34:                                                return 0;
                     35:                                return 1; break;
                     36:                }
                     37: }
                     38:
                     39: void reductr(vl,p,r)
                     40: VL vl;
                     41: Obj p,*r;
                     42: {
                     43:        P t,s,u,cnm,cdn,pnm,pdn;
                     44:        R a;
                     45:
                     46:        if ( !p )
                     47:                *r = 0;
                     48:        else if ( OID(p) <= O_P )
                     49:                *r = p;
                     50:        else if ( ((R)p)->reduced )
                     51:                *r = p;
                     52:        else if ( NUM(DN((R)p)) )
                     53:                divsp(vl,NM((R)p),DN((R)p),(P *)r);
                     54:        else if ( qcoefp((Obj)NM((R)p)) && qcoefp((Obj)DN((R)p)) ) {
                     55:                ptozp(NM((R)p),1,(Q *)&cnm,&pnm); ptozp(DN((R)p),1,(Q *)&cdn,&pdn);
                     56:                ezgcdpz(vl,pnm,pdn,&t);
                     57:                divsp(vl,NM((R)p),t,&u); divsp(vl,DN((R)p),t,&s);
                     58:                if ( NUM(s) )
                     59:                        divsp(vl,u,s,(P *)r);
                     60:                else {
                     61:                        divsp(vl,u,cdn,&pnm); divsp(vl,s,cdn,&pdn);
                     62:                        MKRAT(pnm,pdn,1,a); *r = (Obj)a;
                     63:                }
                     64:        } else {
                     65:                MKRAT(NM((R)p),DN((R)p),1,a); *r = (Obj)a;
                     66:        }
                     67: }
                     68:
                     69: void pderivr(vl,a,v,b)
                     70: VL vl;
                     71: V v;
                     72: Obj a,*b;
                     73: {
                     74:        P t,s,u;
                     75:        R r;
                     76:
                     77:        if ( !a )
                     78:                *b = 0;
                     79:        else if ( OID(a) <= O_P )
                     80:                diffp(vl,(P)a,v,(P *)b);
                     81:        else {
                     82:                diffp(vl,NM((R)a),v,&t); mulp(vl,t,DN((R)a),&s);
                     83:                diffp(vl,DN((R)a),v,&t); mulp(vl,t,NM((R)a),&u);
                     84:                subp(vl,s,u,&t);
                     85:                if ( t ) {
                     86:                        mulp(vl,DN((R)a),DN((R)a),&u); MKRAT(t,u,0,r); *b = (Obj)r;
                     87:                } else
                     88:                        *b = 0;
                     89:        }
                     90: }
                     91:
                     92: void clctvr(vl,p,nvl)
                     93: VL vl,*nvl;
                     94: Obj p;
                     95: {
                     96:        VL vl1,vl2;
                     97:
                     98:        if ( !p )
                     99:                *nvl = 0;
                    100:        else if ( OID(p) <= O_P )
                    101:                clctv(vl,(P)p,nvl);
                    102:        else {
                    103:                clctv(vl,NM((R)p),&vl1); clctv(vl,DN((R)p),&vl2); mergev(vl,vl1,vl2,nvl);
                    104:        }
                    105: }