Changeset 9431925 in git


Ignore:
Timestamp:
Aug 9, 2004, 3:50:11 PM (20 years ago)
Author:
Viktor Levandovskyy <levandov@…>
Branches:
(u'spielwiese', '5b153614cbc72bfa198d75b1e9e33dab2645d9fe')
Children:
1b11d1e2918321346483d859f0c183f4403551b6
Parents:
5831fa903418ab2fa4947fb0388f156f8b41b8cb
Message:
*levandov: Markus code for detecting and applying involution for noncomm case is added


git-svn-id: file:///usr/local/Singular/svn/trunk@7339 2c84dea3-7e68-4137-9b89-c4e89433aadc
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:20 levandov Exp $";
     1version="$Id: control.lib,v 1.9 2004-08-09 13:50:11 levandov Exp $";
    22category="Miscellaneous";
    33info="
     
    2020
    2121AUXILIARY PROCEDURES:
     22ncdetection(ring r);          computes an ideal, presenting an involution map on non-comm algebra r;
     23involution(m, map theta); applies the involution, presented by theta to  m of typ poly, vector, ideal, module;
    2224declare(string NameOfRing, string Variables[,string  Parameters, string Ordering]);     defines the ring, optional parametes are a string of parameters and a sting of ordering,
    2325view();                      Well-formatted output of lists, modules and matrixes
     
    3436LIB "poly.lib";
    3537LIB "primdec.lib";
     38LIB "ncalg.lib";
    3639//---------------------------------------------------------------
    3740proc declare(string NameOfRing, string Variables, list #)
     
    641644}; 
    642645//---------------------------------------------------------------------------
     646static 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
     673proc 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}
     722example
     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
     745proc 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}
     862example
     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.