
# LAST EDIT: Mon Jan  4 14:21:22 1993 by Axel Boldt (6500axel@ucsbuxa.ucsb.edu)

coxpoly := proc(kbaum,T,V)
#
# Computes the coxeterpolynomial of the rooted cycletree described by
# the symbol kbaum at T. If the optional parameter V is present and V
# and T are names, then the result will contain the abbreviation V(j)
# for (T^j-1)/(T-1).
# See the help-text at the end of this file for a description of the
# structure of valid symbols for rooted cycletrees.
#
#
  local resultat,W;

  # coxpoly's argument must not be a single $-expression. We have to
  # check this here, because coxpoly1 accepts these expressions.
  if type(kbaum,function) and op(0,kbaum)=`$` then
    ERROR(`$-expressions are not allowed as arguments `,
          kbaum)
  fi;

  if not(type(`&Chi`,name) and type(`&chi`,name)) then
    print(`WARNING: &chi and &Chi should be Names without values.`);
  fi;

  # coxpoly1 yields the coxeterpolynomial of kbaum as well as that of
  # the cycletree resulting from deletion of kbaum's root. Here, we
  # are only interested in the former:
  resultat:=`coxpoly/coxpoly1`(kbaum,T,W)[1];

  # Deal with the abbreviation V:
  if nargs=3 then
    if not( type (T,name) and type(V,name)) then
      ERROR(`the second and third argument must be names.`)
    fi;
    W:=proc(j,U)
      if   j=-1 then RETURN(-U^(-1))
      elif j=0  then RETURN(0)
      elif j=1  then RETURN(1)
      else RETURN ('procname'(args[1]))
      fi;
    end;
    # Substitute V for W in the result, but deal with W(-1,U), W(0,U)
    # and W(1,U) separately.
    RETURN(subs(W=V,eval(resultat)))
  else
    if T=1 then
      W:=proc(j,U)
        RETURN (j) # V(j) has the value j at 1.
      end
    elif T=0 then
      W:=proc(j,U)
        if j=0 then
          RETURN(0)
        else
          RETURN(1)
        fi
      end
    else
      W:=proc(j,U)
        if   j=-1 then RETURN(-U^(-1))
        elif j=0  then RETURN(0)
        elif j=1  then RETURN(1)
        elif j=2  then RETURN(U+1)
        # If Maple computed x^j as x*x*...*x, then we would have to
        # place a routine here which is able to compute x^j in time
        # O(log(j)):
        else RETURN((U^j-1)/(U-1))
        fi
      end
    fi;

    # Now replace W by its definition:
    RETURN(normal(eval(resultat),expanded))
  fi
end:



####
#### The subprocedures for coxpoly:
####

`coxpoly/is_nat_number_expr`:= proc(s)

# Determines if s is an expression denoting a natural number
# (i.e. s is a natural number or the names and functionnames
# in s start with lower case letters).

  evalb( type(s,posint) or `coxpoly/is_number_expr`(s) )

end:




`coxpoly/is_number_expr`:= proc(s)

# Determines if s is an expression denoting a whole number (i.e. if
# the names and functionnames in s start with lower case letters).

  local result,opnd;
  option remember;

  if type(s,string) then
    RETURN( evalb( lexorder('a',s) # Attention: 'a' and NOT `a`!
                   and lexorder(s,'zzzz') ) ) # well, not exactly...
  elif type(s,function) or type(s,indexed) then
    RETURN(`coxpoly/is_number_expr`(op(0,s)))
  elif type(s,integer) then
    RETURN(true)
  elif type(s,`+`) or type(s,`*`) or type(s,`^`) then
    # Check now all operands of s:
    result:=true;
    for opnd in op(s) while result do
      result := `coxpoly/is_number_expr`(opnd)
    od;
    RETURN(result)
  else
    RETURN(false)
  fi
end:



`coxpoly/is_kbaum_name` := proc(s)

# Determines if s is the name of a generalized rooted cycletree
# (starting with an upper case letter)

  option remember;

  if type(s,string) then
    RETURN( evalb ( lexorder('A',s)
                    and lexorder(s,'ZZZZ') ) )
  elif type(s,function) or type(s,indexed) then
    RETURN(`coxpoly/is_kbaum_name`(op(0,s)))
  else
    RETURN(false)
  fi
end:






`coxpoly/coxpoly1` := proc(kbaum,T,V)

# Let p1 be the coxeterpolynomial of kbaum and p2 be that of the graph
# resulting from deletion of kbaum's root. coxpoly1 returns a list of the
# values of p1 and p2 at T. In the result, V(j,T) stands as a abbreviation
# for (T^j-1)/(T-1), j>=-2.

  local n,r,k,p,q,i,j,t,u,result,dummy_p1,dummy_q1,G,
        erst_opnd,kanten,pkte,result_ohne_wurzel,zweit_opnd;
  option remember;

##############################
  if `coxpoly/is_nat_number_expr`(kbaum) then
    RETURN( V(kbaum+1,T),
            V(kbaum,T)
          )
##############################
  elif type(kbaum,function) and op(0,kbaum)=`&*` then
    if nops(kbaum)<>2 then
      ERROR(`The operator &* needs two operands `,kbaum)
    fi;
    erst_opnd:=op(1,kbaum);
    if type(erst_opnd,function) and op(0,erst_opnd)=`&*` then
      # We have to take care that chains like n1 &* n2 &* n3 &* ...
      # are evaluated as n1 &* ( n2 &* ( n3 &* ... ))) :
      RETURN(`coxpoly/coxpoly1`(op(1,erst_opnd)&*
                                  (op(2,erst_opnd)&*op(2,kbaum)),
                                T,
                                V)
            )
    elif type(op(2,kbaum),function) and op(0,op(2,kbaum))=`$` then
      ERROR(`The second operand of &* must not be an $-expression `,
            kbaum)
    elif `coxpoly/is_nat_number_expr`(erst_opnd) then
      p:=`coxpoly/coxpoly1`(op(2,kbaum),T,V);
      RETURN( V(erst_opnd,T)*p[1]-T*V(erst_opnd-1,T)*p[2],
              V(erst_opnd-1,T)*p[1]-T*V(erst_opnd-2,T)*p[2]
            )
    elif type(erst_opnd,function) and op(0,erst_opnd)=`&K` then
      if not(  nops(erst_opnd)=1 and
               `coxpoly/is_nat_number_expr`(op(1,erst_opnd))
            )
      then
        ERROR(`&K needs a natural number as argument `,kbaum)
      fi;
      p:=`coxpoly/coxpoly1`(op(2,kbaum),T,V);
      RETURN( V(2,T)*p[1]-op(1,erst_opnd)^2*T*p[2],
              p[1]
            )
    else
      ERROR(`the first operand of &* must have the form n or &K(n) with n>=1 `,
            kbaum)
    fi
##############################
  elif type(kbaum,list) then
    t:=nops(kbaum);
    for i from 1 to t do
      p[i]:=`coxpoly/coxpoly1`(kbaum[i],T,V)
    od;
    RETURN( product('p[i][2]','i'=1..t)
              *(sum('p[i][1]/p[i][2]','i'=1..t)-(t-1)*V(2,T)),
            product('p[i][2]','i'=1..t)
          )
##############################
  elif `coxpoly/is_kbaum_name`(kbaum) then
    RETURN( &Chi(kbaum),
            &chi(kbaum)
          )
##############################
  elif type(kbaum,function) and op(0,kbaum)=`&C` then
    if nops(kbaum)=0 then
      ERROR(`&C needs at least one argument `,kbaum)
    fi;
    kanten:=op(1,kbaum);
    if not( type(kanten,list) and nops(kanten)=2 and
            `coxpoly/is_nat_number_expr`(kanten[1]) and
            `coxpoly/is_nat_number_expr`(kanten[2])
          )
    then
      ERROR(`The first argument of &C must be a list of two natural numbers `,
                  kbaum)
    fi;
    if nops(kbaum)=1 then
      RETURN( (T^kanten[1]-1)*(T^kanten[2]-1),
              V(kanten[1]+kanten[2],T)
            )
    elif type(nops(kbaum),odd) then
      ERROR(`&C needs one or an even number of arguments `,
                 kbaum)
    fi;
    t:=nops(kbaum)/2-1;
    # t is the number of graphs attached to the circle.
    #
    # Determine for i=t..1 the coxeterpolynomial u[i] of the linear
    # graph going from the root of kbaum to the root of the i-th
    # attached graph (excluding the latter).
    u[t+1]:=0;
    pkte:=-1;
    for j from t by -1 to 1 do
      k:=op(2*j+2,kbaum);
      if ( type(k,integer) and k<=1 ) or
           not `coxpoly/is_number_expr`(k)
      then
        ERROR(`The arguments l,n1,c1,..,nt,ct of &C should have the following`.
              ` type: l is a list of 2 numbers; n1,..,nt are integers >=2`.
              ` and  c1,..,ct are symbols for cycletrees `,
              kbaum)
      fi;
      u[j]:=(T*u[j+1]+1)*V(k-1,T)+u[j+1]*V(k,T)-V(2,T)*u[j+1]*V(k-1,T);
      pkte:=pkte+k-1
    od;
    #
    result:=(T^kanten[1]-1)*(T^kanten[2]-1);
    # At the beginning, result is the coxeterpolynomial of the circle
    # with no attached graphs. Now, we successively attach the graphs
    # to the circle and change result accordingly.
    n:=op(2,kbaum);
    # n is always the point-distance from the root of the last to the
    # root of the actual considered graph.
    if ( type(n,integer) and n<=1 )
       or not `coxpoly/is_number_expr`(n)
    then
      ERROR(`The arguments l,n1,c1,..,nt,ct of &C should have the following`.
            ` type: l is a list of 2 numbers; n1,..,nt are integers >=2`.
            ` and  c1,..,ct are symbols for cycletrees `,
            kbaum)
    fi;
    if normal(pkte+n-kanten[1]-kanten[2]) <> 0 then
      ERROR(`The numerical data in the &C-expression is not consistent `,
            kbaum)
    fi;
    p[1]:=V(n+1,T);
    p[2]:=V(n,T);
    # p denotes the coxeterpolynomials of the graph K, which consists
    # of the part of kbaum from its root to the root of the actual considered
    # graph (excluding the actual considered graph). The root of K
    # is the root of the actual considered graph.
    q[1]:=V(n,T);
    q[2]:=V(n-1,T);
    # q denotes the coxeterpolynomials of the graph resulting from
    # deletion of kbaum's root from K.
    for i from 1 to t do
      result_ohne_wurzel:=p[2]*u[i]+q[2]*(T*u[i]+1)-V(2,T)*q[2]*u[i];
      # Let Q be the cyletree, the coxeterpolynomial of which is result.
      # result_ohne_wurzel is the coxeterpolynomial of the graph resulting
      # from deletion of the root of the actual considered i-th graph from Q.
      #
      G:=op(2*i+1,kbaum);
      # G is the actual considered graph.
      if type( G,function) and op(0,G)=`$`
      then
        ERROR(`&C-expressions must not contain $-expressions.`,
                   kbaum)
      fi;
      # Compute result, the coxeterpolynomial of Q.
      r:=`coxpoly/coxpoly1`(G,T,V);
      result:=result*r[2]+result_ohne_wurzel*r[1]
               -V(2,T)*result_ohne_wurzel*r[2];
      n:=op(2*i+2,kbaum);
      if ( type(n,integer) and n<=1 )
         or not `coxpoly/is_number_expr`(n)
      then
        ERROR(`The arguments l,n1,c1,..,nt,ct of &C should have the following`.
              ` type: l is a list of 2 numbers; n1,..,nt are integers >=2`.
              ` and  c1,..,ct are symbols for cycletrees `,
              kbaum)
      fi;
      # Compute the new p and the new q:
      r:=`coxpoly/coxpoly1`([G,n],T,V); # Note that the coxeterpolynomial of G
                                        # has not to be computed once again
                                        # because of option remember.
      dummy_p1:=p[1]*r[2]+p[2]*r[1]-V(2,T)*p[2]*r[2];
      dummy_q1:=q[1]*r[2]+q[2]*r[1]-V(2,T)*q[2]*r[2];
      r:=`coxpoly/coxpoly1`([G,n-1],T,V); # s.o.
      p[2]:=p[1]*r[2]+p[2]*r[1]-V(2,T)*p[2]*r[2];
      q[2]:=q[1]*r[2]+q[2]*r[1]-V(2,T)*q[2]*r[2];
      p[1]:=dummy_p1;
      q[1]:=dummy_q1;
    od;
    RETURN( result,
            q[2]
          )
##############################
  elif type(kbaum,function) and op(0,kbaum)=`$` then
    if nops(kbaum)<>2 then
      ERROR(`The operator $ needs two arguments`,kbaum)
    fi;
    p:=`coxpoly/coxpoly1`(op(1,kbaum),T,V);
    zweit_opnd:=op(2,kbaum);
    if `coxpoly/is_nat_number_expr`(zweit_opnd) then
      RETURN( p[2]^(zweit_opnd - 1) *
               (zweit_opnd * p[1]-(zweit_opnd - 1)*V(2,T)* p[2]),
              p[2]^zweit_opnd
            )
    elif type(zweit_opnd,`=`) and
         # the running variable must begin with a lower case letter!
         `coxpoly/is_number_expr`(op(1,zweit_opnd)) and
         type(op(1,zweit_opnd),name) and
         type(op(2,zweit_opnd),range)
    then
      # We return Sum and Product instead of sum and product.
      # This results in an tremendous save of computingtime, because
      # sum and product would try to simplify right away, which is
      # not desired here.
      if type(T,numeric) then
        RETURN( product(p[2],zweit_opnd)*
                 (sum(p[1]/p[2],zweit_opnd)-
                 (op(2,op(2,zweit_opnd))-op(1,op(2,zweit_opnd)))*V(2,T)),
                product(p[2],zweit_opnd)
              )
      else
        RETURN( Product(p[2],zweit_opnd)*
                 (Sum(p[1]/p[2],zweit_opnd)-
                 (op(2,op(2,zweit_opnd))-op(1,op(2,zweit_opnd)))*V(2,T)),
                Product(p[2],zweit_opnd)
              )
      fi
    else
      ERROR(`The second argument to $ should be a natural number or an `.
            `equation of the form name=range.`,
            kbaum)
    fi
##############################
  elif type(kbaum,function) and op(0,kbaum)=`&K` then
    if not( nops(kbaum)=1 and `coxpoly/is_nat_number_expr`(op(1,kbaum))
          )
    then
      ERROR(`The operator &K needs a s argument a natural number `,
            kbaum)
    fi;
    RETURN( V(2,T)^2-op(1,kbaum)^2*T,
            V(2,T)
          )
##############################
  else
    ERROR(`This is no valid symbol for a rooted cycletree. `.
          `Allowed operators are &*, &K, &C and [..]. `
          ,kbaum)
  fi

end:


`help/text/coxpoly`:=TEXT(
`FUNCTION: coxpoly - compute the Coxeterpolynomial of a cycletree `,
` `,
`CALLING SEQUENCE: `,
`    coxpoly(cyctree,T,V); `,
` `,
`PARAMETERS: `,
`    cyctree - an expression denoting a cycletree as described below `,
`    T       - an expression `,
`    V       - an optional name `,
` `,
`SYNOPSIS: `,
`- cyctree denotes the equivalence class of an orientation of a rooted `,
`  cycletree without oriented cycles. The value of the corresponding `,
`  Coxeterpolynomial (which ist the characteristic polynomial of the `,
`  Coxetermatrix) at T is returned. `,
` `,
`- if T is a number and if we assume that addition and multiplication `,
`  of numbers are constant operations, then the procedure computes the `,
`  value of the coxeterpolynomial at T in a time proportional to the length `,
`  of the symbol cyctree.`,
` `,
`- if the third parameter V is present, T and V must be names. In the `,
`  result, V(j) stands for (T^j-1)/(T-1) (this term appears often). `,
` `,
`- a cycletree is an undirected, connected graph every two `,
`  distinct simple cycles of which are edge-disjoint. Multiple edges `,
`  are allowed (but not in cycles). Loops are not allowed.`,
` `,
`- a rooted graph is a graph together with one of its points,`,
`  which is called its root.`,
` `,
`- two orientations of a cycletree are said to be equivalent if the `,
`  first can be transformed to the second using only reflections at `,
`  sinks or sources. `,
` `,
`- two equivalent orientations of a cycletree yield similar Coxeter-`,
`  matrices of the corresponding (hereditary) path-algebras. Their`,
`  characteristic polynomial is called the Coxeterpolynomial of the`,
`  equivalence class.`,
` `,
`- the linear graph with n points is denoted by n. (The root is one `,
`  end.) `,
` `,
`- the graph with two points and a n-fold edge between them is denoted `,
`  by &K(n) `,
` `,
`- if u is the symbol of a linear graph or a multiple edge and S is `,
`  any symbol denoting a rooted cycletree, then u&*S stands for the `,
`  identification of one end of u with the root of S. The root of u&*S `,
`  is the other end of u. `,
` `,
`- if S1,...,St are symbols, then [S1,...,St] denotes the class of the `,
`  graph resulting from identifying the roots of S1,...,St to one `,
`  point, the root of [S1,...,St]. `,
` `,
`- if S1,...,St are symbols and p,q,n_1,...,n_(t+1) are natural `,
`  numbers with n_i>=2 and n_1+...+n_(t+1) = p+q+t+1, then `,
`  &C([p,q],n_1,S1,n_2,S2,...,St,n_(t+1)) stands for the graph `,
`  resulting from identifying the root of n_1 with the free end of `,
`  n_(t+1) to a new root in n_1&*[S1,n_2&*[...n_t&*[St,n_(t+1)]...]]. `,
`  Of the p+q edges of the cycle, p are oriented clockwise and q `,
`  counterclockwise. `,
` `,
`- &C([p,q]) is an abbreviation for &C([p,q],p+q+1) `,
` `,
`- in the above, the S,S1,...,St are allowed to be unevaluated `,
`  (perhaps indexed) names beginning with capital letters. The `,
`  Coxeterpolynomial is then computed symbolically using &Chi(S) for `,
`  the Coxeterpolynomial of S and &chi(S) for the Coxeterpolynomial `,
`  of the graph resulting from deletion of the root of S. Here, S stands `,
`  for an arbitrary, noncyclic orientated, rooted graph, not necessary a`,
`  cycletree.`,
` `,
`- in the above, n,p,q,n_1,...,n_(t+1) are allowed to be `,
`  expressions containing unevaluated (perhaps indexed) names all of `,
`  which have to begin with lower case letters. The Coxeterpolynomial`,
`  is then computed symbolically using these names as parameters. `,
` `,
`- you can use (possibly nested) $-expressions in lists: [A(i)$i=1..t] `,
`  is the same as [A(1),...,A(t)], even if t is an unevaluated name. `,
` `,
`- you may have to substitute "sum" for "Sum" and "product" for "Product"`,
`  in the result and simplify afterwards if you want to evaluate the result`,
`  for concrete values of the parameters.`,
` `,
`EXAMPLES: `,
`> coxpoly([B1,B2],T); `,
` `,
`> coxpoly(4 &* [ 3, &C( [4,5], 4, &K(3), 3, &C([3,3]), 5) ], U); `,
` `,
`> coxpoly([ p(i)&*[2,2] $ i=1..t ],1); `,
` `,
`SEE ALSO: `,
`  The detailed explanation of the algorithm and the determination of`,
`  its running time is contained in the Diplomarbeit of Axel Boldt,`,
`  titled "Coxetertransformationen", Paderborn/Germany 1992, obtainable,`,
`  via e-mail from axel@uni-paderborn.de. `
):

#save `coxpoly.m`;
#quit
