Esempio n. 1
0
File: weyl.c Progetto: nhatcher/lie
matrix* Weyl_orbit(entry* v, matrix** orbit_graph)
{ lie_Index i,j,k,r=Lierank(grp),s=Ssrank(grp);
  matrix* result; entry** m;
  lie_Index level_start=0, level_end=1, cur=1;
  
  { entry* lambda=mkintarray(r); 
    copyrow(v,lambda,r); make_dominant(lambda);
    result=mkmatrix(bigint2entry(Orbitsize(lambda)),r);
    copyrow(lambda,result->elm[0],r); freearr(lambda);
    if (orbit_graph!=NULL) *orbit_graph=mkmatrix(result->nrows,s);
  }
  m=result->elm;
  while (level_start<level_end)
  { 
    for (k=level_start; k<level_end; ++k)
      for (i=0; i<s; ++i)
        if (m[k][i]>0) /* only strictly cross walls, and from dominant side */
        { w_refl(m[k],i);
          for (j=level_end; j<cur; ++j)
            if (eqrow(m[k],m[j],s)) break;
          if (orbit_graph!=NULL)
          { (*orbit_graph)->elm[k][i]=j; (*orbit_graph)->elm[j][i]=k; }
          if (j==cur)
    	{ assert(cur<result->nrows);
              copyrow(m[k],m[cur++],r);
            }
          w_refl(m[k],i);
        }
        else if (m[k][i]==0 && orbit_graph!=NULL) (*orbit_graph)->elm[k][i]=k;
    level_start=level_end; level_end=cur;
  }
  return result;
}
Esempio n. 2
0
poly* SAtensor(boolean alt,_index m,poly* p)
{ _index n,r=Lierank(grp); poly** adams,** q,* result;
  if (m==0) return poly_one(r);  else if (m==1) return p;

  adams=alloc_array(poly*,m+1); 
  for (n=1; n<=m; ++n) adams[n]=Adams(n,p);
  q=alloc_array(poly*,m+1);
  q[0]=poly_one(r);
  for (n=1; n<=m; ++n)
  { 
    { _index i; q[n]=Tensor(p,q[n-1]); /* the initial term of the summation */
      for (i=2; i<=n; ++i) q[n] =
        Add_pol_pol(q[n],Tensor(adams[i],q[n-i]),alt&&i%2==0);
    }
    
    { _index i; bigint* big_n=entry2bigint(n);  setshared(big_n);
      for (i=0; i<q[n]->nrows; ++i)
      { bigint** cc= &q[n]->coef[i]
             ,* c= (clrshared(*cc),isshared(*cc)) ? copybigint(*cc,NULL) : *cc;
        *cc=divq(c,big_n); setshared(*cc);
        
        { if (c->size != 0)
            error("Internal error (SAtensor): remainder from %ld.\n" ,(long)n);
          freemem(c);
        }
      }
      clrshared(big_n); freemem(big_n);
    }
  }
  result=q[m];
{ for (n=1; n<=m; ++n) freepol(adams[n]); } freearr(adams);
{ for (n=0; n<m; ++n)  freepol(q[n]); } freearr(q);
 return result;
}
Esempio n. 3
0
cmp_tp height_decr(entry* v,entry * w, lie_Index len)
{ lie_Index i; entry delta=0;
  assert(level_vec!=NULL && Lierank(level_vec_group)==len);
  for (i=0; i<len; ++i) delta += (v[i]-w[i])*level_vec[i];
  if (delta) return delta>0 ? 1 : -1;
  return lex_decr(v,w,len); /* for equal level, revert to lexicographic */
}
Esempio n. 4
0
poly* Plethysm(entry* lambda,_index l,_index n,poly* p)
{ if (n==0) return poly_one(Lierank(grp));  else if (n==1) return p;

  { _index i,j;
    poly* sum= poly_null(Lierank(grp)),**adams=alloc_array(poly*,n+1);
    poly* chi_lambda=MN_char(lambda,l);
    for (i=1; i<=n; ++i) { adams[i]=Adams(i,p); setshared(adams[i]); }
    
    for (i=0;i<chi_lambda->nrows;i++)
    { entry* mu=chi_lambda->elm[i]; poly* prod=adams[mu[0]],*t;
      for (j=1; j<n && mu[j]>0; ++j)
        { t=prod; prod=Tensor(t,adams[mu[j]]); freepol(t); }
      sum= Addmul_pol_pol_bin(sum,prod,mult(chi_lambda->coef[i],Classord(mu,n)));
    }
    freemem(chi_lambda);
    setshared(p); /* protect |p|; it coincides with |adams[1]| */
    for (i=1; i<=n; ++i)
      { clrshared(adams[i]); freepol(adams[i]); }  freearr(adams);
  clrshared(p);

    
    { bigint* fac_n=fac(n);  setshared(fac_n); /* used repeatedly */
      for (i=0; i<sum->nrows; ++i)
      { bigint** cc= &sum->coef[i]
             ,* c= (clrshared(*cc),isshared(*cc)) ? copybigint(*cc,NULL) : *cc;
        *cc=divq(c,fac_n); setshared(*cc);
        if (c->size!=0) error("Internal error (plethysm).\n");  else freemem(c);
      }
      clrshared(fac_n); freemem(fac_n);
    }
    return sum;
  }
}
Esempio n. 5
0
poly* Adams(_index n,poly* p)
{ if (n==1) return p; /* avoid work in this trivial case */
  { _index i,j, r=Lierank(grp); poly* dom_ch=Domchar_p(p);
    for (i=0; i<dom_ch->nrows; ++i)
      for (j=0; j<r; j++) dom_ch->elm[i][j] *= n;
    { poly* result=Vdecomp(dom_ch); freepol(dom_ch); return result; }
  }
}
Esempio n. 6
0
File: weyl.c Progetto: nhatcher/lie
matrix* Weyl_mat(vector* word)
{ lie_Index i,j,r=Lierank(grp); matrix* res=mkmatrix(r,r); entry** m=res->elm;
  for (i=0; i<r; ++i)
  { for (j=0; j<r; ++j) m[i][j]= i==j;
    Waction(m[i],word);
  }
  return res;
}
Esempio n. 7
0
poly* Vdecomp(poly* p)
{   lie_Index i,r=Lierank(grp);
    poly* result=poly_null(r);
    cur_expon=mkintarray(r); /* large enough */
    for (i=0; i<p->nrows; ++i)
        result=Addmul_pol_pol_bin(result,vdecomp_irr(p->elm[i]),p->coef[i]);
    freearr(cur_expon);
    return result;
}
Esempio n. 8
0
cmpfn_tp set_ordering (cmpfn_tp criterion, lie_Index n, object g)
{ if (criterion!=height_decr && criterion!=height_incr) return criterion;
  if (g==NULL || n!=Lierank(g))
    return criterion==height_decr ? deg_decr : deg_incr; /* substitute */
  if (level_vec==NULL
     || int_eq_grp_grp(g,level_vec_group)==(object)bool_false)
  { if (level_vec!=NULL) freearr(level_vec);
    level_vec=Lv(g); level_vec_group=g;
  }
  return criterion;
}
Esempio n. 9
0
matrix* Resmat(matrix* roots)
{ lie_Index i,j,k,r=Lierank(grp),s=Ssrank(grp), n=roots->nrows;
  vector* root_norms=Simproot_norms(grp);
  entry* norms=root_norms->compon;
    /* needed to compute $\<\lambda,\alpha[i]>$ */
  matrix* root_images=Matmult(roots,Cartan()),* result=mkmatrix(r,r);
  entry** alpha=roots->elm,** img=root_images->elm,** res=result->elm;

  for (i=0; i<r; i++) for (j=0; j<r; j++) res[i][j]= i==j;
    /* initialise |res| to identity */
  for (j=0; j<n; j++) /* traverse the given roots */
  
  { entry* v=img[j], norm=(checkroot(alpha[j]),Norm(alpha[j]));
    for (k=s-1; v[k]==0; k--) {}
    if (k<j)
      error("Given set of roots is not independent; apply closure first.\n");
    
    if (v[k]<0)
    { for (i=j; i<n; i++) img[i][k]= -img[i][k];
      for (i=k-j; i<s; i++) res[i][k]= -res[i][k];
    }
    while(--k>=j)
      /* clear |v[k+1]| by unimodular column operations with column~|j| */
    { 
        entry u[3][2];  lie_Index l=0;
        u[0][1]=u[1][0]=1; u[0][0]=u[1][1]=0;
        u[2][1]=v[k]; u[2][0]=v[k+1];
        if (v[k]<0) u[2][1]= -v[k], u[0][1]= -1; /* make |u[2][1]| non-negative */
        do /* subtract column |l| some times into column |1-l| */
        { entry q=u[2][1-l]/u[2][l];  for (i=0; i<3; i++) u[i][1-l]-=q*u[i][l];
        } while (u[2][l=1-l]!=0);
        if (l==0)  for (i=0; i<2; i++) swap(&u[i][0],&u[i][1]);
      
      { for (i=j; i<n; i++) /* combine columns |k| and |k+1| */
        { entry img_i_k=img[i][k];
          img[i][k]  =img_i_k*u[0][0]+img[i][k+1]*u[1][0];
          img[i][k+1]=img_i_k*u[0][1]+img[i][k+1]*u[1][1];
        }
        for (i=k-j; i<s; i++)
        { entry res_i_k=res[i][k];
          res[i][k]=res_i_k*u[0][0]+res[i][k+1]*u[1][0];
          res[i][k+1]=res_i_k*u[0][1]+res[i][k+1]*u[1][1];
        }
      }
     }
    for (i=0; i<s; i++) 
                    { lie_Index inpr= norms[i]*alpha[j][i]; /* this is $(\omega_i,\alpha[j])$ */
                      if (inpr%norm!=0) error("Supposed root has non-integer Cartan product.\n");
                      res[i][j]=inpr/norm; /* this is $\<\omega_i,\alpha[j]>$ */
                    }
  }
  freemem(root_norms); freemem(root_images); return result;
}
Esempio n. 10
0
File: weyl.c Progetto: nhatcher/lie
matrix* Weyl_root_orbit(entry* v)
{ lie_Index i,j,r=Lierank(grp),s=Ssrank(grp);
  entry* x=mkintarray(r); matrix* orbit, *result; entry** m;
  lie_Index dc=Detcartan();
  mulvecmatelm(v,Cartan()->elm,x,s,r);
  orbit=Weyl_orbit(x,NULL);
result=mkmatrix(orbit->nrows,s); m=result->elm;
  mulmatmatelm(orbit->elm,Icartan()->elm,m,orbit->nrows,s,s);
  freemem(orbit);
  for (i=0; i<result->nrows; ++i) 
    for (j=0; j<s; ++j) m[i][j]/=dc;
  return result;
}
Esempio n. 11
0
File: grpdata.c Progetto: d4g33z/lie
matrix* Cartan(void)
{ if (type_of(grp)==SIMPGRP) return simp_Cartan(&grp->s);
  if (simpgroup(grp)) return simp_Cartan(Liecomp(grp,0));
  { _index i,j, t=0;
    matrix* cartan=mat_null(Ssrank(grp),Lierank(grp));
    for (i=0; i<grp->g.ncomp; ++i)
    { _index r=Liecomp(grp,i)->lierank;
      entry** c=simp_Cartan(Liecomp(grp,i))->elm;
      for (j=0; j<r; ++j) copyrow(c[j],&cartan->elm[t+j][t],r);
      t+=r;
    }
    return cartan;
  }
}
Esempio n. 12
0
File: grpdata.c Progetto: d4g33z/lie
vector* Exponents(object grp)
{ if (type_of(grp)==SIMPGRP)
    { simp_exponents(&grp->s); return grp->s.exponents; }
  if (simpgroup(grp))
    { simp_exponents(Liecomp(grp,0)); return Liecomp(grp,0)->exponents; }
  { _index i,t=0; vector* v=mkvector(Lierank(grp)); entry* e=v->compon;
    { for (i=0; i<grp->g.ncomp; ++i)
      { simpgrp* g=Liecomp(grp,i); _index r=g->lierank; 
	copyrow(simp_exponents(g),&e[t],r); t+=r;
      }
      for (i=0; i<grp->g.toraldim; ++i) e[t+i]=0;
    }
    return v;
  }
}
Esempio n. 13
0
File: grpdata.c Progetto: d4g33z/lie
matrix* Icartan(void)
{ if (simpgroup(grp)) return simp_icart(Liecomp(grp,0));
  { matrix* result=mat_null(Lierank(grp),Ssrank(grp)); entry** m=result->elm;
    _index k,t=0;
    entry det=Detcartan(); /* product of determinants of simple factors */
    for (k=0; k<grp->g.ncomp; ++k)
    { simpgrp* g=Liecomp(grp,k);
      _index i,j,r=g->lierank;
      entry** a=simp_icart(g)->elm;
      entry f=det/simp_detcart(g); /* multiplication factor */
      for (i=0; i<r; ++i)  for (j=0; j<r; ++j) m[t+i][t+j]=f*a[i][j];
      t+=r;
    }
    return result;
  }
}
Esempio n. 14
0
matrix* Closure(matrix* m, boolean close, group* lie_type)
{ matrix* result;  lie_Index i,j;
  group* tp=(s=Ssrank(grp), lie_type==NULL ? mkgroup(s) : lie_type);

  tp->toraldim=Lierank(grp); tp->ncomp=0; /* start with maximal torus */
  m=copymatrix(m);
  
  if (close)
    if (type_of(grp)==SIMPGRP) close = two_lengths(grp->s.lietype);
    else
    { for (i=0; i<grp->g.ncomp; i++)
        if (two_lengths(Liecomp(grp,i)->lietype)) break;
      close= i<grp->g.ncomp;
    }
  
  { entry* t;
    for (i=0; i<m->nrows; i++)
    if (!isroot(t=m->elm[i]))
      error("Set of root vectors contains a non-root\n");
    else if (!isposroot(t=m->elm[i]))
      for (j=0; j<m->ncols; j++) t[j]= -t[j]; /* make positive root */
    Unique(m,cmpfn);
  }
  { lie_Index next;
    for (i=0; i<m->nrows; i=next)
    
    { lie_Index d,n=0;  simpgrp* c;
      next=isolcomp(m,i);
      fundam(m,i,&next);
      if (close) long_close(m,i,next),fundam(m,i,&next);
      c=simp_type(&m->elm[i],d=next-i);
      
      { j=tp->ncomp++;
        while(--j>=0 && grp_less(tp->liecomp[j],c))
          n += (tp->liecomp[j+1]=tp->liecomp[j])->lierank;
        tp->liecomp[++j]=c; tp->toraldim -= d;
          /* insert component and remove rank from torus */
        cycle_block(m,i-n,next,n);
          /* move the |d| rows down across |n| previous rows */
      }
    }
  }
  if (lie_type==NULL)
    return result=copymatrix(m),freemem(m),freemem(tp),result;
  else return freemem(m),(matrix*)NULL; /* |Cartan_type| doesn't need |m| */
}
Esempio n. 15
0
File: grpdata.c Progetto: d4g33z/lie
poly* Adjoint(object grp)
{ _index i,j,r=Lierank(grp)
  ,n=type_of(grp)==SIMPGRP ? 1: grp->g.ncomp+(grp->g.toraldim!=0);
  poly* adj= mkpoly(n,r);
  for (i=0; i<n; ++i)
  { adj->coef[i]=one; for (j=0; j<r; ++j) adj->elm[i][j]=0; }
  if (type_of(grp)==SIMPGRP) set_simp_adjoint(adj->elm[0],&grp->s);
  else
  { _index offs=0; simpgrp* g;
    for (i=0; i<grp->g.ncomp; offs+=g->lierank,++i)
      set_simp_adjoint(&adj->elm[i][offs],g=Liecomp(grp,i));
    if (grp->g.toraldim!=0)
    { adj->coef[i]=entry2bigint(grp->g.toraldim);
      setshared(adj->coef[i]);
    }
  }
  return adj;
}
Esempio n. 16
0
File: grpdata.c Progetto: d4g33z/lie
matrix* Center(object grp)
{ _index i,j,R=Lierank(grp),n_gen;
  
  for (n_gen=grp->g.toraldim,i=0; i<grp->g.ncomp; ++i)
  { simpgrp* g=Liecomp(grp,i);
    if (simp_detcart(g)>1) n_gen+=1+(g->lietype=='D' && g->lierank%2==0);
  }
  { matrix* res=mat_null(n_gen,R+1); entry** m=res->elm; _index k=0,s=0;
    for (j=0; j<grp->g.ncomp; ++j)
    { simpgrp* g=Liecomp(grp,j); _index n=g->lierank; entry d=simp_detcart(g);
      if (d>1)
      { 
        switch (g->lietype)
        {      case 'A':  for (i=0; i<n; ++i) m[k][s+i]=i+1;
        	/* $[1,2,3,\ldots,n]$; $d=n+1$ */ 
        break; case 'B': m[k][s+n-1]=1; /* $[0,0,\ldots,0,1]$; $d=2$ */ 
        break; case 'C':  for (i=0; i<n; i+=2) m[k][s+i]=1;
        	/* $[1,0,1,0,\ldots]$; $d=2$ */ 
        break; case 'D': 
                      { m[k][s+n-2]=m[k][s+n-1]=1;
                        if (n%2==1)  for (i=0; i<n; i+=2) m[k][s+i]+=2;
                          /* $[2,0,2,\ldots,2,1,3]$; $d=4$ */
                        else
                        { d=2; m[k++][R]=d; /* $[0,0,\ldots,0,1,1]$; $d=2$ */
                          for (i=0; i<n; i+=2) m[k][s+i]=1; /* $[1,0,1,\ldots,1,0]$; $d=2$ */
                        }
                      }
         
        break; case 'E':
          if (n==7)
            { m[k][s+1]=m[k][s+4]=m[k][s+6]=1; } /* $[0,1,0,0,1,0,1]$; $d=2$ */
          else { m[k][s]=m[k][s+4]=1; m[k][s+2]=m[k][s+5]=2; }
             /* $[1,0,2,0,1,2]$; $d=3$ */
        }
	m[k++][R]=d; /* insert denominator for last generator, and advance */
      }
      s+=n; /* advance offset into semisimple elements */
    }
    
    for (i=0; i<grp->g.toraldim; ++i) m[k++][s+i]=1;
    assert(k==n_gen); return res;
  }
}
Esempio n. 17
0
void char_init(object g) {
    set_weight_sorting(g);
    wt_init(Lierank(g));
}
Esempio n. 18
0
File: grpdata.c Progetto: d4g33z/lie
entry Dimgrp(object grp)
{ return Lierank(grp) + 2*Numproots(grp); }