Changeset 6149f4f in git
 Timestamp:
 May 24, 1998, 6:43:11 PM (25 years ago)
 Branches:
 (u'jengelhdatetime', 'ceac47cbc86fe4a15902392bdbb9bd2ae0ea02c6')(u'spielwiese', '0604212ebb110535022efecad887940825b97c3f')
 Children:
 fbb9b1ddc38f7b1d1c34af1cc911d3accaacf872
 Parents:
 45f7bfcca3edf19f70b4d4e83236758f8d71c6da
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/standard.lib
r45f7bf r6149f4f 1 // $Id: standard.lib,v 1.1 2 19980524 15:50:27obachman Exp $2 ////////////////////////////////////////////////////////////////////////////// /3 4 version="$Id: standard.lib,v 1.1 2 19980524 15:50:27obachman Exp $";1 // $Id: standard.lib,v 1.13 19980524 16:43:11 obachman Exp $ 2 ////////////////////////////////////////////////////////////////////////////// 3 4 version="$Id: standard.lib,v 1.13 19980524 16:43:11 obachman Exp $"; 5 5 info=" 6 6 LIBRARY: standard.lib PROCEDURES WHICH ARE ALWAYS LOADED AT STARTUP … … 12 12 "; 13 13 14 ////////////////////////////////////////////////////////////////////////////// /14 ////////////////////////////////////////////////////////////////////////////// 15 15 16 16 proc stdfglm (ideal i, list #) … … 55 55 i2; 56 56 } 57 ///////////////////////////////////////////////////////////////////////////// //57 ///////////////////////////////////////////////////////////////////////////// 58 58 59 59 proc stdhilb(ideal i,list #) … … 122 122 ideal i2=stdhilb(i,v); 123 123 } 124 ////////////////////////////////////////////////////////////////////////// /////124 ////////////////////////////////////////////////////////////////////////// 125 125 126 126 proc groebner(def i, list #) 127 "USAGE: groebner(i ) i ideal/module128 RETURNS: standard basis of ideal or module which is computed using a127 "USAGE: groebner(i[, wait]) i  ideal/module; wait  int 128 RETURNS: Standard basis of ideal or module which is computed using a 129 129 heuristically choosen method: 130 If the ordering of the current ring is a lo kal ordering, or130 If the ordering of the current ring is a local ordering, or 131 131 if it is a nonblock ordering and the current ring has no 132 132 parameters, then std(i) is returned. … … 135 135 followed by a Hilbertseries based std computation in the 136 136 original ring. 137 NOTE: If a 2nd argument 'wait' is given, then the computation proceeds 138 at most 'wait' seconds. That is, if no result could be computed in 139 'wait' seconds, then the computation is interrupted, 0 is returned, 140 a warning message is displayed, and the global variable 141 'groebner_error' is defined. 137 142 EXAMPLE: example groebner; shows an example" 138 143 { 139 144 def P=basering; 145 146 // we have two arguments  try to use MPfork links 140 147 if (size(#) > 0) 141 148 { … … 144 151 if (typeof(#[1]) == "int") 145 152 { 146 int wait = #[1] ;147 int j, pid;153 int wait = #[1] * 1000000; 154 int j,k = 10, 0; 148 155 string bs = nameof(basering); 149 156 link l_fork = "MPtcp:fork"; 150 157 open(l_fork); 151 158 write(l_fork, quote(system("pid"))); 152 pid = read(l_fork);159 int pid = read(l_fork); 153 160 write(l_fork, quote(groebner(eval(i)))); 154 161 155 for (j=0; j<wait; j++)162 while(k < wait) 156 163 { 157 if (status(l_fork, "read", "ready", 1)) {break;} 164 if (status(l_fork, "read", "ready", j)) {break;} 165 k = k + j; 166 j = j + j; 158 167 } 159 168 160 169 if (status(l_fork, "read", "ready")) 161 170 { … … 168 177 kill PP; 169 178 } 179 if (defined(groebner_error)) 180 { 181 kill(groebner_error); 182 } 170 183 kill (l_fork); 171 184 } … … 173 186 { 174 187 ideal result; 188 groebner_error = 1; 175 189 if (! defined(groebner_error)) 176 190 { 177 int groebner_error ;191 int groebner_error = 1; 178 192 export groebner_error; 179 193 } 180 groebner_error = 1;181 194 "// ** groebner did not finish"; 182 195 j = system("sh", "kill " + string(pid)); … … 194 207 } 195 208 } 196 string ordstr_P = ordstr(P); 197 198 if (find(ordstr_P,"s") > 0) 199 { 200 //spaeter den lokalen fall ueber lp oder aehnlich behandeln 201 return(std(i)); 202 } 203 204 int IsSimple_P; 205 if (system("nblocks") <= 2) 206 { 207 if (find(ordstr_P, "M") <= 0) 208 { 209 IsSimple_P = 1; 210 } 211 } 212 int npars_P = npars(P); 213 214 // return std if no parameters and (dp or wp) 215 if ((npars_P == 0) && IsSimple_P) 216 { 217 if (find(ordstr_P, "d") > 0) 218 { 219 return (std(i)); 220 } 221 if (find(ordstr_P,"w") > 0) 222 { 223 return (std(i)); 224 } 225 } 226 227 // reset options 228 intvec opt=option(get); 229 int p_opt; 230 string s_opt = option(); 231 option(none); 232 // turn on option(prot) and/or option(mem), if previously set 233 if (find(s_opt, "prot")) 234 { 235 option(prot); 236 p_opt = 1; 237 } 238 if (find(s_opt, "mem")) 239 { 240 option(mem); 241 } 242 243 // construct ring in which first std computation is done 244 string varstr_P = varstr(P); 245 string parstr_P = parstr(P); 246 int is_homog = (homog(i) && (npars_P == 0)); 247 248 string ri = "ring Phelp =" + string(char(P)) + ",(" + varstr_P; 249 // parameters are converted to ring variables 250 if (npars_P > 0) 251 { 252 ri = ri + "," + parstr_P; 253 } 254 // a homogenizing variable is added, if necessary 255 if (! is_homog) 256 { 257 ri = ri + ",@t"; 258 } 259 // ordering is set to (dp, C) 260 ri = ri + "),(dp,C);"; 261 262 // change the ring 263 execute(ri); 264 265 // get ideal from previous ring 266 if (is_homog) 267 { 268 ideal qh = imap(P, i); 269 } 270 else 271 { 272 // and homogenize 273 ideal qh=homog(imap(P,i),@t); 274 } 275 276 // compute std and hilbert series 277 if (p_opt) 278 { 279 "std in " + ri[13, size(ri)  13]; 280 } 281 ideal qh1=std(qh); 282 intvec hi=hilb(qh1,1); 283 284 if (is_homog && (npars_P == 0)) 285 { 286 // no additional variables were introduced 287 setring P; // can immediately change to original ring 288 // simply compute std with hilbert series in original ring 289 if (p_opt) 290 { 291 "std with hilb in basering"; 292 i = std(i, hi); 293 } 294 } 295 else 296 { 297 // additional variables were introduced 298 // need another intermediate ring 299 ri = "ring Phelp1 =" + string(char(P)) 300 + ",(" + varstr(Phelp) + "),(" + ordstr_P; 209 210 // we are still here  do the actual computation 211 string ordstr_P = ordstr(P); 212 if (find(ordstr_P,"s") > 0) 213 { 214 //spaeter den lokalen fall ueber lp oder aehnlich behandeln 215 return(std(i)); 216 } 217 218 int IsSimple_P; 219 if (system("nblocks") <= 2) 220 { 221 if (find(ordstr_P, "M") <= 0) 222 { 223 IsSimple_P = 1; 224 } 225 } 226 int npars_P = npars(P); 227 228 // return std if no parameters and (dp or wp) 229 if ((npars_P == 0) && IsSimple_P) 230 { 231 if (find(ordstr_P, "d") > 0) 232 { 233 return (std(i)); 234 } 235 if (find(ordstr_P,"w") > 0) 236 { 237 return (std(i)); 238 } 239 } 240 241 // reset options 242 intvec opt=option(get); 243 int p_opt; 244 string s_opt = option(); 245 option(none); 246 // turn on option(prot) and/or option(mem), if previously set 247 if (find(s_opt, "prot")) 248 { 249 option(prot); 250 p_opt = 1; 251 } 252 if (find(s_opt, "mem")) 253 { 254 option(mem); 255 } 256 257 // construct ring in which first std computation is done 258 string varstr_P = varstr(P); 259 string parstr_P = parstr(P); 260 int is_homog = (homog(i) && (npars_P == 0)); 261 262 string ri = "ring Phelp =" + string(char(P)) + ",(" + varstr_P; 263 // parameters are converted to ring variables 264 if (npars_P > 0) 265 { 266 ri = ri + "," + parstr_P; 267 } 268 // a homogenizing variable is added, if necessary 269 if (! is_homog) 270 { 271 ri = ri + ",@t"; 272 } 273 // ordering is set to (dp, C) 274 ri = ri + "),(dp,C);"; 275 276 // change the ring 277 execute(ri); 278 279 // get ideal from previous ring 280 if (is_homog) 281 { 282 ideal qh = imap(P, i); 283 } 284 else 285 { 286 // and homogenize 287 ideal qh=homog(imap(P,i),@t); 288 } 289 290 // compute std and hilbert series 291 if (p_opt) 292 { 293 "std in " + ri[13, size(ri)  13]; 294 } 295 ideal qh1=std(qh); 296 intvec hi=hilb(qh1,1); 297 298 if (is_homog && (npars_P == 0)) 299 { 300 // no additional variables were introduced 301 setring P; // can immediately change to original ring 302 // simply compute std with hilbert series in original ring 303 if (p_opt) 304 { 305 "std with hilb in basering"; 306 i = std(i, hi); 307 } 308 } 309 else 310 { 311 // additional variables were introduced 312 // need another intermediate ring 313 ri = "ring Phelp1 =" + string(char(P)) 314 + ",(" + varstr(Phelp) + "),(" + ordstr_P; 301 315 302 303 304 305 306 307 308 316 // for lp without parameters, we do not need a block ordering 317 if ( ! (IsSimple_P && (npars_P + is_homog < 2) && find(ordstr_P, "l"))) 318 { 319 // need block ordering 320 ri = ri + ", dp(" + string(npars_P + is_homog) + ")"; 321 } 322 ri = ri + ");"; 309 323 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 324 // change to intermediate ring 325 execute(ri); 326 ideal qh = imap(Phelp, qh); 327 kill Phelp; 328 if (p_opt) 329 { 330 "std with hilb in " + ri[14,size(ri)14]; 331 } 332 // compute std with Hilbert series 333 qh = std(qh, hi); 334 // subst 1 for homogenizing var 335 if (!is_homog) 336 { 337 qh = subst(qh, @t, 1); 338 } 325 339 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 340 // go back to original ring 341 setring P; 342 // get ideal, delete zeros and clean SB 343 i = imap(Phelp1,qh); 344 i = simplify(i, 34); 345 kill Phelp1; 346 } 347 348 // cleanup time 349 option(set, opt); 350 if (find(s_opt, "redSB") > 0) 351 { 352 i=interred(i); 353 } 354 attrib(i, "isSB", 1); 355 return (i); 342 356 } 343 357 example … … 353 367 option(noprot); 354 368 j; simplify(j, 1); std(i); 355 } 356 369 if (system("with", "MP")) {groebner(i, 0);} 370 defined(groebner_error); 371 } 372 373 374 ////////////////////////////////////////////////////////////////////////// 375 proc resu(list #) 376 { 377 def P=basering; 378 list result; 379 def m=#[1]; //the ideal or module 380 381 int i=#[2]; //the length of the resolution 382 //if size(#)>2 a minimal resolution is computed 383 384 //LaScala for the homogeneous case 385 if(homog(m)==1) 386 { 387 resolution re=lres(m,i); 388 if(size(#)>2) 389 { 390 re=minres(re); 391 } 392 return(re); 393 } 394 395 //mres for the global non homogeneous case 396 if(find(ordstr(P),"s")==0) 397 { 398 string ri= "ring Phelp =" 399 +string(char(P))+",("+varstr_P+"),(dp,C);"; 400 execute(ri); 401 def m=imap(P,m); 402 list re=mres(m,i); 403 setring P; 404 result=imap(Phelp,re); 405 return(result); 406 } 407 408 //sres for the local case and not minimal resolution 409 if(size(#)<=2) 410 { 411 string ri= "ring Phelp =" 412 +string(char(P))+",("+varstr_P+"),(ls,c);"; 413 execute(ri); 414 def m=imap(P,m); 415 m=std(m); 416 list re=sres(m,i); 417 setring P; 418 result=imap(Phelp,re); 419 return(result); 420 } 421 422 //mres for the local case and minimal resolution 423 string ri= "ring Phelp =" 424 +string(char(P))+",("+varstr_P+"),(ls,C);"; 425 execute(ri); 426 def m=imap(P,m); 427 list re=mres(m,i); 428 setring P; 429 result=imap(Phelp,re); 430 return(result); 431 } 432 433 proc minresu(list #) 434 { 435 return(resu(#[1],#[2],1)); 436 }
Note: See TracChangeset
for help on using the changeset viewer.