示例#1
0
文件: weyl.c 项目: 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;
}
示例#2
0
文件: symg.c 项目: nhatcher/lie
static lie_Index n_parts(lie_Index n)
{ lie_Index i,k,np; entry* c=mkintarray(n+1); /* coefficients */
  if (n>121) error("Too many partitions to generate.\n");
  for (i=0; i<=n; ++i) c[i]=1; /* initialise to ${1\over1-X}$ */
  for (i=2; i<=n; ++i)
    for (k=i; k<=n; ++k) c[k]+=c[k-i]; /* multiply by ${1\over1-X^i}$ */
  np=c[n]; freearr(c); return np;
}
示例#3
0
文件: decomp.c 项目: nhatcher/lie
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;
}
示例#4
0
文件: weyl.c 项目: nhatcher/lie
bigint* Orbitsize(entry* w)
{ lie_Index i,d,s=Ssrank(grp); entry* x=mkintarray(s),* y=x; bigint* result=one;
  copyrow(w,x,s); make_dominant(x);
  if (type_of(grp)==SIMPGRP) return simp_worbitsize(x,&grp->s);
  for (i=0; i<grp->g.ncomp; ++i,y+=d)
  { simpgrp* g=Liecomp(grp,i); d=g->lierank;
    result=mult(result,simp_worbitsize(y,g));
  }
  freearr(x); return result;
}
示例#5
0
文件: lr.c 项目: d4g33z/lie
poly* LR_tensor_irr(entry* lambda,entry * mu, _index n)
{ _index i,j;
	entry* nu; entry** T;
  if (n==0) return poly_one(0);
  
  { nu=&mkintarray(n+1)[1]; copyrow(lambda,nu,n); nu[-1]=lambda[0]+mu[0];
  T=alloc_array(entry*,n+1);
    for (i=0;i<=n;++i) /* allocate row |T[i]| and place sentinel before it */
    	{ T[i]= &mkintarray(mu[i==0?0:i-1]+1)[1]; T[i][-1]=n-1-i; }
    for (i=0,j=mu[0]-1; j>=0; --j)
    { while (i<n && mu[i]>j) ++i; /* find first |i| with |mu[i]<=j| */
      T[i][j]=-1; /* place sentinel at bottom of column |j| */
    } 
  }
  wt_init(n); /* prepare to collect terms with exponents of size~|n| */

  
  { j=-1;  for (i=n-1; i>0 && mu[i]==0; --i) {} /* move to initial position */
  recurse: /* recursive starting point; */
    if (++j>=mu[i] &&(j=0,--i<0)) /* move to next empty position, if any */
      wt_ins(nu,one,false); /* if not, |T| is full; contribute |nu| once */
  else
    
    { _index k= T[i+1][j]; entry prev= nu[k];
      do
      { while (nu[++k]==prev) {} /* find next |k| with |nu[k]<nu[@t$k'$@>]| */
        ++nu[T[i][j]=k]; goto recurse;
          /* insert |k| into |T| and extend partition |nu|; recurse */
        resume: prev= --nu[k=T[i][j]];
          /* restore |k| and |nu|; set |prev=nu[k]| */
      } while (prev>nu[T[i][j-1]]);
          /* if so, there are still corners of |nu| to try */
    }
    if (j==0) j= ++i<n?mu[i]:0; /* return to end of row below if necessary */
    if (--j>=0) goto resume; /* do return jump unless empty row is reached */
  }
  
  { --nu; freearr(nu);
    for (i=0;i<=n;i++) { entry* t=&T[i][-1]; freearr(t); }
    freearr(T);
  }
  return wt_collect(); /* return sum of all contributed terms */
}
示例#6
0
文件: symg.c 项目: nhatcher/lie
entry Schur_char_val(entry* lambda, entry* mu, lie_Index l, lie_Index m)
{ lie_Index i; entry sum=0;
  while (l>0 && lambda[l-1]==0) --l; /* get reduced form of~|lambda| */
  
  if (l<=1) return 1; /* trivial character */
  if (l>lambda[0]) /* then better work with the transpose partition */
  { vector* tr=Trans_part(lambda,l);
    entry ch=Schur_char_val(tr->compon,mu,lambda[0],m); freemem(tr);
    return Sign_part(mu,m)*ch;
  }
  
  { entry* lambda_prime=mkintarray(4*l)
       ,* sigma=lambda_prime+l,* pos=sigma+l,* nu=pos+l;
      /* 4 length-|l| arrays */
    boolean sg=true; /* positive sign */
    copyrow(lambda,lambda_prime,l);
      /* |lambda| might be alias of |mu|, but |lambda_prime| is not */
    for (i=0; i<l; ++i) pos[i]=sigma[i]=i;
      /* |sigma| is the permutation; |pos| records its swap sequence */
    do
    { copyrow(lambda_prime,nu,l); 
                                  { lie_Index i; for (i=1; i<l; ++i) if (nu[i]>nu[i-1]) /* skip most cases */
                                    { entry nui=nu[i]; lie_Index j=i;
                                      do nu[j]=nu[j-1]; while (--j>0 && nui>nu[j-1]); nu[j]=nui;
                                    }
                                  }
      sum+= sg ? Young_char_val(nu,mu,l,m) : -Young_char_val(nu,mu,l,m);
      
      { lie_Index i=0,j;
        
        do
        { 
          { lambda_prime[i]-=sigma[i];
            if ((j=pos[i])<i) { swap(&sigma[i],&sigma[j]); sg=!sg;}
          }
          do
            if(--j<0) break; /* tried all positions for this |i| */
          while (lambda_prime[i]+sigma[j]<0);
        } while (j<0 && ++i<l);
        if (i==l) break;
        
        do /* now |j>=0| and |sigma[j]| can move validly to |sigma[i]| */
        { 
          { if ((pos[i]=j)<i) { swap(&sigma[i],&sigma[j]); sg=!sg;}
            lambda_prime[i]+=sigma[i]; /* this becomes non-negative */
          }
          if (--i<0) break;
          for (j=i; lambda_prime[i]+sigma[j]<0; --j) {} /* this leaves |j>=0| */
        } while (true);
      }
    } while (true);
    freearr(lambda_prime);
  }
  return sum;
}
示例#7
0
文件: symg.c 项目: nhatcher/lie
bigint* MN_char_val(entry* lambda, entry* mu, lie_Index l, lie_Index m)
{ bigint* value=null; lie_Index n=check_part(lambda,l),m2;
  if (n==0) return one;
  while (lambda[l-1]==0) --l;  while (mu[m-1]==0) --m;
  for (m2=m; m2>0 && mu[m2-1]==1; --m2) {} /* number of parts $\mu_i\geq2$ */
  { entry* save=mkintarray(2*n),* lambda_prime=save+n;
    int i, j, d=lambda[0]+l, k=0; /* sum of leg lengths */
    boolean* edge=alloc_array(boolean,2*d);
    enum {hor, vert};

    
    { int r=l-1,c=0; /* current column number */
      for (j=0; r>=0; --r)
      { while (c<lambda[r]) { edge[j++]=hor; ++c; } /* columns of length |r| */
        edge[j++]=vert; /* row |r|, of length |c==lambda[r]| */
      }
    }
    
    for (i=0; i<m2; ++i)
    { for (j=0; j+mu[i]<d; ++j)
        if (edge[j]==hor && edge[j+mu[i]]==vert) break;
      if (j+mu[i]==d) return null; /* no hook of size |mu[i]| was found */
    }
    
    { i=0; /* index into |mu| */
    recurse:
      if (i<m2)
        
        { int r=mu[i];
          for (j=1; j<r; ++j) k+=edge[j]; /* leg length of hook first tried */
          for (j=0; j+r<d; ++j)
          { if (edge[j]==hor && edge[j+r]==vert)
            { edge[j]=vert; edge[j+r]=hor; save[i++]=j; goto recurse;
            resume: j=save[--i]; r=mu[i]; edge[j]=hor; edge[j+r]=vert;
            }
            k+= edge[j+r]-edge[j+1]; /* adjust |k| for hook tried next */
          }
          while (++j<d) k-= edge[j]; /* restore |k| */
        }
      else
        
        { int r=l,c=0,s=0; /* size of |lambda_prime| */
          for (j=0; r>0; )
            if (edge[j++]==vert) s+=lambda_prime[--r]=c;  else ++c;
            /* build |lambda_prime| from edges */
          value= k%2==0 ? add(value,n_tableaux(lambda_prime,l))
                        : sub(value,n_tableaux(lambda_prime,l)) ;
        }
      if (i>0) goto resume;
    }
    freearr(edge); freearr(save);
  }
  return value;
}
示例#8
0
文件: symg.c 项目: nhatcher/lie
matrix* Partitions(lie_Index n)
{ matrix* result=mkmatrix(n_parts(n),n);
  if (n>0)
  { entry* lambda=mkintarray(n),** res=result->elm; lie_Index i=0,j;
    lambda[0]=n; 
    for(j=1;j<n;j++) lambda[j]=0; /* initialise |lambda| to $[n,0,0,\ldots]$ */
    do copyrow(lambda,res[i++],n); while(Nextpart(lambda,n));
    freearr(lambda);
  }
  return result;
}
示例#9
0
文件: symg.c 项目: nhatcher/lie
matrix* Permutations(entry* v,lie_Index n)
{ lie_Index N=1; entry* w=mkintarray(n); copyrow(v,w,n); sortrow(w,n);
  { lie_Index i=0,j=n-1; while (i<j) swap(&w[i++],&w[j--]); }
    /* increasing order */
  
  { lie_Index i=0, mult=1;
    while (++i<n) { N*=i+1; if (w[i]>w[i-1]) mult=1; else N /= ++mult; }
  }
  { matrix* result=mkmatrix(N,n); lie_Index i=0;
    do copyrow(w,result->elm[i++],n); while (Nextperm(w,n));
    freearr(w); return result;
  }
}
示例#10
0
文件: symg.c 项目: nhatcher/lie
matrix* Tableaux(entry* lambda, lie_Index l)
{ bigint* nt=n_tableaux(lambda,l); lie_Index n=check_part(lambda,l);
  matrix* result=mkmatrix(bigint2entry(nt),n);
  entry** res=result->elm,* t=mkintarray(n);
  freemem(nt);

  
  { lie_Index i=0,j,k;
    for (j=1; j<=l; ++j) for (k=lambda[j-1]; k>0; --k) t[i++]=j;
  }
  { lie_Index i=0; do copyrow(t,res[i++],n); while(Nexttableau(t,n)); }
  freearr(t); return result;
}
示例#11
0
文件: weyl.c 项目: 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;
}
示例#12
0
文件: symg.c 项目: nhatcher/lie
bigint* n_tableaux(entry* lambda, lie_Index l)
{ lie_Index i,j,k=0; entry* h; bigint* res=copybigint(one,NULL);
  do  if (--l<=0) return one; 
  while (lambda[l]==0); /* find last non-zero part */
  h=mkintarray(lambda[0]); 
  for(j=0; j<lambda[0]; ++j) h[j]=0; /* accumulated column heigths */
  for(i=l; i>=0; --i)
    
    { entry li=lambda[i]-1;
      for(j=0; j<=li; ++j) res=mul1(res,++k); /* part of factorial */
      for(j=0; j<=li; ++j) div1(res,(++h[j])+li-j); /* divide by hook lengths */
    }
  freearr(h); return res;
}
示例#13
0
文件: closure.c 项目: nhatcher/lie
local void long_close(matrix* m, lie_Index first, lie_Index last)
{ lie_Index i,j;  entry* root_i,* root_j,* t=mkintarray(s);
  for (i=first; i<last; ++i)
  { root_i=m->elm[i]; if (Norm(root_i)>1) continue;
    for (j=i+1; j<last; ++j)
    { root_j=m->elm[j]; if (Norm(root_j)>1) continue;
      subrow(root_i,root_j,t,s);
      if (isroot(t))
	if (isposroot(t)) 
	{ copyrow(t,root_i,s); break;  } /* need not consider more |j|'s */
	else add_xrow_to(root_j,-1,root_i,s);
    }
  }
  freearr(t);
}
示例#14
0
文件: closure.c 项目: nhatcher/lie
local void fundam(matrix* roots, lie_Index first, lie_Index* last)
{ lie_Index i,j,d;  boolean changed;
  entry* t=mkintarray(s);  matrix mm,* m=&mm;
  mm.elm=&roots->elm[first]; mm.nrows=*last-first; mm.ncols=roots->ncols;
  for (i=m->nrows-1; i>0; changed ? Unique(m,cmpfn),i=m->nrows-1 : --i)
  { entry* root_i=m->elm[i]; changed=false;
    
    for (j=i-1; j>=0; j--)
    { entry* root_j=m->elm[j]; entry c=Cart_inprod(root_j,root_i);
      if (c==2 && eqrow(root_j,root_i,s))
        
        { cycle_block(m,j,m->nrows--,1); root_i=m->elm[--i];
        } 
      else if (c>0)
      { changed=true;
        
        { copyrow(root_j,t,s); add_xrow_to(t,-c,root_i,s);
          if (isposroot(t)) copyrow(t,root_j,s);
          else
          { j=i; c=Cart_inprod(root_i,root_j);
            copyrow(root_i,t,s); add_xrow_to(t,-c,root_j,s);
            if (isposroot(t)) copyrow(t,root_i,s);
            else 
                 { lie_Index k;  entry* ln,* sh; /* the longer and the shorter root */
                   if (Norm(root_i)>Norm(root_j))
                     ln=root_i, sh=root_j;  else ln=root_j, sh=root_i;
                   switch (Norm(ln))
                   { case 2: subrow(ln,sh,sh,s); /* |sh=ln-sh| */
                     add_xrow_to(ln,-2,sh,s); /* |ln=ln-2*sh| */
                   break; case 3: /* |grp=@t$G_2$@>| now */
                     for (k=0; sh[k]==0; ++k) {} /* find the place of this $G_2$ component */
                     sh[k]=1; sh[k+1]=0; ln[k]=0; ln[k+1]=1;
                       /* return standard basis of full system */
                   break; default: error("problem with norm 1 roots\n");
                   }
                 }
          }
        }
      }
    }
  }
  cycle_block(roots,first+mm.nrows,roots->nrows,d=*last-first-mm.nrows);
*last-=d; roots->nrows-=d;
  freearr(t);
}
示例#15
0
文件: weyl.c 项目: nhatcher/lie
poly* alt_Wsum(poly* p)
{ lie_Index i,k=0,r=p->ncols; poly* result; entry** res,*rho=mkintarray(r);
  p=Alt_dom(p); for (i=0; i<r; ++i) rho[i]=1;
  for (i=0; i<p->nrows; ++i) add_xrow_to(p->elm[i],1,rho,r);
  result=mkpoly(p->nrows*bigint2entry(Worder(grp)),r); res=result->elm;
  for (i=0; i<p->nrows; ++i)
  { lie_Index j,l; matrix* orbit=Weyl_orbit(p->elm[i],NULL); entry** x=orbit->elm;
    bigint* c=p->coef[i],* min_c=sub(null,c);
    for (j=0; j<orbit->nrows; ++j)
    { subrow(*x,rho,res[k],r); l=make_dominant(*x++)%2;
      result->coef[k]= l ? min_c : c; setshared(result->coef[k]); ++k;
    }
    freemem(orbit);
  }
  freearr(rho);
  assert(k==result->nrows);
  return result; /* not sorted, but rows are unique */
}
示例#16
0
文件: grpdata.c 项目: d4g33z/lie
matrix* simp_proots(simpgrp* g)
{ if (g->roots!=NULL) return g->roots;
  { _index r=g->lierank,l,i,last_root;
    entry** cartan=simp_Cartan(g)->elm;
    entry** posr=(g->roots=mkmatrix(simp_numproots(g),r))->elm;
    entry* level=(g->level=mkvector(simp_exponents(g)[r-1]+1))->compon;
    entry* norm=(g->root_norm=mkvector(g->roots->nrows))->compon;
    entry* alpha_wt=mkintarray(r);
      /* space to convert roots to weight coordinates */
    setlonglife(g->roots),
    setlonglife(g->level),
    setlonglife(g->root_norm); /* permanent data */
    
    { _index i,j;  for (i=0; i<r; ++i)  for (j=0; j<r; ++j) posr[i][j] = i==j;
      level[0]=0; last_root=r;
      for (i=0; i<r; ++i) norm[i]=1; /* norms are mostly |1| */
      switch (g->lietype) /* here are the exceptions */
      {	    case 'B': 
        for (i=0; i<r-1; ++i) norm[i]=2; /* $2,2,\ldots,2,1$ */
       break; case 'C': norm[r-1]=2; /* $1,1,\ldots,1,2$ */
       break; case 'F': norm[0]=norm[1]=2; /* $2,2,1,1$ */
       break; case 'G': norm[1]=3; /* $ 1,3$ */
      }
    }
    for (l=0; last_root>level[l]; ++l)
    { level[l+1]=last_root; /* set beginning of a new level */
      for (i=level[l]; i<level[l+1]; ++i)
	
	{ _index j,k; entry* alpha=posr[i];  mulvecmatelm(alpha,cartan,alpha_wt,r,r);
	    /* get values $\<\alpha,\alpha_j>$ */
	  for (j=0; j<r; ++j) /* try all fundamental roots */
	  { entry new_norm; 
	    
	    { if (alpha_wt[j]<0) /* then $\alpha+\alpha_j$ is a root; find its norm */
	        if (norm[j]==norm[i]) new_norm=norm[j]; /* |alpha_wt[j]==-1| */
	        else new_norm=1; /* regardless of |alpha_wt[j]| */
	      else if (norm[i]>1 || norm[j]>1) continue; /* both roots must be short now */
	      else if (strchr("ADE",g->lietype)!=NULL) continue;
	        /* but long roots must exist */
	      else if (alpha_wt[j]>0)
	        if (g->lietype!='G'||alpha_wt[j]!=1) continue;  else new_norm=3;
	        /* $[2,1]\to[3,1]$ for $G_2$ */
	      else if (alpha[j]==0) continue;
	        /* $\alpha-\alpha_j$ should not have a negative entry */
	      else
	      { 
	        { --alpha[j]; 
	          for (k=level[l-1]; k<level[l]; ++k) 
	            if (eqrow(posr[k],alpha,r)) break;
	          ++alpha[j]; 
	          if (k==level[l]) continue;
	        }
	      new_norm=2; }
	    }
	    ++alpha[j]; /* temporarily set $\alpha\K\alpha+\alpha_j$ */
	    for (k=level[l+1]; k<last_root; ++k)
	      if (eqrow(posr[k],alpha,r)) break;
	      /* if already present, don't add it */
	    if (k==last_root)
	      { norm[last_root]=new_norm; copyrow(alpha,posr[last_root++],r); }
	    --alpha[j]; /* restore |alpha| */
	  }
	}
    }
    freearr(alpha_wt); return g->roots;
  }
}
示例#17
0
文件: symg.c 项目: nhatcher/lie
poly* MN_char(entry* lambda, lie_Index l)
{ lie_Index n=check_part(lambda,l);
  if (n==0) return poly_one(0); /* the character of $\Sym0$ */
  while (lambda[l-1]==0) --l; /* minimise |l| */
  wt_init(n); /* get ready for accumulating contributions to the character */
  { 
    entry* mu=mkintarray(3*n),* save=mu+n,* lambda_prime=save+n;
    int i, j, r, d=lambda[0]+l, k=0; /* sum of leg lengths */
    boolean* edge=alloc_array(boolean,2*d-2),* candidate=edge+d-2;
      /* lie_Index |2<=r<d| */
    enum {hor, vert}; /* values used for |edge| */
    
    for (i=0; i<n; ++i) mu[i]=0;
    
    { int r=l-1,c=0; /* current column number */
      for (j=0; r>=0; --r)
      { while (c<lambda[r]) { edge[j++]=hor; ++c; } /* columns of length |r| */
        edge[j++]=vert; /* row |r|, of length |c==lambda[r]| */
      }
    }
    
    for (r=2; r<d; ++r)
    { for (j=0; j+r<d; ++j)
        if (edge[j]==hor && edge[j+r]==vert) break;
      candidate[r]= j+r<d;
    }
    

    
    { i=0; /* index of last entry that was set in~|mu| */
      for (r=d-1; r>1; --r) /* try hooks of size |r| */
        if (candidate[r])
        { recurse: /* recursive starting point */
          
          { for (j=1; j<r; ++j) k+=edge[j]; /* leg length of hook first tried */
            for (j=0; j<d-r; ++j)
            { if (edge[j]==hor && edge[j+r]==vert)
              { edge[j]=vert; edge[j+r]=hor; mu[i]=r; save[i++]=j; goto recurse;
              resume: j=save[--i]; r=mu[i]; mu[i]=0; edge[j]=hor; edge[j+r]=vert;
              }
              k+= edge[j+r]-edge[j+1]; /* adjust |k| for hook tried next */
            }
            while (++j<d) k-= edge[j]; /* restore |k| */
          }
        }
    }
    
    { int r=l,c=0,s=0; /* size of |lambda_prime| */
      for (j=0; r>0; )
        if (edge[j++]==vert) s+=lambda_prime[--r]=c;  else ++c;
        /* build |lambda_prime| from edges */
      for (j=0; j<s; ++j) mu[i++]=1; /* extend |mu| with |s| ones */
      wt_ins(mu,n_tableaux(lambda_prime,l),k%2);
      for (j=0; j<s; ++j) mu[--i]=0; /* remove the ones again */
    }
    if (i>0) goto resume;
    
     
    { freearr(edge); freearr(mu); }
  }
  return wt_collect();
}
示例#18
0
文件: closure.c 项目: nhatcher/lie
local simpgrp* simp_type(entry** m, entry n)
{ matrix* adjs=mkmatrix(n,3);
  entry** adj=adjs->elm /* |adj[i]| lists up to 3 neighbours of node |i| */
  ,* norm=mkintarray(3*n) /* norms of roots */
  ,* valency=&norm[n] /* valencies in Dynkin diagram */
  ,* p=&valency[n]; /* permutation of |n| */
  simpgrp* result;
  lie_Index i,j,k, a_val[4]={-1,-1,-1,-1};
    /* |a_val[i]| is index of a node of valency |i|, if any */

  if (n==0) error("empty input in simp_type\n");
  
  { for (i=0;i<n;i++) valency[i]=0;
      /* |valency[i]| is also index of next slot in |adj[i]| */
    for (i=n; --i>=0;)
    { norm[i]= Norm(m[i]); /* where |Norm(x)==Inprod(x,x)/2| */
      for (j=i; --j>=0;)
        if (Inprod(m[i],m[j])!=0) /* then valencies increase */
        { if (valency[i]>=3 || valency[j]>=3) error ("valency >3 found\n");
  	adj[i][valency[i]++]=j; adj[j][valency[j]++]=i;
  	/* update valencies and adjacencies */
        }
      a_val[valency[i]]=i; /* valency of node |i| is now known */
    }
  }
  if (a_val[3]<0)
  
  { lie_Index e; /* index of end node (|valency[e]<=1|) */
    if (a_val[0]>=0) p[0]=e=a_val[0]; /* must be type $A_1$ */
    else
    { if (a_val[1]>=0) p[0]=e=a_val[1]; /* other linear types */
      else error("no end node found\n");
  
      
      { k=p[1]=adj[e][0]; /* the unique neighbour of node |e| */
        for(i=2;i<n;i++)  p[i]=k=opposite(p[i-2],k); /* here |k==p[i-1]| */
      }
      
      if ( n==2 && norm[p[0]]+2*norm[p[1]]==5
        || n>=3 && norm[p[0]]!=norm[p[1]]
        || n==4 && norm[p[1]]<norm[p[2]]
         )
      { for (i=0; i<n-1-i; i++) swap(&p[i],&p[n-1-i]); e=p[0]; }
    }
    
    { entry norm0=norm[p[0]], norm1=norm[p[n-1]];
      if (norm0==norm1) result = mksimpgrp('A',n);
      else if (norm1==3) result=mksimpgrp('G',2);
      else if (norm1==2) result=mksimpgrp('C',n);
      else if (norm0!=2) error("I don't recognize this Cartan Type\n");
      else if (n==4 && norm[p[2]]==1) result=mksimpgrp('F',4);
      else result=mksimpgrp('B',n);
    }
  }
 /* no nodes of valency 3 */
  else 
       { entry* branch=adj[a_val[3]], end[3], end_count=0;
         for (j=2; j>=0; j--)
           if (valency[branch[j]]==1) end[end_count++]=branch[j];
         if (end_count>1) 
                         { p[n-1]=end[1]; p[n-2]=end[0]; p[n-3]=a_val[3];
                           k=p[n-4]=branch[0]+branch[1]+branch[2]-p[n-1]-p[n-2];
                             /* the remaining branch */
                           for(i=n-5; i>=0; i--)
                           { if (valency[k]!=2) error("unlinear Dn tail.\n");
                             p[i]=k=opposite(p[i+2],k);
                           }
                           result=mksimpgrp('D',n);
                         }
         else if (end_count==1) 
                              { p[3]=a_val[3]; p[1]=end[0];
                                for (j=2; j>=0; j--)
                                  if (valency[branch[j]]==2)
                                    if (valency[opposite(a_val[3],branch[j])]==1) break;
                                if (j<0) error("type E not recognised\n");
                                p[2]=branch[j]; p[0]=opposite(p[3],p[2]);
                                p[4]=k=branch[0]+branch[1]+branch[2]-p[1]-p[2]; /* remaining branch */
                                for(i=5;i<n;i++)
                                { if (valency[k]!=2) error("wrong type E system.\n");
                                  p[i]=k=opposite(p[i-2],k);
                                }
                                result=mksimpgrp('E',n);
                              }
         else error("no end node adjacent to valency 3 node\n");
       }
  
  for (i=0; i<n; i++) if (p[i]>=0) /* then |p[i]| starts an untreated cycle */
  { entry* mi=m[j=i]; /* record beginning of cycle */
    while (p[j]!=i)
      { k=j; j=p[j]; m[k]=m[j]; p[k]= -1; }
        /* assign |m[j]=m[p[j]]| and advance */
    m[j]=mi; p[j]= -1; /* close the cycle */
  }
  freemem(adjs); freearr(norm);
  return result;
}