[BACK]Return to new.sm1 CVS log [TXT][DIR] Up to [local] / OpenXM / src / k097 / lib / minimal

File: [local] / OpenXM / src / k097 / lib / minimal / new.sm1 (download)

Revision 1.2, Tue Aug 1 03:42:35 2000 UTC (23 years, 11 months ago) by takayama
Branch: MAIN
CVS Tags: maekawa-ipv6, R_1_3_1-2, RELEASE_1_3_1_13b, RELEASE_1_2_3_12, RELEASE_1_2_3, RELEASE_1_2_2_KNOPPIX_b, RELEASE_1_2_2_KNOPPIX, RELEASE_1_2_2, RELEASE_1_2_1, RELEASE_1_1_3, KNOPPIX_2006, HEAD, DEB_REL_1_2_3-9
Changes since 1.1: +116 -1 lines

New functions are added to for (u,v)-strict resolutions.
Ord_w_m(f,w,m) (ord_w<m>) returns the order of f with respect to w for the
shift vector m.
Init_w_m(f,w,m) returns the initial of f with respect to w for the shift vector m.
Sinit_w(resmat,w) returns the initial of the complex resmat.
test17() and test18() check the (-w,w)-strictness of our minimal
resolution.

% $OpenXM: OpenXM/src/k097/lib/minimal/new.sm1,v 1.2 2000/08/01 03:42:35 takayama Exp $
%% These functions should be moved to complex.sm1
%% homogenize<m>, ord_w<m>, init<m>, ...

/.toSm1Integer {
  /arg1 set
  [/in-.toSm1Integer /ans /v] pushVariables
  [
    /v arg1 def
    /ans v def
    v isArray {
     v { .toSm1Integer } map /ans set
    }{  } ifelse
    v isUniversalNumber {
       v (integer) dc /ans set
    }{  } ifelse
    /arg1 ans def
  ] pop
  popVariables
  arg1
} def
/.toUniversalNumber {
  /arg1 set
  [/in-.toUniversalNumber /ans /v] pushVariables
  [
    /v arg1 def
    /ans v def
    v isArray {
     v { .toUniversalNumber } map /ans set
    }{  } ifelse
    v isInteger {
       v (universalNumber) dc /ans set
    }{  } ifelse
    /arg1 ans def
  ] pop
  popVariables
  arg1
} def

/ord_w<m>  {
  /arg3 set /arg2 set /arg1 set
  [/in-ord_w<m>  /f /weight /shift /www ] pushVariables
  [
    /f arg1 def
    /weight arg2 def
    /shift arg3 def
    weight .toSm1Integer /weight set
    shift  .toSm1Integer /shift  set
    f isArray {
      f { weight ord_w } map /www set
    }{
      [f weight ord_w ] /www set
    }ifelse
    www shift add /arg1 set
  ] pop
  popVariables
  arg1
} def
[(ord_w<m>)
[(f weight shift ord_w<m> w)
 (It returns the ord_w with the shift vector shift.)
 (Example 1:)
 $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
 $    define_ring $
 $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] ord_w<m> ::$
]] putUsages


/init_w<m>  {
  /arg3 set /arg2 set /arg1 set
  [/in-init_w<m>  /f /fv /weight /shift /www 
   /maxw /i /ans /tmp] pushVariables
  [
    /f arg1 def
    /weight arg2 def
    /shift arg3 def
    weight .toSm1Integer /weight set
    shift  .toSm1Integer /shift  set
    f isArray {
      f { weight ord_w } map /www set
      /fv f def
    }{
      [f weight ord_w ] /www set
      /fv [f] def
    }ifelse
    www shift add /www set
    /maxw www 0 get def
    0 1 www length 1 sub {
      /i set
      www i get maxw gt {
       /maxw www i get def
      } { } ifelse
    } for
    /ans [ 0 1 www length 1 sub { pop (0). } for ] def
    0 1 www length 1 sub {
      /i set
      www i get maxw eq {
        fv i get weight weightv init /tmp set
        ans i tmp put
      }{ } ifelse    
    }for
    f isArray {
      /arg1 ans def
    }{
      /arg1 ans 0 get def
    } ifelse
  ] pop
  popVariables
  arg1
} def
[(init_w<m>)
[(f weight shift init_w<m> w)
 (It returns the initial with the shift vector shift and the weight)
 (Example 1:)
 $   [(x) ring_of_differential_operators [[(x) -1 (Dx) 1]] weight_vector 0]$
 $    define_ring $
 $    [(x Dx + 1). (Dx^2+x).] [(x) -1 (Dx) 1] [2 0] init_w<m> ::$
]] putUsages