Annotation of OpenXM/src/kan96xx/Doc/sst.sm1, Revision 1.1
1.1 ! takayama 1: %% $OpenXM$
! 2: %% Sample implementations of small algorithms in the book SST.
! 3: %% gbhg3/Int/sst.sm1 --> kan96xx/lib
! 4: [(parse) (oxasir.sm1) pushfile] extension
! 5:
! 6: %% 1999, 9/21 saturation, intersection are moved to SSkan/lib/complex.sm1
! 7:
! 8: /stdpair0 {
! 9: /arg1 set
! 10: [/in-stdpair0 /ff /mm /vlist /sigma /sigma* /srule
! 11: /msigma /satMsigma ] pushVariables
! 12: [(CurrentRingp) (KanGBmessage)] pushEnv
! 13: [
! 14: /ff arg1 def
! 15: /mm ff 0 get def
! 16: /sigma ff 1 get {toString} map def
! 17: /vlist [ff 2 get to_records pop ] def
! 18:
! 19: sigma vlist complement /sigma* set
! 20: [vlist from_records ring_of_polynomials 0] define_ring
! 21: sigma { [ 2 1 roll . (1).] } map /srule set
! 22: mm {toString . srule replace} map /msigma set
! 23: [(KanGBmessage) 0] system_variable
! 24: [msigma] groebner_sugar 0 get /msigma set
! 25:
! 26: [msigma sigma* sigma* from_records] saturation /satMsigma set
! 27: [satMsigma msigma sigma*] /arg1 set
! 28: ] pop
! 29: popEnv
! 30: popVariables
! 31: arg1
! 32: } def
! 33: (stdpair0 ) message
! 34:
! 35: [(stdpair0)
! 36: [ $[M sigma vlist] stdpair0 [M_sigma M sigma*]$
! 37: $Example: [[(x2^2) (x2 x4) (x2 x3) (x1 x4^2)] $
! 38: $ [(x1) (x3)] (x1,x2,x3,x4)] stdpair0 :: $
! 39: ]] putUsages
! 40:
! 41: /stdpair {
! 42: /arg1 set
! 43: [/in-stdpair /ffs /vlist /mm /ass /i /pp /vlist0 /ass*] pushVariables
! 44: [(CurrentRingp) (KanGBmessage)] pushEnv
! 45: [
! 46: /ffs arg1 def
! 47: ffs 0 get /mm set
! 48: ffs 1 get /vlist0 set
! 49:
! 50: [vlist0 to_records pop] /vlist set
! 51: [mm vlist] primadec /ass set
! 52: ass { 1 get } map /ass set
! 53: %%(Associated primes are : ) messagen ass pmat
! 54: ass { {toString} map vlist complement } map /ass* set
! 55:
! 56: /pp ass length def
! 57: [
! 58: 0 1 pp 1 sub {
! 59: /i set
! 60: %%(stdpair0 of : ) messagen
! 61: %%[mm ass* i get vlist0] pmat
! 62: [mm ass* i get vlist0] stdpair0
! 63: [ass* i get] join
! 64: } for
! 65: ] /arg1 set
! 66: ] pop
! 67: popEnv
! 68: popVariables
! 69: arg1
! 70: } def
! 71: [(stdpair)
! 72: [ $ [[ A B sigma^c sigma] [ ] ....] $
! 73: $ Monomials in A/B give u part of (x^u,sigma). $
! 74: $Example 1: [[(x2^2) (x2 x4) (x2 x3) (x1 x4^2)] $
! 75: $ (x1,x2,x3,x4)] stdpair pmat $
! 76: $Example 2: [[(x2 x3) (x1^3 x4^2)] $
! 77: $ (x1,x2,x3,x4,x5)] stdpair pmat $
! 78: $Example 3: [[(x4^2) (x3^7) (x2 x3^6) (x2^2)] $
! 79: $ (x1,x2,x3,x4,x5)] stdpair pmat $
! 80: ]] putUsages
! 81: (stpair ) message
! 82:
! 83: /stien {
! 84: (See sec 5.6, Consider submodule generated by x5. Or, annihilating ideal of x5 which can be obtained by the syzygy computation. See the paper by Stienstra.) message
! 85: %% (x1+x2+x3+x4+x5+1) does not work!
! 86: /ff1
! 87: [(x1+x2+x3+x4+x5) (x1+x2-x4) (x2+x3-x4) (x1 x3) (x2 x4)]
! 88: def
! 89: [(x1,x2,x3,x4,x5) ring_of_polynomials
! 90: [[(x1) 1] [(x2) 1] [(x3) 1] [(x4) 1]] weight_vector 0] define_ring
! 91: ff1 {. } map /ff1 set
! 92: [ff1] groebner_sugar 0 get /ff2 set ff2 pmat
! 93: [[(x5).] ff1 join [(needSyz)]] groebner_sugar /ff3 set
! 94: ff3 2 get /ff4.syz set
! 95: ff4.syz [[(x5).] ff1 join] transpose mul pmat %% check!
! 96: ff4.syz { 0 get dup (0). eq { pop } { } ifelse } map /ann-x5 set ann-x5 pmat
! 97: [ff1 ann-x5 join] groebner_sugar 0 get pmat
! 98: } def
! 99: (stien ) messagen
! 100:
! 101: /stien2 {
! 102: (See sec 5.6, Consider submodule generated by x5+1. Or, annihilating ideal of x5+1 which can be obtained by the syzygy computation. See the paper by Stienstra.) message
! 103: /ff1
! 104: [(x1+x2+x3+x4+x5+1) (x1+x2-x4) (x2+x3-x4) (x1 x3) (x2 x4)]
! 105: def
! 106: [(x1,x2,x3,x4,x5) ring_of_polynomials
! 107: [[(x1) 1] [(x2) 1] [(x3) 1] [(x4) 1]] weight_vector 0] define_ring
! 108: ff1 {. } map /ff1 set
! 109: [ff1] groebner_sugar 0 get /ff2 set ff2 pmat
! 110: [[(x5+1).] ff1 join [(needSyz)]] groebner_sugar /ff3 set
! 111: ff3 2 get /ff4.syz set
! 112: ff4.syz [[(x5+1).] ff1 join] transpose mul pmat %% check!
! 113: ff4.syz { 0 get dup (0). eq { pop } { } ifelse } map /ann-x5 set ann-x5 pmat
! 114: [ff1 ann-x5 join] groebner_sugar 0 get /ff-stien set ff-stien pmat
! 115: [[(3 x5 + 3 + 8 x4). (x5 + 1 + 4 x3). (x5 + 1 + 8 x2). (x5 + 1 + 4 x1).
! 116: (x5^2 + 2 x5 + 1).]] groebner_sugar 0 get /ff-int set ff-int pmat
! 117: [(Homogenize) 0] system_variable
! 118: ff-stien { ff-int reduction 0 get } map pmat
! 119: ff-int { ff-stien reduction 0 get } map pmat
! 120: [(Homogenize) 1] system_variable
! 121:
! 122: } def
! 123: (stien2 ) messagen
! 124:
! 125: /stien3 {
! 126: (See sec 5.6,) message
! 127: [(x1,x2,y1,y2,z,zz) ring_of_polynomials
! 128: [[(zz) 1]] weight_vector
! 129: 0] define_ring
! 130: [(x1 z +x1 x2 + x2 z + y1 y2 + z^2).
! 131: (x1 y1 - z^2).
! 132: (x2 y2 - z^2).
! 133: (z zz -1).
! 134: ]
! 135: /ff1 set
! 136: [ff1] groebner_sugar 0 get /ff2 set
! 137:
! 138: ff2 [(zz)] eliminatev /ff2 set
! 139: ff2 pmat
! 140: (--------------------------- see stien3.mac --) message
! 141: ( ) message
! 142: [(x1 z + x2 z + y1 y2 + z^2).
! 143: (x1 y1 - z^2).
! 144: (x2 y2 - z^2).
! 145: (z zz -1).
! 146: ]
! 147: /ff1a set
! 148: [ff1a] groebner_sugar 0 get /ff2a set
! 149:
! 150: ff2a [(zz)] eliminatev /ff2a set
! 151: ff2a pmat
! 152:
! 153: } def
! 154: (stien3 ) messagen
! 155:
! 156: /stien3a {
! 157: (See sec 5.6, msri/book/stien3.mac ) message
! 158: [(a,b,A,B,z,zz) ring_of_polynomials
! 159: [[(zz) 1]] weight_vector
! 160: 0] define_ring
! 161: [(B A z + B z^2+ B a z + B a^2 + A z^2+ z^3 + a z^2+ b A z+ b z^2+ b^2 A).
! 162: (a A - z^2).
! 163: (b B - z^2).
! 164: (z zz -1).
! 165: ]
! 166: /ff1 set
! 167: [ff1] groebner_sugar 0 get /ff2 set
! 168:
! 169: ff2 [(zz)] eliminatev /ff2 set
! 170: ff2 pmat
! 171: (--------------------------- see stien3a.mac , ff2--) message
! 172: 1 1 ff2 length { /ii set
! 173: ff2 ii 1 sub get /ff22 set
! 174: (poly f) messagen ii messagen ( ) messagen ff22 message
! 175: } for
! 176:
! 177: (---------------------------------------------) message
! 178: [(B A z + 2 B z^2+ 3 B a z + 4 B a^2 + 5 A z^2+ z^3 + 6 a z^2+ 7 b A z+ 8 b z^2+ 9 b^2 A).
! 179: (a A - z^2).
! 180: (b B - z^2).
! 181: (z zz -1).
! 182: ]
! 183: /ff1 set
! 184: [ff1] groebner_sugar 0 get /ff2 set
! 185:
! 186: ff2 [(zz)] eliminatev /ff2 set
! 187: ff2 pmat
! 188: (--------------------------- see stien3a.mac , ff2--) message
! 189: 1 1 ff2 length { /ii set
! 190: ff2 ii 1 sub get /ff22 set
! 191: (poly f) messagen ii messagen ( ) messagen ff22 message
! 192: } for
! 193: } def
! 194: (stien3a ) message
! 195:
! 196:
! 197: ( ) message
! 198:
! 199: /foo1 {
! 200: [(x1 y1 + x2 y2 + x3 y3 + x4 y4)
! 201: (x2 y2 + x4 y4) (x3 y3 + x4 y4) (y1 y4 - y2 y3)
! 202: (y1 u1 -1) (y2 u2 -1) (y3 u3 -1) (y4 u4-1)] /ff set
! 203: [(x1,x2,x3,x4,y1,y2,y3,y4,u1,u2,u3,u4) ring_of_polynomials
! 204: [[(y1) 1 (y2) 1 (y3) 1 (y4) 1 (u1) 1 (u2) 1 (u3) 1 (u4) 1]]
! 205: weight_vector 0] define_ring
! 206: [ff {.} map] groebner_sugar 0 get
! 207: [(y1) (y2) (y3) (y4) (u1) (u2) (u3) (u4)] eliminatev ::
! 208: } def
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to sst.sm1 CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM / src / kan96xx / Doc