Return to over.sm1 CVS log

Up to [local] / OpenXM / src / k097 / debug

Annotation of OpenXM/src/k097/debug/over.sm1, Revision 1.1.1.1

1.1       maekawa     1: /permuteOrderMatrix {
                      2: %% order perm puermuteOrderMatrix newOrder
                      3:   /arg2 set /arg1 set
                      4:   [/order /perm /newOrder /k ] pushVariables
                      5:   [
                      6:     /order arg1 def
                      7:     /perm arg2 def
                      8:     ( Hi0 ) print
                      9:     order transpose /order set
                     10:     ( Hi1 ) print pstack
                     11:     order 1 copy /newOrder set pop
                     12:
                     13:     0 1 << perm length 1 sub >>
                     14:     {
                     15:        /k set
                     16:        newOrder << perm k get >> << order k get >> put
                     17:     } for
                     18:     newOrder transpose /newOrder set
                     19:   ] pop
                     20:   /arg1 newOrder def
                     21:   popVariables
                     22:   arg1
                     23: } def
                     24:
                     25: /elimination_order {
                     26: %% [x-list d-list params]  (x,y,z) elimination_order
                     27: %%  vars                    evars
                     28: %% [x-list d-list params order]
                     29:   /arg2 set  /arg1 set
                     30:   [/vars /evars /univ /order /perm /univ0 /compl] pushVariables
                     31:   /vars arg1 def /evars [arg2 to_records pop] def
                     32:   [
                     33:     /univ vars 0 get reverse
                     34:           vars 1 get reverse join
                     35:     def
                     36:
                     37:     << univ length 2 sub >>
                     38:     << evars length >>
                     39:     eliminationOrderTemplate /order set
                     40:     %%(Hello2 ) print pstack
                     41:
                     42:     [[1]] order oplus [[1]] oplus /order set
                     43:     %%(Hello3 ) print pstack
                     44:
                     45:     /univ0 [univ reverse aload pop pop] reverse def %% [e,x,y,h] --> [x,y,h]
                     46:
                     47:     %%(Hello4 ) print pstack
                     48:     /compl
                     49:       [univ 0 get] evars join evars univ0 complement join
                     50:     def
                     51:     compl univ
                     52:     getPerm /perm set
                     53:     %%perm :: univ :: compl ::
                     54:     (Hello5 ) print pstack
                     55:     order :: perm ::
                     56:     order perm permuteOrderMatrix /order set
                     57:     (Hello6 ) print pstack
                     58:
                     59:
                     60:     vars [order] join /arg1 set
                     61:   ] pop
                     62:   popVariables
                     63:   arg1
                     64: } def
                     65:
                     66: [
                     67: (z0,z1,z2,z3,z4,z5,z6,z7,z8,z9,z10,z11,z12,z13,z14,z15,z16,z17,z18,z19,z20,z21,z22,z23,z24,z25,z26,z27,z28,z29) ring_of_differential_operators
                     68:  ( ) elimination_order 0]
                     69: define_ring