Changeset 1e745b in git for Singular/LIB/sing.lib
 Timestamp:
 May 1, 1997, 7:49:56 PM (27 years ago)
 Branches:
 (u'spielwiese', 'ec94ef7a30b928574c0c3daf41f6804dff5f6b69')
 Children:
 4b35a9008ee2cec61ef2193763b534f1c072bf19
 Parents:
 22d79069af63dd10b93e136d82bb339faa6c28d9
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

Singular/LIB/sing.lib
r22d790 r1e745b 1 // $Id: sing.lib,v 1. 2 19970428 19:27:25 obachmanExp $1 // $Id: sing.lib,v 1.3 19970501 17:49:56 Singular Exp $ 2 2 //system("random",787422842); 3 3 //(GMG/BM, last modified 26.06.96) … … 21 21 T2((i); T2module of ideal i 22 22 T12(i); T1 and T2module of ideal i 23 codim (id1, id2); codimension of of id2 in id1 23 24 24 25 LIB "inout.lib"; … … 654 655 } 655 656 /////////////////////////////////////////////////////////////////////////////// 657 proc codim (id1, id2) 658 USAGE: codim(id1,id2); id1,id2 ideal or module, both result of std 659 RETURN: result is the number of elements in id1 but not in id2 if finite, 660 conditions: 661 1. id2 is contained in id1, if not return 2 662 2. finiteness 663 consider the two hilberseries iv1(t) and iv2(t) 664 q(t)=(iv2(t)iv1(t))/(1t)^n must be rational, if not return 1 665 (n dimension of basering) 666 then the result is the sum of the coeff. of q(t) 667 { 668 intvec iv1, iv2, iv; 669 int i, d1, d2, dd, i1, i2, ia, ie; 670 // check id2 < id1  671 i = size(NF(lead(id2),lead(id1))); 672 if ( i > 0 ) 673 { 674 return(2); 675 } 676 // 1. check finiteness  677 i1 = dim(id1); 678 i2 = dim(id2); 679 if (i1 < 0) 680 { 681 if (i2 == 0) 682 { 683 return vdim(id2); 684 } 685 else 686 { 687 return(1); 688 } 689 } 690 if (i2 != i1) 691 { 692 return(1); 693 } 694 if (i2 <= 0) 695 { 696 return(vdim(id2)vdim(id1)); 697 } 698 if (mult(id2) != mult(id1)) 699 { 700 return(1); 701 } 702 // module  703 d1 = nrows(id1); 704 d2 = nrows(id2); 705 dd = 0; 706 if (d1 > d2) 707 { 708 id2=id2,maxideal(1)*gen(d1); 709 dd = 1; 710 } 711 if (d2 > d1) 712 { 713 id1=id1,maxideal(1)*gen(d2); 714 dd = 1; 715 } 716 // compute first hilbertseries  717 iv1 = hilb(id1,1); 718 i1 = size(iv1); 719 iv2 = hilb(id2,1); 720 i2 = size(iv2); 721 // difference of hilbertseries  722 if (i2 > i1) 723 { 724 for ( i=1; i<=i1; i=i+1) 725 { 726 iv2[i] = iv2[i]iv1[i]; 727 } 728 ie = i2; 729 iv = iv2; 730 } 731 else 732 { 733 for ( i=1; i<=i2; i=i+1) 734 { 735 iv1[i] = iv2[i]iv1[i]; 736 } 737 iv = iv1; 738 for (ie=i1;ie>=0;ie=ie1) 739 { 740 if (ie == 0) 741 { 742 return(0); 743 } 744 if (iv[ie] != 0) 745 { 746 break; 747 } 748 } 749 } 750 ia = 1; 751 while (iv[ia] == 0) { ia=ia+1; } 752 // ia <= nonzeros <= ie  753 iv1 = iv[ia]; 754 for(i=ia+1;i<=ie;i=i+1) 755 { 756 iv1=iv1,iv[i]; 757 } 758 // compute second hilbertseries  759 iv2 = hilb(iv1); 760 // check finitenes  761 i2 = size(iv2); 762 i1 = ie  ia + 1  i2; 763 if (i1 != nvars(basering)) 764 { 765 return(1); 766 } 767 // compute result  768 i1 = 0; 769 for ( i=1; i<=i2; i=i+1) 770 { 771 i1 = i1 + iv2[i]; 772 } 773 return(i1+dd); 774 } 775
Note: See TracChangeset
for help on using the changeset viewer.