Annotation of OpenXM/src/k097/lib/restriction/complex.k, Revision 1.1
1.1 ! takayama 1: /* $OpenXM$ */
! 2: /* Document is at k097/Doc/complex.k */
! 3:
! 4: load["lib/restriction/restriction.k"];;
! 5: def man(a) {
! 6: local lang,n;
! 7: n = Length(Arglist);
! 8: lang = GetEnv("LANG");
! 9: if (lang == "C" || Length(lang) == 0) {
! 10: if (n < 1) {
! 11: sm1(" (ls $OpenXM_HOME/lib/k097/help/help-en ) system ");
! 12: }else {
! 13: sm1(" [(more $OpenXM_HOME/lib/k097/help/help-en/) a] cat system ");
! 14: }
! 15: }else{
! 16: if (n < 1) {
! 17: sm1(" (ls $OpenXM_HOME/lib/k097/help/help-ja ) system ");
! 18: }else {
! 19: sm1(" [(jless $OpenXM_HOME/lib/k097/help/help-ja/) a] cat system ");
! 20: }
! 21: }
! 22: }
! 23:
! 24: def Res_solv(m,d,rng) {
! 25: local r,rr,ans,ac;
! 26: ac = Length(Arglist);
! 27: r = GetRing(Poly("1")); /* Save the current ring. */
! 28: if (ac < 3) {
! 29: rng = null;
! 30: rr = GetRing(m);
! 31: if (Tag(rr) == 0) rr = GetRing(d);
! 32: if (Tag(rr) != 0) SetRing(rr);
! 33: }else{
! 34: SetRing(rng);
! 35: }
! 36: m=DC(m,"polynomial"); d = DC(d,"polynomial");
! 37:
! 38: if (IsRing(rng)) {
! 39: sm1(" [ m d rng] res-solv /ans set ");
! 40: }else{
! 41: sm1(" [ m d] res-solv /ans set ");
! 42: }
! 43:
! 44: SetRing(r);
! 45: return(ans);
! 46: }
! 47:
! 48: /* m : D^p ---> D^q/jj, u m = d mod jj */
! 49: def Res_solv2(m,d,jj,rng) {
! 50: local r,rr,ans,ac,pp,qq,kk;
! 51:
! 52: ac = Length(Arglist);
! 53: r = GetRing(Poly("1")); /* Save the current ring. */
! 54: if (ac < 4) {
! 55: rng = null;
! 56: rng = GetRing(m);
! 57: if (Tag(rng) == 0) rng = GetRing(d);
! 58: }
! 59:
! 60: pp = Length(m);
! 61: if (!IsArray(m[0])) {
! 62: sm1(" m { [ 2 1 roll ] } map /m set ");
! 63: }
! 64: qq = Length(m[0]);
! 65: if (Length(jj) > 0) {
! 66: if (!IsArray(jj[0])) {
! 67: sm1(" jj { [ 2 1 roll ] } map /jj set ");
! 68: }
! 69: if (qq != Length(jj[0])) {
! 70: Error(" Matrix size mismatch in m and jj of Kernel2(m,jj,r).");
! 71: }
! 72: }
! 73: m = Join(m,jj);
! 74:
! 75: ans = Res_solv(m,d,rng);
! 76: /* Println(ans); */
! 77: SetRing(r);
! 78: return([Firstn(ans[0],pp),ans[1]]);
! 79: }
! 80: /* Res_solv2([x,y],[x^2+y^2],[x]):*/
! 81:
! 82: def Res_solv_h(m,d,rng) {
! 83: local r,rr,ans,ac;
! 84: ac = Length(Arglist);
! 85: r = GetRing(Poly("1")); /* Save the current ring. */
! 86: if (ac < 3) {
! 87: rng = null;
! 88: rr = GetRing(m);
! 89: if (Tag(rr) == 0) rr = GetRing(d);
! 90: if (Tag(rr) != 0) SetRing(rr);
! 91: }else{
! 92: SetRing(rng);
! 93: }
! 94: m=DC(m,"polynomial"); d = DC(d,"polynomial");
! 95:
! 96: if (IsRing(rng)) {
! 97: sm1(" [ m d rng] res-solv-h /ans set ");
! 98: }else{
! 99: sm1(" [ m d] res-solv-h /ans set ");
! 100: }
! 101:
! 102: SetRing(r);
! 103: return(ans);
! 104: }
! 105:
! 106: /* m : D^p ---> D^q/jj, u m = d mod jj */
! 107: def Res_solv2_h(m,d,jj,rng) {
! 108: local r,rr,ans,ac,pp,qq,kk;
! 109:
! 110: ac = Length(Arglist);
! 111: r = GetRing(Poly("1")); /* Save the current ring. */
! 112: if (ac < 4) {
! 113: rng = null;
! 114: rng = GetRing(m);
! 115: if (Tag(rng) == 0) rng = GetRing(d);
! 116: }
! 117:
! 118: pp = Length(m);
! 119: if (!IsArray(m[0])) {
! 120: sm1(" m { [ 2 1 roll ] } map /m set ");
! 121: }
! 122: qq = Length(m[0]);
! 123: if (Length(jj) > 0) {
! 124: if (!IsArray(jj[0])) {
! 125: sm1(" jj { [ 2 1 roll ] } map /jj set ");
! 126: }
! 127: if (qq != Length(jj[0])) {
! 128: Error(" Matrix size mismatch in m and jj of Kernel2(m,jj,r).");
! 129: }
! 130: }
! 131: m = Join(m,jj);
! 132:
! 133: ans = Res_solv_h(m,d,rng);
! 134: /* Println(ans); */
! 135: SetRing(r);
! 136: return([Firstn(ans[0],pp),ans[1]]);
! 137: }
! 138: /* Res_solv2_h([x,y],[x^2+y^2],[x]):*/
! 139:
! 140: def Getxvars() {
! 141: local v,n,i,ans,ans2;
! 142: sm1(" getvNames /v set ");
! 143: sm1(" [(NN)] system_variable (universalNumber) dc /n set ");
! 144: ans = [];
! 145: for (i=1; i<n; i++) {
! 146: ans = Append(ans,v[i]);
! 147: }
! 148: sm1(" ans from_records /ans2 set ");
! 149: return([ans,ans2]);
! 150: }
! 151:
! 152: /* This works only for D cf. Getxvars(). */
! 153: def Intersection(i1,i2,rng) {
! 154: local r,rr,ans,n,tt,vv,ac;
! 155: ac = Length(Arglist);
! 156: r = GetRing(Poly("1")); /* Save the current ring */
! 157: if (ac < 3) {
! 158: rr = GetRing(i1);
! 159: if (Tag(rr) == 0) rr = GetRing(i2);
! 160: if (Tag(rr) != 0) SetRing(rr);
! 161: }else{
! 162: SetRing(rng);
! 163: }
! 164: /*
! 165: i1=DC(i1,"polynomial"); i2 = DC(i2,"polynomial");
! 166: */
! 167: i1 = ReParse(i1); i2 = ReParse(i2);
! 168:
! 169: vv = Getxvars();
! 170: vv = vv[1];
! 171: if (Length(i1) == 0) {
! 172: ans = i2;
! 173: }else if (!IsArray(i1[0])) {
! 174: sm1(" [i1 i2 vv] intersection /ans set ");
! 175: }else {
! 176: n = Length(i1[0]);
! 177: sm1(" i1 fromVectors /i1 set ");
! 178: sm1(" i2 fromVectors /i2 set ");
! 179: sm1(" [i1 i2 vv] intersection /tt set ");
! 180: sm1(" [n (integer) dc tt] toVectors /ans set ");
! 181: }
! 182:
! 183: SetRing(r);
! 184: return(ans);
! 185: }
! 186:
! 187: def Firstn(a,n) {
! 188: local r,i,j,ans;
! 189: if (Length(a) == 0) {
! 190: return([ ]);
! 191: }
! 192: if (!IsArray(a[0])) {
! 193: r = NewArray(n);
! 194: for (i=0; i<n; i++) {
! 195: r[i] = a[i];
! 196: }
! 197: return(r);
! 198: }else{
! 199: ans = [ ];
! 200: for (j=0; j < Length(a); j++) {
! 201: r = NewArray(n);
! 202: for (i=0; i<n; i++) {
! 203: r[i] = a[j,i];
! 204: }
! 205: ans = Append(ans,r);
! 206: }
! 207: return(ans);
! 208: }
! 209: }
! 210:
! 211: /* Kernel is also defined in lib/minimal/minimal.k */
! 212: def Kernel(f,v) {
! 213: local ans;
! 214: /* v : string or ring */
! 215: if (Length(Arglist) < 2) {
! 216: sm1(" [f] syz /ans set ");
! 217: }else{
! 218: sm1(" [f v] syz /ans set ");
! 219: }
! 220: return(ans);
! 221: }
! 222:
! 223: def Kernel_h(f,v) {
! 224: local ans;
! 225: /* v : string or ring */
! 226: if (Length(Arglist) < 2) {
! 227: sm1(" [f] syz_h /ans set ");
! 228: }else{
! 229: sm1(" [f v] syz_h /ans set ");
! 230: }
! 231: return(ans);
! 232: }
! 233:
! 234: /* Kernel of (D^p --- m ---> D^q/jj) */
! 235: def Kernel2(m,jj,r)
! 236: {
! 237: local crng,ac,pp,qq,kk;
! 238: ac = Length(Arglist);
! 239: crng = GetRing(Poly("1"));
! 240: if (ac < 3) {
! 241: r = GetRing(m);
! 242: }
! 243: pp = Length(m);
! 244: if (!IsArray(m[0])) {
! 245: sm1(" m { [ 2 1 roll ] } map /m set ");
! 246: }
! 247: qq = Length(m[0]);
! 248: if (Length(jj) > 0) {
! 249: if (!IsArray(jj[0])) {
! 250: sm1(" jj { [ 2 1 roll ] } map /jj set ");
! 251: }
! 252: if (qq != Length(jj[0])) {
! 253: Error(" Matrix size mismatch in m and jj of Kernel2(m,jj,r).");
! 254: }
! 255: }
! 256: m = Join(m,jj);
! 257: kk = Kernel(m,r);
! 258: SetRing(crng);
! 259: return(Firstn(kk[0],pp));
! 260: }
! 261:
! 262: /* Kernel of (D^p --- m ---> D^q/jj) */
! 263: def Kernel2_h(m,jj,r)
! 264: {
! 265: local crng,ac,pp,qq,kk;
! 266: ac = Length(Arglist);
! 267: crng = GetRing(Poly("1"));
! 268: if (ac < 3) {
! 269: r = GetRing(m);
! 270: }
! 271: pp = Length(m);
! 272: if (!IsArray(m[0])) {
! 273: sm1(" m { [ 2 1 roll ] } map /m set ");
! 274: }
! 275: qq = Length(m[0]);
! 276: if (Length(jj) > 0) {
! 277: if (!IsArray(jj[0])) {
! 278: sm1(" jj { [ 2 1 roll ] } map /jj set ");
! 279: }
! 280: if (qq != Length(jj[0])) {
! 281: Error(" Matrix size mismatch in m and jj of Kernel2(m,jj,r).");
! 282: }
! 283: }
! 284: m = Join(m,jj);
! 285: kk = Kernel_h(m,r);
! 286: SetRing(crng);
! 287: return(Firstn(kk[0],pp));
! 288: }
! 289:
! 290: /* From lib/minimal/minimal.k */
! 291: def Gb(m,rng) {
! 292: local r,rr,ans,ac;
! 293: ac = Length(Arglist);
! 294: r = GetRing(Poly("1")); /* Save the current ring. */
! 295: if (ac < 2) {
! 296: rng = null;
! 297: rr = GetRing(m);
! 298: if (Tag(rr) != 0) SetRing(rr);
! 299: }else{
! 300: rr = rng;
! 301: SetRing(rr);
! 302: }
! 303: /* m=DC(m,"polynomial"); */
! 304: m = ReParse(m);
! 305: sm1(" [m rr] gb /ans set ");
! 306: SetRing(r);
! 307: return(ans);
! 308: }
! 309:
! 310: def Gb_h(m,rng) {
! 311: local r,rr,ans,ac;
! 312: ac = Length(Arglist);
! 313: r = GetRing(Poly("1")); /* Save the current ring. */
! 314: if (ac < 2) {
! 315: rng = null;
! 316: rr = GetRing(m);
! 317: if (Tag(rr) != 0) SetRing(rr);
! 318: }else{
! 319: rr = rng;
! 320: SetRing(rr);
! 321: }
! 322: /* m=DC(m,"polynomial"); */
! 323: m = ReParse(m);
! 324: sm1(" [m rr] gb_h /ans set ");
! 325: SetRing(r);
! 326: return(ans);
! 327: }
! 328:
! 329: def Res_shiftMatrix(m,v,rng) {
! 330: local n,ans,r,ac,i,j,b1,b2;
! 331: sm1(" 40 (string) dc /b1 set ");
! 332: sm1(" 41 (string) dc /b2 set ");
! 333: ac = Length(Arglist);
! 334: r = GetRing(Poly("1")); /* Save the current ring. */
! 335: if (ac < 3) {
! 336: }else{
! 337: SetRing(rng);
! 338: }
! 339: n = Length(m);
! 340: ans = NewVector(n);
! 341: for (i=0; i<n; i++) {
! 342: ans[i] = NewVector(n);
! 343: for (j=0; j<n; j++) {
! 344: ans[i,j] = Poly("0");
! 345: }
! 346: ans[i,i] = Poly(AddString([
! 347: DC(v,"string"),"^",b1,DC(m[i],"string"),b2]));
! 348: }
! 349: SetRing(r);
! 350: return(ans);
! 351: }
! 352:
! 353:
! 354: /* -------- manuals have been written in complex.k ---------------- */
! 355: /* From lib/minimal/minimal.k */
! 356: def ReParse(a) {
! 357: local c;
! 358: if (IsArray(a)) {
! 359: c = Map(a,"ReParse");
! 360: }else{
! 361: sm1(a," toString . /c set");
! 362: }
! 363: return(c);
! 364: }
! 365:
! 366: def void Pmat(a) {
! 367: sm1(" a pmat ");
! 368: }
! 369:
! 370: def test2() {
! 371: RingD("x,y,z");
! 372: /* Step 1. J */
! 373: Println(" ---------- J --------------");
! 374: mm = [[1],
! 375: [x*Dx],
! 376: [y*Dy],
! 377: [z*Dz]];
! 378: b1 = Res_solv(mm,[Dz]);
! 379: Println(b1);
! 380: b2 = Res_solv(mm,[Dy]);
! 381: Println(b2);
! 382: /* Step 2. K */
! 383: Println(" --------- K -------------");
! 384: mm2 = [[Dz],
! 385: [Dy],
! 386: [x*Dx],
! 387: [y*Dy],
! 388: [z*Dz]];
! 389: k1 = Kernel(mm2);
! 390: Pmat(Firstn(k1[0],2));
! 391: aa=Kernel2([[Dz],[Dy]],[x*Dx,y*Dy,z*Dz]);
! 392: Pmat(aa);
! 393: }
! 394:
! 395: def test3() {
! 396: RingD("x,y,z");
! 397: mm = [[-Dz],[Dy],[x*Dx],[0]];
! 398: kk = Kernel(mm);
! 399: Pmat(kk[0]);
! 400: rrr= RingD("x,y,z,t",[["t",1,"x",-1,"y",-1,"z",-1,
! 401: "Dx",1,"Dy",1,"Dz",1]]);
! 402: kk0 = Reparse(kk[0]);
! 403: gg = Gb(kk0*Res_shiftMatrix([1,1,0,2],t));
! 404: Pmat(gg[0]); Pmat(gg[1]);
! 405: gg2= Substitute(Substitute(gg[0],t,1),h,1);
! 406: Pmat(gg2);
! 407: Println("----------------------------");
! 408: mm2 = [[0,0],
! 409: [0,0],
! 410: [0,0],
! 411: [-Dy,-Dz]];
! 412: jj2 = [[x*Dx,0],
! 413: [y*Dy,0],
! 414: [z,0],
! 415: [0,x*Dx],
! 416: [0,y],
! 417: [0,z*Dz]];
! 418: kk2 = Kernel2(mm2,jj2);
! 419: Pmat(kk2);
! 420: Println("-----------------------");
! 421: ii = Intersection(gg2,kk2);
! 422: Pmat(ii);
! 423: SetRing(rrr);
! 424: ii = Reparse(ii);
! 425: gg3 = Gb(ii*Res_shiftMatrix([1,1,0,2],t));
! 426: Pmat(gg3[0]);
! 427: gg4= Substitute(Substitute(gg3[0],t,1),h,1);
! 428: Println("---- page 20, observation 4 -----");
! 429: Pmat(gg4);
! 430: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to complex.k CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / k097 / lib / restriction