Changeset 9431925 in git
- Timestamp:
- Aug 9, 2004, 3:50:11 PM (20 years ago)
- Branches:
- (u'spielwiese', '5b153614cbc72bfa198d75b1e9e33dab2645d9fe')
- Children:
- 1b11d1e2918321346483d859f0c183f4403551b6
- Parents:
- 5831fa903418ab2fa4947fb0388f156f8b41b8cb
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Singular/LIB/control.lib
r5831fa9 r9431925 1 version="$Id: control.lib,v 1. 8 2004-08-09 12:57:20levandov Exp $";1 version="$Id: control.lib,v 1.9 2004-08-09 13:50:11 levandov Exp $"; 2 2 category="Miscellaneous"; 3 3 info=" … … 20 20 21 21 AUXILIARY PROCEDURES: 22 ncdetection(ring r); computes an ideal, presenting an involution map on non-comm algebra r; 23 involution(m, map theta); applies the involution, presented by theta to m of typ poly, vector, ideal, module; 22 24 declare(string NameOfRing, string Variables[,string Parameters, string Ordering]); defines the ring, optional parametes are a string of parameters and a sting of ordering, 23 25 view(); Well-formatted output of lists, modules and matrixes … … 34 36 LIB "poly.lib"; 35 37 LIB "primdec.lib"; 38 LIB "ncalg.lib"; 36 39 //--------------------------------------------------------------- 37 40 proc declare(string NameOfRing, string Variables, list #) … … 641 644 }; 642 645 //--------------------------------------------------------------------------- 646 static proc invo_poly(poly m, map theta) 647 //applies the involution map theta to m, where m=polynomial 648 { 649 int i,j; 650 intvec v; 651 poly p,z; 652 poly n = 0; 653 i = 1; 654 while(m[i]!=0) 655 { 656 v = leadexp(m[i]); 657 z =1; 658 for(j=nvars(basering); j>=1; j--) 659 { 660 if (v[j]!=0) 661 { 662 p = var(j); 663 p = theta(p); 664 z = z*(p^v[j]); 665 } 666 } 667 n = n + (leadcoef(m[i])*z); 668 i++; 669 } 670 return(n); 671 } 672 673 proc involution(m, map theta) 674 //applies the involution map theta to m, where m=vector, polynomial, 675 //module,ideal 676 { 677 int i,j; 678 intvec v; 679 poly p,z; 680 if (typeof(m)=="poly") 681 { 682 return (invo_poly(m,theta)); 683 } 684 if ( typeof(m)=="ideal" ) 685 { 686 ideal n; 687 for (i=1; i<=size(m); i++) 688 { 689 n[i] = invo_poly(m[i],theta); 690 } 691 return(n); 692 } 693 if (typeof(m)=="vector") 694 { 695 for(i=1;i<=size(m);i++) 696 { 697 m[i] = invo_poly(m[i],theta); 698 } 699 return (m); 700 } 701 702 if ( (typeof(m)=="matrix") || (typeof(m)=="module")) 703 { 704 // m=transpose(m); 705 matrix n = matrix(m); 706 int @R=nrows(n); 707 int @C=ncols(n); 708 for(i=1; i<=@R; i++) 709 { 710 for(j=1; j<=@C; j++) 711 { 712 n[i,j] = invo_poly( m[i,j], theta); 713 } 714 } 715 } 716 if (typeof(m)=="module") 717 { 718 return (module(n)); 719 } 720 return(n); 721 } 722 example 723 { 724 "EXAMPLE:";echo = 2; 725 ring r = 0,(x,d),dp; 726 ncalgebra(1,1); // Weyl-Algebra 727 map F = r,x,-d; 728 poly f = x*d^2+d; 729 poly If = involution(f,F); 730 f-If; 731 poly g = x^2*d+2*x*d+3*x+7*d; 732 poly tg = -d*x^2-2*d*x+3*x-7*d; 733 poly Ig = involution(g,F); 734 tg-Ig; 735 ideal I = f,g; 736 ideal II = involution(I,F); 737 II; 738 I - involution(II,F); 739 module M = [f,g,0],[g,0,x^2*d]; 740 module IM = involution(M,F); 741 print(IM); 742 print(M - involution(IM,F)); 743 } 744 745 proc ncdetection( r) 746 //in dieser proc. wird eine matrix erzeugt, die in der i-ten zeile die indices 747 //der differential-,shift- oder advance-operatoren enthaelt mit denen die i-te 748 //variable nicht kommutiert. 749 { 750 int i,j,k,LExp; 751 int NVars=nvars(r); 752 matrix rel = NCRelations(r)[2]; 753 intmat M[NVars][3]; 754 int NRows = nrows(rel); 755 intvec v,w; 756 poly d,d_lead; 757 ideal I; 758 map theta; 759 760 for( j=NRows;j>=2;j-- ) 761 { 762 if( rel[j] == w ) //the whole column is zero 763 { 764 j--; 765 continue; 766 } 767 768 for( i=1;i<j;i++ ) 769 { 770 if( rel[i,j]==1 ) //relation of type var(j)*var(i) = var(i)*var(j) +1 771 { 772 M[i,1]=j; 773 } 774 if( rel[i,j] == -1 ) //relation of type var(i)*var(j) = var(j)*var(i) -1 775 { 776 M[j,1]=i; 777 } 778 d = rel[i,j]; 779 d_lead = lead(d); 780 v=leadexp(d_lead); //in the next lines we check wether we have a relation of differential or shift type 781 LExp=0; 782 for( k=1;k<=NVars;k++) 783 { 784 LExp = LExp + v[k]; 785 } 786 if( (d-d_lead != 0) || (LExp > 1) ) 787 { 788 return( "wrong input" ); 789 } 790 if( v[j] == 1) //relation of type var(j)*var(i) = var(i)*var(j) -lambda*var(j) 791 { 792 if (leadcoef(d) < 0) 793 { 794 M[i,2] = j; 795 } 796 else 797 { 798 M[i,3] = j; 799 } 800 } 801 if( v[i]==1 ) //relation of type var(j)*var(i) = var(i)*var(j) -lambda*var(i) 802 { 803 if (leadcoef(d) > 0) 804 { 805 M[j,2] = i; 806 } 807 else 808 { 809 M[j,3] = i; 810 } 811 } 812 } 813 } 814 //ab hier wird die map ausgerechnet 815 for(i=1;i<=NVars;i++) 816 { 817 I=I+var(i); 818 } 819 820 for(i=1;i<=NVars;i++) 821 { 822 if( M[i,1..3]==(0,0,0) ) 823 { 824 i++; 825 continue; 826 } 827 if( M[i,1]!=0 ) 828 { 829 if( (M[i,2]!=0) && (M[i,3]!=0) ) 830 { 831 I[M[i,1]] = -var(M[i,1]); 832 I[M[i,2]] = var(M[i,3]); 833 I[M[i,3]] = var(M[i,2]); 834 } 835 if( (M[i,2]==0) && (M[i,3]==0) ) 836 { 837 I[M[i,1]] = -var(M[i,1]); 838 } 839 if( ( (M[i,2]!=0) && (M[i,3]==0) )|| ( (M[i,2]!=0) && (M[i,3]==0) ) 840 ) 841 { 842 I[i] = -var(i); 843 } 844 } 845 else 846 { 847 if( (M[i,2]!=0) && (M[i,3]!=0) ) 848 { 849 I[i] = -var(i); 850 I[M[i,2]] = var(M[i,3]); 851 I[M[i,3]] = var(M[i,2]); 852 } 853 else 854 { 855 I[i] = -var(i); 856 } 857 } 858 } 859 return(I); 860 861 } 862 example 863 { 864 "EXAMPLE:"; echo = 2; 865 ring r=0,(x,y,z,D(1..3)),dp; 866 matrix D[6][6]; 867 D[1,4]=1; 868 D[2,5]=1; 869 D[3,6]=1; 870 ncalgebra(1,D); 871 ncdetection(r); 872 kill r; 873 //---------------------------------------- 874 ring r=0,(x,S),dp; 875 ncalgebra(1,-S); 876 ncdetection(r); 877 kill r; 878 //---------------------------------------- 879 ring r=0,(x,D(1),S),dp; 880 matrix D[3][3]; 881 D[1,2]=1; 882 D[1,3]=-S; 883 ncalgebra(1,D); 884 ncdetection(r); 885 }
Note: See TracChangeset
for help on using the changeset viewer.