| version 1.18, 2000/07/30 02:26:25 |
version 1.23, 2000/08/01 08:51:03 |
|
|
| /* $OpenXM: OpenXM/src/k097/lib/minimal/minimal.k,v 1.17 2000/07/26 12:56:36 takayama Exp $ */ |
/* $OpenXM: OpenXM/src/k097/lib/minimal/minimal.k,v 1.22 2000/08/01 06:26:11 takayama Exp $ */ |
| #define DEBUG 1 |
#define DEBUG 1 |
| /* #define ORDINARY 1 */ |
Sordinary = false; |
| /* If you run this program on openxm version 1.1.2 (FreeBSD), |
/* If you run this program on openxm version 1.1.2 (FreeBSD), |
| make a symbolic link by the command |
make a symbolic link by the command |
| ln -s /usr/bin/cpp /lib/cpp |
ln -s /usr/bin/cpp /lib/cpp |
| Line 34 def load_tower() { |
|
| Line 34 def load_tower() { |
|
| if (Boundp("k0-tower.sm1.loaded")) { |
if (Boundp("k0-tower.sm1.loaded")) { |
| }else{ |
}else{ |
| sm1(" [(parse) (k0-tower.sm1) pushfile ] extension "); |
sm1(" [(parse) (k0-tower.sm1) pushfile ] extension "); |
| |
sm1(" [(parse) (new.sm1) pushfile ] extension "); |
| sm1(" /k0-tower.sm1.loaded 1 def "); |
sm1(" /k0-tower.sm1.loaded 1 def "); |
| } |
} |
| sm1(" oxNoX "); |
sm1(" oxNoX "); |
|
|
| def Sgroebner(f) { |
def Sgroebner(f) { |
| sm1(" [f] groebner /FunctionValue set"); |
sm1(" [f] groebner /FunctionValue set"); |
| } |
} |
| |
|
| |
def Sinvolutive(f,w) { |
| |
local g,m; |
| |
if (IsArray(f[0])) { |
| |
m = NewArray(Length(f[0])); |
| |
}else{ |
| |
m = [0]; |
| |
} |
| |
g = Sgroebner(f); |
| |
/* This is a temporary code. */ |
| |
sm1(" g 0 get { w m init_w<m>} map /FunctionValue set "); |
| |
} |
| |
|
| |
|
| |
|
| |
def Error(s) { |
| |
sm1(" s error "); |
| |
} |
| |
|
| |
def IsNull(s) { |
| |
if (Stag(s) == 0) return(true); |
| |
else return(false); |
| |
} |
| |
|
| |
def MonomialPart(f) { |
| |
sm1(" [(lmonom) f] gbext /FunctionValue set "); |
| |
} |
| |
|
| |
def Warning(s) { |
| |
Print("Warning: "); |
| |
Println(s); |
| |
} |
| |
def RingOf(f) { |
| |
local r; |
| |
if (IsPolynomial(f)) { |
| |
if (f != Poly("0")) { |
| |
sm1(f," (ring) dc /r set "); |
| |
}else{ |
| |
sm1(" [(CurrentRingp)] system_variable /r set "); |
| |
} |
| |
}else{ |
| |
Warning("RingOf(f): the argument f must be a polynomial. Return the current ring."); |
| |
sm1(" [(CurrentRingp)] system_variable /r set "); |
| |
} |
| |
return(r); |
| |
} |
| |
|
| |
def Ord_w_m(f,w,m) { |
| |
sm1(" f w m ord_w<m> { (universalNumber) dc } map /FunctionValue set "); |
| |
} |
| |
HelpAdd(["Ord_w_m", |
| |
["Ord_w_m(f,w,m) returns the order of f with respect to w with the shift m.", |
| |
"Note that the order of the ring and the weight w must be the same.", |
| |
"When f is zero, it returns -intInfinity = -999999999.", |
| |
"Example: Sweyl(\"x,y\",[[\"x\",-1,\"Dx\",1]]); ", |
| |
" Ord_w_m([x*Dx+1,Dx^2+x^5],[\"x\",-1,\"Dx\",1],[2,0]):"]]); |
| |
|
| |
def Init_w_m(f,w,m) { |
| |
sm1(" f w m init_w<m> /FunctionValue set "); |
| |
} |
| |
HelpAdd(["Init_w_m", |
| |
["Init_w_m(f,w,m) returns the initial of f with respect to w with the shift m.", |
| |
"Note that the order of the ring and the weight w must be the same.", |
| |
"Example: Sweyl(\"x,y\",[[\"x\",-1,\"Dx\",1]]); ", |
| |
" Init_w_m([x*Dx+1,Dx^2+x^5],[\"x\",-1,\"Dx\",1],[2,0]):"]]); |
| |
|
| |
def Max(v) { |
| |
local i,t,n; |
| |
n = Length(v); |
| |
if (n == 0) return(null); |
| |
t = v[0]; |
| |
for (i=0; i<n; i++) { |
| |
if (v[i] > t) { t = v[i];} |
| |
} |
| |
return(t); |
| |
} |
| |
HelpAdd(["Max", |
| |
["Max(v) returns the maximal element in v."]]); |
| |
|
| |
/* End of standard functions that should be moved to standard libraries. */ |
| def test0() { |
def test0() { |
| local f; |
local f; |
| Sweyl("x,y,z"); |
Sweyl("x,y,z"); |
| Line 136 sm1(" [(AvoidTheSameRing)] pushEnv |
|
| Line 217 sm1(" [(AvoidTheSameRing)] pushEnv |
|
| |
|
| def SresolutionFrameWithTower(g,opt) { |
def SresolutionFrameWithTower(g,opt) { |
| local gbTower, ans, ff, count, startingGB, opts, skelton,withSkel, autof, |
local gbTower, ans, ff, count, startingGB, opts, skelton,withSkel, autof, |
| gbasis, nohomog; |
gbasis, nohomog,i,n; |
| |
/* extern Sordinary */ |
| nohomog = false; |
nohomog = false; |
| count = -1; |
count = -1; Sordinary = false; /* default value for options. */ |
| if (Length(Arglist) >= 2) { |
if (Length(Arglist) >= 2) { |
| if (IsInteger(opt)) { |
if (IsArray(opt)) { |
| count = opt; |
n = Length(opt); |
| }else if (IsString(opt)) { |
for (i=0; i<n; i++) { |
| if (opt == "homogenized") { |
if (IsInteger(opt[i])) { |
| nohomog = true; |
count = opt[i]; |
| }else{ |
} |
| Println("Warning: unknown option"); |
if (IsString(opt[i])) { |
| Println(opt); |
if (opt[i] == "homogenized") { |
| |
nohomog = true; |
| |
}else if (opt[i] == "Sordinary") { |
| |
Sordinary = true; |
| |
}else{ |
| |
Println("Warning: unknown option"); |
| |
Println(opt); |
| |
} |
| |
} |
| } |
} |
| |
} else if (IsNull(opt)){ |
| |
} else { |
| |
Println("Warning: option should be given by an array."); |
| |
Println(opt); |
| |
Println("--------------------------------------------"); |
| } |
} |
| }else{ |
|
| count = -1; |
|
| } |
} |
| |
|
| sm1(" setupEnvForResolution "); |
sm1(" setupEnvForResolution "); |
| Line 314 def StotalDegree(f) { |
|
| Line 407 def StotalDegree(f) { |
|
| return(d0); |
return(d0); |
| } |
} |
| |
|
| |
HelpAdd(["Sord_w", |
| |
["Sord_w(f,w) returns the w-order of f", |
| |
"Example: Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]):"]]); |
| /* Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]); */ |
/* Sord_w(x^2*Dx*Dy,[x,-1,Dx,1]); */ |
| def Sord_w(f,w) { |
def Sord_w(f,w) { |
| local neww,i,n; |
local neww,i,n; |
| Line 512 def SlaScala(g,opt) { |
|
| Line 608 def SlaScala(g,opt) { |
|
| place = f[3]; |
place = f[3]; |
| /* (level-1, place) is the place for f[0], |
/* (level-1, place) is the place for f[0], |
| which is a newly obtained GB. */ |
which is a newly obtained GB. */ |
| #ifdef ORDINARY |
if (Sordinary) { |
| redundantTable[level-1,place] = redundant_seq; |
redundantTable[level-1,place] = redundant_seq; |
| redundant_seq++; |
redundant_seq++; |
| #else |
}else{ |
| if (f[4] > f[5]) { |
if (f[4] > f[5]) { |
| /* Zero in the gr-module */ |
/* Zero in the gr-module */ |
| Print("v-degree of [org,remainder] = "); |
Print("v-degree of [org,remainder] = "); |
| Line 526 def SlaScala(g,opt) { |
|
| Line 622 def SlaScala(g,opt) { |
|
| redundantTable[level-1,place] = redundant_seq; |
redundantTable[level-1,place] = redundant_seq; |
| redundant_seq++; |
redundant_seq++; |
| } |
} |
| #endif |
} |
| redundantTable_ordinary[level-1,place] |
redundantTable_ordinary[level-1,place] |
| =redundant_seq_ordinary; |
=redundant_seq_ordinary; |
| redundant_seq_ordinary++; |
redundant_seq_ordinary++; |
| Line 652 def SunitOfFormat(pos,forms) { |
|
| Line 748 def SunitOfFormat(pos,forms) { |
|
| return(ans); |
return(ans); |
| } |
} |
| |
|
| def Error(s) { |
|
| sm1(" s error "); |
|
| } |
|
| |
|
| def IsNull(s) { |
|
| if (Stag(s) == 0) return(true); |
|
| else return(false); |
|
| } |
|
| |
|
| def StowerOf(tower,level) { |
def StowerOf(tower,level) { |
| local ans,i; |
local ans,i; |
| ans = [ ]; |
ans = [ ]; |
| Line 681 def Sspolynomial(f,g) { |
|
| Line 769 def Sspolynomial(f,g) { |
|
| sm1("f g spol /FunctionValue set"); |
sm1("f g spol /FunctionValue set"); |
| } |
} |
| |
|
| def MonomialPart(f) { |
|
| sm1(" [(lmonom) f] gbext /FunctionValue set "); |
|
| } |
|
| |
|
| /* WARNING: |
/* WARNING: |
| When you use SwhereInTower, you have to change gbList |
When you use SwhereInTower, you have to change gbList |
| Line 804 def Sreduction(f,myset) { |
|
| Line 889 def Sreduction(f,myset) { |
|
| return([tmp[0],tmp[1],t_syz]); |
return([tmp[0],tmp[1],t_syz]); |
| } |
} |
| |
|
| def Warning(s) { |
|
| Print("Warning: "); |
|
| Println(s); |
|
| } |
|
| def RingOf(f) { |
|
| local r; |
|
| if (IsPolynomial(f)) { |
|
| if (f != Poly("0")) { |
|
| sm1(f," (ring) dc /r set "); |
|
| }else{ |
|
| sm1(" [(CurrentRingp)] system_variable /r set "); |
|
| } |
|
| }else{ |
|
| Warning("RingOf(f): the argument f must be a polynomial. Return the current ring."); |
|
| sm1(" [(CurrentRingp)] system_variable /r set "); |
|
| } |
|
| return(r); |
|
| } |
|
| |
|
| def Sfrom_es(f,size) { |
def Sfrom_es(f,size) { |
| local c,ans, i, d, myes, myee, j,n,r,ans2; |
local c,ans, i, d, myes, myee, j,n,r,ans2; |
| Line 882 def Sbases_to_vec(bases,size) { |
|
| Line 949 def Sbases_to_vec(bases,size) { |
|
| HelpAdd(["Sminimal", |
HelpAdd(["Sminimal", |
| ["It constructs the V-minimal free resolution by LaScala's algorithm", |
["It constructs the V-minimal free resolution by LaScala's algorithm", |
| "option: \"homogenized\" (no automatic homogenization ", |
"option: \"homogenized\" (no automatic homogenization ", |
| |
" : \"Sordinary\" (no (u,v)-minimal resolution)", |
| |
"Options should be given as an array.", |
| "Example: Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);", |
"Example: Sweyl(\"x,y\",[[\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1]]);", |
| " v=[[2*x*Dx + 3*y*Dy+6, 0],", |
" v=[[2*x*Dx + 3*y*Dy+6, 0],", |
| " [3*x^2*Dy + 2*y*Dx, 0],", |
" [3*x^2*Dy + 2*y*Dx, 0],", |
| Line 896 HelpAdd(["Sminimal", |
|
| Line 965 HelpAdd(["Sminimal", |
|
| def Sminimal(g,opt) { |
def Sminimal(g,opt) { |
| local r, freeRes, redundantTable, reducer, maxLevel, |
local r, freeRes, redundantTable, reducer, maxLevel, |
| minRes, seq, maxSeq, level, betti, q, bases, dr, |
minRes, seq, maxSeq, level, betti, q, bases, dr, |
| betti_levelplus, newbases, i, j,qq, tminRes; |
betti_levelplus, newbases, i, j,qq, tminRes,bettiTable; |
| if (Length(Arglist) < 2) { |
if (Length(Arglist) < 2) { |
| opt = null; |
opt = null; |
| } |
} |
| |
/* Sordinary is set in SlaScala(g,opt) --> SresolutionFrameWithTower */ |
| |
|
| ScheckIfSchreyer("Sminimal:0"); |
ScheckIfSchreyer("Sminimal:0"); |
| r = SlaScala(g,opt); |
r = SlaScala(g,opt); |
| /* Should I turn off the tower?? */ |
/* Should I turn off the tower?? */ |
| Line 907 def Sminimal(g,opt) { |
|
| Line 978 def Sminimal(g,opt) { |
|
| freeRes = r[0]; |
freeRes = r[0]; |
| redundantTable = r[1]; |
redundantTable = r[1]; |
| reducer = r[2]; |
reducer = r[2]; |
| |
bettiTable = SbettiTable(redundantTable); |
| |
Println("Betti numbers are ------"); |
| |
sm1_pmat(bettiTable); |
| minRes = SnewArrayOfFormat(freeRes); |
minRes = SnewArrayOfFormat(freeRes); |
| seq = 0; |
seq = 0; |
| maxSeq = SgetMaxSeq(redundantTable); |
maxSeq = SgetMaxSeq(redundantTable); |
| Line 1323 HelpAdd(["IsExact_h", |
|
| Line 1397 HelpAdd(["IsExact_h", |
|
| "cf. ReParse" |
"cf. ReParse" |
| ]]); |
]]); |
| |
|
| |
def IsSameIdeal_h(ii,jj,v) { |
| |
local a; |
| |
v = ToString_array(v); |
| |
a = [ii,jj,v]; |
| |
sm1(a," isSameIdeal_h /FunctionValue set "); |
| |
} |
| |
HelpAdd(["IsSameIdeal_h", |
| |
["IsSameIdeal_h(ii,jj,var): bool", |
| |
"It checks the given ideals are the same or not in D<h> (homogenized Weyl algebra)", |
| |
"cf. ReParse" |
| |
]]); |
| |
|
| def ReParse(a) { |
def ReParse(a) { |
| local c; |
local c; |
| if (IsArray(a)) { |
if (IsArray(a)) { |
| Line 1362 def ScheckIfSchreyer(s) { |
|
| Line 1448 def ScheckIfSchreyer(s) { |
|
| } |
} |
| /* More check will be necessary. */ |
/* More check will be necessary. */ |
| return(true); |
return(true); |
| |
} |
| |
|
| |
def SgetShift(mat,w,m) { |
| |
local omat; |
| |
sm1(" mat { w m ord_w<m> {(universalNumber) dc}map } map /omat set"); |
| |
return(Map(omat,"Max")); |
| |
} |
| |
HelpAdd(["SgetShift", |
| |
["SgetShift(mat,w,m) returns the shift vector of mat with respect to w with the shift m.", |
| |
"Note that the order of the ring and the weight w must be the same.", |
| |
"Example: Sweyl(\"x,y\",[[\"x\",-1,\"Dx\",1]]); ", |
| |
" SgetShift([[x*Dx+1,Dx^2+x^5],[Poly(\"0\"),x],[x,x]],[\"x\",-1,\"Dx\",1],[2,0]):"]]); |
| |
|
| |
def SgetShifts(resmat,w) { |
| |
local i,n,ans,m0; |
| |
n = Length(resmat); |
| |
ans = NewArray(n); |
| |
m0 = NewArray(Length(resmat[0,0])); |
| |
ans[0] = m0; |
| |
for (i=0; i<n-1; i++) { |
| |
ans[i+1] = SgetShift(resmat[i],w,m0); |
| |
m0 = ans[i+1]; |
| |
} |
| |
return(ans); |
| |
} |
| |
HelpAdd(["SgetShifts", |
| |
["SgetShifts(resmat,w) returns the shift vectors of the resolution resmat", |
| |
" with respect to w with the shift m.", |
| |
"Note that the order of the ring and the weight w must be the same.", |
| |
"Zero row is not allowed.", |
| |
"Example: a=Sannfs2(\"x^3-y^2\");", |
| |
" b=a[0]; w = [\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1];", |
| |
" Sweyl(\"x,y\",[w]); b = Reparse(b);", |
| |
" SgetShifts(b,w):"]]); |
| |
|
| |
def Sinit_w(resmat,w) { |
| |
local shifts,ans,n,i,m,mat,j; |
| |
shifts = SgetShifts(resmat,w); |
| |
n = Length(resmat); |
| |
ans = NewArray(n); |
| |
for (i=0; i<n; i++) { |
| |
m = shifts[i]; |
| |
mat = ScopyArray(resmat[i]); |
| |
for (j=0; j<Length(mat); j++) { |
| |
mat[j] = Init_w_m(mat[j],w,m); |
| |
} |
| |
ans[i] = mat; |
| |
} |
| |
return(ans); |
| |
} |
| |
HelpAdd(["Sinit_w", |
| |
["Sinit_w(resmat,w) returns the initial of the complex resmat with respect to the weight w.", |
| |
"Example: a=Sannfs2(\"x^3-y^2\");", |
| |
" b=a[0]; w = [\"x\",-1,\"y\",-1,\"Dx\",1,\"Dy\",1];", |
| |
" Sweyl(\"x,y\",[w]); b = Reparse(b);", |
| |
" c=Sinit_w(b,w); c:" |
| |
]]); |
| |
|
| |
/* This method does not work, because we have zero rows. |
| |
Think about it later. */ |
| |
def SbettiTable(rtable) { |
| |
local ans,i,j,pp; |
| |
ans = SnewArrayOfFormat(rtable); |
| |
for (i=0; i<Length(rtable); i++) { |
| |
pp = 0; |
| |
for (j=0; j<Length(rtable[i]); j++) { |
| |
if (rtable[i,j] != 0) {pp = pp+1;} |
| |
} |
| |
ans[i] = pp; |
| |
} |
| |
return(ans); |
| } |
} |
| |
|