diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /web/reduce |
Initial commit
Diffstat (limited to 'web/reduce')
24 files changed, 14458 insertions, 0 deletions
diff --git a/web/reduce/rweb/Makefile b/web/reduce/rweb/Makefile new file mode 100644 index 0000000000..fb2f271003 --- /dev/null +++ b/web/reduce/rweb/Makefile @@ -0,0 +1,144 @@ +# Copyright 1989 by Norman Ramsey, Odyssey Research Associates. +# To be used for research purposes only. +# For more information, see file COPYRIGHT in the parent directory. + +HOME=/users/redusers# # Make no longer inherits environment vars + +THETANGLE=tangle +THEWEAVE=weave +SPIDER=any.spider +# +DVI=dvi +CFLAGS=-DDEBUG -g -DSTAT + +# CPUTYPE is a grim hack that attempts to solve the problem of multiple +# cpus sharing a file system. In my environment I have to have different +# copies of object and executable for vax, sun3, next, iris, and other +# cpu types. If you will be using Spidery WEB in a homogenous processor +# environment, you can just set CPUTYPE to a constant, or eliminate it +# entirely. +# +# In my environment, the 'cputype' program returns a string that +# describes the current processor. That means that the easiest thing +# for you to do is to define a 'cputype' program that does something +# sensible. A shell script that says 'echo "vax"' is fine. + +CPUTYPE=`cputype` + +# Change the following three directories to match your installation +# +# the odd placement of # is to prevent any trailing spaces from slipping in + +WEBROOT=$(HOME)/spider# # root of the WEB source distribution +DEST=$(HOME)/bin# # place where the executables go +MACROS=$(HOME)/tex/inputs# # place where the macros go + +MASTER=$(WEBROOT)/master# # master source directory +OBDIR=$(MASTER)/$(CPUTYPE)# #common object files + +TANGLESRC=tangle +CTANGLE=ceetangle -I$(MASTER) +CWEAVE=ceeweave -I$(MASTER) +AWKTANGLE=awktangle -I$(MASTER) +COMMONOBJS=$(OBDIR)/common.o $(OBDIR)/pathopen.o +COMMONC=$(MASTER)/common.c $(MASTER)/pathopen.c +COMMONSRC=$(COMMONC) $(MASTER)/spider.awk + + +# Our purpose is to make tangle and weave + +web: tangle weave + +tangle: mktangle + +mktangle: $(COMMONOBJS) $(TANGLESRC).o + $(CC) $(CFLAGS) -o $(DEST)/$(THETANGLE) $(COMMONOBJS) $(TANGLESRC).o + +weave: $(COMMONOBJS) weave.o + $(CC) $(CFLAGS) -o $(DEST)/$(THEWEAVE) $(COMMONOBJS) weave.o + +source: $(TANGLESRC).c $(COMMONSRC) # make tangle.c and common src, then clean + if [ -f WebMakefile ]; then exit 1; fi # don't clean the master! + if [ -f spiderman.tex ]; then exit 1; fi # don't clean the manual + -rm -f tangle.web weave.* common.* # remove links that may be obsolete + -rm -f *.unsorted *.list grammar.web outtoks.web scraps.web + -rm -f cycle.test spider.slog + -rm -f *.o *.tex *.toc *.dvi *.log *.makelog *~ *.wlog *.printlog + +# Here is how we make the common stuff + +$(MASTER)/common.c: $(MASTER)/common.web # no change file + $(CTANGLE) $(MASTER)/common + +$(OBDIR)/common.o: $(MASTER)/common.c + $(CC) $(CFLAGS) -c $(MASTER)/common.c + mv common.o $(OBDIR) + +$(MASTER)/pathopen.c: $(MASTER)/pathopen.web # no change file + $(CTANGLE) $(MASTER)/pathopen + mv pathopen.h $(MASTER) + +$(OBDIR)/pathopen.o: $(MASTER)/pathopen.c + $(CC) $(CFLAGS) -c $(MASTER)/pathopen.c + mv pathopen.o $(OBDIR) + +$(OBDIR): + if /bin/test ! -d $(OBDIR) ; then mkdir $(OBDIR) ; fi + +## Now we make the tangle and weave source locally + +$(TANGLESRC).c: $(MASTER)/$(TANGLESRC).web $(MASTER)/common.h grammar.web rtangle.ch + -/bin/rm -f $(TANGLESRC).web + ln $(MASTER)/$(TANGLESRC).web $(TANGLESRC).web +# chmod -w $(TANGLESRC).web + $(CTANGLE) $(TANGLESRC) rtangle.ch + +weave.c: $(MASTER)/weave.web $(MASTER)/common.h grammar.web rweave.ch + -/bin/rm -f weave.web + ln $(MASTER)/weave.web weave.web +# chmod -w weave.web + $(CTANGLE) weave rweave.ch + +## Here's where we run SPIDER to create the source + +grammar.web: $(MASTER)/cycle.awk $(MASTER)/spider.awk $(SPIDER) + echo "date" `date` | cat - $(SPIDER) | awk -f $(MASTER)/spider.awk + cat $(MASTER)/transcheck.list trans_keys.unsorted | awk -f $(MASTER)/transcheck.awk + awk -f $(MASTER)/cycle.awk < cycle.test + sort *.unsorted | awk -f $(MASTER)/nodups.awk + mv *web.tex $(MACROS) + +## We might have to make spider first. + +$(MASTER)/spider.awk: $(MASTER)/spider.web + $(AWKTANGLE) $(MASTER)/spider + mv cycle.awk nodups.awk transcheck.awk $(MASTER) + rm junk.list + + +# $(MASTER)/cycle.awk: $(MASTER)/cycle.web # making spider also makes cycle +# $(AWKTANGLE) $(MASTER)/cycle + + +# This cleanup applies to every language + +clean: + if [ -f WebMakefile ]; then exit 1; fi # don't clean the master! + if [ -f spiderman.tex ]; then exit 1; fi # don't clean the manual + -rm -f tangle.* weave.* common.* # remove links that may be obsolete + -rm -f *.unsorted *.list grammar.web outtoks.web scraps.web + -rm -f cycle.test spider.slog + -rm -f *.c *.o *.tex *.toc *.dvi *.log *.makelog *~ *.wlog *.printlog + + + +# booting the new distribution +boot: + cd ../master; rm -f *.o; for i in $(COMMONC); do \ + $(CC) $(CFLAGS) -c $$i; \ + mv *.o $(OBDIR) ; \ + done; cd ../c + $(CC) $(CFLAGS) -c $(TANGLESRC).c; \ + $(CC) $(CFLAGS) -o $(DEST)/$(THETANGLE) $(COMMONOBJS) $(TANGLESRC).o + + diff --git a/web/reduce/rweb/Makefile3.3 b/web/reduce/rweb/Makefile3.3 new file mode 100644 index 0000000000..0ed80e2775 --- /dev/null +++ b/web/reduce/rweb/Makefile3.3 @@ -0,0 +1,152 @@ +# Copyright 1989 by Norman Ramsey, Odyssey Research Associates. +# To be used for research purposes only. +# For more information, see file COPYRIGHT in the parent directory. + +HOME=/users/redusers# # Make no longer inherits environment vars + +THETANGLE=tangle +THEWEAVE=weave +SPIDER=any.spider +# +DVI=dvi +CFLAGS=-DDEBUG -g -DSTAT + +# CPUTYPE is a grim hack that attempts to solve the problem of multiple +# cpus sharing a file system. In my environment I have to have different +# copies of object and executable for vax, sun3, next, iris, and other +# cpu types. If you will be using Spidery WEB in a homogenous processor +# environment, you can just set CPUTYPE to a constant, or eliminate it +# entirely. +# +# In my environment, the 'cputype' program returns a string that +# describes the current processor. That means that the easiest thing +# for you to do is to define a 'cputype' program that does something +# sensible. A shell script that says 'echo "vax"' is fine. + +CPUTYPE=`cputype` + +# Change the following three directories to match your installation +# +# the odd placement of # is to prevent any trailing spaces from slipping in + +WEBROOT=$(HOME)/spider# # root of the WEB source distribution +DEST=$(HOME)/bin# # place where the executables go +MACROS=$(HOME)/tex/inputs# # place where the macros go + +MASTER=$(WEBROOT)/master# # master source directory +OBDIR=$(MASTER)/$(CPUTYPE)# #common object files + +TANGLESRC=tangle +CTANGLE=ceetangle -I$(MASTER) +CWEAVE=ceeweave -I$(MASTER) +AWKTANGLE=awktangle -I$(MASTER) +COMMONOBJS=$(OBDIR)/common.o $(OBDIR)/pathopen.o +COMMONC=$(MASTER)/common.c $(MASTER)/pathopen.c +COMMONSRC=$(COMMONC) $(MASTER)/spider.awk + + +# Our purpose is to make tangle and weave + +web: tangle weave + +tangle: mktangle underscore + +mktangle: $(COMMONOBJS) $(TANGLESRC).o + $(CC) $(CFLAGS) -o $(DEST)/$(THETANGLE) $(COMMONOBJS) $(TANGLESRC).o + +weave: $(COMMONOBJS) weave.o + $(CC) $(CFLAGS) -o $(DEST)/$(THEWEAVE) $(COMMONOBJS) weave.o + +underscore: $(DEST)/underscore underscore.web + +$(DEST)/underscore: + $(CTANGLE) underscore.web + $(CC) $(CFLAGS) -o $(DEST)/underscore underscore.c + cp rtangle $(DEST)/rtangle3.3 + +source: $(TANGLESRC).c $(COMMONSRC) # make tangle.c and common src, then clean + if [ -f WebMakefile ]; then exit 1; fi # don't clean the master! + if [ -f spiderman.tex ]; then exit 1; fi # don't clean the manual + -rm -f tangle.web weave.* common.* # remove links that may be obsolete + -rm -f *.unsorted *.list grammar.web outtoks.web scraps.web + -rm -f cycle.test spider.slog + -rm -f *.o *.tex *.toc *.dvi *.log *.makelog *~ *.wlog *.printlog + +# Here is how we make the common stuff + +$(MASTER)/common.c: $(MASTER)/common.web # no change file + $(CTANGLE) $(MASTER)/common + +$(OBDIR)/common.o: $(MASTER)/common.c + $(CC) $(CFLAGS) -c $(MASTER)/common.c + mv common.o $(OBDIR) + + +$(MASTER)/pathopen.c: $(MASTER)/pathopen.web # no change file + $(CTANGLE) $(MASTER)/pathopen + mv pathopen.h $(MASTER) + +$(OBDIR)/pathopen.o: $(MASTER)/pathopen.c + $(CC) $(CFLAGS) -c $(MASTER)/pathopen.c + mv pathopen.o $(OBDIR) + +$(OBDIR): + if /bin/test ! -d $(OBDIR) ; then mkdir $(OBDIR) ; fi + +## Now we make the tangle and weave source locally + +$(TANGLESRC).c: $(MASTER)/$(TANGLESRC).web $(MASTER)/common.h grammar.web rtangle.ch + -/bin/rm -f $(TANGLESRC).web + ln $(MASTER)/$(TANGLESRC).web $(TANGLESRC).web +# chmod -w $(TANGLESRC).web + $(CTANGLE) $(TANGLESRC) rtangle.ch + +weave.c: $(MASTER)/weave.web $(MASTER)/common.h grammar.web rweave.ch + -/bin/rm -f weave.web + ln $(MASTER)/weave.web weave.web +# chmod -w weave.web + $(CTANGLE) weave rweave.ch + +## Here's where we run SPIDER to create the source + +grammar.web: $(MASTER)/cycle.awk $(MASTER)/spider.awk $(SPIDER) + echo "date" `date` | cat - $(SPIDER) | awk -f $(MASTER)/spider.awk + cat $(MASTER)/transcheck.list trans_keys.unsorted | awk -f $(MASTER)/transcheck.awk + awk -f $(MASTER)/cycle.awk < cycle.test + sort *.unsorted | awk -f $(MASTER)/nodups.awk + mv *web.tex $(MACROS) + +## We might have to make spider first. + +$(MASTER)/spider.awk: $(MASTER)/spider.web + $(AWKTANGLE) $(MASTER)/spider + mv cycle.awk nodups.awk transcheck.awk $(MASTER) + rm junk.list + + +# $(MASTER)/cycle.awk: $(MASTER)/cycle.web # making spider also makes cycle +# $(AWKTANGLE) $(MASTER)/cycle + + +# This cleanup applies to every language + +clean: + if [ -f WebMakefile ]; then exit 1; fi # don't clean the master! + if [ -f spiderman.tex ]; then exit 1; fi # don't clean the manual + -rm -f tangle.* weave.* common.* # remove links that may be obsolete + -rm -f *.unsorted *.list grammar.web outtoks.web scraps.web + -rm -f cycle.test spider.slog + -rm -f *.c *.o *.tex *.toc *.dvi *.log *.makelog *~ *.wlog *.printlog + + + +# booting the new distribution +boot: + cd ../master; rm -f *.o; for i in $(COMMONC); do \ + $(CC) $(CFLAGS) -c $$i; \ + mv *.o $(OBDIR) ; \ + done; cd ../c + $(CC) $(CFLAGS) -c $(TANGLESRC).c; \ + $(CC) $(CFLAGS) -o $(DEST)/$(THETANGLE) $(COMMONOBJS) $(TANGLESRC).o + + diff --git a/web/reduce/rweb/README b/web/reduce/rweb/README new file mode 100644 index 0000000000..5e4c2c321b --- /dev/null +++ b/web/reduce/rweb/README @@ -0,0 +1,35 @@ +This directory contains all the necessary stuff for making RWEB, the +REDUCE version of WEB. + +Currently I maintain two versions, one for the old REDUCE version 3.3 +and one for the new version 3.4. It should be noted, however, that I only +make improvements on the new 3.4 version. The main difference until +now in both versions, is the removing of underscores in the 3.3 version. + +Along with these files you need a version of SPIDERY WEB, which can be +obtained by anonymous ftp from princeton.edu (128.112.128.1). + +After you have installed SPIDERY WEB you know what it means to put the +files contained in this directory into a new directory $(WEBROOT)/reduce. +Do it. You might as well want to change the variable HOME in +$(WEBROOT)/reduce/Makefile (which is in fact an adapted version of +$(MASTER)/WebMakefile). + +In order to make RWEB, go to $(WEBROOT)/reduce and type 'make weave', +'make tangle' or 'make web', if you want to make rweave, rtangle or +both. The documentation needed for using RWEB is +$(WEBROOT)/doc/spiderwebman.tex. + +Have fun, + +Old address: + +Marcel Roelofs, +University of Twente, +Department of applied mathematics, +P.O. Box 217, +7500 AE Enschede, +The Netherlands. +E-mail: roelofs@math.utwente.nl + +New (941105) roelofs@cwi.nl diff --git a/web/reduce/rweb/appl/integrator.web b/web/reduce/rweb/appl/integrator.web new file mode 100644 index 0000000000..abdfb6a1d2 --- /dev/null +++ b/web/reduce/rweb/appl/integrator.web @@ -0,0 +1,1230 @@ +% Copyright (c) 1991 Marcel Roelofs, University of Twente, Enschede, +% The Netherlands. +% +% $Header: integrator.web,v 0.92 91/12/18 17:39:37 roelofs Exp $ +% +\input specification +\def\Version$#1Revision: #2 ${Version #2} +\def\title{INTEGRATOR} +\font\titlefont=cmcsc10 scaled\magstep3 +\font\ttitlefont=cmtt10 scaled\magstep4 +\def\topofcontents{\null\vfill +\centerline{\titlefont The {\ttitlefont INTEGRATOR} package for REDUCE} +\vskip15pt\centerline{\Version$Revision: 0.92 $} +\vskip15pt\centerline{\sc Marcel Roelofs}\vfill} +\def\enditem{\medskip\noindent\ignorespaces} +\def\pde{p.d.e.} + +@*=Introduction. In this \.{WEB} file we shall describe a REDUCE package for +the integration of overdetermined systems of partial differential +equations (p.d.e.'s). This work is mainly based on a similar package by Paul +Kersten for just the determination of symmetry groups and an extension +by myself which also allows the determination of Wahlquist and +Estabrook prolongation algebras. + +The main reasons for the implementation of this package, are our +improved insight in the internals of REDUCE, the wish to have one +combined integrator for both cases and the availability of substantially +improved versions of some the procedures used in the former packages. + +\medskip + +The ``banner line'' defined here is intended for indentification +purposes on loading. It should be changed whenever this file is +modified. System dependent changes, however, should be made in a +separate change file. + +@d banner="Integrator package for REDUCE 3.4, $Revision: 0.92 $" + +@ We define the following macros for clarity. +@d change_to_symbolic_mode =symbolic +@d change_to_algebraic_mode =algebraic +@d stop_with_error(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,t) @; +@d message(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,nil) @; +@d operator_name_of=car +@d arguments_of=cdr +@d first_argument_of=cadr +@d second_argument_of=caddr +@d first_element_of=car +@d rest_of=cdr +@d skip_list=cdr %Skip the |'list| in front of an algebraic list% +@f function = identifier + +@ The following macros are intended as common programming idioms. +@d incr(x) = (x:=x+1)@; +@d decr(x) = (x:=x-1)@; + +@ A new REDUCE switch can be introduced using the following code. + +@d initialize_global(global_name,value)=@/ +global '(global_name)$@/ +global_name:=value +@d initialize_fluid(fluid_name,value)=@/ +fluid '(fluid_name)$@/ +fluid_name:=value +@d new_switch(switch_name,value)=@/ +initialize_fluid(!* @& switch_name,value)$@/ +flag('(switch_name),'switch) + +@ We do all initializations in the beginning of the package. +@u +change_to_symbolic_mode$@/ +write banner$terpri()$@/ +@<Lisp initializations@>@/ +change_to_algebraic_mode$ + +@*=Integration of overdetermined systems of \pde's. +For the determination of symmetry groups or prolongation structures of +(systems of) partial differential equations, the defining relations +give rise to an overdetermined system of \pde's. Finding the symmetry +group or prolongation structure boils down to solving such a system. + +There are, however, some differences between the determination of a +symmetry group or the determination of a prolongation structure. These +differences are:\medskip + +\item{1.} The differential equations for the determination of the +symmetry group are linear, the equations for the determination of a +prolongation structure are nonlinear. This nonlinearity, however, is +of a special kind, namely, the only occuring nonlinear terms are +(possibly nested) liebrackets of the functions to be integrated. + +\item{2.} For the determination of symmetry groups, the functions to be +determined integrate to polynomials with constant coefficients. For +the determination of prolongation structures, functions integrate to +polynomials, coefficients of which are generators of some unknown Lie +algebra. The defining relations of this algebra are the remaining +(nonlinear) relations which have no dependency on the independent +variables involved. + +\enditem +From the above it is clear that integration has to be treated slightly +different in either of the cases. The differences are however small +enough to allow the implementation of one integrator for both cases. + +@ In order to explain all possible p.d.e.'s which can be integrated, we make +the following assumptions:\medskip + +\item{1.} Functions are represented by expressions $f(n)$, where $f$ is +some specified operator and $n$ is an integer. Since we intend to use +the package for computations for supersymmetric p.d.e.'s, we shall use +the notion the elements with $n$ positive must integrate to an even +polynomial and elements with negative $n$ must integrate to an odd +polynomial (this is only useful for computations in prolongation +theory, where coefficients can be even or odd Lie algebra generators). + +\item{2.} The dependencies of functions are solely listed on the +dependency list, i.e.\ must be stated by the 'depend' statement of REDUCE. +Notice, however, that we do not allow dependencies of odd variables. +The reason for this is a pragmatic one: due to the anticommutivity of +odd variables, $n$ odd variables can only produce $2^n$ different +terms containing these variables, hence can be stated explicitly +provided that $n$ is not too big. On the other hand, if we allow +dependencies of odd variables, a lot of additional operators have to +be implemented to take care of e.g. partial differentation w.r.t. odd +variables. +\medskip + +@ If $f$ is the operator denoting functions, $x$ the operator denoting +Lie algebra generators (or, in the case of a symmetry group, just +constants), then following the description above, a p.d.e.\ +has the following possible terms (any coefficient $c$ is always some polynomial +in the independent variables):\medskip + +\item{A.} terms of the form $c_n \hbox{df}(f(n),\dots)$. + +\item{B.} terms of the form $c_n f(n)$. + +\item{C.} terms of the form $c_{1,2}[z_1,z_2]$ where $z_1,z_2$ are +either functions $f(n)$ or Lie algebra generators $x(n)$. + +\item{D.} terms of the form $c_n x(n)$. +\medskip + +These possibilities lead, in a natural way, to the following strategy +of solving the p.d.e.'s:\medskip + +\item{1.} If there is only one term of type A, we can integrate this +equation homogeneously, i.e. give a polynomial expression for $f(n)$ +using the variables involved in the differential term. + +\item{2.} If the p.d.e.\ is a polynomial in one or more independent +variables on which none of the occuring functions depend, all +coefficients of this polynomial have to be zero, i.e., the p.d.e.\ +splits up into a set of smaller p.d.e.'s. + +\item{3.} If there are only terms of type C and D we have a Lie +algebra relation, which can be solved by the LIESUPER package, if +solvable. + +\item{4.} If there is a function of type B depending on all variables +occuring in the p.d.e.\ and not occuring in a term of type A, we can +solve for this function. + +\item{5.} If there is one term of type A depending on all variables +occuring the p.d.e.\ and the remaining terms are polynomial in the +variables occuring in the derivative, the p.d.e.\ can be integrated +inhomogeneously. + +\item{6.} If there is just one function in the p.d.e.\ which depends on a +variable only occuring polynomially in the rest of the p.d.e., such +that the p.d.e.\ can not be integrated inhomogeneously since the +dependencies of the various occuring functions do not match, we can +introduce new equations of type 1 by appropriately differentiating the +p.d.e. + +@*1 Initializing an equation set. +The integrator will be implemented in such a way that integration +can be performed on different sets of p.d.e.'s at the same time. +Different sets of p.d.e.'s will be distinguished by the name of the +operator in which they are stored. + +For each operator representing a set of p.d.e.'s we must know: the +name of the operator(s) representing the functions and the operator +that must be used to represent constants coefficients during the +integration. If this last operator is of rtype 'algebra\_generator' we +know that we are in the prolongation case and the name of the +associated liebracket can be found on the property list of this +operator. + +Moreover, we have to know the total number of equations used, in view of +the additional equations that may be generated and which must be +numbered subsequently. +In connection with the integrations taking place we also have to know the +number of functions, resp. constants (generators) being in use. + +This is all taken care of by the procedure |initialize_equations|, +which assigns to an operator |operator_name|, the total number of used +equations |total_used|, the list |variable_list| of all occuring independent +variables, the operator |constant_operator|, elements of +which act as constants, and an arbitrary number of operators +|function_operator| acting as functions. +|constant_operator| and each |function_operator| should be given a an +algebraic list of the form $\{$operator, number of even elements used, +number of odd elements used$\}$. + +In order to allow an arbitrary number of parameters we make +|initialize_equations| a |psopfn|. How |psopfn|'s are dealt with +internally is explained in the documentation of either the TOOLS +package or the LIESUPER package. + +@<Lisp ini...@>=@/ +put('initialize_equations,'psopfn,'initialize_equations1)$ + +@ +@u +lisp procedure initialize_equations1 specification_list; +begin scalar operator_name,total_used,variable_list, + specification,even_used,odd_used, + constant_operator,bracketname,function_name,function_list; + if length specification_list<5 then + rederr("INITIALIZE_EQUATIONS: wrong number of parameters"); + if not idp(operator_name:=first_element_of specification_list) then + rederr("INITIALIZE_EQUATIONS: equations operator must be identifier"); + if not fixp(total_used:= + reval first_element_of(specification_list:=rest_of specification_list)) + or total_used<0 then + rederr("INITIALIZE_EQUATIONS: total number of equations must be positive"); + put(operator_name,'total_used,total_used); + variable_list:=reval first_element_of( + specification_list:=rest_of specification_list); + if atom variable_list or operator_name_of variable_list neq 'list then + rederr("INITIALIZE_EQUATIONS: variable list must be algebraic list"); + put(operator_name,'variable_list,skip_list variable_list); + @<Check and initialize |constant_operator|@>; + @<Check and initialize |function_list|@>; +end$ + +@ The |constant_operator| can either be of rtype |algebra_generator| +or not. If so, we also have to assign the associated liebracket to +|operator_name| and used the procedure |define_used| to take care of +the assignment of the used dimensions to the liebracket. If +|constant_operator| is not an |algebra_generator|, we store these +dimensions in the same way as happens for liebrackets. + +@d check_valid_function_declaration(op_list,op_name)=@/ +if atom op_list or length op_list neq 4 or operator_name_of op_list neq 'list@| + or not idp(op_name:=first_argument_of op_list) or + not fixp(even_used:=reval caddr op_list) @| or + not fixp(odd_used:=reval cadddr op_list) + or even_used<0 or odd_used<0 then @/ + stop_with_error("INITIALIZE_EQUATIONS: invalid declaration of", + op_list,nil,nil) + +@d put_used_dimensions(op_name,even_used,odd_used)=@/ + if get(op_name,'rtype)='algebra_generator then@/ + define_used(bracketname,list('list,even_used,odd_used)) + else + begin + put(op_name,'even_used,even_used);@/ + put(op_name,'odd_used,odd_used); + end + +@<Check and initialize |constan...@>=@/ +specification_list:=rest_of specification_list; +specification:=first_element_of specification_list; +check_valid_function_declaration(specification,constant_operator); +put(operator_name,'constant_operator,constant_operator); +if get(constant_operator,'rtype)='algebra_generator then@/ + put(operator_name,'bracketname, + bracketname:=get(constant_operator,'bracketname)); +put_used_dimensions(constant_operator,even_used,odd_used) + +@ +@<Check and initialize |fu...@>=@/ +for each function_specification in rest_of specification_list do +begin + check_valid_function_declaration(function_specification,function_name); + put_used_dimensions(function_name,even_used,odd_used); + function_list:=function_name . function_list; +end; +put(operator_name,'function_list,function_list) + +@ Since we can apparently choose different sets of p.d.e.'s for +solving, we must tell the integrator which set to take. This is done +via a global variable |current_equation_set!*|. We will take the +operator |equ| as the default |current_equation_set!*|. +In this file we will use the abbreviation |ces!*| for +|current_equation_set!*|. + +@d ces!*=current_equation_set!* + +@<Lisp ini...@>=@/ +initialize_global(ces!*,'equ)$ + +@ +@u +lisp operator use_equations;@/ +lisp procedure use_equations operator_name; +begin + if idp operator_name then + ces!*:=operator_name + else rederr("USE_EQUATIONS: argument must be identifier"); +end$ + +@*1 The integration procedure. +The implementation of the integrator follows the description of all +the possible steps given above. + +\noindent For the use of the fluid variable |listpri_depth!*|, see below. Its +local rebinding is necessary for a proper printing of the messages +given by the procedure. + +@u +lisp operator integrate_equation; +lisp procedure integrate_equation n; +begin scalar listpri_depth!*,total_used,equation,denominator, + solvable_kernel,solvable_kernels,df_list,df_kernel, + function_list,present_functions_list,variable_list,absent_variables, + polynomial_variables,equations_list,linear_functions_list,constants_list, + bracketname,df_terms,df_functions,@| + linear_functions,functions_and_constants_list,commutator_functions, + present_variables,@| + inhomogeneous_term,nr_of_variables,integration_variables, + forbidden_functions,differentiations_list,polynomial_order; + listpri_depth!*:=200; + terpri!* t; + @<Find the equation to be integrated@>; + @<Step 1: search for homogeneous integration@>; + @<Step 2: search for polynomial behaviour@>; + @<Step 3: search for a Lie relation@>; + @<Step 4: search for a solvable function@>; + @<Step 5: search for inhomogeneous integration@>; + @<Step 6: search for a useful differentation@>; + @<Step 7: print a ``Not solved'' message@>; +solved: %Go here when the equation is solved or its type is determined% +end$ + +@ The part of the equation containing all necessary information is its +numerator. For reasons that will become clear in the sequel we need, +however, also know its denominator. If the equation is zero, no +analysis has to be performed. + +@d nullify_equation(n)=@/ + setk(list(ces!*,n),0) + +@<Find the equation...@>= + if null(total_used:=get(ces!*,'total_used)) or + n>total_used then + stop_with_error("INTEGRATE_EQUATIONS: properly initialize", + ces!*,nil,nil); + if null (equation:=cadr assoc(list(ces!*,n), + get(ces!*,'kvalue))) then + stop_with_error("INTEGRATE_EQUATION:", list(ces!*,n), + "is non-existent",nil); + denominator:=denr(equation:=simp!* equation); + equation:=numr equation; + if null equation then + <<write ces!*,"(",n,") = 0"; terpri!* t; + nullify_equation(n); goto solved>> + +@*1 Homogeneous integration. +Homogeneous integration must be performed if the equation consists +of just one |df| term. In order to find all possible |df| terms we +apply |split_form| to |equation|. This returns a list the |car| of +which is the part of |equation| independent of the |df| operator, the +|cdr| of which is a list of all linear |df| terms, together with their +coefficients. |split_form| will return with an error if nonlinear |df| +terms occur. + +@d independent_part_of=car +@d kc_list_of=cdr +@d kernel_of=car %For use with a kernel-coefficient list% +@d coefficient_of=cdr %For use with a kernel-coefficient list% + +@ If there is one |df| term, we only solve it if its coefficient is a +number, by default. This behaviour is governed by the switch +|coefficient_check|, which is |on| by default. In order to check the coefficient +we will use the procedure |find_solvable_kernel| to be explained below. + +@<Lisp ini...@>= +new_switch(coefficient_check,t)$ + +@ +@d assoc_delete(kernel,assoc_list)=@/ + delete(assoc(kernel,assoc_list),assoc_list) +@d successful_message_for(action,kernel)=@/ +<<write ces!*,"(",n,"): ",action; maprin kernel; terpri!* nil;@/ + nullify_equation(n); goto solved>> +@d not_a_number_message_for(action,kernel)=@/ +<<write "*** ",ces!*,"(",n,"): ",action," failed:"; terpri!* t;@/ + write " coefficient not a number for "; + maprin kernel; terpri!* nil;@/ + write " Solvable with 'off coefficient_check'";@/ + terpri!* t; goto solved>> + +@<Step 1...@>=@/ + df_list:=split_form(equation,'(df)); + if null independent_part_of df_list and + (kc_list_of df_list) and length(kc_list_of df_list)=1 + then + if (solvable_kernel:=find_solvable_kernel(@| + solvable_kernels:=list(kernel_of first_element_of kc_list_of df_list),@| + kc_list_of df_list,denominator)) then + <<df_kernel:=first_argument_of solvable_kernel;@/ + setk(df_kernel,homogeneous_integration_of(solvable_kernel));@/ + depl!*:=assoc_delete(df_kernel,depl!*); + %Remove |df_kernel| from the |depl!*| list% + successful_message_for("Homogeneous integration of ",solvable_kernel)>> + else not_a_number_message_for("Homogeneous integration", + first_element_of solvable_kernels) + +@ The procedure |find_solvable_kernel| tries to find the first element +of |kernel_list| which has a number as coefficient. +If |coefficient_check| is |off| we can simply take the first element +of |kernel_list|, otherwise we can most conveniently implement a +recursive procedure |first_solvable_kernel|, which finds the first +element of |kernel_list| with a number as coefficient. + +@u +lisp procedure find_solvable_kernel(kernel_list,kc_list,denominator); +if !*coefficient_check then first_solvable_kernel(kernel_list,kc_list,denominator) +else first_element_of kernel_list$ + +@# +lisp procedure first_solvable_kernel(kernel_list,kc_list,denominator); +if kernel_list then @/ + (if numberp coefficient_of kc_pair or + numberp !*ff2a(coefficient_of kc_pair,denominator) + then @/ kernel_of kc_pair + else first_solvable_kernel(rest_of kernel_list,kc_list,denominator)) + where kc_pair=assoc(first_element_of kernel_list,kc_list)$ + +@ The equation +\def\dd#1#2{{\partial^{#2}\over\partial{#1}^{#2}}} +$$ +\dd{x_1}{k_1}\cdots\dd{x_m}{k_m} f(x_1,\dots,x_n)=0\qquad (m\leq n) +$$ +has general solution +$$ +f=\sum_{j=1}^{m}\sum_{i_j=0}^{k_j-1} +x_j^{i_j}f_{j,i_j}(x_1,\dots,\hat{x_j},\dots,x_n). +$$ +Thus, given a homogenous p.d.e., |homogeneous_integration_of| has to +return the REDUCE equivalent of the last expression. + +If $f$ depends on only one variable the $f_{j,i_j}$ are constants, +otherwise they are new functions with dependency on one less variable. +In the Lie algebra case the constants are generators of the Lie +algebra. Since the dimensions of a |liebracket| in REDUCE have to be +given on beforehand, there may not be enough generators left to +generate $f$. In this case, we have to enlarge the |liebracket|. + +@d get_dependencies_of(kernel)=@/ + ((if depl_entry then cdr depl_entry)@| where depl_entry=assoc(kernel,depl!*)) + +@u +lisp procedure homogeneous_integration_of df_term; +begin scalar df_function,function_number,dependency_list,integration_list, + coefficient_name,bracketname,even_used,odd_used, + integration_variable,@| + number_of_integrations,solution,new_dependency_list; +@<Check if |df_term| can be integrated, find |df_function| and +|function_number|@>; +dependency_list:=get_dependencies_of(df_function); +if length dependency_list=1 then + coefficient_name:=get(ces!*,'constant_operator) + else coefficient_name:=operator_name_of df_function; +@<Get |even_used|, |odd_used| and if necessary |bracketname|@>; +integration_list:=rest_of arguments_of df_term; +@<Find the next |integration_variable| and |number_of_integrations|@>; +if bracketname then + @<Check and possibly enlarge dimensions of |bracketname|@>; +@<Perform the integration@>; +return solution +end$ + +@ We required |df_term| to be of the form |df|($f(k),\dots$) where +$f$ is a function occuring on the |function_list| of |ces!*| and $k$ +is an integer not equal to zero. + +@<Check if |df_term|...@>=@/ +df_function:=first_argument_of df_term; +if not member(operator_name_of df_function,get(ces!*,'function_list)) @| +or not fixp(function_number:=first_argument_of df_function) or function_number=0 then +@/stop_with_error("PERFORM_HOMOGENEOUS_INTEGRATION: integration of", + df_function, "not allowed",nil) + +@ In the liebracket case |even_used| and |odd_used| are stored as +properties of |bracketname| instead of |coefficient_name|. + +@<Get |even_used|, |odd...@>= + if get(coefficient_name,'rtype)='algebra_generator then + begin bracketname:=get(ces!*,'bracketname);@/ + even_used:=get(bracketname,'even_used); + odd_used:=get(bracketname,'odd_used); + end + else + begin + even_used:=get(coefficient_name,'even_used);@/ + odd_used:=get(coefficient_name,'odd_used); + end + +@ Finding the integration variables is rather straightforward. + +@<Find the next |int...@>= +if integration_list then integration_variable:=first_element_of +integration_list else integration_variable:=nil; +if integration_variable and (integration_list:=rest_of integration_list) @| + and fixp first_element_of integration_list then + <<number_of_integrations:=first_element_of integration_list; + integration_list:=rest_of integration_list>> +else number_of_integrations:=1 + +@ If |df_function| depends on only one variable, the number of +constants being introduced is equal to the |number_of_integrations|. +The even and odd dimension of |bracketname| are stored as the +properties |even_dimension| and |odd_dimension|. + +@<Check and poss...@>= +if function_number > 0 then @/ + (if even_used+number_of_integrations>get(bracketname,'even_dimension) then@/ + change_dimensions_of(bracketname,even_used+number_of_integrations,@| + get(bracketname,'odd_dimension))) +else @/ + (if odd_used+number_of_integrations>get(bracketname,'odd_dimension) then@/ + change_dimensions_of(bracketname,get(bracketname,'even_dimension), + odd_used+number_of_integrations)) + +@ The actual integration is fairly straightforward by now: for all the +possible integration variables we can simply add new terms to +|solution|. + +@d new_coefficient=@/ +list(coefficient_name,if function_number>0 then + incr(even_used) else -incr(odd_used)) +@d ext_mksq(kernel,power)=@/ +if power=0 then 1 ./ 1 else mksq(kernel,power) +@d depend_new_coefficient(dependency_list)=@/ + depl!*:= (list(coefficient_name,if function_number>0 then even_used +else -odd_used) . dependency_list) . depl!*; + +@<Perform the integration@>=@/ +solution:=nil ./ 1; +while integration_variable do +begin new_dependency_list:=delete(integration_variable,dependency_list); + for i:=0:number_of_integrations-1 do + <<solution:=addsq(solution,multsq(ext_mksq(integration_variable,i), + mksq(new_coefficient,1))); + if new_dependency_list then depend_new_coefficient(new_dependency_list) + >>; + @<Find the next |int...@> +end; +solution:=mk!*sq subs2 solution;@/ +put_used_dimensions(coefficient_name,even_used,odd_used) + +@*1 Splitting polynomial equations. +For the polynomial behaviour of |equation| we need to know the +dependencies of all the functions occuring in |equation| at any level. +If there occur any other variables in |equation| and |equation| is +polynomial in these variables, the coefficients of this polynomial +give rise to a new set of equations. + +@d pc_list_of=kc_list_of %power-coefficient list% +@d powers_of=kernel_of + +@<Step 2...@>=@/ +@<Find |present_functions_list| and the |absent_variables|@>; +@<Find the |polynomial_variables| and test for polynomial behaviour@>; +@<If possible, split up |equation| into smaller equations@> + +@ Finding all the functions in |equation| can be done by applying the +procedure |get_recursive_kernels| of the TOOLS package. + +@<Find |present_functions_list| and the |absent_variables|@>=@/ +function_list:=get(ces!*,'function_list);@/ +present_functions_list:=get_recursive_kernels(equation,function_list);@/ +variable_list:=get(ces!*,'variable_list); +absent_variables:=variable_list; +for each function in present_functions_list do + for each variable in get_dependencies_of(function) do@/ + absent_variables:=delete(variable,absent_variables) + +@ In most cases the equations under consideration are polynomial in any +of the variables and therefore we shall by default not test for +polynomial behaviour. This testing is governed by the switch +|polynomial_check| which, be default, is |off|. If it is |on| testing +is done by the procedure |polynomialp| to be defined below. + +@<Find the |polynomial_variables| and test for polynomial behaviour@>=@/ +polynomial_variables:=absent_variables; +if !*polynomial_check then@/ + polynomial_variables:=for each variable in polynomial_variables join@/ + if polynomialp(equation,variable) then list(variable) + +@ @<Lisp ini...@>= +new_switch(polynomial_check,nil)$ + +@ Checking a standard form for polynomial behaviour in some kernel can +be done by checking the main variable, the leading coefficient and the +reductum, respectively. + +@u +lisp procedure polynomialp(expression,kernel); +if domainp expression then t +else ((main_variable=kernel or not depends(main_variable,kernel)) @|and + polynomialp(lc expression,kernel) and polynomialp(red expression,kernel)) @| + where main_variable=mvar expression$ + +@ The coefficients of a polynomial can be found by +applying the procedure |multi_split_form| from the TOOLS package. + +@<If possible, split up |equation| into smaller equations@>=@/ +equations_list:=multi_split_form(equation,polynomial_variables); +if length equations_list>1 then +<<for each pc_pair in pc_list_of equations_list do@/ + setk(list(ces!*,incr(total_used)), + mk!*sq((coefficient_of pc_pair) ./ 1)); + if independent_part_of equations_list then @/ + setk(list(ces!*,incr(total_used)), + mk!*sq((independent_part_of equations_list) ./ 1)); + write ces!*,"(",n,") breaks into ", + ces!*,"(",get(ces!*,'total_used)+1,@| + "),...,",ces!*,"(",total_used,") by ";@/ + maprin partial_list(polynomial_variables,5); + terpri!* nil;@/ + nullify_equation(n); + put(ces!*,'total_used,total_used); + goto solved +>> + +@ In order to get messages in a readable form, we sometimes need to +print lists partially. This is taken care of the following procedures. + +@u +lisp procedure partial_list(printed_list,nr_of_items); +'list . broken_list(printed_list,nr_of_items)$ +@# +lisp procedure broken_list(list,n); +if list then if n=0 then '(!.!.!.) +else car list . broken_list(cdr list,n-1)$ + +@*1 Solving Lie algebra relations. +If the first two steps have failed, we need to analyze |equation| in +a more drastic way: we need to find all functions occuring linearly in +|equation|, and if a liebracket is specified, all commutators and +algebra generators occuring in |equation| as well. +Since we have already looked for |df| terms in |equation| in each next +step we only have to examine the independent part of the previous step. + +@<Step 3...@>=@/ +linear_functions_list:=split_form(independent_part_of df_list, + function_list);@/ +df_list:=kc_list_of df_list; +constants_list:=split_form(independent_part_of linear_functions_list, + list get(ces!*,'constant_operator));@/ +linear_functions_list:=kc_list_of linear_functions_list; +if (bracketname:=get(ces!*,'bracketname)) then + @<Solve |equation| if it is a Lie expression@> + +@ In the Lie algebra case we can try to solve the Lie expression if +there are no |df| terms or linearly occuring functions. Solving Lie +expression can be done using the procedure |relation_analysis| of the +LIESUPER package. |relation_analysis| returns either the kernel for which +the relation is solved or an atom indicating the nature of the +non-solvability. + +@<Solve |equation| if it is a Lie expression@>= + if length(df_list)=0 and + length(linear_functions_list)=0 then + << + if atom(solvable_kernel:= + relation_analysis(!*ff2a(equation,denominator),bracketname)) + then <<write ces!*,"(",n,") is a non-solvable Lie relation"; + terpri!* t >> + else <<write ces!*,"(",n,") solved for "; maprin solvable_kernel; + terpri!* t; nullify_equation(n)>>; + goto solved + >> + +@*1 Solving a function. +If |equation| is not a Lie expression, there may be a function or a +constant for which we can solve it. In order to do this we need to +\medskip + +\item{$-$} find all variables |present_variables|, on which at +least one of the present functions |recursive_functions_list| depends; +of course it is the complement of |absent_variables| in |variable_list|. + +\item{$-$} find all linearly occuring functions |solvable_kernels| which +depend on all of the |present_variables|; these are the possible +candidates for solving. If there are no |present_variables|, +|equation| is apparently a relation between some constants and we can +try to solve one. + +\item{$-$} remove all functions from |solvable_kernels|, which also +occur in a |df| term, or in the liebracket case, in a commutator. + +\item{$-$} if |coefficient_check| is |on| we must only solve for those +functions which have a number as coefficient. This is checked by the procedure +|find_solvable_kernel|. + +\enditem +Before doing anything we shall, however, construct lists containing +all functions occuring in |df| terms, occuring linearly (and the +constants) and, if necessary, occuring in commutators. These lists +will also come in handy in the next steps. + +@<Step 4...@>= +@<Construct |df_terms|, |df_functions|, |linear_functions| and +|commutator_functions|@>; +@<Get |present_variables| and |nr_of_variables|@>; +for each kernel in linear_functions do if length + get_dependencies_of(kernel)=nr_of_variables then@/ + solvable_kernels:=kernel . solvable_kernels; +for each kernel in append(df_functions,commutator_functions) do @/ + solvable_kernels:=delete(kernel,solvable_kernels); +if solvable_kernels then + @<Try to solve a function@> + +@ Of course we are only interested in |df| terms of functions occuring +on |function_list|. + +@<Construct |df_terms|, |df_functions|, ...@>= +df_terms:=for each df_term in df_list join + if member(operator_name_of first_argument_of kernel_of df_term,function_list) + then @/list kernel_of df_term; +for each df_term in df_terms do if not member(first_argument_of +df_term,df_functions) then@/ df_functions:=first_argument_of(df_term) . df_functions; +functions_and_constants_list:=append(linear_functions_list, + kc_list_of constants_list);@/ +linear_functions:=for each linear_function in + functions_and_constants_list collect kernel_of linear_function; +if bracketname then commutator_functions:=@| + get_recursive_kernels(independent_part_of constants_list, + get(ces!*,'function_list)); + +@ @<Get |present_variables| and |nr_of_variables|@>= +present_variables:=variable_list; +for each variable in absent_variables do + present_variables:=delete(variable,present_variables); +nr_of_variables:=length present_variables + +@ @<Try to solve a function@>= + <<solvable_kernel:= + find_solvable_kernel(solvable_kernels,functions_and_constants_list,denominator); + if solvable_kernel then + <<linear_solve_and_assign(!*ff2a(equation,1),solvable_kernel); + depl!*:=assoc_delete(solvable_kernel,depl!*); + %Remove the dependencies of the solved function% + successful_message_for("Solved for ",solvable_kernel) + >> + else not_a_number_message_for("Solving a function", + partial_list(solvable_kernels,3)) + >> + +@*1 Inhomogeneous integration. +For an inhomogeneous integration, we are looking for a maximal |df| term, +i.e. which has dependency on all the |present_variables|, such that +the remaining part of |equation| is polynomial in the +variables, w.r.t.\ which the function in the |df| term is +differentiated, i.e.\ {\it a}) we only have to look at |df| terms +which are differentiated w.r.t.\ variables on which none of the +non-maximally occuring functions in |equation| depend, and {\it b}) if +|polynomial_check| is |on|, we must check explicitly if the rest of +|equation| is polynomial in these variables. + +We shall collect the list of ``integrable'' variables in the list +|integration_variables|. + +@<Step 5...@>= +@<Find the possible |integration_variables|@>; +@<If possible find and integrate the integrable |df| term |solvable_kernel|@> + +@ Finding the |integration_variables| is rather easy using the lists +|df_functions|, |linear_functions| and |commutator_functions|. +Starting with |present_variables| we have to +delete all variables on which on of the |linear_functions| or +|commutator_functions| depend, or one of the |df_functions|, which do +not have maximal dependency, i.e. which do no depend on +|nr_of_variables| variables. + +@<Find the possible |int...@>=@/ +integration_variables:=present_variables; +for each kernel in append(linear_functions,commutator_functions) do + for each variable in get_dependencies_of(kernel) do@/ + integration_variables:=delete(variable,integration_variables); +for each df_function in df_functions do + if not length get_dependencies_of(df_function)=nr_of_variables then + for each variable in get_dependencies_of(df_function) do@/ + integration_variables:=delete(variable,integration_variables) + +@ Finding the integrable |df| terms is rather easy know: find all +the |df| terms which have maximal dependency and are only +differentiated w.r.t.\ variables occuring on |integration_variables|. +In order to check this last item we need to know the form of |df| +term: it is a list |'(df @tfunction@> @tdifferentiation\_sequence@>)|, where +differentiation\_sequence is a sequence of variables, each variable optionally +followed by a integer indicating the number of differentiations +w.r.t.\ to that variable. The procedure +|check_differentiation_sequence| checks whether all variables in a +differentiation\_sequence are member of the second argument +|variable_list|. + +@u +lisp procedure check_differentiation_sequence(sequence,variable_list); +if null sequence then t +else @+if fixp first_element_of sequence or + member(first_element_of sequence,variable_list) then@/ +check_differentiation_sequence(rest_of sequence,variable_list)$ + +@ @<If possible find and integrate...@>= +@<Find the integrable |df_terms|@>; +@<Find a |solvable_kernel|, check the |inhomogeneous_term| and possibly integrate@> + +@ There one situation we have to take care of specifically: if there +are more |df_terms| for the same function, only one of which is +differentiated just w.r.t. |integration_variables|, we are not allowed +to integrate, since the function would be expressed in itself. In this +case, we will make |solvable_kernels| a list of at least length 2 +in order to prevent integration. + +@<Find the integrable |df_terms|@>= +for each df_term in df_terms do + <<if length get_dependencies_of(first_argument_of df_term)=nr_of_variables @| + and (check_differentiation_sequence(rest_of arguments_of df_term, + integration_variables)@| + or member(first_argument_of df_term,forbidden_functions)) + then @/solvable_kernels:=if member(first_argument_of df_term,forbidden_functions) + then list(nil,nil) else df_term . solvable_kernels; + forbidden_functions:=(first_argument_of df_term) . forbidden_functions>>; + +@ @<Find a |solvable_kernel|, check the |inhomogeneous_term| and possibly integrate@>= +if solvable_kernels then +if length(solvable_kernels)=1 then + if (solvable_kernel:=find_solvable_kernel(solvable_kernels,df_list,denominator)) + then + if (inhomogeneous_term:=linear_solve(mk!*sq(equation ./ 1),solvable_kernel))@| + and (not !*polynomial_check @|or + check_polynomial_integration(solvable_kernel,inhomogeneous_term)) + then + <<df_kernel:=first_argument_of solvable_kernel;@/ + setk(df_kernel, + inhomogeneous_integration_of(solvable_kernel,inhomogeneous_term)); + depl!*:=assoc_delete(df_kernel,depl!*); + %Remove |df_kernel| from the |depl!*| list% + successful_message_for("Inhomogeneous integration of ",solvable_kernel)>> + else + <<write ces!*,"(",n,"): Inhomogeneous integration failed: "; terpri!* t; + write "inhomogeneous term not polynomial in integration variables"; + terpri!* t; goto solved>> + else not_a_number_message_for("Inhomogeneous integration", + first_element_of solvable_kernels) +else <<write ces!*,"(",n,"): Inhomogeneous integration failed: "; terpri!* t; + write "more terms with maximal dependency"; terpri!* t; goto solved>> + +@ Checking that the inhomogeneous term is polynomial in the +integration variables is fairly easy. For all the integration +variables we have to check that the denominator does not depend on it +and the numerator should be polynomial. + +@u lisp procedure check_polynomial_integration(df_term,integration_term); +begin scalar numerator,denominator,integration_variables,variable,ok; + numerator:=numr simp integration_term; + denominator:=denr simp integration_term;@/ + integration_variables:= + for each argument in rest_of arguments_of df_term join + if not fixp argument then list argument; + ok:=t; + while ok and integration_variables do + <<variable:=first_element_of integration_variables; + ok:=(not depends(denominator,variable) and polynomialp(numerator,variable)); + integration_variables:=rest_of integration_variables + >>; + return ok; +end$ + +@ We can perform the inhomogeneous integration by applying +|multi_split_form| to find all the +polynomial components of the inhomogeneous term and +|homogeneous_integration_of| for solving the homogeneous equation. + +@u +lisp procedure inhomogeneous_integration_of(df_term,inhomogeneous_term); +begin scalar df_sequence,integration_variables,int_sequence, + variable,nr_of_integrations,integration_terms,solution, + powers,coefficient,int_factor,solution_term,n,k; + df_sequence:=rest_of arguments_of df_term; + @<Find the |integration_variables| and |int_sequence|@>; + integration_terms:=multi_split_form(numr simp inhomogeneous_term, + integration_variables); + integration_terms:=(nil . independent_part_of integration_terms) . + pc_list_of integration_terms; + %Make |integration_terms| a full blown |pc_list|% + @<Perform the inhomogeneous integration of the numerator of |inhomogeneous_term|@>; + solution:=multsq(solution,1 ./ denr simp inhomogeneous_term); + solution:=mk!*sq subs2 addsq(solution,simp homogeneous_integration_of df_term); + return solution +end$ + +@ We must analyze |df_sequence| to get all the integration variables, +together with the number of integrations belonging to them. + +@<Find the |integration_variables| and ...@>= + while df_sequence do + <<variable:=first_element_of df_sequence; + df_sequence:=rest_of df_sequence; + if df_sequence and fixp first_element_of df_sequence then + <<nr_of_integrations:=first_element_of df_sequence; + df_sequence:=rest_of df_sequence>> + else nr_of_integrations:=1; + integration_variables:=variable . integration_variables; + int_sequence:=(variable . nr_of_integrations) . int_sequence + >> + +@ The particular solution of the equation $F^{(k)}(x)=x^n$ is +$$ +F(x)={1\over(n+1)\cdots(n+k)}x^{n+k}. +$$ +This process has to be performed for all the terms in +|integration_terms| and for all integrations in |int_sequence|. + +@<Perform the inhomogeneous integration ...@>= +solution:=nil ./ 1; +for each term in integration_terms do +<<powers:=powers_of term; coefficient:=coefficient_of term; + int_factor:=1; solution_term:=1 ./ 1; + for each integration in int_sequence do + <<variable:=car integration; k:=cdr integration;@/ + n:=(if power then cdr power @+else 0) where power=assoc(variable,powers); + %If |variable| does not occur in |term|, |n=0|% + for i:=1:k do int_factor:=(n+i)*int_factor; + solution_term:=multsq(solution_term,mksq(variable,n+k)) + >>; + solution_term:=multsq(solution_term,coefficient ./ int_factor); + solution:=addsq(solution,solution_term) +>> + +@*1 Generation of new equations by differentiation. +As a last method of solving we notice the following: if there is a +variable, such that just one |df| term or just one linearly occuring +function depends on it and all the other terms are polynomial in this +variable, let's say of degree $n$, then we can differentiate +|equation| $n+1$ times to get a new equation of type A. + +Experience has proven, however, that applying the above mentioned +method, generally will lead to multiple generation of equivalent +terms in the answer. Therefore we will only generate a new equation if +the switch |allow_differentiation| is |on|, otherwise we will only +generate a message that it is possible to generate a new equation of +type A. Solving of such a new equation is always left to the responsibility +of the user. + +@<Lisp ini...@>=@/ +new_switch(allow_differentiation,nil)$ + +@ After this introduction it is clear what we have to do for step 6: + +@<Step 6...@>= +@<Count the number of occurences of all |present_variables|@>; +@<If possible and allowed, generate new equations@> + +@ Counting the occurence of variables is rather easy. For all +functions in |df_terms|, |linear_functions| and +|commutator_functions|, we have to count the occurences of all the +variables in their respective entries on the dependency list |depl!*|. + +For this purpose we rebuild |present_variables| to an association list +with entries of the form |variable . origin . number_of_occurences| +where |origin| indicates the |df_term|, |linear_function| or +|commutator_function| in which |variable| occured last. + +The action of the following macros, which harmlessly make use of the +procedure |rplacd|, is clear. + +@d reinitialize_present_variables=@/ +present_variables:=for each variable in present_variables collect + (variable . nil . 0) +@d variable_of=car +@d origin_of=cadr +@d counter_of=cddr +@d update_variable(variable,origin)= +rplacd(entry,origin . (counter_of entry + 1)) + where entry=assoc(variable,present_variables) +@d update_variables_using(kernel_list,kernel_selector,flag_function)=@/ +for each kernel in kernel_list do + for each variable in get_dependencies_of(kernel_selector(kernel)) do@/ + update_variable(variable,flag_function(kernel)); +@d identity_function(kernel)=kernel +@d empty_function(kernel)=nil + +@<Count the number ...@>=@/ +reinitialize_present_variables;@/ +update_variables_using(df_terms,first_argument_of,identity_function);@/ +update_variables_using(linear_functions,identity_function,identity_function); +if bracketname then update_variables_using(commutator_functions, + identity_function,empty_function) + +@ After the preceding step we can generate new equations by +differentiating |equation| w.r.t.\ to all those variables which occur +in only one |df_term| or |linear_function| and for which all other +terms of |equation| are polynomial. Using the above code one can check +that these variables are exactly the ones for which the |origin| has a +value and the |counter| is 1. + +@<If possible and ...@>= +differentiations_list:= + for each entry in present_variables join + if origin_of entry and counter_of entry=1 @|and + (polynomial_order:=@|get_polynomial_order( + linear_solve(mk!*sq(equation ./ 1),origin_of entry),variable_of entry))@| + then list(variable_of entry . origin_of entry . (polynomial_order+1)); +if differentiations_list then + if !*allow_differentiation then + <<for each entry in differentiations_list do @/ + setk(list(ces!*,incr(total_used)),@| + mk!*sq simpdf list(mk!*sq(equation ./ 1), + variable_of entry,counter_of entry)); + write ces!*,"(",n,"): Generation of ",ces!*,"(",get(ces!*,'total_used)+1, + "),...,",@|ces!*,"(",total_used,") by differentiation w.r.t. "; + terpri!* t;@/ + maprin partial_list(for each entry in differentiations_list collect@| + list('list, variable_of entry,counter_of entry),10);@/ + terpri!* nil; + put(ces!*,'total_used,total_used); + goto solved + >> + else << + write "*** ",ces!*,"(",n, + "): Generation of new equations by differentiation possible."; + terpri!* t; write " Solvable with 'on allow_differentiation'"; + terpri!* t; goto solved>> + +@ An algebraic expression is polynomial in a variable if the +denominator does not depend on it and if the numerator is polynomial +(we only have to check this if |polynomial_check| is |on|). +The polynomial order we can obtain by simply reordering the numerator +w.r.t. the variable involved. + +@u +lisp procedure get_polynomial_order(expression,variable); +if not depends(denr(expression:=simp expression),variable) @|and + (not !*polynomial_check or polynomialp(numr expression,variable)) then + begin scalar kord!*; + setkorder list !*a2k variable; + expression:=reorder numr expression; + return @+if mvar expression=variable then ldeg expression @+else 0; + end$ + +@ If none of the above methods can be applied, we cannot solve +|equation|. + +@<Step 7...@>=@/ +write ces!*,"(",n,") not solved"; terpri!* t + +@*=Additional tools. +The following procedure are meant for solving more equations at a +time or solving ``exceptional'' equations, which need the least restrictive +setting of the switches |coefficient_check|, |polynomial_check| or +|allow_differentiation|. + +@u +algebraic procedure integrate_equations(m,n); +for i:=m:n do integrate_equation(i)$ + +@# +lisp operator integrate_exceptional_equation; +lisp procedure integrate_exceptional_equation(n); +integrate_equation(n) +where @| + !*coefficient_check=nil,@| + !*polynomial_check=nil,@| + !*allow_differentiation=t$ + + +@ As a last set of tools, we shall give a procedure to print +an equation together with all the functions occuring in it and their +dependencies, and some procedures for showing and changing the properties +of an equation set and a the functions/constants used. + +As a side effect the procedure |show_equation| will reassign the shown +equation to its current value. + +@u lisp operator show_equation; +lisp procedure show_equation n; +begin scalar equation,total_used,function_list; + if null(total_used:=get(ces!*,'total_used)) or + n>total_used then + stop_with_error("SHOW_EQUATION: properly initialize", + ces!*,nil,nil); + if (equation:=assoc(list(ces!*,n),get(ces!*,'kvalue))) then + begin + equation:=setk(list(ces!*,n),aeval cadr equation); + varpri(equation,list('setk,mkquote list(ces!*,n),mkquote equation),'only); + function_list:=get_recursive_kernels(numr simp equation, + get(ces!*,'function_list)); + if function_list then + <<terpri!* t; + for each fn in function_list do + <<maprin(fn . get_dependencies_of(fn)); terpri!* nil>> + >> + else terpri!* nil + end +end$ + +@# +algebraic procedure show_equations(m,n); +for i:=m:n do show_equation i$ + +@ +@u +lisp operator functions_used,put_functions_used,equations_used,put_equations_used; + +@# +lisp procedure functions_used function_name; +list('list,get(function_name,'even_used),get(function_name,'odd_used))$ + +@# +lisp procedure put_functions_used(function_name,even_used,odd_used); +begin + if not fixp even_used or even_used<0 or + not fixp odd_used or odd_used<0 then@/ + stop_with_error("PUT_FUNCTIONS_USED: used functions number invalid",nil,nil,nil); + put(function_name,'even_used,even_used); + put(function_name,'odd_used,odd_used); +end$ + +@# +lisp procedure equations_used; +get(ces!*,'total_used)$ + +@# +lisp procedure put_equations_used(n); +if not fixp n or n<0 then@/ + stop_with_error("PUT_EQUATIONS_USED: used equation number invalid",nil,nil,nil) +else put(ces!*,'total_used,n)$ + +@ There is one slight detail which we have not dealt with yet: in +prolongation theory differentiation should act as a derivation on the +arguments of a (eventually nested) commutator. In REDUCE 3.4 there is +a hook which can take care of this situation. In the procedure +|diffp|, which takes care of differentiation of standard powers, if +this standard power is an operator kernel, the property |dfform| is +checked for operator concerned. If this property has a value, it +should be a function which takes care of the differentiation of such a +standard power. + +@u +lisp operator df_acts_as_derivation_on; + +lisp procedure df_acts_as_derivation_on operator_name; +begin + put(operator_name,'dfform,'df_as_derivation); +end$ + +@ The procedure |df_as_derivation| is quite straightforward: apply +|df| to all the arguments of the operator, one at a time, leaving the +other ones untouched. + +@u +lisp procedure df_as_derivation(kernel,variable,power); +begin scalar left_part,right_part,argument,derivative; + if power neq 1 then + stop_with_error("DF_AS_DERIVATION:",kernel,"must occur linearly",nil); + left_part:=list operator_name_of kernel;@/ right_part:=arguments_of kernel;@/ + derivative:=nil . 1; + while right_part do + <<argument:=first_element_of right_part; @/right_part:= rest_of right_part;@/ + derivative:=addsq(derivative, + simp append(reverse left_part,list('df,argument,variable) . right_part));@/ + left_part:=argument . left_part; + >>; + return derivative; +end$ + +@ In order to get nice output of some of the messages given by +|integrate_equation| we redefine the print function |listpri| for +algebraic lists. Namely, we want don't want algebraic lists to split +over multiple lines in the messages we give. For this purpose, we +introduce a fluid variable |listpri_depth!*| which governs the depth +for which algebraic lists are split along lines. The default value is +the same as the value in the used in REDUCE. + +@<Lisp ini...@>= +initialize_fluid(listpri_depth!*,40)$ + +@ The following procedure can be used at algebraic level to change +|listpri_depth!*|. + +@u +lisp operator listlength$ +lisp procedure listlength l; +listpri_depth!*:=l$ + +@ The definition of |listpri| is basically that of |inprint|, except +that it decides when to split at the comma by looking at the size of +the argument, using the global variable |listpri_depth!*|. + +@u +symbolic procedure listpri l; + begin scalar orig,split,u; + u := l; + l := cdr l; + prin2!* get('!*lcbkt!*,'prtch); + % Do it this way so table can change% + orig := orig!*;@/ + orig!* := if posn!*<18 then posn!* @+else orig!*+3; + if null l then go to b; + split := treesizep(l,listpri_depth!*); + a: maprint(negnumberchk car l,0); + l := cdr l; + if null l then go to b; + oprin '!*comma!*; + if split then terpri!* t; + go to a; + b: prin2!* get('!*rcbkt!*,'prtch); + orig!* := orig; + return u + end$ + +@ The end of a REDUCE input file must be marked with |end|. + +@u end; + +@*=Index. This section contains a cross reference index of all +identifiers, together with the numbers of the mdules in which they are +used. Underlined entries correspond to module numbers where the +identifier was declared. + diff --git a/web/reduce/rweb/appl/liesuper.web b/web/reduce/rweb/appl/liesuper.web new file mode 100644 index 0000000000..c760f2da6e --- /dev/null +++ b/web/reduce/rweb/appl/liesuper.web @@ -0,0 +1,4287 @@ +% Copyright (c) 1991 Marcel Roelofs, University of Twente, Enschede, +% The Netherlands. +% +% $Header: liesuper.web,v 1.5 92/02/26 14:22:25 roelofs Exp $ +% +\input specification +\def\Version$#1Revision: #2 ${Version #2} +\def\title{LIESUPER} +\font\titlefont=cmcsc10 scaled\magstep3 +\font\ttitlefont=cmtt10 scaled\magstep4 +\def\topofcontents{\null\vfill +\centerline{\titlefont The {\ttitlefont LIESUPER} package for REDUCE} +\vskip15pt\centerline{\Version$Revision: 1.5 $} +\vskip15pt\centerline{\sc Marcel Roelofs}\vfill} +\def\concl{\bigskip\narrower\narrower\narrower\noindent + {\bf SPECIFICATIONS}:\hskip1em\ignorespaces} +\def\endconcl{\par\leftskip=0pt\rightskip=0pt\noindent\ignorespaces} +\def\enditem{\medskip\noindent\ignorespaces} +\def\lie{{\it lie}} +\def\newpage{\vfill\eject} + +@*= Introduction. In this \.{WEB} file we will describe a REDUCE package for +symbolic computations in (free) Lie (super)algebras. For this purpose +we will introduce a new rtype liebracket, which satisfies the +bilinearity and the (graded) skew-symmetry of the liebracket. +Moreover, we will implement a mechanism to check the (graded) Jacobi +identity and add sufficient bells and whistles to facilitate the usage +of various kinds of gradings. + +Although we call it a rtype there is a difference with the usual +rtypes in REDUCE like arrays or matrices. Elements of an array or a +matrix can be accessed through a get-element-function and always have +a value (which can be and actually is simplified before returning it). +Elements of a liebracket, however, need not always have a value, in +which case the element itself should be returned in a canonical form +(in this way it resembles the REDUCE operator |df|). Hence access to +elements of a liebracket must necessarily be through a simplification +function, in order to avoid infinite loops on simplification. + +On the other hand a liebracket isn't an algebraic operator in the +usual sense either, because we don't want to use the standard +mechanism for storing elements of algebraic operators, since this +generates a linear list containing all values, which is too time +consuming if a large number of values have to be stored. Instead we +will use a vector structure which is better suited to the structure of +a liebracket. Therefore we are enforced to use a set-element-function +to assign values to elements of a liebracket. The only way to +accomplish this is to define liebracket to be a rtype. + +Another bottleneck for operators with a large number of used elements +is the use of the so called klist. On this list all operator elements +are stored which at least have occured once in an algebraic expression. +Therefore we shall extend some standard REDUCE procedures which take +care of or use the klist mechanism, in such a way that for liebrackets +the klist is replaced by an additional field in the vector structure. + +It is well known that commutators are normally represented by a pair +of square brackets $[\,\ldotp\,,\,\ldotp\,]$ in mathematics. Since we +explicitly want to allow more liebrackets at a time, it is impossible +for us to denote all commutators in this notation. We will, however, +facilitate the use of square brackets for a specific liebracket, which +can be used in all cases where one only needs to work with one +liebracket. + +\medskip +The ``banner line'' defined here is intended for indentification +purposes on loading. It should be changed whenever this file is +modified. System dependent changes, however, should be made in a +separate change file. + +@d banner="Lie (super)algebra package for REDUCE 3.4, $Revision: 1.5 $" + +@ We define the following macros for clarity. +@d change_to_symbolic_mode =symbolic +@d change_to_algebraic_mode =algebraic +@d stop_with_error(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,t) @; +@d message(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,nil) @; +@d operator_name_of=car +@d arguments_of=cdr +@d first_argument_of=cadr +@d second_argument_of=caddr +@d first_element_of=car +@d second_element_of=cadr +@d rest_of=cdr +@d skip_list=cdr %Skip the |'list| in front of an algebraic list% +@d independent_part_of=cadr %For use with lists returned by |operator_coeff|% +@d kernel_coeff_list_of=cddr %For use with lists returned by |operator_coeff|% +@d kernel_of=cadr %For use with a kernel-coefficient list% +@d coefficient_of=caddr %For use with a kernel-coefficient list% + +@ The following macros are intended as common programming idioms. +@d incr(x) = (x:=x+1)@; +@d decr(x) = (x:=x-1)@; + +@ A new REDUCE switch can be introduced using the following code. + +@d initialize_global(global_name,value)=@/ +global '(global_name)$@/ +global_name:=value + +@d new_switch(switch_name,value)=@/ +initialize_global(!* @& switch_name,value)$@/ +flag('(switch_name),'switch) + +@ We do all initializations in the beginning of the package. +@u +change_to_symbolic_mode$@/ +write banner$terpri()$@/ +@<Check if the TOOLS package is already loaded@>$ +@<Lisp initializations@>@/ +change_to_algebraic_mode$ + +@ For a proper function of some procedures of this \.{WEB} file we +need a number of procedures from the TOOLS package. Therefore we will +check if the TOOLS package has already been loaded. We do this by +verifying that |operator_coeff| is defined as function. + +@<Check if the TOOLS...@>= +if not getd 'operator_coeff then +message("LIESUPER_INIT: load the TOOLS package before continuing",nil,nil,nil) @; + + +@*= Implementing free Lie superalgebras. For $m,n\geq 0$ let ${\sl +Lib}={\sl Lib}(x_1,\dots,x_m,\xi_1,\dots,\xi_n)$ be the free algebra +on generators $x_1,\dots,x_m,\xi_1,\dots,\xi_n$. We introduce a {\bf +Z}$_2$-grading $\vert\,\ldotp\vert$ on {\sl Lib\/} by defining $\vert +x_i\vert=0$ $(i=1,\dots,m)$, $\vert \xi_j\vert=1$ $(j=1,\dots,n)$ and +$\vert xy\vert=\vert x\vert+\vert y\vert$ for all homogeneous $x,y\in +{\sl Lib}$. We define $L=L(x_1,\dots,x_m,\xi_1,\dots,\xi_n)$ to be the +quotient algebra ${\sl Lib}/I$ where $I$ is the ideal, which for all +homogeneous $x,y,z\in {\sl Lib}$ is generated by the elements +$xy+(-1)^{\vert x\vert \cdot\vert y\vert}yx$ and $(-1)^{\vert + x\vert\cdot\vert z\vert }x(yz)+ + (-1)^{\vert y\vert \cdot\vert x\vert}y(zx)+ + (-1)^{\vert z\vert \cdot\vert y\vert }z(xy)$. + +On $L$ we define a bracket $[x,y]\equiv xy$. Then from the definition +above it is clear that this bracket satisfies the graded skew-symmetry +$$[x,y]=-(-1)^{\vert x\vert \cdot\vert y\vert}[y,x]$$ +and the graded Jacobi identity +$$(-1)^{\vert x\vert\cdot\vert z\vert }[x,[y,z]]+ + (-1)^{\vert y\vert \cdot\vert x\vert}[y,[z,x]]+ + (-1)^{\vert z\vert \cdot\vert y\vert }[z,[x,y]]=0.$$ +Moreover it is bilinear because of the bilinearity of the multiplication +in {\sl Lib}. Therefore $L$ defines a Lie superalgebra, the so called +{\it free Lie superalgebra\/} on even generators $x_1,\dots,x_m$ and odd +generators $\xi_1,\dots,\xi_n$. It is obvious that for $m>1$ or $n>1$ +$L$ is infinite dimensional. + +From this free Lie superalgebra we can get some specific Lie +(super)algebra by imposing additional relations on top of the graded +skew-symmetry and the graded Jacobi identity. For instance, we can get a +finite dimensional simple Lie algebra by imposing appropriate Serre +relations. + +As a last point we have to mention gradings of Lie (super)algebras, +because these can be very helpful when working on Lie (super)algebras. +A Lie (super)algebra can admit more than one grading, for example, +the free Lie (super)algebra on $n$ generators admits a {\bf +Z}$_2$-grading, but also admits the length of ``words'' as a grading, +or a multigrading where the degree of $x_i$ is the $n$-tuple +$(0,\dots,1,\dots,0)$ (1 on the $i$-th place). + +\bigskip +There is one fact about free Lie superalgebras which is very useful if +we want to implement a free Lie superalgebra in REDUCE. To explain +this, let $L_1=L(x_1,\dots,x_n)$ be the free Lie superalgebra on +generators $x_1,\dots,x_n$ for some $n>1$. Then it is easy to prove +that $L_1$ is isomorphic to +$L_2=L(x_1,\dots,x_{n+1})/I(x_{n+1}-[x_1,x_2])$ where +$I(x_{n+1}-[x_1,x_2])$ is the ideal in $L_2$ generated by +$x_{n+1}-[x_1,x_2]$. +This means that we can avoid expressions containing commutators like +$[x_1,x_2]$ just by introducing a new generator $x_{n+1}$ and imposing +one additional relation $[x_1,x_2]=x_{n+1}$. +\newpage +@ In the sections that follow we will take some decisions about how we are +planning to introduce a structure in REDUCE suitable to deal with free +Lie superalgebras. From what we have said in the previous section it is +clear that the following points have to be taken into account:\medskip + +\item{1.} the bilinearity of the bracket. +\item{2.} the graded skew-symmetry of the bracket. +\item{3.} the number of generators and the possibility to introduce new + generators as new names for unknown commutators. +\item{4.} the Jacobi identity. +\item{5.} the ability to use various kinds of gradings. + +@*2 Representation of Lie algebras. The first point we have to take +care of is how to represent commutators and generators in REDUCE. +Generators we want to represent by an algebraic operator. For example, +we could represent $x_i$ by an operator $x(i)$. We should, however, be +able to discriminate between even and odd generators. There are a few +solutions to this problem:\medskip +\item{1.} use different operators for even and odd generators. +\item{2.} for each generator keep record of its grade. \item{3.} use +different ranges for even and odd generators. For instance, use $x(i)$ +with $i>0$ for even generators and $x(i)$ with $i<0$ for odd +generators. \enditem We have chosen the third solution, since it +seems the most practical one. Namely, it offers a very easy way to +test whether a generator is odd or even. + +@ Commutators can simply be represented by an algebraic operator with +two arguments. If we use, for example, the operator \lie\ for +commutators and $x$ for generators, $[x_i,x_j]$ will be represented by +$\lie(x(i),x(j))$. For this kind of expression, however, it seems +useful to introduce a shorthand notation $\lie(i,j)$, since these +expressions will be playing a very important role. We have found: + +\concl To each liebracket we assign two algebraic operators to +represent the commutators and the generators, respectively. If $x$ is +the operator assigned to some liebracket as generator, the elements +$x(i)$ for $i<0$ represent the odd generators of the Lie superalgebra, +the elements $x(i)$ for $i>0$ represent the even generators. +Commutators are represented by an algebraic operator with two +arguments. If \lie\ is this operator, $\lie(i,j)$ with $i$ and $j$ +integer will be a shorthand notation for $\lie(x(i),x(j))$. +\bigskip +\endconcl +If in the sequel we want to explain things about liebrackets by giving +an example, we will always use the pair |@!lie|, |@!x| to represent +the commutators and generators, respectively. + +@ We have seen that we are allowed to set an unknown commutator +$\lie(i,j)$ equal to $x(p)$ for some new generator $x(p)$ and still +keep the same algebra (up to isomorphism). Hence in ordinary cases we +need not assign values to expressions like $\lie(\lie(i,j),q)$, because +with the above substitution for $\lie(i,j)$ it can be simplified to +$\lie(p,q)$. + +It seems like a good idea to adopt the introduction of new generators +for unknown commutators as a very useful strategy, because it prevents +nested commutators to be represented in REDUCE by very lengthy and +deeply nested expressions. This may become very important for it +takes significantly more time to simplify deeply nested expressions +than simple expressions like $\lie(i,j)$ with $i$ and $j$ integer. +Moreover, the points raised above make the following simplifications +possible:\medskip +\item{1.} Using the bilinearity we see that $\lie(10*x(1),x(2)+x(3))$ +is equal to $10*\lie(1,2)+10*\lie(1,3)$. This means that there is no +need to store commutators of linear combinations of generators. +\item{2.} From the graded skew-symmetry we see that $\lie(j,i)$ is +equal to $-\lie(i,j)$ if $\vert x_i\vert\cdot\vert x_j\vert=0$ and +equal to $\lie(i,j)$ otherwise. So our first observation is that there +must be a mechanism to store values of $\lie(i,j)$ for $j\geq i$. +\enditem +Although most Lie (super)algebras under consideration will be infinite +dimensional, it will only be possible to compute a finite dimensional +part of it by computer. Following our strategy of introducing new +generators for unknown commutors, this boils down to the fact that we +can only compute finitely many commutators of two generators. +So it's no real restriction to impose upperbounds on the number of +generators beforehand. + +For practical problems, however, these upperbounds may still be +rather big, let's say 100 odd and 100 even generators. In principle +all commutators of these generators may get a value, but if we assume +that only a quarter of all commutators is known, in our example with +200 generators this still means that about 5000 values have to be +stored. + +This already indicates that it isn't a good idea to store the values +of commutators of generators on the standard REDUCE kvalue list, which +is an association list. Access to an association list is by comparing +the |car| of all its elements with the wanted expression until both +are equal. Hence it will take more and more time to access an element +of an association list as it grows. + +For practical problems like the example above, access to an +association list will already be too time consuming. Therefore we +will choose to store values of commutators of generators in a vector +structure, a lisp object which is more directly accessible. Because a +vector is a static object, we need the upperbounds on the number of +generators right at this place. Resuming we have found: + +\concl We impose upperbounds on the number of even and odd +generators (these upperbounds should include the number of generators +which we want to introduce as new names for unknown commutators). +If these upperbounds are $m$ and $n$, respectively, we store +the values of $\lie(i,j)$ for $-n\leq i\leq j\leq m$ in a vector +structure. +\endconcl + +@ For some applications we sometimes need to allow more general +expressions as element of a Lie (super)algebra than just the +generators. For instance, this is the case if we want to do +computations in (super)prolongation theory, where we are working with +Lie (super)algebra valued functions. + +Nevertheless we should be able to assign values to commutators +containing such expressions or to commutators containing nested +commutators, to which we don't want or cannot assign a value, for +whatever reason. But this means that we can't just do with the vector +structure, because these ``irregular'' commutators don't fit into it. +The most appropriate way to store such kind of commutators is to use +the standard REDUCE kvalue list. + +However, we have to impose some restrictions on the kind expressions +which we allow to act as algebra elements. We should, for instance, be +able to recognize it as an algebra element. In view of the way we +will decompose a commutator into its smallest components later on, the +first restriction must be that we can only allow operator expressions +to act as algebra elements. +Therefore the easiest way to allow for more general algebra elements +is to add to a liebracket a list of operatornames, elements of which +are regarded to be elements of that Lie (super)algebra. + +There is one more restriction we have to impose, namely for each +algebra element we want to know if it is odd or even (nonhomogenous +elements we can split up into an odd and an even part). The reason that +we want to know this will become clear in the following section. +This can also be achieved very easily: if $f(a_1,\dots)$ is some +general algebra element, not being a commutator or a generator, we +demand its first argument $a_1$ to be a positive or negative integer, +indicating if the algebra element is even or odd, respectively. + +\concl To each liebracket we add a list of operators, elements of +which will be regarded to be elements of the Lie (super)algebra. The +first argument of such an element should be a positive or negative +integer, indicating if it is an even or even algebra element. The +values of commutators containing algebra elements, which are not +generators, will be stored on the standard REDUCE kvalue list. +\endconcl + +@ Now we know how all possible algebra elements look like, we want to +have a canonical representation of all commutators. In this way REDUCE +will always correctly recognize sums of commutators to be zero, which +otherwise might possibly have slipped through because of the +bilinearity or the skew-symmetry of the bracket. +To get a commutator in canonical representation we apply the +following rules:\medskip +\item{1.} decompose the commutator into its smallest components +using the bilinearity of the bracket. +\item{2.} commutators $\lie(x(i),f(a_1,\dots))$, where $f$ is +some operator allowed as algebra element (including generators and nested +commutators), are represented by its shorthand notation +$\lie(i,f(a_1,\dots))$. The same applies to the second argument. +\item{3.} if one of the arguments is 0, the commutator is 0. This +follows directly from the bilinearity. From this we see the necessity +not to allow $x(0)$ as a generator, because its shorthand notation in +a commutator would be 0 and all commutators with $x(0)$ would become 0 +applying the rule stated above. +\item{4.} using the standard REDUCE procedure |ordp(x,y)|, the +arguments $x$ and $y$ of $\lie(x,y)$ are orderded canonically. +If we have to switch $x$ and $y$ the result is +provided with a minus sign if not both $x$ and $y$ are odd algebra +elements. This actually is the reason, why for every algebra element +we need to know if it is odd or even. + +@*1 Jacobi identities. The Jacobi identity expresses the fact that not +all commutators are linear independent. To explain this, we look at +the Jacobi identity for $x(1)$, $x(2)$ and $x(3)$. It reads +$\lie(1,\lie(2,3))-\lie(2,\lie(1,3))+\lie(3,\lie(1,2))=0$, where we +have used graded skew-symmetry to get the second term. Further suppose +that we have introduced new generators $\lie(1,2)=x(4)$, +$\lie(1,3)=x(5)$ and $\lie(2,3)=x(6)$, then this Jacobi identity +implies that $\lie(1,6)-\lie(2,5)+\lie(3,4)=0$. But this is nothing +else than to say that $\lie(1,6)$, $\lie(2,5)$ and $\lie(3,4)$ are +linear dependent. If, moreover, $\lie(1,6)$, $\lie(2,5)$ and +$\lie(3,4)$ all are a sum of generators, the Jacobi identity might +either be zero or otherwise lead to a linear dependency for some +generators of the Lie (super)algebra. + +It is clear that for each triple of algebra elements the +Jacobi identity is either zero or leads to a relation between algebra +elements and/or commutators of algebra elements. If we have $N$ linear +independent and homogeneous (w.r.t.\ the {\bf Z}$_2$ grading) algebra +elements (generators as well as the more general operator expressions +allowed as algebra element), the number of Jacobi identities amounts +to $N\choose 3$ if all algebra elements are even, and slightly more if +some of the elements are odd. Hence we conclude that the number of +Jacobi identities grows very fast for increasing $N$. + +Just if only a small part of the Jacobi identities would lead to new +relations this still means that quite a lot of values would have to be +stored. If we were to store these values on the kvalue list of the +operator representing the commutator, we would be facing an increasing +access time for that kvalue list very soon. This indicates that it is +only useful to compute and solve those Jacobi identities which don't +lead to storing of values on the kvalue list of the commutator. +Therefore we should only check those Jacobi identities that +(eventually) lead to new relations for commutators of two generators +(since these are stored in a vector structure) or to relations between +some generators (since this kind of relation cannot be avoided). + +Hence the first remark that can be made, is that we only have to check +Jacobi identities for triples of generators $x(i)$, $x(j)$ and $x(k)$, +since these are the only ones to lead without too much difficulty to +the desired kind of relation. +Furthermore, if we want to satisfy the condition stated above, it is +easy to see that all three commutators $\lie(i,j)$, $\lie(j,k)$ and +$\lie(i,k)$ are to be entirely expressed in terms of some other +generators. Therefore we have found: + +\concl +There must be a mechanism to compute and solve the Jacobi +identities for all triples of generators $x(i)$, $x(j)$ and $x(k)$ +which satisfy the condition that all three commutators $\lie(i,j)$, +$\lie(j,k)$ and $\lie(i,k)$ are a linear combination of generators. + +\bigskip \endconcl It is well known that one can give a basis of a +free Lie (super)algebra seen as a linear space, the so called Hall +basis. Consequently, this Hall basis respects the linear dependencies +caused by the Jacobi identity and the graded skew-symmetry. + +Now suppose that we start off with a free Lie (super)algebra on $n$ +generators, i.e., a Lie (super)algebra without any additional +relations, and suppose that we want to compute a basis of this algebra +as a linear space in REDUCE. It is not difficult to see that we can +construct this basis upto ``words'' of a certain length $L$ by +executing a cycle of introducing new generators for still unknown +commutators of length $l$ and trying to solve Jacobi identities for +$l=2,\dots,L$. The result in each step of solving the Jacobi +identities is that all linear dependencies for commutators of length +$l+1$ are found and solved. Hence in the step for $l+1$ only the +remaining independent commutators will be renamed. + +From this we see that solving Jacobi identities the way we are +planning to, is a means to get a minimal set of generators of a Lie +(super)algebra up to a certain length. + +@*2 Gradings. The next point we should say something about are +gradings. As we have already seen, a Lie (super)algebra can have more +than one grading. However, all gradings together constitute a +multigrading. Although not all gradings adopt integer values (for +example the grading belonging to the root space decomposition of +Kac-Moody algebras), we can, at least for finitely generated algebras, +represent them by an appropriate multigrading with integer values. + +If for each generator we store its multigrade, we can retrieve the +grade of every commutator (of two generators), since it is the sum of +the grades of its arguments. + +\concl +There must be a mechanism to store and retrieve integer valued +multigrades of every generator of the Lie (super)algebra. With help of +these the multigrade of every commutator can be determined. +\endconcl + +@ Then finally, we want to introduce a shorthand notation to be able +to input nested commutators more easily, which can be very useful when +actually working on Lie (super)algebras. For this suppose, for +example, that we want to compute the commutator +$[[x_1,x_2],[x_2,[x_3,x_4]]]$. Using the rules described above, it can +be represented by the expression $\lie(\lie(1,2),\lie(2,\lie(3,4)))$ +in REDUCE. This is a rather lengthy expression and, moreover, it +doesn't express the structure of the commutator very clearly. If we +denote the bracket by a $\cdot$, the above commutator reads $(x_1\cdot +x_2)\cdot(x_2\cdot(x_3\cdot x_4))$ or $(x_1\cdot x_2)\cdot x_2\cdot +x_3\cdot x_4$, if we define $\cdot$ to be right associative (by this +we mean that $x_1\cdot x_2\cdot x_3\equiv x_1\cdot(x_2\cdot x_3)$). + +In our opinion this is the most simple and easy to understand +expression representing the above commutator, and we want to introduce +a counterpart of this representation in REDUCE. Therefore, let for +$N\geq 3$ the expression $\lie(x_1,\dots,x_N)$ be a shorthand notation for +$\lie(x_1,\lie(x_2,\dots,\lie(x_{N-1},x_N)\dots))$, where +$x_1,\dots,x_N$ are algebra elements. +Moreover, to avoid lengthy expressions, we will allow (algebraic) list +expression as nested commutators. +With these simplifications the above commutator may be represented by +the REDUCE expression $\lie(\{1,2\},2,3,4)$. + +Of course, if one is working with the ``default'' liebracket which may +be represented by square brackets (mentioned in the introduction), it +may also be represented by $[[1,2],2,3,4]$ or even by +$[\{1,2\},2,3,4]$. + +\concl +For $N\geq 3$ the expression +$\lie(x_1,\dots,x_N)$ is defined to be a shorthand notation for +$\lie(x_1,\lie(x_2,\dots,\lie(x_{N-1},x_N)\dots))$, where +$x_1,\dots,x_N$ are algebra elements. +Algebraic list expressions are allowed as nested commutators. +\endconcl + +@*= Simplification of commutators. In the introduction we have already +explained that the requirements stated above, force us to use a +simplification function to retrieve values of commutators. We have +gathered enough material now to outline this simplification function. +It should be noted that the procedure |simp_liebracket| expects the +|car| of its argument to be the name of the liebracket. To achieve +this, the liebracket under consideration must be flagged |full|. + +A simplification function, hence also the procedure |simp_liebracket|, +should return the value of its argument as a standard quotient. + +@u +lisp procedure simp_liebracket val; +if length val=3 then @<Simplify commutator |val|@> +else if length val>3 then @<Simplify nested commutator |val|@> +else rederr("SIMP_LIEBRACKET: wrong number of arguments")$ + +@ We simplify a commutator as explained in the previous sections. The +procedure |simp_liebracket_vector| checks if a commutator with two +integer arguments has a value, or otherwise returns it in canonical +form. We simplify both arguments before continuing in order to be able +to recognize negative integer arguments. It is easily verified that +this has almost no influence on the timings. + +@<Simplify commutator |val|@>= +begin scalar bracketname,arg1,arg2; + bracketname:=operator_name_of val; + arg1:=mk!*sq simp!* first_argument_of val; + arg2:=mk!*sq simp!* second_argument_of val; + return + if fixp arg1 and fixp arg2 then simp_liebracket_vector(bracketname,arg1,arg2) + else @<Simplify |bracketname(arg1,arg2)| using the bilinearity@>; +end @; + +@ To decompose a commutator into its smallest components using the +bilinearity we will use the procedures of the TOOLS package +implemented to deal with operators which are multilinear w.r.t.\ some +specified operators. We recall that this implementation consists of a +simplification procedure |simp_multilinear| together with a +resimplification procedure for the smallest constituent parts of the +operator $O$ under consideration, which name is to be found on the +property list of $O$ as the property |resimp_fn|. The list of operators +w.r.t.\ which $O$ is multilinear has to be stored as the property +|oplist|. Hence essentially it suffices to write an appropriate +resimplification procedure in our case. + +There are, however, a few minor points which have to be taken into +account. First we allowed sole integers as a shorthand notation for +generators. To make |simp_multilinear| work properly we have to undo +this simplification temporarily. The name of this generator is stored +on the property list of the liebracket as the property |generatorname|. +Moreover, we allowed algebraic lists to denote nested commutators. +Since algebraic list are represented by the operator |list| +internally, this can be dealt with by putting |list| on the |oplist| +of a liebracket. + +@<Simplify |bracketname(arg1,arg2)| using the bilinearity@>= +simp_multilinear list(bracketname, + if fixp arg1 and arg1 neq 0 then list(generatorname,arg1) @+else arg1, + if fixp arg2 and arg2 neq 0 then list(generatorname,arg2) @+else arg2)@/ +where generatorname=get(bracketname,'generatorname) @; + +@ The resimplification procedure |resimp_liebracket| is rather simple. +Each of the arguments can be:\medskip +\item{1.} an integer: since the shorthand notation of generators is +hidden before simplification, this can only occur if there is an unwanted +mixing of the full and the shorthand notation for generators. Hence we +must stop with an error message in this case. +\item{2.} a generator: we have to strip off the generatorname and +represent it by its shorthand notation. +\item{3.} an algebraic list representing a nested commutator: we have +to replace |list| by the name of the liebracket and simplify the +whole commutator again. +\item{4.} any other algebra element: nothing special has to be done. +\enditem +The definition |update_argument| takes care of the necessary +actions. The variable |resimplify| indicates the necessity of +resimplification due to case 3.\ and should be local to the procedure +|resimp_liebracket|. + +@d update_argument(arg)=@/ +if fixp arg then rederr("SIMP_LIEBRACKET: argument contains a non algebra element") +else if operator_name_of arg=generatorname then arg:=first_argument_of arg +else if operator_name_of arg='list then @/ + <<resimplify:=t;arg:=bracketname . arguments_of arg>> @; + +@ If both arguments are generators we have to check the vectorstructure +for further simplification, otherwise the kvalue list. This is done in +the procedures |simp_liebracket_vector| and |simp_liebracket_kvalue|, +respectively. + +@u lisp procedure resimp_liebracket val; +begin scalar bracketname,generatorname,arg1,arg2,resimplify; + bracketname:=operator_name_of val; + generatorname:=get(bracketname,'generatorname); + arg1:=first_argument_of val;arg2:=second_argument_of val; + update_argument(arg1);update_argument(arg2); + return + if resimplify then simp_liebracket list(bracketname,arg1,arg2) + else + if fixp arg1 and fixp arg2 + then simp_liebracket_vector(bracketname,arg1,arg2) + else simp_liebracket_kvalue(bracketname,arg1,arg2); +end$ + +@ Now we have dealt with ordinary commutators satisfactorily, it's +time to aim our attention to the nested commutators. Notice that we +have defined an expression like $\lie(\{1,2\},2,3,4)$ to be nothing but +the expression $\lie(\lie(1,2),\lie(2,\lie(3,4)))$. Since we have already +treated list expressions as part of ordinary commutators, we only have +to reverse the list of arguments and compute the commutators +repeatedly. + +@<Simplify nested commutator |val|@>= +begin scalar bracketname,arguments,result; + bracketname:=operator_name_of val; + arguments:=reverse arguments_of val; + result:=simp_liebracket list(bracketname,second arguments,first arguments);@/ + arguments:=cddr arguments; %Chop first two arguments% + for each arg in arguments do + result:=simp_liebracket list(bracketname,arg,mk!*sq result); + return result; +end @; + +@*= Storing and retrieving values of commutators. In the following +sections we will explain how we are planning to store values of +commutators exactly. We recall that we have to make a clear +distinction between commutators of two generators, in which case we +want to store the values in a vector structure, and all other cases, +for which we want to store the values on the kvalue list. + +@ We have seen in one of the previous sections that we have to store +$\lie(i,j)$ for $-n\leq i\leq j\leq m$, if $lie$ is a liebracket and +$m$ and $n$ the number even and odd generators, respectively. There +are a few ways to store the values of these commutators in a vector +structure:\medskip +\item{1.} put them all together in one vector and +supply a procedure to compute the index for a tuple $(i,j)$. +\item{2.} make a vector of vectors: put for all $i$ the vectors +containing the values of $\lie(i,j)$ for $i\leq j\leq m$ in a vector. +\enditem +The second alternative has the advantage, that it is rather easy to +compute the indices, but we have to access two vectors to get the +value of a commutator. For the first alternative the index has a more +complex structure, but we have only to access one vector. We have +compiled and tested both alternatives in a REDUCE version built on top +of Innovus Lisp on a HP9000 series at our site. In this +configuration the second alternative has proven to be the fastest. +Therefore we will use this one to store the values of commutators of +two generators. + +The indices of a vector of dimension $N$ run from $0,\dots,N$. Hence +the dimension of the outer vector structure must be $m+n$, which must +have for $-n\leq i\leq m$ as value at index $n+i$ the vector of +dimension $m-i$ containing the values of $\lie(i,j)$ for $i\leq j\leq +m$. For each $-n\leq i\leq j\leq m$ we can add to the tuple $(i,j)$ a +couple of indices $(n+i,m-j)$ for the outer and the inner vector, +respectively. Note that we use the inner vector structure in a +reverse way to keep the indices as short as possible. + +@ We will store the vector structure of a liebracket |bracketname| on +the property list as the property |vector_structure|. The dimensions +$m$ and $n$ of a liebracket are stored on the property list as the +properties |even_dimension| and |odd_dimension|, respectively. + +Access to a vector is through the procedures |getv|, to +get a value, and |putv|, to store a value. One +should be aware of the fact that |putv| doesn't make a new copy of the +vector, but replaces the value at the required index directly in the +physical memory. Therefore it is unnecessary to do a |putv| for the +outer vector structure when storing a commutator, because a |getv| for +the outer vector structure will return a vector, which we can change +directly in the physical memory at the right index with a |putv|. + +There is one point which we haven't explained so far, but which +already has to be used here. Namely, to enable the computation of +Jacobi identities to be as efficient as possible, it is not enough for +each commutator just to store its value, but we have to store some +more information. Moreover, as explained in the introduction, we shall +also put the information about possible occurences of commutators in +the vector structure. For ordinary algebraic operators this kind of +information is recorded on the klist. +Therefore for each commutator we will store a dotted +pair of length 3, the |car| being additional information about the +commutator, the |cadr| being the replacement for the klist mechanism, +the |cddr| being its value. + +Although we won't explain the meaning of the two first items right +away, it is enough to know here that the additional information must +be initialized to |nil|. The part meant as the replacement for the klist +mechanism must must be initialized to |nil|, if it is not present, +otherwise the old value must be taken. + +We think that it is convenient to have procedures both to access the +entire vector structure as well as just the values of commutators. +Access to the vector structure is through the macros +|get_vector_structure| and |put_vector_structure|, access to the +values of commutators of two generators is through the macros +|get_commutator| and |put_commutator|, where the last two +simply use the first two. The procedures don't perform range checking +on their parameters. + +@d informative_part_of=car +@d k_info_and_commutator_part_of=cdr +@d k_info_of=cadr +@d commutator_part_of=cddr +@d get_vector_structure(bracketname,i,j)=@/ +getv(getv(get(bracketname,'vector_structure), + get(bracketname,'odd_dimension)+i),@| + get(bracketname,'even_dimension)-j) @; +@d put_vector_structure(bracketname,i,j,value)=@/ +putv(getv(get(bracketname,'vector_structure), + get(bracketname,'odd_dimension)+i),@| + get(bracketname,'even_dimension)-j,value) @; +@d get_commutator(bracketname,i,j)=@/ +(if entry then commutator_part_of entry) + where entry=get_vector_structure(bracketname,i,j) @; +@d put_commutator(bracketname,i,j,value)=@/ +(if old_value then + put_vector_structure(bracketname,i,j,nil . (k_info_of old_value) . value) + else put_vector_structure(bracketname,i,j,nil . nil . value)) +where old_value=get_vector_structure(bracketname,i,j) @; + +@ Before we can write the procedures |simp_liebracket_vector| and +|simp_liebracket_kvalue| we have to explain how to get the arguments of a +commutator in a canonical order. + +The macro |not_ordered_commutator| checks whether or not +the arguments of a commutator are well ordered. It uses the standard +REDUCE procedure |ordp| and is written in such a way that a pair +$(i,j)$ for $i$,$j$ integer, $i\leq j$ is well ordered. + +@d not_ordered_commutator(arg1,arg2)= @/ +(if fixp arg1 and fixp arg2 then arg1>arg2 @+else +ordp(arg1,arg2) and arg1 neq arg2) @; + +@ If the two arguments are not well ordered they must be switched. +Moreover, if not both arguments are odd a minus sign should be added. +Therefore we must have a function |even_element| to check if an +argument is even or not. + +We have explained earlier that an argument of a commutator should be +an integer (namely, the number of the generator), a commutator with +two arguments, or another algebra element for which we have to check +the first parameter. Unfortunately, that is not the whole truth. There +is one exceptional situation for some specific application, which +should be added: in prolongation theory we will use Lie (super)algebra +valued functions. So far no problems, but these functions may also be +differentiated, in which case one will get other algebra elements. +However, an expression like |df(f(1),x)| doesn't belong in any of the +classes stated above. We can test if it is even or odd, by testing the +differentiated function. We add this as a special case. + +@u +lisp procedure even_element(bracketname,exprn); + if fixp exprn then exprn>0 + else if operator_name_of exprn=bracketname then + ((b1 and b2) or (not b1 and not b2)) @| where + b1=even_element(bracketname,first_argument_of exprn), + b2=even_element(bracketname,second_argument_of exprn) + else if operator_name_of exprn='df then + even_element(bracketname,first_argument_of exprn) + else if fixp first_argument_of exprn then + first_argument_of exprn>0 + else stop_with_error("EVEN_ELEMENT: impossible to determine sign of", + exprn,nil,nil)$ + +@ Both in |simp_liebracket_vector| and |simp_liebracket_kvalue| the +arguments must be ordered canonically, hence we make that part a +module. Both procedures should have a local variable |sign|, +indicating if a sign must be added. + +@<Order |arg1| and |arg2| canonically and possibly set |sign| to |t|@>= +if not_ordered_commutator(arg1,arg2) then +begin scalar h; + sign:=(even_element(bracketname,arg1) or even_element(bracketname,arg2));@/ + h:=arg1;arg1:=arg2;arg2:=h; %Switch |arg1| and |arg2|% +end @; + +@ Once |arg1| and |arg2| are ordered (i.e., |arg1|${}\leq{}$|arg2|), we +still have to check for integer valued |arg1| and |arg2| that +$-n\leq{}$|arg1| and |arg2|${}\leq m$, if $m$ and $n$ are the number +of even and odd generators, respectively. + +@<Check if |arg1| and |arg2| are not out of range@>= +if arg1<-get(bracketname,'odd_dimension) or arg2>get(bracketname,'even_dimension) then + stop_with_error("SIMP_LIEBRACKET:",list(bracketname,arg1,arg2),"out of range",nil) @; + +@ After the preparations above the implementation of the procedure +|simp_liebracket_vector| is quite straightforward. If the commutator +has a value, this value is simplified and returned as a standard +quotient, otherwise the commutator itself is returned as a standard +quotient. This last step is done by the standard REDUCE procedure +|mksq(kernel,pow)|, which returns |kernel| to the power |pow| as a +standard quotient, but also has a side effect that we will explain in +due time. + +There is, however, one thing, which we should be well aware of. +Namely, if one of the arguments is zero, the commutator must be zero. +This can be achieved by initializing both $\lie(i,0)$ for +$i=-n,\dots,-1$ and $\lie(0,i)$ for $i=0,\dots,m$ to zero. Moreover +the commutators $\lie(i,i)$ with $i>0$ are zero. Hence these should +also be initialized to zero. Moreover, as we will explain later on, +in some cases it will be necessary to resimplify the resulting +commutator, in order the get a well ordered standard quotient, which +will be treated in the right way by REDUCE. This case will be treated +in due time. + +@u +lisp procedure simp_liebracket_vector(bracketname,arg1,arg2); +begin scalar sign,commutator; + @<Order |arg1| ...@>; + @<Check if |arg1| and |arg2|...@>; + @<Get commutator |bracketname(arg1,arg2)| as a canonical standard quotient@>; + return + if sign then negsq commutator + else commutator; +end$ + +@ The kvalue list of an algebraic operator is an association list, the +|car| of an element of which is a kernel of that operator, the |cadr| +its value. The kvalue list of an operator is stored on its propery +list as the property |kvalue|. As already explained, access to an +association list is through the procedure |assoc|. Knowing this, we +can write the procedure |simp_liebracket_kvalue| without difficulty. + +@u +lisp procedure simp_liebracket_kvalue(bracketname,arg1,arg2); +begin scalar sign,commutator; + @<Order |arg1| ...@>; + commutator:=assoc(list(bracketname,arg1,arg2),get(bracketname,'kvalue));@/ + commutator:= + if commutator then simp cadr commutator + else mksq(list(bracketname,arg1,arg2),1); + return + if sign then negsq commutator + else commutator; +end$ + +@*= Assignment to commutators. With the simplification +procedure written above, we are able to retrieve values of +commutators. As we have explained in the introduction, we need a +set-element-function |set_liebracket| to assign values to commutators. + +This seems to be the appropriate moment to explain how one can assign +|value| to |kernel|. This is done by calling the procedure +|setk(kernel,value)|. If |kernel| is of the form $f(a_1,\dots)$, +where $f$ possesses the property |rtype|, which on its turn possesses a +property |setelemfn| (the set-element-function for that rtype), the +assignment is done by this set-element-function. In all other cases +the procedure |setk1| takes care of it. So to +make the construction work in our case, we have to declare +any liebracket to be of rtype |liebracket| and assign to |liebracket| the +property |setelemfn|. + +@ There is, however, one more thing to explain about rtypes: +commutators should not be recognized as objects of rtype |liebracket| +since this will lead to type mismatch problems throughout REDUCE. To +get the rtype of an object REDUCE almost anywhere uses the procedure +|getrtype|, which, if provided, uses a rtypefn, to determine the rtype +of an object. Rtypefn's have one argument, which are the arguments of +the object, if this is not an atom, |nil| otherwise. +So if we do not want commutators to be recognized as objects of rtype +|liebracket|, we can simply return |nil| in all cases; + +@<Lisp ini...@>=@/ +put('liebracket,'rtypefn,'liebracket_rtypefn)$@/ +put('liebracket,'setelemfn,'set_liebracket)$ + +@ +@u +lisp procedure liebracket_rtypefn u;@/ nil$ + +@ There are, however, some points, which should be taken into +account, before we can write the procedure. The first of this is, +that we want commutators only to adopt values which are actually +algebra elements. Hence we should check this condition if an +assignment is made. + +The most convenient way to check if some expression is is an element +of the Lie (super)algebra is to use the procedure |independent_part| +of the TOOLS package. If the variable |algebra_elements| is the list +of all operators allowed as algebra elements, then the result of +calling |independent_part(value,algebra_elements)| is the part of +|value| independent of operator allowed as algebra element, hence for +a {\it valid\/} algebra element |value| 0. + +@<Check if |value| is a valid algebra element@>= +if independent_part(value,algebra_elements) neq 0 then + rederr("SET_LIEBRACKET: assigned value invalid as algebra element") @; + +@ We have already explained that it is not necessary or even +undesirable to assign values to commutators, which can be decomposed +into smaller components, using the bilinearity. For such an assignment +will never be used, since the simplification procedure of a liebracket +actually decomposes a commutator into is smallest components, before +trying to find any value. + +Therefore both arguments of a commutator, which we want to assign a +value to, either have to be integer (as a shorthand notation for a +generator), or a single algebra element. If they have the form $x(i)$ +where |x| is the generatorname of liebracket |bracketname|, we must +strip off the generator, in order to get the commutator in a canonical +form. Moreover generators should not exceed the maximal number of odd +or even generators, respectively. + +The macro |check_and_strip_argument| checks one argument for its +validity, using the conditions stated in the previous section. +Because we have to satisfy a lot of conditions and we don't want the +procedure merely to exist out of error messages, we use a variable +|error| to indicate whether an error has occured or not. In this way +we can do with one error message after all tests. The variable +|error| has to be local at some higher level. The macro +|wrong_atomic_argument| checks an atomic argument is an integer and +lies within the ranges of the liebracket. + +@d wrong_atomic_argument(arg)=@/ +((not fixp arg) or arg<-get(bracketname,'odd_dimension) + or @| arg>get(bracketname,'even_dimension)) @; + +@d check_and_strip_argument(arg)=@/ +if atom arg then error:=wrong_atomic_argument(arg) +else begin + error:=not member(operator_name_of arg,algebra_elements); + if not error and operator_name_of arg=generatorname then + begin + arg:=first_argument_of arg; + error:=not atom arg or wrong_atomic_argument(arg); + end; +end @; + +@<Prepare and check |arg1| and |arg2|@>=@/ +check_and_strip_argument(arg1); +if not error then check_and_strip_argument(arg2); +if error then + rederr("SET_/CLEAR_LIEBRACKET: argument(s) invalid or out of range") @; + +@ There are a few ``special'' commutators which are initialized to +zero and should never be changed again. If $\lie$ is a liebracket, +these commutators are $\lie(i,i)=0$ for all $i>0$ (this follows +directly from the (graded) skew-symmetry and the fact that $x(i)$ is +even for $i>0$), $\lie(i,0)$ for $i=-n,\dots,-1$ and $\lie(0,i)$ for +$i=0,\dots,m$ (this has been explained in one of the previous +sections). Moreover, if a commutator has been used to solve other +commutators or generators using the Jacobi identity, it may be +dangerous to change this commutator. In the first case we must give an +error message, in the second case a warning will do. + +This kind of information is most conveniently recovered from the +informative part of the vector structure. Without going into detail +right here, the following module will take care of the point raised +above. Note that |arg1| and |arg2| need to be we ordered for this check. + +@d special=s + +@<Check |arg1| and |arg2| for special or dangerous commutators@>=@/ + error:=@+if fixp arg1 and fixp arg2 then + (if entry then informative_part_of entry) + where entry=get_vector_structure(bracketname,arg1,arg2); + if error then + if car error='special then + rederr("SET_/CLEAR_LIEBRACKET: commutator can not be changed") + else message("SET_/CLEAR_LIEBRACKET: changing", + list(bracketname,arg1,arg2),"may lead to errors",nil) @; + +@ With the modules written above we can implement the procedure +|set_liebracket| at once. We |reval| both arguments before +continuing. This is useful, because the simplification procedure does +the same. Notice that a set-element-function doesn't need to return a +value. + +@u +lisp procedure set_liebracket(val,value); +if length val neq 3 then + rederr("SET_LIEBRACKET: assignment only possible to commutators") +else begin scalar bracketname,generatorname,algebra_elements,arg1,arg2, + error,sign; + bracketname:=operator_name_of val; + generatorname:=get(bracketname,'generatorname); + algebra_elements:=bracketname . generatorname . get(bracketname,'algebra_elements); + arg1:=reval first_argument_of val; + arg2:=reval second_argument_of val; + @<Prepare and check |arg1| and |arg2|@>; + @<Order |arg1| and |arg2|...@>; + @<Check |arg1| and |arg2| for special or dangerous commutators@>; + value:=aeval value; + @<Check if |value| is a valid algebra element@>; + if sign then value:=mk!*sq negsq simp value; + @<Store the assignment |bracketname(arg1,arg2):=value@;|@>; +end$ + +@ Before we can implement the remaining part of the +set-element-function of a liebracket, we have to say something about +the mechanism that controls the reevaluation of algebraic expressions +in REDUCE, the !*SQ prefixform. + +An algebraic expression in !*SQ prefixform is a list of the form +(|!*sq| {\it standard\_quotient} [|t|$\vert$|nil|]). If the last +element is |t|, no assignments have taken place after the last +simplification of the expression, which can affect its value. If it is +|nil|, the expression may have been affected by some assignment that +has taken place, so reevaluation is necessary. If reevalutation is +necessary, it is clear that the |t|'s must be replaced by |nil| for +all algebraic expressions at a time. At this place it is not necessary +to explain how this can be accomplished, but it is sufficient to say that +the call |rmsubs()| does the job properly. + +If a kernel has never been used in any other algebraic expression, it +is clear that it is unnecessary to call |rmsubs| if someone assigns a +value to this kernel. Therefore, for every kernel REDUCE keeps track +if it has been used in some other algebraic expression. For atoms this +is done by flagging them |used!*|, for operator elements it is recorded +on the so called klist of that operator. + +Of course the standard REDUCE procedures respect this mechanism. But +we took the simplification of and assignment to commutators in our own +hands. Did we take enough precautions to respect this mechanism? Well, +a few sections ago, when implementing the simplification function of a +liebracket, we mentioned, but did not explain a side effect of the +procedure |mksq| which we used to convert a kernel to a standard +quotient. This seems to be the right moment to explain that this side +effect is the recording of the fact that the kernel is used by +flagging it |used!*| or putting it on the klist. + +This partially solves our problem, for if a unknown commutator is used +in some other algebraic expression it will be simplified by +|simp_liebracket| which makes it a standard quotient by calling +|mksq|. On the other hand, as experience showed, for a liebracket of average +length, the klist may get a length of about 10000 to 20000 elements +and reduce the performance of the entire system in an quite drastic way. + +Therefore we will partially replace the klist mechanism for a +liebracket by storing the klist information as an additional entry in +the vector structure, just for those commutators whose +value is also stored in the vector structure. + +In order to make this new construction work it turns out that two +standard REDUCE procedures have to be adapted. These changes are explained in +the last section of this document. + +@ If we do an assignment to a commutator we must call +|rmsubs| if necessary. Without going into the matter too deep right +here, we will simply give a macro definition which checks if an +operator element is used. + +@d used_operator_element(opr_el)=@/ + 'used!* memq cddr fkern opr_el@; + +@ If the two arguments of the commutator which we want to store are +integers, we must use the vector structure to store it and eventually +call |rmsubs| ourselves, otherwise it must be stored on the kvalue +list. In the last case the standard REDUCE procedure |setk1| takes care +of everything. + +@<Store the assignment |brack...@>= +if fixp arg1 and fixp arg2 then +begin + if used_operator_element(list(bracketname,arg1,arg2)) then rmsubs(); + put_commutator(bracketname,arg1,arg2,value); +end else + setk1(list(bracketname,arg1,arg2),value,t) @; + +@*= Clearing liebrackets. There is one aspect of the access to +liebrackets and/or commutators which we have left out of sight so far +deliberately, namely how to clear these objects. Clearing expressions +and/or operators in REDUCE is done by the procedures |clear| and +|clear1|, the last one of which does its job by two subsequent calls +of the procedure |let2| with different parameters. + +In earlier versions of this package we used the procedure |clear| to +clear commutators, but it seemed impossible to use it to clear an +entire liebracket, because a liebracket isn't just an ordinary rtype. +The only possibility to let this construction work for commutators, +was to jump through some procedures in an obscure and illogical way +and finally let the clearing take place in the simplification +procedure depending on the flag |subfg!*|. Clearing of an entire +liebracket was done by a procedure of itself. + +In this version we will do the job in a more logical way by changing +the standard REDUCE procedure |clear| in such a way that the clearing +of both commutators and liebrackets will take place in a procedure of +itself. The idea behind this change is quite simple: if the object to +be cleared is of some rtype which on its turn possesses the property +|clearfn|, then apply |clearfn| to it, otherwise proceed as before. +In that way it resembles the procedure |setk|, which uses a +set-element-function for rtypes. + +Note that |clear| has the property |stat='rlis| which means that it +can have an arbitrary number of arguments separated by commas, which +the parser will pass to it as a list. Hence also |clear1|, which is +called by |clear|, will have its argument as one list. + +Notice that we can't use |getrtype| to get the rtype of an operator +element since |getrtype| will, for instance, not recognize a +commutator to be an element of the rtype liebracket. + +@u +lisp procedure clear1 u; + begin scalar x,xx; + while u do + <<if flagp(x := car u,'share) + then if not flagp(x,'reserved) then set(x,x) else rsverr x + else if eqcar(x,'list) + then u := nil . append(cdr x,cdr u) + else if eqcar(x,'replaceby) then rule!-list(list x,nil) + else if smemq('!~,x) + then if eqcar(x,'equal) then rule!-list(list x,nil) + else rule!-list(list list('replaceby,x,nil),nil) + else if (xx:=get(if atom x then x @+else car x,'rtype)) + and (xx:=get(xx,'clearfn)) + then apply1(xx,x) + else @+<<let2(x,nil,nil,nil); let2(x,nil,t,nil)>>; + u := cdr u>> + end$ + +@ The clearfn of a liebracket will be the procedure |clear_liebracket|. +This has to be placed on the property list of |liebracket|. + +@<Lisp ini...@>=@/ + put('liebracket,'clearfn,'clear_liebracket)$ + + +@ The procedure |clear_liebracket| is rather simple: if its argument +is an atom, we have to clear an entire liebracket by removing all its +properties, otherwise the argument should be a commutator. + +@u +lisp procedure clear_liebracket val; +if atom val then @<Remove all properties of liebracket |val|@> +else if length val = 3 then @<Clear commutator |val|@> +else rederr("CLEAR_LIEBRACKET: wrong number of arguments to commutator")$ + + +@ Clearing a commutator is almost the same as assigning |nil| to it. +Therefore we have to manipulate the arguments in the same way as in +the procedure |set_liebracket|, except that we need not incorporate a +possible change of sign. We copy it without comment. + +@<Clear commutator |val|@>= +begin scalar bracketname,generatorname,algebra_elements,arg1,arg2,error,h; + bracketname:=operator_name_of val; + generatorname:=get(bracketname,'generatorname); + algebra_elements:=bracketname . generatorname . get(bracketname,'algebra_elements); + arg1:=reval first_argument_of val; + arg2:=reval second_argument_of val; + @<Prepare and check |arg1| and |arg2|@>; + if not_ordered_commutator(arg1,arg2) then + begin + h:=arg1;arg1:=arg2;arg2:=h; %Switch |arg1| and |arg2|% + end; + @<Check |arg1| and |arg2| for...@>; + @<Clear commutator |bracketname(arg1,arg2)|@>; +end @; + +@ If |arg1| and |arg2| are integers, we have to clear an entry in the +vector structure, otherwise we have to clear the commutator by +replacing the kvalue list of |bracketname| by the old kvalue list with +one entry removed. Note that there is no need to update the !*SQ +prefixforms by calling |rmsubs|, since the calling procedure |clear| +has already taken care of that. + +@<Clear commutator |bra...@>=@/ +val:=list(bracketname,arg1,arg2); +if fixp arg1 and fixp arg2 then + if get_commutator(bracketname,arg1,arg2) then @| + put_commutator(bracketname,arg1,arg2,nil) + else message("CLEAR_LIEBRACKET:",val,"not found",nil) +else begin scalar kvalue; + kvalue:=get(bracketname,'kvalue); + if (h:=assoc(val,kvalue)) then + put(bracketname,'kvalue,delete(h,kvalue)) + else message("CLEAR_LIEBRACKET:",val,"not found",nil); +end @; + +@*= Tools for solving Jacobi identities. We have gathered +enough material now to implement one of the main tasks of this +package, namely the computing and solving of Jacobi identities in +order to find new relations between commutators and generators. To +accomplish this, we have to do the following things in succession: +first we have to find all triples $(i,j,k)$ with $i,j,k$ integer that +satisfy all conditions such that the Jacobi identity for $x(i)$, +$x(j)$ and $x(k)$ may lead to a new relation and secondly, for each +triple $(i,j,k)$ found in the first step, we must compute this Jacobi +identity and solve it. + +\bigskip +In the sections where we specified the requirements for a +liebracket, we found that it is interesting to compute and solve the +Jacobi identities for all $x(i)$, $x(j)$ and $x(k)$ such that all +three commutators $\lie(i,j)$, $\lie(j,k)$ and $\lie(i,k)$ are a +linear combination of generators. For these Jacobi identities (may) +lead to new relations between generators and/or commutators of two +generators, which are the main object of our interest. + +How must we proceed to find all triples $(i,j,k)$ that satisfy the +conditions stated above? Well, a typical sequence of actions while +trying to compute (part of) a Lie (super)algebra could be: introduce +some new generators as names for unknown commutators (i.e., assign the +generators to these commutators) and try to find new relations implied +by Jacobi identities containing these commutators. Hence we could +proceed as follows: first find all ``new'' commutators $\lie(i,j)$ +which are a linear combination of generators (by ``new'' we mean those +commutators which haven't been processed before). Then, if $\lie(i,j)$ +is such a commutator, $(i,j,k)$ is a triple for which the Jacobi +identity has to be checked, if both $\lie(i,k)$ and $\lie(j,k)$ are +linear combinations of generators. It is easily seen that proceeding +this way one will find all Jacobi identities solvable until that +stage. + +There is one aspect which we haven't explained yet: how do +we recognize commutators which have already been processed. The +observant reader will remember that we used the vector structure not +only to store values of commutators, but also reserved a part for +additional information about the commutator, initialized to |nil|. +It is clear that we can use it right here to mark commutators which +have already been processed. + +\bigskip +There is, however, another purpose for which we will use the +``informative'' part of the vector structure, namely to indicate if +the computation of a Jacobi identity can be done more efficiently, +which is very important because of the large amount of Jacobi +identities we have to compute. For this look at a characteristic term +of a Jacobi identity, say $\lie(i,\lie(j,k))$, and suppose that +$\lie(j,k)=\sum_q a_q*x(q)$, a linear combination of generators. Hence +we have to compute $\lie(i,\sum_q a_q*x(q))$ or using the bilinearity +$\sum_q a_q*\lie(i,q)$. Computing this kind of expression by simply +applying |simp_liebracket| to it, we (have to) use the procedure +|operator_coeff| to get all $x(q)$'s and $a_q$'s every time we come +across $\lie(j,k)$. + +It would be much more efficient, if the value of $\lie(j,k)$ were +stored in such a way, that there is no need to use the procedure +|operator_coeff| to get all $x(q)$'s and $a_q$'s. This can indeed be +done, if we take advantage of the way how standard forms in REDUCE are +build up. Using the procedure |get_all_kernels|, described in the +TOOLS package, and the standard REDUCE procedure |reorder|, it is very +easy to accomplish that the $x(q)$'s occur as leading variable of (a +reduced part of) the value of $\lie(j,k)$ and the $a_q$'s as leading +coefficient. + +If $\lie(j,k)$ is a reordered sum of generators and we want to compute +$\lie(i,\lie(j,k))$ using this reordering, we cannot simplify +$\lie(j,k)$ during the computation because this would destroy the +special ordering we imposed. This implies that we should think about +what to do if we find a linear dependency between some generators and +solve it for one of them, let's say $x(q)$. For suppose this $x(q)$ +occurs in the value of $\lie(j,k)$, then computing $\lie(i,\lie(j,k))$ +using the reordering, would lead to a term $\lie(i,q)$ which is not +desirable because of the linear dependency found. A solution to this +problem would be, if we find a linear dependency and solve it for +$x(q)$, to assign to all $\lie(i,q)$'s a value according to this +linear dependency. + +The most convenient way to implement this is by making a Lie +(super)algebra generator a rtype of itself, |algebra_generator|, and +assigning a set-element-function and a clear function to it, which +take care of all the necessary actions. Moreover, this offers us the +possibility do some more checks. For instance, in order to keep the +solving of Jacobi identities act as we intended, we only want to +allow assignments to a generator, which are linear combinations of +other generators. For if we would allow this, we would possibly get +Jacobi identities, marked as solvable by the process described above, +containing commutators with non-integer arguments, for which we +certainly don't want to solve. We will write these procedures in a +next chapter. + +@ In the previous sections we have seen to which purposes we can use +the informative part of the vector structure. Before describing its +contents exactly, we will add one other application. Namely, for +whatever reason, we may want to compute all Jacobi identities again, +so it must be possible to indicate if all Jacobi identities containing +some commutator have to be recomputed. Therefore, we can distinguish +the following three conditions for each commutator:\medskip + +\item{1.} the commutator hasn't been reordered and hence hasn't been +checked until now. This is the initial status for every commutator and +is indicated by |nil| (we already used this in the procedure +|put_commutator|). + +\item{2.} the commutator has both been reordered and checked. This is +indicated by |'(t)|. + +\item{3.} the commutator has been reordered, but must be +checked again. This is indicated by |'(nil)|. + +\enditem +If we want to recompute all Jacobi identities for some liebracket, +|'(t)| has to be replaced by |'(nil)| for each commutator in the +vector structure of this liebracket, which has already been checked. +To accomplish this we will use a mechanism similar to the one used for +!*SQ prefixforms. These are constructed by |cons|'ing +|'!*sq . @t{\it standard\_quotient}@> . !*sqvar!*|, +where |!*sqvar!*| is a list |'(t)|. In doing so, the |t| of !*SQ +prefixforms can be replaced by |nil| {\it globally}, by replacing the +|car| of |!*sqvar!*| by |nil| with the procedure |rplaca|. This +construction works because |rplaca(alist,new_car)| doesn't replace the +|car| of |alist| by making a new copy |new_car . cdr alist|, but +replaces the |car| in the physical memory. + +We will also |cons| a variable |!*jacobi_var!*| with value |'(t)| to +each reordered commutator in the vectorstructure of a liebracket. +However, in our case we don't want to replace the |t| by |nil| +globally, but only for one liebracket at a time. Therefore each +liebracket should have its own variable |!*jacobi_var!*|. It should be +placed on the property list of the liebracket under consideration as +the property |!*jacobi_var!*|. + +The procedure |recompute_jacobi_identities_of| takes care of this +replacement and also puts a new copy of |!*jacobi_var!*| on the +property list. This procedure should be available in algebraic mode. + +We foresee that we have to check if |bracketname| is a liebracket in +a lot of procedures. In order to be able print an appropriate error +message we will make definition to deal with it. For convenience we +will also write a definition which checks the validity of a generator. + +@d check_if_bracketname_is_a_liebracket_in(proc)=@/ + if get(bracketname,'rtype) neq 'liebracket then@| + stop_with_error(proc,bracketname,"is not a liebracket",nil) @; +@d check_if_generatorname_is_a_generator_in(proc)=@/ + if get(generatorname,'rtype) neq 'algebra_generator then@| + stop_with_error(proc,generatorname,"is not an algebra generator",nil) @; + +@u +lisp operator recompute_jacobi_identities_of; + +lisp procedure recompute_jacobi_identities_of bracketname; +begin scalar !*jacobi_var!*; + check_if_bracketname_is_a_liebracket_in("RECOMPUTE_JACOBI_IDENTITIES:"); + !*jacobi_var!*:=get(bracketname,'!*jacobi_var!*); + rplaca(!*jacobi_var!*,nil); + put(bracketname,'!*jacobi_var!*,list t); +end$ + +@*1 Finding the unprocessed commutators. After the introduction above +we are able to take care of the first part of finding the solvable +Jacobi identities, namely collecting all commutators which are a sum +of generators and haven't been processed until now. If we find such a +commutator we must (a) reorder it in such a way that all generators +occur in it as leading variables, (b) put it on a list of all +commutators which have to be processed and (c) mark it processed in +the vector structure. These three steps are implemented in the +procedure |find_unprocessed_commutators_of|. + +In |find_unprocessed_commutators_of| we need quite a lot of +properties of the liebracket under consideration. Some of them we have +already met before, but there are also a few, which need some +explanation right now. + +First of all we will store the list of unprocessed commutators on the +property list as the property |commutator_list|, in order to keep the +system as fool proof as possible. Namely, if we would keep this list +as a local variable in |find_unprocessed_commutators_of| it could be +destroyed by some user break, while in the vector structure these +commutators were already marked as being processed. In that way we +could loose some Jacobi identities. +Because of the possibility of an user break we must be aware of the fact +that this list may not be empty. Hence in all cases we must |cons| new +commutators in front of it. + +Secondly we should be aware of the fact that not all commutators have +to be used. Hence it is useless to check commutators which contain +unused commutators. The number of used even and odd generators is +stored on the property list of a liebracket as the properties +|even_used| and |odd_used| respectively. + +The following definition sums up all the properties and variables +necessary to access the vector structure directly, we can use it in +several places. The module following it initializes them. Recall that +we used the letter $m$ for the number of even generators and $n$ for +odd generators. + +@d properties_for_direct_access=@/ +vector_structure,m,m_used,n,n_used + +@<Initialize properties for direct access@>=@/ + vector_structure:=get(bracketname,'vector_structure);@/ + m:=get(bracketname,'even_dimension);n:=get(bracketname,'odd_dimension);@/ + m_used:=get(bracketname,'even_used);n_used:=get(bracketname,'odd_used) @; + +@ The properties necessary in the procedure +|find_unprocessed_commutators_of| are listed below. The module +following it initializes them. The variable |non_generators| +represents all operators, except the generator, that are allowed as +algebra element. + +@d necessary_properties_for_finding_commutators=@;@/ +properties_for_direct_access,generatorname,non_generators, +commutator_list,!*jacobi_var!* + +@<Get all necessary properties for finding commutators@>= + @<Initialize properties for direct access@>; + generatorname:=get(bracketname,'generatorname);@/ + non_generators:=bracketname . get(bracketname,'algebra_elements);@/ + commutator_list:=get(bracketname,'commutator_list);@/ + !*jacobi_var!*:=get(bracketname,'!*jacobi_var!*) @; + +@ The procedure |find_unprocessed_commutators_of| is quite +straightforward. Note that we don't make an exception for the +``special'' commutators |bracketname(i,j)| with $i=0$ or $j=0$ or +$i=j>0$. Of course we don't want these commutators to be processed any +further. This means that they must be initialized as already being +processed. + +Also another category of commutators need not be processed, namely the +commutators of generators which have been found linear dependent. +Checking of Jacobi identities for linear dependent generators boils +down to checking a linear combination of Jacobi identities for linear +independent generators. Thus we shouldn't mark commutators of linear +dependent generators as processed. + +Recall that the data of commutator |bracketname(i,j)| are stored in +the vector structure at indices $n+i$ and $m-j$ for the outer and +inner vector, respectively. + +@u +lisp procedure find_unprocessed_commutators_of bracketname; +begin scalar vector_i,entry_i_j,k_info_i_j,commutator,form,kord!*, + necessary_properties_for_finding_commutators,comm_list_i, + dependent_generators; + @<Get all necessary properties for finding com...@>; + @<Find the |dependent_generators|@>; + for i:=-n_used:m_used do + if not memq(i,dependent_generators) then + begin + vector_i:=getv(vector_structure,n+i); + for j:=i:m_used do + if not memq(j,dependent_generators) then @| + @<Mark |bracketname(i,j)| processed, if it is a sum of generators@>; + end; + return commutator_list; +end$ + +@ Finding the dependent generators can be easily done using the kvalue +list of |generatorname|. Of course we only need to store the index of +each dependent generator. + +@<Find the |dependent_generators|@>= +dependent_generators:= + for each entry in get(generatorname,'kvalue) collect + first_argument_of first_element_of entry + +@ An entry in the vector structure consists of a informative part (the +|car|) and the klist and commutator part (the |cdr|). The following +definitions translate some conditions of the informative part (which +we have defined in one of the previous sections) into their lisp +equivalents. + +@d not_processed=null car +@d recomputation_necessary_for=null caar + +@ A standard form belonging to an algebra element is a sum of +generators, if it contains no kernels of all other operators allowed +as algebra elements. We can check this most conveniently by using the +procedure |get_all_kernels|, which acts on standard forms and is +described in the TOOLS package. Recall that the variable +|non_generators| is the list of all operators other then the +generator, allowed as algebra element. + +@d sum_of_generators(algebra_element)=@/ + null get_all_kernels(algebra_element,non_generators) @; + +@ If a commutator is a sum of generators the following things should +be done:\medskip +\item{1.} it has to be reordered in such a way that all generators +occur as leading variables of (a reduced part of) it. One should +remember that reordering in REDUCE is done by the procedure |reorder|, +which works on standard forms (this is described in more detail in the +TOOLS package). Note that we rebinded the fluid system variable +|kord!*| in the procedure |find_unprocessed_commutators_of|. In doing +so the kernel ordering outside this procedure will not be affected. +The definition |convert_form_into_reordered_commutator| takes care of +the reordering. + +\item{2.} the commutator list must be updated. We store the indices +$i$ and $j$ on it, since these contain all the necessary information. +We will, however, use an association list on $i$, i.e., the smallest +index, to store $i$ and $j$, because the number of commutators to be +processed may be rather big. To keep the system fool proof we put the +updated commutator list on the property list of the liebracket for +each commutator separately. This part is taken care of by the +definition |update_commutator_list|. Notice the use of |rplacd| to +replace the |cdr| of nested lists. It is easily checked that this +causes no harm. Due to the use of |rplacd| we do not have to store +|commutator_list| on the property list of |bracketname|. If there is, +however, no entry on |commutator_list| for $i$, we have to extend +|commutator_list| with it and do store it. + +\item{3.} the entry in the vector structure has to marked as checked. +This can be done by storing |!*jacobi_var!* . k_info_i_j . commutator| +at the right place in the inner vector, where |k_info_i_j| is the +|k_info| value of the $(i,j)$-th entry of the vector structure. The definition +|mark_entry_as_checked| takes care of it. + +@d convert_form_into_reordered_commutator=@/ + setkorder get_all_kernels(form,generatorname);@/ + commutator:=!*ff2a(reorder form,denr commutator) @; +@d update_commutator_list=@/ + if (comm_list_i:=assoc(i,commutator_list)) then@/ + (if not member(j,comm_list_i) then + rplacd(comm_list_i,j . cdr comm_list_i)) + else @+ + <<commutator_list:=list(i,j) . commutator_list; + put(bracketname,'commutator_list,commutator_list)>> @; +@d mark_entry_as_checked=@/ + putv(vector_i,m-j,!*jacobi_var!* . k_info_i_j . commutator) @; + +@ If a commutator has not been checked so far, we should only process +it now, if it is a sum of generators. Commutators, for which +recomputation is necessary, don't have to be reordered, since this has +already been done the first time they were checked. + +@<Mark |brac...@>= +begin +entry_i_j:=getv(vector_i,m-j); +if entry_i_j and commutator_part_of entry_i_j then + if not_processed entry_i_j then + begin + commutator:=simp!* commutator_part_of entry_i_j; + k_info_i_j:=k_info_of entry_i_j; + form:=numr commutator; + if sum_of_generators(form) then begin + convert_form_into_reordered_commutator; + update_commutator_list; + mark_entry_as_checked; + end; + end + else if recomputation_necessary_for entry_i_j then begin + commutator:=commutator_part_of entry_i_j; + k_info_i_j:=k_info_of entry_i_j;@/ + update_commutator_list; + mark_entry_as_checked; + end; +end @; + +@*1 Finding the unsolved Jacobi identities. With help of the procedure +described above we have found a list of unprocessed commutators and +put it on the property list of the liebracket under consideration. Our +next task is for each commutator on this list to find the unsolved +Jacobi identities belonging to it. If $(i,j)$ is a couple of indices +of the commutator list, the solvable Jacobi identities are represented +by all triples $(i,j,k)$ for which both |bracketname(i,k)| and +|bracketname(j,k)| are a sum of generators, i.e., are marked as +processed in the vector structure. + +It is easy to see that the (graded) Jacobi identity + $$(-1)^{\vert x\vert\cdot\vert z\vert }[x,[y,z]]+ + (-1)^{\vert y\vert \cdot\vert x\vert}[y,[z,x]]+ + (-1)^{\vert z\vert \cdot\vert y\vert }[z,[x,y]]=0$$ +in case of equality of some of the elements $x$, $y$ and $z$ sometimes +is fulfilled automatically, depending if $x$, $y$ and $z$ are odd or +even. If we want to compute Jacobi identities for $x(i)$, $x(j)$ and +$x(k)$ with $i\leq j\leq k$ the reader should check that only the +following ranges for $i$, $j$ and $k$ give rise to meaningful +identities (i.e., identities which are not fulfilled automatically): +(1) $i\leq j\leq k < 0$, (2) $i\leq j <0<k$, (3) $i<0<j<k$ and (4) +$0<i<j<k$. Moreover it is easily seen that these conditions are +satisfied if and only if none of the commutators $\lie(i,j)$, +$\lie(i,k)$ and $\lie(j,k)$ is one of the ``special'' commutators +$\lie(p,q)$ with $p=0$ or $q=0$ or $p=q>0$. We recall that we +expected these ``special'' commutators to be initialized to zero and +to be marked as processed. Now the condition ``marked as processed'' +only means that the informative part of an entry in the vector +structure is a list whose |car| is |t| (i.e., has a value) or |nil| +(i.e., has no value), indicating whether or not recomputation of +Jacobi identities for this commutator is necessary. In the light of +what we have said in this section it seems not a bad idea to mark +these ``special'' commutators as special. We can do this by +initializing the informative part of an entry in the vector structure +to |'(special)|. One can easily check that this does not affect the +condition ``marked as processed''. + +Hence if we have to find all meaningful triples $(i,j,k)$ belonging to +an unprocessed commutator represented by the couple $(i,j)$ with +$i\leq j$, we have to check the commutators (1) |bracketname(k,i)| and +|bracketname(k,j)| for $-n_{\rm used}\leq k\leq i-1$, (2) +|bracketname(i,k)| and |bracketname(k,j)| for $i\leq k\leq j-1$ and +(3) |bracketname(i,k)| and |bracketname(j,k)| for $j\leq k\leq m_{\rm +used}$ to be marked as processed, but not special, where $m_{\rm +used}$ and $n_{\rm used}$ are the number of even and odd generators +which have been used so far. The macro |processed_but_not_special| +checks this for an entry of the vectorstructure. + +@d processed_but_not_special(entry)=@/ + (car entry and caar entry neq 'special) @; + +@ As in the case of finding the unprocessed commutators we will store +the list of solvable Jacobi identities on the property list of the +liebracket under consideration as the property |identity_list|. +In this section we will initialize all necessary properties for +finding Jacobi identities. + +@d necessary_properties_for_finding_identities=@/ +properties_for_direct_access,commutator_list,identity_list + +@<Get all necessary properties for finding identities@>= + @<Initialize properties for direct access@>; + commutator_list:=get(bracketname,'commutator_list);@/ + identity_list:=get(bracketname,'identity_list) @; + +@ If a Jacobi identity $(i,j,k)$ is solvable, depends on the $(i,k)$-th +and $(j,k)$-th entry of the vector structure and it has only to be stored +if it has not been stored before. These conditions are checked by the +definition |check_and_store_identity|. Its argument is a triple +$i,j,k$ with $i\leq j\leq k$. + +We will store the Jacobi identities to be solved on a double +association list |identity_list|, as the number of them may increase +very rapidly, in which case linear search would be too time consuming. +Storing a Jacobi identity on |identity_list| is taken care of by the +macro |update_identity_list|. + +@d check_and_store_identity(i,j,k)=@/ + if processed_but_not_special(entry_i_k) and + processed_but_not_special(entry_j_k) + then update_identity_list(i,j,k) @; +@d update_identity_list(i,j,k)=@/ + if (id_list_i:=assoc(i,identity_list)) then + if (id_list_i_j:=assoc(j,cdr id_list_i)) then @/ + (if not member(k,cdr id_list_i_j) then + rplacd(id_list_i_j,k . cdr id_list_i_j)) + else rplacd(id_list_i,list(j,k) . cdr id_list_i) + else identity_list:=list(i,list(j,k)) . identity_list @; + +@ The procedure |find_Jacobi_identities_of| essentially consists of a +double |while| loop in which we try to find solvable Jacobi identities for +each commutator on the |commutator_list| of a liebracket. Commutators +which have been checked may be removed from the |commutator_list|. +As in |find_unprocessed_commutators_of| we will use |rplacd| to alter +the inner lists of |commutator_list|. + +@u +lisp procedure find_Jacobi_identities_of bracketname; +begin scalar comm_list_i,i,j,vector_i,vector_j,vector_k, + entry_i_k,entry_j_k, + necessary_properties_for_finding_identities, + id_list_i,id_list_i_j; + @<Get all necessary properties for finding id...@>; + while commutator_list do begin + comm_list_i:=first_element_of commutator_list; + i:=car comm_list_i; + while cdr comm_list_i do begin + j:=cadr comm_list_i; + @<Find and store all Jacobi identities for |i| and |j|@>; + rplacd(comm_list_i,cddr comm_list_i); + end; + commutator_list:=rest_of commutator_list;@/ + put(bracketname,'commutator_list,commutator_list); + end; +return identity_list; +end$ + +@ Finding and storing all Jacobi identity for a couple $i,j$ consists +of three phases which differ in the way they get the $(i,k)$-th +and $(j,k)$-th entry of the vector structure. After we +have found all identities belonging to $i,j$ we must save the updated +|identity_list| on the property list of the liebracket under +consideration. Saving it once for a commutator pair $i,j$ will do +since at this stage the commutator pair has not been removed from +the commutator list yet. + +@<Find and store all ...@>=@/ +vector_i:=getv(vector_structure,n+i); +vector_j:=getv(vector_structure,n+j); +for k:=-n_used:i-1 do begin + vector_k:=getv(vector_structure,n+k); + if (entry_i_k:=getv(vector_k,m-i)) and (entry_j_k:=getv(vector_k,m-j)) then + check_and_store_identity(k,i,j); +end; +for k:=i:j-1 do begin + vector_k:=getv(vector_structure,n+k); + if (entry_i_k:=getv(vector_i,m-k)) and (entry_j_k:=getv(vector_k,m-j)) then + check_and_store_identity(i,k,j); +end; +for k:=j:m_used do begin + if (entry_i_k:=getv(vector_i,m-k)) and (entry_j_k:=getv(vector_j,m-k)) then + check_and_store_identity(i,j,k); +end;@/ +put(bracketname,'identity_list,identity_list) @; + +@*1 Computing special Jacobi identities. The procedures developed so +far supplied us with a list of triples $(i,j,k)$ with $i\leq j\leq k$ +such that all three commutators $\lie(i,j)$, $\lie(i,k)$ and +$\lie(j,k)$ are linear combinations of generators and are stored in a +reordered form, which facilitates a fast computation of the nested +commutators of the Jacobi identity for $x(i)$, $x(j)$ and $x(k)$. In +the following sections we will write the procedure +|special_Jacobi_identity| that performs the next step, namely the +actual computation of a Jacobi identity for a triple $(i,j,k)$ +satisfying the requirements stated above. + +To explain the idea behind the calculation of the Jacobi identity, +suppose we have a triple $i,j,k$ as stated above. Then by assumption +we have $\lie(j,k)=\sum a^l_{jk}x(l)$ so that +$\lie(i,\lie(j,k))=\sum a^l_{jk}\lie(i,l)$. Now the right hand side of +the last expression can be computed rather easily by using the +reordering imposed on the commutator $\lie(j,k)$ as we will see in +the sequel. One should be aware that is not possible to simplify the +expression for $\lie(j,k)$ before using it, because this will destroy +the reordering. Therefore we have to take into account the following +points:\medskip +\item{1.} In case one of the generators $x(l)$ has been found linear +dependent of other generators, we must see to it that $\lie(i,l)$ +evaluates to the right value. As we have already explained this will +be taken care of by the set-element-function for generators. +\item{2.} The coefficient $a^l_{jk}$ must be simplified before usage. +\item{3.} $\sum a^l_{jk}\lie(i,l)$ must be evaluated to the right +value, i.e., we must take care that substitutions for products and +powers take place properly. This can be achieved by calling the +standard REDUCE procedure |subs2| on the simplified expression. A +search for substitution of powers is only performed if the fluid +system variable |!*sub2| is set to |t|. If necessary this is done +automatically by low level procedures used during ordinary +simplification, depending if a kernel in the simplified expression +occurs on the list of power substitutions, |powlis!*|. After a call of +|subs2| |!*sub2| will always be |nil|, so that it can be used for the +next expression to be simplified. |!*sub2| also occurs on the so +called |initl| of REDUCE. Variables occuring on the |initl| are +initialized to an initial value before every command. + +@ The procedure |sub_identity| calculates a general term +$(-1)^{\vert x(i)\vert\cdot\vert x(k)\vert}\lie(i,\lie(j,k))$ of the +Jacobi identity using the method described above. To achieve this we +must use the numerator of $\lie(j,k)$ (which is a standard form) to +add up all terms of $\lie(i,\lie(j,k))$. If $\lie(j,k)$ is zero, +|sub_identity| also is zero, otherwise by assumption the main variable +|mvar| of the numerator of $\lie(j,k)$ is a generator, the leading +coefficient |lc| its coefficient. The same applies to the reductum +|red| of the standard form. Therefore the summation can simply be +performed in a |while| loop. Standard quotients can be added, +subtracted, multiplied and divided by the procedures |addsq|, +|subtrsq|, |multsq| and |quotsq| respectively. + +To simplify the coefficients we can use the procedure |subf1| which +simplifies a standard form to a standard quotient. Its first argument +is the standard form to be simplified, the second argument a list of +substitutions to be performed (in our case |nil|). + +Recall that the commutators are stored as !*SQ prefixforms. To get the +unsimplified standard quotient of a !*SQ prefixform we should simply +take its |cadr|. + +@d simp_sf_to_sq(sf)=subf1(sf,nil)@; +@d get_sq_of=cadr + +@u +lisp procedure sub_identity(bracketname,i,j,k); +begin scalar comm_j_k,denr_j_k,coeff_l,l,comm_i_l,term; +comm_j_k:=get_commutator(bracketname,j,k); +return if comm_j_k= 0 then nil . 1 else +begin + comm_j_k:=get_sq_of comm_j_k; + denr_j_k:=simp_sf_to_sq(denr comm_j_k); + comm_j_k:=numr comm_j_k; + @<Add all terms of $\lie(i,|comm_j_k|)$ up to |term|@>; + if i<0 and k<0 then term:=negsq term; + @+%Add a sign if $x(i)$ and $x(k)$ are odd% + return quotsq(term,denr_j_k); +end; +end$ + +@ One should notice that we don't check during the assignment to a +commutator if all generators occuring in the assigned value are valid. +Since the call of |simp_liebracket_vector| checks the validity of +integer arguments of a commutator, we only have to check if the +generators occuring have integer arguments here. + +@<Add all terms of $\lie(i,|comm_j_k|)$ up to |term|@>= + term:=nil . 1; %Initialize |term| as standard quotient% + while comm_j_k do begin + l:=first_argument_of mvar comm_j_k; + coeff_l:=simp_sf_to_sq(lc comm_j_k); + if not fixp l then + stop_with_error("SOLVE_JACOBI_IDENTITIES:",list(bracketname,j,k), + "contains invalid generator",mvar comm_j_k); + comm_i_l:=simp_liebracket_vector(bracketname,i,l); + term:=addsq(term,multsq(coeff_l,comm_i_l)); + comm_j_k:=red comm_j_k; + end @; + +@ The procedure |special_Jacobi_identity| can now be written at once. We add +an additional minus sign because in most cases this will neutralize a +minus sign in the output. Since |sub_identity| expects its arguments +to be ordered, we have to switch |k| and |i| and the second term. This +gives an additional sign $(-1)^{1+\vert i\vert\cdot\vert j\vert+ +\vert i\vert\cdot\vert k\vert+\vert j\vert\cdot\vert k\vert}$, i.e., +if $j>0$ an additional minus has to be added. + +@u +lisp procedure special_Jacobi_identity(bracketname,i,j,k); +mk!*sq subs2 negsq + addsq(sub_identity(bracketname,i,j,k),@| + addsq(multsq((if j>0 then -1 @+else 1) . 1, + sub_identity(bracketname,j,i,k)),@| + sub_identity(bracketname,k,i,j)))$ + +@*1 Updating the vector structure. From the last sections it may have +become clear that until now it is impossible to update (i.e., store +the simplified values of) the entries of the vector structure without +deleting all additional information, since the set-element-function of +a liebracket initializes the additional information to |nil|. As a +consequence of this, updating the vector structure implies +recomputation of all Jacobi identities. The procedure +|update_vector_structure_of| does a better job. + +@u +lisp operator update_vector_structure_of; +lisp procedure update_vector_structure_of bracketname; +begin scalar vector_i,entry_i_j, + commutator,form,kord!*,generatorname,properties_for_direct_access; + @<Initialize prop...@>; + generatorname:=get(bracketname,'generatorname); + for i:=-n_used:m_used do begin + vector_i:=getv(vector_structure,n+i); + for j:=i:m_used do begin + entry_i_j:=getv(vector_i,m-j); + @<If necessary update |entry_i_j|@>; + end; + end; +end$ + +@ Updating an entry is necessary if it has a value, if it is not processed +or if it is processed but not special. In the last case we must take +care of the proper reordering. + +@<If necessary update |entry_i_j|@>= +if entry_i_j and commutator_part_of entry_i_j then + if not_processed entry_i_j then@| + putv(vector_i,m-j,nil . k_info_of(entry_i_j) . + aeval commutator_part_of entry_i_j) + else if processed_but_not_special(entry_i_j) then begin + commutator:=simp!* commutator_part_of entry_i_j;@/ + form:=numr commutator; + convert_form_into_reordered_commutator; + putv(vector_i,m-j,informative_part_of(entry_i_j) . + k_info_of(entry_i_j) . commutator); + end @; + +@ As promised in the section where we implemented the simplification +procedure of a liebracket, we will now explain how a (known) +commutator of two generators has to be simplified exactly. Namely, if +the value of a commutator is a sum of generators, the internal +ordering of the standard quotient in the vector structure representing +the commutator may be different from the default kernel ordering used +in REDUCE, because of the reordering we performed intended for the +efficient computation of Jacobi identities. Since differences in +ordering may lead to unexpected results (e.g. zero expressions which +are not represented by 0), we must see to it that we restore the right +ordering of the standard quotient before returning any commutator. + +It is easily checked that reordering is necessary if and only if the +condition |processed_but_not_special| is true. The ordinary ordering can +be restored by applying |resimp| on the standard quotient part of the +commutator. In all other cases if is sufficient just to apply |simp| +to the commutator. The difference between both methods is the +following: using the second method the standard quotient will be +returned unchanged if the |cadr| of the !*SQ prefix form is |t| and +simplified if |nil|. The first method, however, will always simplify +and hence reorder the standard quotient before returning it. + +@<Get commutator |bracketname(arg1,arg2)| as...@>=@/ + commutator:=get_vector_structure(bracketname,arg1,arg2);@/ + commutator:= + if commutator and commutator_part_of commutator then + if processed_but_not_special(commutator) then + if commutator_part_of commutator=0 then nil . 1 + else resimp get_sq_of commutator_part_of commutator + else simp commutator_part_of commutator + else mksq(list(bracketname,arg1,arg2),1) @; + + +@*= Analysis of relations in Lie superalgebras. If we have a relation +in a Lie superalgebra we have a few possibilities to solve it:\medskip +\item{1.} The relation contains a commutator, for which we can solve +the relation. +\item{2.} The relation contains only generators, we have found a +linear dependency which we can solve. +\item{3.} The defining relations of the Lie superalgebra contained +some parameters, which also occur in the relation to solve. In this +case we can proceed as in case 1.\ and 2., but more carefully. For +instance, suppose that we have found the relation +$a(1)*\lie(1,2)+a(2)*x(1)+x(2)=0$. Then it is dangerous simply to +solve for $\lie(1,2)$ because $a(1)$ eventually may become 0, in which +case the relation becomes a linear dependency between $x(1)$ and +$x(2)$. Also a relation like $(a(1)-1)*x(1)+a(2)*x(2)=0$ can be +solved in two ways: we can put $a(1)=1$ and $a(2)=0$ or solve the +linear dependency in case $a(1)\neq 1$ or $a(2)\neq 0$. +\enditem +To be able to recognize these parameters we will add to each +liebracket the property |parameters|, which is an operator, elements of +which may occur as parameters of the Lie superalgebra. + +@ To keep the computations as compact as possible we will suppose that +any relation $R$ to be solved is a sum of generators and commutators +of two generators. Taking into account the points raised above we can +deduce the following strategy for finding a solution of a relation: +\medskip +\item{1.} If the relation contains at least one commutator whose +coefficient does not depend on a parameter, choose one and solve for +it. +\item{2.} If the relation contains commutators, but all possessing +coefficients depending on parameters, do not solve the relation. +\item{3.} If the relation does not contain commutators, but at least +one generator whose coefficient does not depend on a parameter, choose +one and solve for it. +\item{4.} If the relation does not contain commutators and all +generators have coefficients depending on parameters, try solve the +relation by solving the set of coefficients regarded as a linear set +of equations in an appropriate set of parameters. +\enditem +These tasks can most conveniently be performed by using the procedures +|operator_coeff|, for finding all generators with their corresponding +coefficients, and |solvable_kernels| from the TOOLS package. +The procedure |operator_coeff| has already been used and described +before. + +The call |solvable_kernels(exprn,k_oplist,c_oplist)| will +return an algebraic list of kernels |x| from operators occuring on +|k_oplist|, such that |x| occurs linearly in |exprn| and the +coefficient of |x| does not depend on any operator occuring on +|c_oplist|. From this it is clear that |solvable_kernels| can +be fruitfully used in step 1, 2 and 4. + +The process described above will be performed by the procedure +|relation_analysis|. It returns either the kernel for which the +relation is solved or |'unsolvable| or |'nested_commutator| if the +relation for whatever reason is not solvable or contains nested +commutators. + +@d zero_list= '(list 0)@; %List returned by |operator_coeff| applied +to 0% + +@u lisp operator relation_analysis; +lisp procedure relation_analysis(relation,bracketname); +begin scalar generatorname,parameters,kernel_list,solvable_kernels, + test,kernel,optimal_kernel,coefficient,clear_list; + check_if_bracketname_is_a_liebracket_in("RELATION_ANALYSIS:"); + generatorname:=get(bracketname,'generatorname); + parameters:=get(bracketname,'parameters);@/ + kernel_list:=operator_coeff(relation,generatorname); + return + if kernel_list=zero_list then 0 + else if independent_part_of kernel_list neq 0 then + @<Solve |relation| for a commutator@> + else @<Solve |relation| for a generator or parameters@>; +end$ + +@*1 Solving relations for a commutator. To solve |relation| for a +commutator we must first find out if there are commutators whose +coefficients do not contain parameters. This is performed by calling +|solvable_kernels|. If there are any we have to choose one and solve +for it. + +@<Solve |relation| for a com...@>= +begin@/ +solvable_kernels:=skip_list solvable_kernels(independent_part_of + kernel_list,bracketname,parameters); +return +if null solvable_kernels then 'unsolvable +else begin + @<Find the optimal commutator |optimal_kernel| for which to solve@>; + return + if optimal_kernel then@+ + <<linear_solve_and_assign(relation,optimal_kernel);optimal_kernel>> + else 'nested_commutator; +end; +end + +@ The main problem in solving a commutator from a relation, is +choosing the most appropriate one to solve. We adopt the idea here +that the grading of a liebracket will possess all necessary +information. For instance, if one of the components of the grading is +the length of the words in the Lie algebra, it is natural to solve for +the longest word. In this view, if a Lie algebra only possesses a zero +grading it doesn't matter for which commutator to solve. + +If a liebracket possesses a multigrading we will assume that the first +component is the most important one. This means that we will first +compare the first components and will only use the further components +if these are equal. + +The basic procedure needed for this purpose is |first_degree_higher| +which returns |t| if the first degree is higher than the second one. + +@u +lisp procedure first_degree_higher(degree_1,degree_2); +if null degree_1 then nil +else if car degree_1>car degree_2 then t +else first_degree_higher(cdr degree_1,cdr degree_2)$ + +@ In case two commutators have the same degree the above procedure +will not give a unique choice independent of the ordering currently +used in REDUCE. However, in order to guarantee an unique choice, we +shall add the indices of the commutator to the degree. + +@u +lisp procedure extended_commutator_degree(commutator,bracketname); +nconc(add_degrees(get_permuted_degree(bracketname,i), + get_permuted_degree(bracketname,j)),@| + list(i,j)) @/ +where i=first_argument_of commutator, j=second_argument_of commutator$ + + +@ In case we have to compare two generators we assume the these will +both be odd or even. Since in case of solving it is most natural to +solve for the generator with the highest number we shall add the +absolute value of the generator number to the degree list. + +@u +lisp procedure extended_generator_degree(generator,bracketname); +append(get_permuted_degree(bracketname,i),list abs(i)) @/ +where i=first_argument_of generator$ + +@ Getting the highest of two degrees is fairly simple now. We should +only be aware that in the application below the second degree may not +be a list (if there is no second element for which we have to compare +the degrees). In this case we should simply return the first degree. + +@u +lisp procedure highest_degree(degree_1,degree_2); +if atom degree_2 then degree_1 +else if first_degree_higher(degree_1,degree_2) then degree_1 +else degree_2$ + +@ In the code below the variable |optimal_kernel| will be a dotted +pair containing the present highest degree and the present optimal +kernel, until the last line. + +We will not solve the relation if it contains a nested commutator. In +this case we set |optimal_kernel| to |nil . nil|. + +@<Find the optimal commutator ...@>=@/ + optimal_kernel:= 0 . nil; + while solvable_kernels and car optimal_kernel do begin + kernel:=first_element_of solvable_kernels; + if not fixp first_argument_of kernel or + not fixp second_argument_of kernel then optimal_kernel:=nil . nil + else + if not ((test:=highest_degree(extended_commutator_degree(kernel,bracketname), + car optimal_kernel)) eq car optimal_kernel) then + optimal_kernel:=test . kernel; + solvable_kernels:=rest_of solvable_kernels; + end;@/ + optimal_kernel:=cdr optimal_kernel @; + +@*1 Solving relations for a generator or parameters. If |relation| +does not contain commutators we have to find out if there are +generators without parameter coefficients. If so we have a linear +dependency to be solved w.r.t. generator which is optimal in some +sense, otherwise we may try to solve the relation by appropriately +solving parameters. + +@<Solve |relation| for a gen...@>= +begin@/ +solvable_kernels:=skip_list + solvable_kernels(relation,generatorname,parameters); +return +if null solvable_kernels then + @<Solve |relation| by appropiately solving parameters@> +else + begin + @<Find the optimal generator |optimal_kernel| for which to solve@>; + return + if optimal_kernel then@+ + <<linear_solve_and_assign(relation,optimal_kernel);optimal_kernel>> + else 'invalid_generator; + end; +end @; + +@ +@<Find the optimal gene...@>=@/ + optimal_kernel:= 0 . nil; + while solvable_kernels and car optimal_kernel do begin + kernel:=first_element_of solvable_kernels; + if not fixp first_argument_of kernel then + optimal_kernel:=nil . nil + else + if not ((test:=highest_degree(extended_generator_degree(kernel,bracketname), + car optimal_kernel)) eq car optimal_kernel) then + optimal_kernel:=test . kernel; @/ + solvable_kernels:=rest_of solvable_kernels; + end;@/ + optimal_kernel:=cdr optimal_kernel @; + +@ Solving parameters boils down to the following actions to be taken +for each |coefficient| of a generator occuring on |kernel_list|, the +list of generators and their coefficients:\medskip +\item{1.} If |coefficient| contains some solvable parameters (i.e., +occuring linearly in it), choose the first one, solve |coefficient| +w.r.t. this parameter and put it on |clear_list|. Searching for +solvable parameters can be performed by applying |solvable_kernels| +with appropriate arguments. +\item{2.} If a |coefficient| does not contain a solvable parameter, we +have to clear all the parameters occuring on |clear_list| (i.e., which +had been previously solved) and set |clear_list| equal to |nil|, +indicating that |relation| is not solvable. + +@<If possible find and solve the list of parameters |clear_list|@>= + repeat begin + coefficient:=coefficient_of first_element_of kernel_list; + solvable_kernels:=skip_list + solvable_kernels(coefficient,parameters,parameters); + if null solvable_kernels then + begin + apply1('clear,clear_list); + clear_list:=nil + end + else begin + kernel:=first_element_of solvable_kernels; + linear_solve_and_assign(coefficient,kernel); + clear_list:=kernel . clear_list; + kernel_list:=rest_of kernel_list; + end end + until null kernel_list or null clear_list @; + +@ In order to give the user full control over the process of solving +parameters we introduce a switch |solve_parameters|, indicating if +solving of parameters is allowed. + +@<Lisp ini...@>=@/ +new_switch(solve_parameters,nil)$ + +@ If it is allowed to solve parameters we can do so, otherwise +|relation| is not solvable. The reader should verify that we are sure +that |relation| contains generators at this stage. + +@<Solve |relation| by appr...@>= +if !*solve_parameters then +begin + kernel_list:=kernel_coeff_list_of kernel_list; + @<If possible find and solve the list of parameters |clear_list|@>; + return if clear_list then 'list . clear_list else 'unsolvable; +end +else 'unsolvable @; + +@*= Solving Jacobi identities. Now we have written all kinds of tools +for solving Jacobi identities and a procedure for analysing Lie +algebraic relations, we are able to implement the top level procedure +|solve_Jacobi_identities_of| for actually solving Jacobi identities, +and some other auxiliary procedures. + +Using the procedures |find_unprocessed_commutators_of|, +|find_Jacobi_identities_of| and |relation_analysis|, solving Jacobi +identities is in fact really simple: while there are processable +commutators, find the Jacobi identities belonging to them, try to solve +and if necessary print these identities. Identities which are not +solvable automatically should be stored on the property list of the +liebracket for reconsideration by the user. + +Printing of Jacobi identities is controled by a switch +|print_identities|, which is \&{off} by default. If identities are +to be printed only the identities not equal to 0 are printed. + +@<Lisp ini...@>=@/ +new_switch(print_identities,nil)$ + +@ The procedure |solve_Jacobi_identities_of| can be written down +without much explanation. We declare it a lisp operator. + +Notice that the property |commutator_list| of a liebracket is cleared +by a call of |find_Jacobi_identities_of|. The list of unsolved +identities is stored as the property |unsolved_identities|. After +storing the unsolved identities, the property |identity_list| can be +cleared, since all identities on it have been checked. + +We want all message in this procedure to appear with the switch |nat| +turned on. Therefore we will force this and restore the old +environment afterwards. + +@u +lisp operator solve_Jacobi_identities_of; +lisp procedure solve_Jacobi_identities_of bracketname; +begin scalar generatorname,stage,identity_list,i,j,identity, + solution,nr_computed,nr_solved,environment,origin; + check_if_bracketname_is_a_liebracket_in("SOLVE_JACOBI_IDENTITIES_OF:");@/ + generatorname:=get(bracketname,'generatorname); + environment:=!*nat; !*nat:=t; stage:=0; + @<Prepare next stage@>; + while identity_list do + @<Perform current stage@>;@/ + print_statistics_of bracketname;@/ + !*nat:=environment; +end$ + +@ Preparing the next stage of solving Jacobi identities consists of +finding the unprocessed commutators and after that finding all Jacobi +identities following from them. + +@<Prepare next stage@>= +@<Print starting message for next stage@>; +find_unprocessed_commutators_of bracketname;@/ +@<Report the search for identities@>; +identity_list:=find_Jacobi_identities_of bracketname @; + +@ @<Perform current stage@>= +begin + nr_computed:=0; nr_solved:=0;@/ + @<Report the solving of identities@>; + @<Compute, solve and print all Jacobi identities in |identity_list|@>; + put(bracketname,'identity_list,nil);@/ + @<Print the number of identities solved@>; + @<Prepare next stage@>; +end @; + +@ Recall that |identity_list| is a double association list. Hence we +must unfold it before usage. Recursive solving of dependencies may +occur when we are solve a relation. Therefore we have to in- and +decrease |indentation_level!*| beforehand and afterwards. + +@<Compute, solve and print all Jacobi identities in |identity_list|@>= +for each id_list_i in identity_list do begin + i:=car id_list_i; id_list_i:=cdr id_list_i; + for each id_list_i_j in id_list_i do begin + j:=car id_list_i_j; id_list_i_j:=cdr id_list_i_j; + for each k in id_list_i_j do begin + incr(nr_computed);@/ + identity:=special_Jacobi_identity(bracketname,i,j,k); + origin:=list('list,i,j,k);@/ + @<If necessary print |identity|@>; + solution:=relation_analysis(identity,bracketname); + @<Take the actions appropriate for |solution|@>; + @<If necessary print |solution|@>; + end; + end; +end @; + +@ Due the recursive nature of solving linear dependencies we +have to use some indentation to indicate the level of +solving dependencies. Therefore we have to precede |prin2!*| by an +indentation according to a global variable |indentation_level!*|, +which represents the level of indentation necessary, in all messages +at the beginning of a line that are also usable when solving +dependencies. Messages used only when solving Jacobi identities will +only be performed at top level, so no indentation is needed there. + +The problem with the |indentation_level!*| is that we must be sure +that it must be zero at start of any command, i.e., at algebraic +level. But how can we be sure this, for something may go wrong at any +level, causing a return to algebraic level without properly decreasing +|indentation_level!*|. Fortunately, there is the |initl| mechanism of +REDUCE, causing global quantities on the (global) list |initl!*| to be +initialized to an initial value at algebraic level. Therefore we will +make |indentation_level!*| a global variable and put it on |initl!*| +with initial value 0. + +@d indent_according_to_level=@/ + for i:=1:indentation_level!* do prin2!* "| " @; +@d indented_print(string)=@/ + <<indent_according_to_level; prin2!* string>>@; +@d indented_empty_line=@/ + if indentation_level!*=0 then terpri!* t else + @+ <<terpri!* nil; indent_according_to_level; terpri!* nil>> @; + +@<Lisp ini...@>=@/ +global '(indentation_level!*)$@/ +initl!*:='indentation_level!* . initl!*$@/ +put('indentation_level!*,'initl,0)$ + +@ The message are rather straightforward and will not be explained in +all detail. + +@<Print starting message for next stage@>=@/ +prin2!* "Starting stage "; prin2!* incr(stage); prin2!* ":"; terpri!* nil; +prin2!* "Reordering the commutators..."; terpri!* nil @; + +@ @<Report the search for identities@>=@/ +prin2!* "Searching for identities..."; terpri!* nil @; + +@ @<Report the solving of identities@>=@/ +prin2!* "Solving the identities..."; terpri!* nil; +if !*print_identities then @+ +<<prin2!* "=========================="; + terpri!* nil>> @; + +@ @<If necessary print |identity|@>= +if !*print_identities and identity neq 0 then +begin indent_according_to_level; maprin origin; terpri!* nil; @/ + indent_according_to_level; maprin identity; terpri!* nil; +end @; + +@ @<If necessary print |solution|@>= +if !*print_identities and solution neq 0 then +begin + if member(solution,'(unsolvable nested_commutator invalid_generator)) + then indented_print("Not solved.") + else @+ <<if car solution=generatorname or car solution='list then + indented_print("*** Solved for: ") + else indented_print("Solved for: "); + maprin solution>>;@/ + indented_empty_line; +end @; + +@ @<Print the number of identities solved@>=@/ +indented_print(nr_solved); prin2!* " identities solved of "; +prin2!* nr_computed; indented_empty_line @; + +@ We recall that the procedure |relation_analysis| can only return 0, +|unsolvable|, |nested_commutator|, |invalid_generator| or a list, the +|car| of which is |bracketname|, |generatorname| or |list| (in which +case some parameters of the Lie superalgebra were solved). The second +third and fourth case give rise to an unsolved identity, which has to +be placed on the list of unsolved identities. The last two cases are +important enough to be mentioned even if |print_identities| is turned +\&{off}. + +In the case that we have an unsolved identity we store it together +with its origin in an algebraic list on the |unsolved_identities| list +of the liebracket. + +@d update_unsolved_identities_list=@/ +put(bracketname,'unsolved_identities,@| + list('list,origin,identity) . get(bracketname,'unsolved_identities)) @; + +@<Take the actions appropriate for |solution|@>= +if solution neq 0 then +if member(solution,'(unsolvable nested_commutator invalid_generator)) then + update_unsolved_identities_list +else if car solution=generatorname or car solution='list then +begin incr(nr_solved); + if not !*print_identities then + <<indented_print("*** Identity "); maprin origin; + prin2!* " solved for: "; maprin solution; terpri!* nil>> +end +else incr(nr_solved) @; + +@*1 Printing unsolved identities and statistics. Users should be able +to take a look at the list of unsolved identities. For this purpose we +will write a procedure |unsolved_identities_of|, which rebuilds the +list of unsolved identities by deleting all entries that have become 0 +during the process and returns it as an algebraic list for further +examination by the user. Recall that the identities on the unsolved +identities list are algebraic lists consisting of the origin of the +identity and the identity itself. + +The procedure has to be available in algebraic mode. + +@u +lisp operator unsolved_identities_of; +lisp procedure unsolved_identities_of bracketname; +begin scalar unsolved_identities,id;@/ + check_if_bracketname_is_a_liebracket_in("UNSOLVED_IDENTITIES_OF:"); + unsolved_identities:=get(bracketname,'unsolved_identities);@/ + unsolved_identities:=@+ + for each identity in unsolved_identities join + if (id:=aeval second_argument_of identity) neq 0 then @| + list list('list,first_argument_of identity,id); + put(bracketname,'unsolved_identities,unsolved_identities); + return 'list . unsolved_identities; +end$ + +@ It may be convenient to get track of some statistics concerning a +Lie superalgebra, for instance if one wants to know if a Lie +superalgebra is solved completely. The procedure |print_statistics_of| +prints the number of used generators, the number of commutators, +generators and parameters solved and the number of unsolved +identities; Of course we don't want to count the {\it special} +commutators in the number of solved commutators. We can check this by +looking at the informative part of an entry of the vectorstructure. + +@d not_special(entry)=@/informative_part_of entry neq '(special)@; + +@u +lisp operator print_statistics_of; +lisp procedure print_statistics_of bracketname; +begin scalar properties_for_direct_access,vector_i,entry_i_j,nr_solved,total; + check_if_bracketname_is_a_liebracket_in("PRINTS_STATISTICS_OF:"); + @<Initialize prop...@>; + nr_solved:=0; + for i:=-n_used:m_used do begin + vector_i:=getv(vector_structure,n+i); + for j:=i:m_used do + if (entry_i_j:=getv(vector_i,m-j)) and + commutator_part_of(entry_i_j) and not_special(entry_i_j) + then incr(nr_solved); + end; + total:=((m_used+n_used)^2-m_used+n_used)/2; + if total=0 then rederr("PRINT_STATISTICS_OF: first define used area"); + terpri!* t; + prin2!* "Statistics for liebracket "; maprin bracketname; terpri!* nil;@/ + prin2!* m_used; prin2!* " even and "; prin2!* n_used; + prin2!* " odd generators used"; terpri!* nil; + prin2!* nr_solved; prin2!* " commutators solved of ";@/ prin2!* total; + prin2!* " ("; prin2!* ((nr_solved*100)/total); prin2!* " %)"; terpri!* nil;@/ + prin2!* length get(get(bracketname,'generatorname),'kvalue);@/ + prin2!* " linear dependencies found"; terpri!* nil;@/ + total:=for each parameter in get(bracketname,'parameters) sum + length get(parameter,'kvalue);@/ + prin2!* total; prin2!* " parameters solved"; terpri!* nil;@/ + prin2!* length get(bracketname,'unsolved_identities); + prin2!* " unsolved identities"; terpri!* t; +end$ + + +@*= Access to generators. In the introduction of the previous chapter +we concluded that it was most convenient to control the access to a +generator of a Lie (super)algebra by an set-element-function and a +clear function. For a detailed description how these procedures should +act we refer to the previous chapter. In the following sections we will +take care of the set-element-function |set_generator| and the clear +function |clear_generator| belonging to the rtype |algebra_generator|. +Moreover, to let the clear function work properly, |algebra_generator| +must have a rtypefn |generator_rtypefn|. How a set-element-function, +a clear function and an rtype function work and cooperate exactly, we +have already explained for a liebracket. + +The names of all three procedures must be put on the property list of +|algebra_generator|. + +@<Lisp ini...@>=@/ +put('algebra_generator,'setelemfn,'set_generator)$@/ +put('algebra_generator,'clearfn,'clear_generator)$@/ +put('algebra_generator,'rtypefn,'generator_rtypefn)$ + +@ The same remarks that were made for the rtypefn |liebracket_rtypefn| +apply to the rtypefn for a algebra generator, |generator_rtypefn|, +since we don not want particular generators to be recognized as a +|algebra_generator|. + +@u +lisp procedure generator_rtypefn u; +nil$ + +@ The set-element-function |set_generator| of an algebra generator +should do three things: check if |val| is a valid generator and +|value| a sum of generators, do the assignment |val:=value| and adjust +all commutators containing |val|. For the last action we need to know +the name of the liebracket associated to the algebra generator +involved. We expect this name to be stored on the property list of +this generator as the property |bracketname|. + +Since we use the standard REDUCE procedure |setk1| to do the +assignment on the kvalue list of the generator we must call |rmsubs()| +ourselves, in order to assure proper reevaluation of algebraic +expressions. + +@u lisp procedure set_generator(val,value); if length val neq 2 then + rederr("SET_GENERATOR: generator must have one integer argument") +else begin scalar generatorname,bracketname,i,valuelist, + identity,solution, + nr_computed,nr_solved,environment,origin; + generatorname:=operator_name_of val; + bracketname:=get(generatorname,'bracketname); + i:=reval first_argument_of val; + value:=aeval value;@/ + @<Check that |val| and |value| are valid for assignment@>; + if used_operator_element(val) then rmsubs();@/ + setk1(val,value,t); %Do the assignment on the kvalue list of |generatorname|% + @<Adjust commutators |bracketname(i,j)| for $j=-n,\dots,1$ and $j=1,\dots,m$@>; +end$ + +@ We must check that |val| is a valid generator, i.e., $i$ must be +integer and not out of range. For this purpose we will use the macro +|wrong_atomic_argument| we wrote before. Moreover, we must check +that |value| is a sum of valid generators. This can be done most +conveniently by using |operator_coeff| and |wrong_atomic_argument|. We will +use the variable |valuelist| (local within |set_generator|) to +store the list produced by |operator_coeff|. + +@<Check that |val| and |value| are valid for assignment@>=@/ +if not atom i or wrong_atomic_argument(i) then @| + stop_with_error("SET_GENERATOR:",val,"invalid or out of range",nil); +valuelist:=operator_coeff(value,generatorname); +if independent_part_of valuelist neq 0 then + stop_with_error("SET_GENERATOR:",@|independent_part_of valuelist, + "not a sum of generators",nil); +for each term in kernel_coeff_list_of valuelist do + if length(term:=kernel_of term) neq 2 or + not atom first_argument_of term or @| + wrong_atomic_argument(first_argument_of term) then @| + stop_with_error("SET_GENERATOR:",term,"invalid or out of range",nil) @; + +@*1 Adjusting commutators. After the assignment we have to adjust +the values of $\\{bracketname}(i,j)$ for $j=-n,\dots,1$ and +$j=1,\dots,m$ according to the assignment made. Hence we have to solve +the identities $\\{bracketname}(i,j)=\\{bracketname}(\\{value},j)$. +This can be done by using the procedure |relation_analysis|. + +Recall that we stored the even and odd dimensions $m$ and $n$ on the +property list of a liebracket as the properties |even_dimension| and +|odd_dimension|. + +Note that there are some different cases to distinguish: $\lie(i,i)$ +may be set for $i<0$, but not for $i>0$. $\lie(i,0)$ may also not be +set. These cases are already incorporated in the |repeat| statement. +Moreover, note that |value| has been |aeval|'ed, hence is in !*SQ +prefixform. + +To stay in line with the procedure |solve_Jacobi_identities_of| we +will take the same actions and print the same kind of information as +we did during the solving of Jacobi identities. Recall that all +message that may occur recursively at deeper levels of solving linear +dependencies are indented according to the global variable +|identation_level!*|. Hence this level must be increased before +we start adjusting commutators. + +@<Adjust commuta...@>=@/ +environment:=!*nat; !*nat:=t; %Force the switch |nat| to be on% +@<Write a message that adjustment of commutators has begun@>; +incr(indentation_level!*); +nr_computed:=0;nr_solved:=0; +for j:=-get(bracketname,'odd_dimension):get(bracketname,'even_dimension) do + if j neq 0 and (i neq j or i<0) then + begin + incr(nr_computed);@/ + identity:=@<|bracketname(i,j)-bracketname(value,j)|@>; + origin:=list('list,i,j);@/ + @<If necessary print |ide...@>; + solution:=relation_analysis(identity,bracketname); + @<Take the actions appr...@>; + @<If necessary print |sol...@>; + end; +@<Print the number of ident...@>; +decr(indentation_level!*);@/ +!*nat:=environment %Restore the original setting of |nat|% @; + +@ @<Write a message that ...@>=@/ +indented_print("Adjusting the commutators of "); @/ maprin val; prin2!* "..."; +terpri!* nil; +if !*print_identities then @+ +<<indented_print("| ========================"); +terpri!* nil;>> @; + +@ To get the difference of |bracketname(i,j)| and +|bracketname(value,j)| we use |simp_liebracket| to get both +commutators as standard quotients, |subtrsq| to subtract them and +|mk!*sq| to convert a standard quotient into a !*SQ prefixform. +Because we use the answer to solve an algebra relation we have to +make sure that all substitutions are performed, hence we must apply +|subs2| to the standard quotient. + +@<|bracketname(i,j)-bracketname(value,j)|@>=@/ +mk!*sq subs2 subtrsq(simp_liebracket(list(bracketname,i,j)),@| + simp_liebracket(list(bracketname,value,j))) @; + +@*1 Clearing generators. The clear function of an algebra generator is +much easier than its set-element-function, because it is nearly +impossible to backtrace all commutators which have been set by the +assignment to this generator. To understand this, one should be aware +of the fact that the process of adjusting commutators to linear +dependencies of some generators may be recursive, namely if one the +relations |bracketname(i,j)-bracketname(i,value)| itself is a linear +dependency of some generators. Moreover, the relations caused by this +linear dependency may have introduced new solvable Jacobi identities, +which may already have been solved. Hence we will only give a warning +that things may get messed up. + +@u +lisp procedure clear_generator val; +if atom val then rederr("CLEAR_GENERATOR: clear associated liebracket instead") +else if length val neq 2 then + rederr("CLEAR_GENERATOR: generator must have one integer argument") +else begin scalar generatorname,kvalue,h; + generatorname:=operator_name_of val; + val:=list(generatorname,reval first_argument_of val); + kvalue:=get(generatorname,'kvalue); + if (h:=assoc(val,kvalue)) then + begin + put(generatorname,'kvalue,delete(h,kvalue)); + message("CLEAR_GENERATOR: clearing",val,"may lead to errors",nil); + end + else message("CLEAR_GENERATOR:",val,"not found",nil); +end$ + +@*= Multigradings, definitions and introduction of new generators. In the +first section we urged the need to store and retrieve integer valued +multigrades of all generators of a Lie algebra. In this section we +will introduce an environment for these multigrades, implement +procedures to find generators and unknown commutators of a certain +degree and a procedure to determine the degree of an given expression. + +Moreover, we will write a procedure to introduce a new generator for a +given (unknown) commutator and at the same time determine the degree +of it, i.e., the degree of the commutator. Besides a grading it will +also be convenient to know the definition and the ``history'' of a +newly introduced generator, i.e., what commutator was used at highest +level to define this generator and which commutators were +recursively used to construct it . This kind of information will +also be stored. + +For each generator we will store this information in a vector of +dimension $m+n$ where $m$ and $n$ are the even and odd dimension of +the Lie superalgebra, respectively. Each entry of this vector will be +a dotted pair, consisting of a degree part, a definition part and a +history part. At initialization the entry for a generator |y(i)| +($-n\leq i\leq m$) will be initialized to |'(0) . i . i|, i.e., we +initialize the degree of all generators to a multi degree of length 1 +with value 0. + +The vector with degree and history information will be stored on the +property list of the liebracket as the property |info_list|. The +information of generator |y(i)| will be contained in this vector at +index $n+i$. Access to this vector can be obtained by using the macros +|get_info| and |put_info|. The length of the multi degrees +is stored as the property |degree_length|. As stated above it is +initialized to 1. + +@d degree_part=car +@d definition_part=cadr +@d history_part=cddr +@d get_degree=degree_part get_info +@d get_definition=definition_part get_info +@d get_history=history_part get_info +@d get_info(bracketname,i)=@/ +getv(get(bracketname,'info_list),get(bracketname,'odd_dimension)+i) @; +@d put_info(bracketname,i,value)=@/ +putv(get(bracketname,'info_list),get(bracketname,'odd_dimension)+i,value)@; + +@ The most important action for manipulating degrees is the +possibility to add them. This is done by the recursive procedure +|add_degrees|, which expects its arguments to be of identical length +and, moreover, expects its arguments to be integer lists. + +@u lisp procedure add_degrees(degree1,degree2); +if degree1 then (car degree1 + car degree2) . add_degrees(cdr +degree1,cdr degree2)$ + +@ From using this package it became apparent that it may be quite +convenient to look at gradings in another order, since during the +process of computing Lie super algebras, different components of a +multigrading may turn out to play an important role. As it is quite +bothersome to change the order of gradings by hand, we will offer a mechanism +here that selects a subset of an actual multigrading in a prescribed +order. + +The procedure |degree_component_sequence| will assign a prescibed +sequence of the multigrading to a liebracket by saving this sequence +as the property |degree_sequence|. A degree sequence may be given as +an integer or an algebraic or lisp list of integers. This can be +transformed into a lisp list using the macro |make_oplist| to be +explained below. + +@u lisp operator degree_component_sequence; +lisp procedure degree_component_sequence(bracketname,degree_sequence); +begin scalar degree_length; + check_if_bracketname_is_a_liebracket_in("DEGREE_COMPONENT_SEQUENCE:"); + degree_sequence:=make_oplist(degree_sequence); + degree_length:=get(bracketname,'degree_length); + degree_sequence:= + for each component in degree_sequence collect + if fixp component and component >0 and component leq degree_length then + component + else + stop_with_error("DEGREE_COMPONENT_SEQUENCE: multigrading has no component", + component,nil,nil); + put(bracketname,'degree_sequence,degree_sequence); +end$ + +@ Given a |degree| the procedure |permuted_degree| returns |degree| +permuted w.r.t.\ a prescribed |sequence|. If there is no |sequence| +degree should be returned without change. + +@d get_permuted_degree(bracketname,i)= + permuted_degree(degree_part get_info(bracketname,i), + get(bracketname,'degree_sequence)) + +@u lisp procedure permuted_degree(degree,sequence); +if null sequence then degree else permute_degree(degree,sequence)$ + +lisp procedure permute_degree(degree,sequence); +if sequence then + nth(degree,car sequence) . permute_degree(degree,cdr sequence)$ + +@ If we want to determine the degree of a general Lie algebra element +|element| belonging to a liebracket |bracketname|, we have to +distinguish three cases:\medskip + +\item{1.} if |element| is the index number of a generator, we can simply +get the information about |element| and return the degree part of it. + +\item{2.} if |element| is a commutator, we can add the degrees of both +components. Because we will use algebraic list to return the +definition a some generator, as explained in one of the next sections, +we will also consider algebraic lists as commutators, in this case. + +\item{3.} if |element| is a generator, we can return the degree of the +index number of |element|. +\enditem +The procedure |degree_of1| takes care of these cases. Notice that we +expect commutators to have only two arguments. We can achieve this by +simplifying |element| before applying |degree_of1|. + +@u lisp procedure degree_of1(bracketname,element); +if atom element then + if wrong_atomic_argument(element) then@| + stop_with_error("DEGREE_OF: cannot determine degree of",element,nil,nil) + else get_permuted_degree(bracketname,element) +else +if operator_name_of element=bracketname or operator_name_of element='list then + add_degrees(degree_of1(bracketname,first_argument_of element),@| + degree_of1(bracketname,second_argument_of element)) +else if operator_name_of element=get(bracketname,'generatorname) then @| + degree_of1(bracketname,first_argument_of element) +else stop_with_error("DEGREE_OF: cannot determine degree of",element,nil,nil)$ + +@ At algebraic level we will return the degree of some Lie algebra +element as an algebraic list. This is done by the procedure +|degree_of|. + +In order to avoid difficulties with linear dependencies of some +generators, we shall also allow linear combinations of Lie algebra +elements and suppose that the sum offered is homogeneous. In this case +we return the degree of the first Lie algebra element encountered. + +Notice that |element| is evaluated specifically as requested in the +previous module. + +@u lisp operator degree_of; +lisp procedure degree_of element; +begin scalar operatorname,bracketname,check_element; + if (element:=reval element)=0 then @+return nil; + if not atom element then + begin + operatorname:=operator_name_of element; + if get(operatorname,'rtype)='liebracket then bracketname:=operatorname + else if get(operatorname,'rtype)='algebra_generator then @| + bracketname:=get(operatorname,'bracketname) + end; + if null bracketname then @<Check for linear combinations of Lie algebra elements@>; + if null bracketname then @| + stop_with_error("DEGREE_OF: cannot determine degree of",element,nil,nil); + return 'list . degree_of1(bracketname,element) +end$ + +@ If a linear combination is a sum we can check the first term. If it +is a quotient we have to examine the numerator. If it is a product we +have to examine the factors until we have encountered a Lie algebra +element. + +@<Check for linear combinations of Lie algebra elements@>= +begin + check_element:=element; + while not atom check_element and @| + member(operator_name_of check_element,'(quotient plus minus difference)) do + check_element:=first_argument_of check_element; + if not atom check_element then@/ + (if operator_name_of check_element='times then + @<Check all factors for Lie algebra elements@> + else + begin + operatorname:=operator_name_of check_element; + if get(operatorname,'rtype)='liebracket then bracketname:=operatorname + else if get(operatorname,'rtype)='algebra_generator then @| + bracketname:=get(operatorname,'bracketname); + if bracketname then element:=check_element + end) +end + +@ @<Check all factors for Lie algebra elements@>= + while null bracketname and (check_element:=rest_of check_element) do + <<if not atom first_element_of check_element then + begin + operatorname:=operator_name_of first_element_of check_element; + if get(operatorname,'rtype)='liebracket then bracketname:=operatorname + else if get(operatorname,'rtype)='algebra_generator then @| + bracketname:=get(operatorname,'bracketname) + end; + if bracketname then element:=first_element_of check_element>> + + +@ The next step towards a useful application of gradings is the +availability of a procedure |define_degree| to assign a new value to the +degree of some generator (since a grading with all degrees equal to 0 +isn't very useful). We impose a few requirements on the degrees to be +assigned:\medskip + +\item{1.} A newly assigned degree should have the +proper length, i.e., should have length |degree_length|. + +\item{2.} All entries of a multi degree should be integer valued. + +\item{3.} A degree can be entered as an atom, an algebraic list or a +lisp list. This is the same syntax for entering ``lists'' of some +objects which we used for lists of operatornames for multilinear +operatornames, as introduced in the TOOLS package. Hence we copy the +definition |make_oplist| which transforms one the alternatives +mentioned above in an ordinary lisp list. + +@d make_oplist(op_list)=@/if null op_list then op_list else if atom +op_list then list op_list else if +car op_list='list then cdr op_list else op_list @; + +@<Check if |degree| is a valid degree@>=@/ +if not integer_valued(degree:=make_oplist(degree)) or + length degree neq get(bracketname,'degree_length) then +stop_with_error("DEGREE:",'list . degree,"invalid degree",nil) @; + +@ Checking that a list consists of integers can be done with help of +the following recursive procedure. + +@u +lisp procedure integer_valued degree; +if null degree then t +else if fixp car degree then integer_valued cdr degree$ + +@ Assigning a new degree to a generator is really simple now: check if +the generator is indeed a generator, check the degree for its validity +and update the info entry for the generator. + +@u lisp operator define_degree; +lisp procedure define_degree(generator,degree); +begin scalar generatorname,bracketname,info; + @<Check if |generator| is valid, if so find |bracketname|@>; + @<Check if |degree| is a valid degree@>; + info:=get_info(bracketname,generator); + put_info(bracketname,generator, + degree . definition_part info . history_part info); +end$ + +@ A generator is valid, if it is an operator element +whose operator is of rtype |algebra_generator| and, moreover, the +argument of which is not out of range. Before checking the argument we +must |reval| it because this is not necessarily done (for instance in +the procedures |definition_of| and |history_of|, which will be +explained in a few sections). + +@<Check if |generator| is valid, if so find |bracketname|@>= + if atom generator then + stop_with_error("DEGREE:",generator,"invalid generator",nil); + generatorname:=operator_name_of generator; + check_if_generatorname_is_a_generator_in("DEGREE:"); + bracketname:=get(generatorname,'bracketname); + generator:=reval first_argument_of generator; + if wrong_atomic_argument(generator) then @| + stop_with_error("DEGREE: generator index", + generator,"out of range",nil) @; + +@ Since all procedures concerning degrees check for the proper length +of the degrees, there should be a procedure |change_degree_length| to +change the length of all degrees. The main part of it consists of +adapting the length of all existing degrees. This is necessary because +|add_degrees| expects all degrees to be of the same length. If the new +length of is larger than the old one we must extend all degrees with +an appropriate number of zeros, otherwise we can take the sub degree of +appropriate length. + +@u +lisp operator change_degree_length; +lisp procedure change_degree_length(bracketname,degree_length); +begin scalar m,n,old_length,shortage,extension,info,degree; + check_if_bracketname_is_a_liebracket_in("CHANGE_DEGREE_LENGTH:"); + if not fixp degree_length or degree_length <= 0 then + rederr("CHANGE_DEGREE_LENGTH: degree length should be >= 0");@/ + m:=get(bracketname,'even_dimension); + n:=get(bracketname,'odd_dimension);@/ + old_length:=get(bracketname,'degree_length); + shortage:=degree_length-old_length; + if shortage>0 then extension:=@+for i:=1:shortage collect 0;@/ + @<Adapt the |info_list|@>; + put(bracketname,'degree_length,degree_length); +end$ + +@ @<Adapt the |info_list|@>= + for i:=-n:m do + begin info:=get_info(bracketname,i); @/ + degree:=if extension then append(degree_part info,extension) + else sub_list(degree_part info,degree_length); + put_info(bracketname,i, + degree . definition_part info . history_part info) + end @; + +@ The sub list of a list |l|, consisting of the first $n$ elements, +can be collected using the recursive procedure |sub_list|. + +@u +lisp procedure sub_list(l,n); +if l and n>0 then car l . sub_list(cdr l,n-1)$ + +@ Finding the definition or the history of some generator is much +easier than the determination of the degree of some Lie algebra +element, and is taken care of by the procedure |definition_of| and +|history_of|, both to be available in algebraic mode. +There is, however, one tricky point which we should take care of in +both cases, namely if some generator is found linear independent, we +still want to be able to retrieve the definition/history of such a +generator. Therefore the arguments of |definition_of| and |history_of| +must not be evaluated. This can be achieved by giving |definition_of| +and |history_of| the property |psopfn|, i.e., the arguments of these +procedures are put on a list and the procedure which name is the value +of the property |psopfn| is applied to this list. For this we will use +the same convention as in the TOOLS package: the |psopfn| is indicated +by a additional 1, the real work, however, is done by a lisp procedure +with the same name and syntax as available in algebraic mode. + +The definition of a generator is either an integer, corresponding to the +generator, or an algebraic list with two integer arguments, +corresponding to the commutator used to define the generator. +We use algebraic lists, because it would be useless to return the +commutator self as the definition, since it will be reevaluated to the +generator immediately. Recall that for this reason we allowed +algebraic lists as a special kind of commutators in |degree_of1|. + +The history of a generator is either an integer, corresponding to the +generator, or an algebraic list of arbitrary length, consisting of +possibly nested lists of integers, corresponding to the possibly +nested commutator used to define the generator, where all integers +recursively occuring in the history have integer histories themselves, +in other words the history corresponds to the way a generator was +introduced recursively. + +@<Lisp ini...@>=@/ +put('definition_of,'psopfn,'definition_of1)$@/ +put('history_of,'psopfn,'history_of1)$ + + +@ +@u lisp procedure definition_of1 listed_generator; +definition_of first_element_of listed_generator$@# + +lisp procedure definition_of generator; +begin scalar generatorname,bracketname; + @<Check if |generator| is valid, if so find |bracketname|@>; + return get_definition(bracketname,generator); +end$@# + +lisp procedure history_of1 listed_generator; +history_of first_element_of listed_generator$@# + +lisp procedure history_of generator; +begin scalar generatorname,bracketname; + @<Check if |generator| is valid, if so find |bracketname|@>; + return get_history(bracketname,generator); +end$ + +@*1 Finding commutators and generators of a given degree. The next +important issue is how to get all (independent) generators or unknown +commutators of a given degree. The first question that arises is how +to define a useful notion of objects ``of a given degree''. A rigid +point of view is to allow all objects whose degree is totally equal to +the given degree. A more general, and to our opinion very useful, +point of view is to allow all objects that have a degree the first +part of which matches the given degree, any other elements of it not +being relevant. This notion enables us to use subsets of a +multigrading for selecting Lie algebra objects. + +The procedure |sub_degree| takes care of the strategy introduced +above, and returns |t| if |degree1| is a subset of |degree2|, |nil| +otherwise. + +@u +lisp procedure sub_degree(degree1,degree2); +if null degree1 then t +else if null degree2 then nil +else if car degree1=car degree2 then + sub_degree(cdr degree1,cdr degree2)$ + +@ Finding all generators of a given degree, is very easy now: first +check if |degree| is a valid degree (if not searching is useless), +then collect all generators whose degree match |degree|. +The result is returned a an algebraic list. + +Of course it is not useful to return generators that are linear +dependent of others, therefore we will also check on the kvalue list +of the generator if it has a value. + +@u +lisp operator generators_of_degree; +lisp procedure generators_of_degree(bracketname,degree); +begin scalar even_used,odd_used,generatorname,kvalue; + check_if_bracketname_is_a_liebracket_in("GENERATORS_OF_DEGREE:");@/ + if not integer_valued(degree:=make_oplist(degree)) then @| + stop_with_error("DEGREE:",'list . degree,"invalid degree",nil);@/ + even_used:=get(bracketname,'even_used); + odd_used:=get(bracketname,'odd_used);@/ + generatorname:=get(bracketname,'generatorname); + kvalue:=get(generatorname,'kvalue); + @<Return the list of generators with right degree@>; +end$ + +@ We use the |for| \dots |join| construct to get the list of generators +with right degree. In this way we can prevent generators with wrong +degree to cause empty entries in the result list. Since this construct +concatenates lists, we have to surround all entries by an additional +list. + +Recall that we prevented the use of 0 as an index of a generator, so +at this place we have to make an exception for it. + +@<Return the list of generators with right degree@>= + return 'list . + for i:=-odd_used:even_used join + if i neq 0 and null assoc(list(generatorname,i),kvalue) and @| + sub_degree(degree,get_permuted_degree(bracketname,i)) + then + list list(generatorname,i) @; + +@ The procedure |commutators_of_degree| returns an algebraic list of +all unknown commutators of a given degree. It's action is similar to +that of |generators_of_degree|. For efficiency reasons we will access +both the |vector_structure| and the |info_list| directly, i.e., +without using the macros |get_commutator| and |get_permuted_degree|. +Recall that the degrees may be permuted, thus we have to call +|permuted_degree| at the proper places. + +@u +lisp operator commutators_of_degree; +lisp procedure commutators_of_degree(bracketname,degree); +begin scalar properties_for_direct_access,vector_i,entry_i_j,info_list, + degree_sequence,degree_i; + check_if_bracketname_is_a_liebracket_in("COMMUTATORS_OF_DEGREE:"); + @<Initialize properties for direct access@>; + info_list:=get(bracketname,'info_list); + if not integer_valued(degree:=make_oplist(degree)) then @| + stop_with_error("DEGREE:",'list . degree,"invalid degree",nil); + degree_sequence:=get(bracketname,'degree_sequence); + @<Return the list of commutators with right degree@>; +end$ + +@ In this case we need not make exceptions for 0 since all $\lie(i,0)$ +are initialized to 0, hence have a value. + +@<Return the list of commutators with right degree@>= + return 'list . + for i:=-n_used:m_used join + <<vector_i:=getv(vector_structure,n+i); + degree_i:=degree_part getv(info_list,n+i);@/ + for j:=i:m_used join + if (null (entry_i_j:=getv(vector_i,m-j)) or + null commutator_part_of(entry_i_j)) and@| + sub_degree(degree,@| + permuted_degree(add_degrees(degree_i, + degree_part getv(info_list,n+j)), + degree_sequence))@/ + then + list list(bracketname,i,j) + >> @; + +@*1 Introduction of new generators. In the light of all the tools we +made for showing and maintaining the degree, definition and history of +a generator, it will be very convenient to have a procedure +|new_generators| that introduces a new generator for some unknown +commutator and at the same time updates the |info_list|. Recall that +associated to a liebracket are the properties |even_used| and +|odd_used|, indicating the number of even and odd generators that are +actually used, respectively. It will be clear that we can use these +properties right here to determine first unused index available for a +newly introduced generator, and, moreover, after introducing a new +generator, have to update them. + +Keeping in mind that the procedure |commutators_of_degree| may be used +to get a list of unknown commutators, for which new generators may be +introduced, it also seems convenient if |new_generators| is able to +deal with lists of unknown commutators. This can be done by calling +|new_generators| recursively on all elements of the list. + +In case of a single commutator we will return the newly introduced +generator, in case of a list of commutators the corresponding list of +newly introduced generators. The second case motivates us not to +produce an error message if, for whatever reason, it impossible to +create an new generator for some object, but simply return it +unchanged, for otherwise it will be impossible to return a list +containing the generators which had already been created. + +Hence we can deduce the following strategy:\medskip + +\item{1.} +if the object is an atom return it unchanged. + +\item{2.} if the object is an algebraic list apply |new_generators| to +all its elements and return the list of results. There is, however, +one tricky point: some commutator may occur several times on the list. +Since we are working in lisp mode this will not be detected +automatically, and thus, for each occurence a new generator would be +introduced. Therefore we must |reval| each entry of the list before +doing anything. + +\item{3.} +if the object is an other operator element but not a commutator, +return it unchanged. + +\item{4.} +if the object is a commutator, check if it is possible to introduce a +new generator for it, if so update the |info_list| and return the +newly introduced generator, else return the commutator unchanged. + +@u +lisp operator new_generators; +lisp procedure new_generators commutator_list; +begin scalar operatorname,bracketname,arg1,arg2,indx, + generator,degree,definition,history; +return + if atom commutator_list then commutator_list + else @+<< + operatorname:=operator_name_of commutator_list; + if operatorname='list then + 'list . for each commutator in arguments_of commutator_list collect @| + new_generators reval commutator + else + if not get(operatorname,'rtype)='liebracket then commutator_list + else + @<If possible introduce and return a new generator, update |info_list|@> >>; +end$ + +@ It is only possible to introduce new generators for commutators of +two generators which are not out of range. + +@<If possible introduce and return a new generator...@>= +begin + bracketname:=operatorname;@/ + arg1:=first_argument_of commutator_list; + arg2:=second_argument_of commutator_list; + if wrong_atomic_argument(arg1) or wrong_atomic_argument(arg2) then + return commutator_list; + @<Check if new |generator| is possible, if so update |info_list|@>; + return if generator then + setk(commutator_list,generator) + else commutator_list +end @; + +@ Depending if the commutator is even or odd, we must introduce a new +even or odd generator, respectively. + +@<Check if new |generator| is possible, if so update |info_list|@>= +if even_element(operatorname,commutator_list) then @| + @<Update |even_used| and |info_list|, if new |generator| is possible@> + else + @<Update |odd_used| and |info_list|, if new |generator| is possible@> + +@ A new generator is possible if index of it (i.e., the number of used +elements plus 1) does not exceed the maximal dimension. + +@<Update |even_used| and |info_list|, if new |generator| is possible@>= +begin + indx:=get(operatorname,'even_used)+1; + if indx<=get(operatorname,'even_dimension) + then@/ + <<put(operatorname,'even_used,indx); + generator:=list(get(operatorname,'generatorname),indx); + @<Update the |info_list|@> >>; +end @; + +@ @<Update |odd_used| and |info_list|, if new |generator| is possible@>= +begin + indx:=get(operatorname,'odd_used)+1; + if indx<=get(operatorname,'odd_dimension) + then@/ + <<put(operatorname,'odd_used,indx); + indx:=-indx; + generator:=list(get(operatorname,'generatorname),indx);@/ + @<Update the |info_list|@> >>; +end @; + +@ Before updating the |info_list| at index |indx|, we must compute +the degree of the newly introduced generator using |add_degrees|, +construct its definition and its history. The last can be done by +applying the procedure |add_histories|, to be implemented in the next +module. + +@<Update the |info_list|@>= +degree:=add_degrees(get_degree(operatorname,arg1), + get_degree(operatorname,arg2));@/ +history:=add_histories(get_history(operatorname,arg1), + get_history(operatorname,arg2));@/ +definition:=list('list,arg1,arg2); +put_info(bracketname,indx,degree . definition . history) @; + +@ Recall that nested commutators are treated right associative by +|simp_liebracket|. Therefore we can append the second history to the +first. + +@u lisp procedure add_histories(history1,history2); +if fixp history2 then list('list,history1,history2) +else + if fixp history1 then 'list . history1 . arguments_of history2 + else 'list . append(list history1,arguments_of history2)$ + +@ Before we can use the procedure |new_generators| we must be able to +change the properties |even_used| and |odd_used|, because these are +both initialized to 0. For clarity we will in- and output them in the +same way, namely as an algebraic list |{even_used,odd_used}|. + +@u lisp operator list_used; +lisp procedure list_used bracketname; +<<check_if_bracketname_is_a_liebracket_in("LIST_USED:"); + list('list,get(bracketname,'even_used),get(bracketname,'odd_used))>>$ + +@ Before defining |even_used| and |odd_used| we must check that they +are integers and not out of range. + +@u +lisp operator define_used; +lisp procedure define_used(bracketname,used_list); +begin scalar even_used,odd_used; + check_if_bracketname_is_a_liebracket_in("DEFINE_USED:"); + if atom(used_list) or operator_name_of(used_list) neq 'list or + length(used_list) neq 3 then + stop_with_error("DEFINE_USED:",used_list,"invalid list of dimensions",nil); + even_used:=first_argument_of used_list; + odd_used:=second_argument_of used_list; + if even_used>get(bracketname,'even_dimension) or + odd_used>get(bracketname,'odd_dimension) + then rederr("DEFINE_USED: dimensions out of range");@/ + put(bracketname,'even_used,even_used); + put(bracketname,'odd_used,odd_used); +end$ + +@*= Declaration and saving of liebrackets. Now we know all ins and +outs of liebrackets (especially the list of properties associated to +them), we can finally write the procedures for the declaration and +saving of liebrackets. Moreover, we will write a procedure for +enlarging the dimensions of a liebracket. + +@ For the declaration of liebrackets we will use the following syntax +$$\hbox{liebracket bracketname(generatorname,even dimension,odd +dimension[,algebra elements,parameters])}$$ where algebra elements and +parameters may be an identifier or an algebraic or lisp list of +identifiers. For this purpose we can use the macro definition +|make_oplist| defined before. + +We give the procedure |liebracket| the property |stat| with value +|rlis| in order to allow more liebracket declarations at a time. +It should be noted that, in doing so, |liebracket| need not be +declared a lisp operator anymore to make it available in algebraic +mode. + +Procedures with |stat='rlis| can have an arbirtrary number of +arguments which the parser passes to them on a list. In our case this +means that |liebracket| is offered a list of liebracket declarations. + +@<Lisp ini...@>= +put('liebracket,'stat,'rlis)$ + +@ The outline of the procedure |liebracket| is real simple: for each +declaration offered extract all identifiers and dimensions from it, +check if this gives rise to a valid liebracket declaration and finally +set up the right environment. + +@u lisp procedure liebracket decl_list; +begin scalar bracketname,generatorname,m,n, + algebra_elements,parameters,rtype,vector_structure,info_list; + for each decl in decl_list do + begin if length decl < 4 then @| + stop_with_error("LIEBRACKET:",decl,"invalid liebracket declaration",nil);@/ + @<Get |bracketname|, |generatorname|, |m|, |n|, +|algebra_elements| and |parameters|@>; + @<Check the liebracket declaration for its validity@>; + @<Set up the environment for liebracket |bracketname|@>; + end; +end$ + +@ Since |decl| is a list of length at least 4 we can retrieve the +desired variables and dimensions from it. If there are no algebra +elements or parameters specified, |algebra_elements| and |parameters| +will become |nil|. We transform them in orderly lisp lists using +|make_oplist|. + +@<Get |bracketname|, |generatorname|, |m|, |n|, |algebra_elements| + and |parameters|@>=@/ +bracketname:=car decl; generatorname:=cadr decl;@/ +m:=reval caddr decl; n:=reval cadddr decl;@/ +if decl:=cddddr decl then +<<algebra_elements:=car decl;algebra_elements:=make_oplist(algebra_elements);@/ +if cdr decl then parameters:=cadr decl; parameters:=make_oplist(parameters)>>@; + +@ For a proper liebracket declaration |bracketname| and +|generatorname| must both be identifiers and may not be any other REDUCE +structure. Moreover |m| and |n| must both be positive integers. +We do not check if all objects offered as algebra +elements or parameters are identifiers, since this cannot do any +harm. + +@<Check the liebracket declaration for its validity@>= +if not idp bracketname or not idp generatorname or not fixp m or not + fixp n or m<0 or n<0 then @| + stop_with_error("LIEBRACKET:",decl,"invalid liebracket declaration",nil); @/ +if get(bracketname,'simpfn) then @| + stop_with_error("LIEBRACKET: operator",bracketname, + "invalid as liebracket",nil);@/ +if rtype:=get(bracketname,'rtype) then @| + stop_with_error("LIEBRACKET:",rtype,bracketname,"invalid as liebracket");@/ +if get(generatorname,'simpfn) then @| + stop_with_error("LIEBRACKET: operator",generatorname, + "invalid as generator",nil);@/ +if rtype:=get(generatorname,'rtype) then @| + stop_with_error("LIEBRACKET:",rtype,generatorname,"invalid as generator") @; + +@ If we have a proper liebracket declaration we have to set up an +environment for the liebracket |bracketname|, first by properly +initializing the |vector_structure| and secondly by putting all other +necessary properties on the property list of |bracketname|. + +Notice that properties of a liebracket that are lists initially being +empty need not be initialized. For convenience we will list here the +lists of all properties associated with a liebracket and a Lie algebra +generator, which we will use later on. For an explanation of the +properties we refer to the sections where they were introduced. +We also recall that we have to flag |bracketname| |full| in order to +enable simplification in the way we perform it. + +@d list_of_properties_of_a_liebracket=@/ +'(vector_structure info_list !*jacobi_var!* even_dimension odd_dimension +even_used odd_used degree_length degree_sequence algebra_elements +parameters oplist resimp_fn +generatorname rtype simpfn commutator_list identity_list +unsolved_identities kvalue)@; +@d list_of_properties_of_a_generator=@;@/ +'(bracketname rtype simpfn kvalue)@; + +@<Set up the environment for liebracket |bracketname|@>= +@<Initialize the vectors |vector_structure| and |info_list|@>; +put(bracketname,'vector_structure,vector_structure);@/ +put(bracketname,'info_list,info_list);@/ +put(bracketname,'!*jacobi_var!*,list t);@/ +put(bracketname,'even_dimension,m);@/ +put(bracketname,'odd_dimension,n);@/ +put(bracketname,'even_used,0);@/ +put(bracketname,'odd_used,0);@/ +put(bracketname,'degree_length,1);@/ +put(bracketname,'algebra_elements,algebra_elements);@/ +put(bracketname,'parameters,parameters);@/ +put(bracketname,'oplist, + bracketname . generatorname . 'list . 'df . algebra_elements);@/ +put(bracketname,'resimp_fn,'resimp_liebracket);@/ +put(bracketname,'generatorname,generatorname);@/ +put(bracketname,'rtype,'liebracket);@/ +put(bracketname,'simpfn,'simp_liebracket);@/ +put(generatorname,'bracketname,bracketname);@/ +put(generatorname,'rtype,'algebra_generator);@/ +put(generatorname,'simpfn,'simpiden);@/ +flag(list bracketname,'full) @; + +@ Now we know all properties associated to a liebracket we can also +write the remaining part of the clear function of a liebracket, namely +removing the properties (and flags). Notice that we do not remove the +|klist|'s of the liebracket and the generators since the commutators +and generators may be used elsewhere. + +@<Remove all prop...@>= +begin scalar bracketname,generatorname; + bracketname:=val; + generatorname:=get(bracketname,'generatorname); + for each property in list_of_properties_of_a_liebracket do + remprop(bracketname,property); + for each property in list_of_properties_of_a_generator do + remprop(generatorname,property);@/ + remflag(list bracketname,'full); +end @; + +@ Recall that the vector structure containing all commutators is a +double vector, the outer of dimension $m+n$, such that for $-n\leq +i\leq m$ at index $n+i$ all commutators $\lie(i,j)$ with $i\leq j\leq +m$ are stored at index $m-j$ in a vector of dimension $m-i$. +Moreover, we have to initialize the ``special'' commutators +$\lie(i,0)$ ($-n\leq i\leq 0$) and $\lie(0,j)$ and +$\lie(j,j)$ ($0<j\leq m$) to 0 and mark them as special. +The second field of each special entry is the klist replacement; it +must be initialized to |nil|. + +@<Initialize |vector_structure|@>= +vector_structure:=mkvect(m+n); +for i:=-n:m do putv(vector_structure,n+i,mkvect(m-i)); +for i:=-n:0 do putv(getv(vector_structure,n+i),m,'(special) . nil . 0); +for j:=1:m do + <<putv(getv(vector_structure,n),m-j,'(special) . nil . 0); + putv(getv(vector_structure,n+j),m-j,'(special) . nil . 0)>> @; + +@ The |info_list| has to be initialized as follows: each generator +|y(i)| has initial degree 0, definition |y(i)| and history $i$. + +@<Initialize the vectors |vector...@>= +@<Initialize |vector_...@>; +info_list:=mkvect(m+n); +for i:=-n:m do putv(info_list,n+i,'(0) . i . i) @; + +@*1 Saving and printing all values of a liebracket. Saving a +liebracket |bracketname| boils down to saving all properties of +|bracketname| in a file, this time including the |klist|'s of the +liebracket and the generator. Before saving it all we have to call +|rmsubs| in order to enable simplification of algebraic expressions +after being read in. We print the values of all properties using the +procedure |prin1|, which, unlike the procedure |prin2|, prints +rereadable expressions. + +One should be aware of the fact that the standard REDUCE token reader +|token1| is not able to recognize and return a vector as a token. +However, on our system |token1| has been replaced by a token reader +based on the lisp underneath REDUCE, which \`{\i}s able to read +vectors. Moreover, on another configuration at our site which did use +|token1| as the token reader, we could patch it in such way that it +was also able to read vectors without too much difficulty. + +The implementation of |save_liebracket| beneath explicitly uses the +fact that the token reader used is able to read vectors. If this is +not the case |save_liebracket| has to be rewritten in such a way that +all commutators to be saved are temporarily stored on a list which can +be read by |token1|. In that case the vector structure has to be build +up again. This case will be dealt with in a separate change file +belonging to this package. + +The procedure |save_liebracket| has to be available in algebraic mode. + +@d print_this_property_of(bracketname)=@/ +<<prin2 "put('"; prin1 bracketname; prin2 ",'"; prin1 property; prin2 ",'"; + prin1 get(bracketname,property); prin2 ")$"; terpri(); terpri()>> @; + +@u +lisp operator save_liebracket; +lisp procedure save_liebracket(bracketname,savefile); +begin scalar generatorname; + check_if_bracketname_is_a_liebracket_in("SAVE_LIEBRACKET:");@/ + generatorname:=get(bracketname,'generatorname);@/ + rmsubs(); + out savefile;@/ + write "lisp$"; %Reading the properties should be done in symbolic mode% + terpri(); terpri();@/ + @<Check if this package has been loaded@>; + for each property in 'klist . list_of_properties_of_a_liebracket do + print_this_property_of(bracketname);@/ + write "flag('(",bracketname,"),'full)$"; terpri(); terpri(); + for each property in 'klist . list_of_properties_of_a_generator do + print_this_property_of(generatorname); + @<Incorporate statements to repair the |vector_structure|@>; + write "algebraic$ end$";@/ + shut savefile; +end$ + +@ We can check if this package has been loaded by verifying that the +procedure |simp_liebracket| has a definition, using |getd|. + +@<Check if this package has been loaded@>=@/ +write "if not getd 'simp_liebracket then";terpri(); +write "rederr(", +"""Load the Lie superalgebra package before reading this file""",")$"; +terpri();terpri() @; + +@ The informative part of some elements in a vector structure may have +the value |(t)|, indicating that the commutator belonging to such an +element has been reordered and the Jacobi identities with the +commutator have been computed. In this case the value of this +informative part is not ordinary |(t)| but in fact it is the value of +|!*jacobi_var!*| belonging to the liebracket under consideration. +After reading the vector structure from file this is not the case +anymore, so we have to replace all occurences of |(t)| by +|!*jacobi_var!*|. This is done by the procedure +|repair_vector_structure_of|. + +Notice that due to the procedure |find_unprocessed_commutators_of| +only commutators with |-n_used|${}\leq i,j \leq{}$|m_used| have +been processed, hence these are the only commutators that have to be +repaired. + +@u +lisp procedure repair_vector_structure_of bracketname; +begin scalar properties_for_direct_access,!*jacobi_var!*,vector_i,entry_i_j; + @<Initialize properties for dir...@>; + !*jacobi_var!*:=get(bracketname,'!*jacobi_var!*); + for i:=-n_used:m_used do + begin vector_i:=getv(vector_structure,n+i); + for j:=i:m_used do + if (entry_i_j:=getv(vector_i,m-j)) and informative_part_of(entry_i_j)='(t) + then @| + putv(vector_i,m-j,!*jacobi_var!* . k_info_and_commutator_part_of entry_i_j); + end; +end$ + +@ @<Incorporate statem...@>=@/ +write "repair_vector_structure_of '",bracketname,"$"; terpri(); terpri() @; + +@ The result of applying the procedure |save_liebracket| is a file, +which can only be read using this package. It will also be convenient +to have a procedure that lists all known commutators in a rereadable +form. A statement |a:=b| can be printed like that by applying +|varpri(b,list('setk,mkquote a,mkquote b),'only)|. With this knowledge +we can easily implement a procedure |print_liebracket| which print the +definitions of all known commutators $\lie(i,j)$ for |-n_used|${}\leq +i\leq j\leq{}$|m_used|, which are not special. Printing of the +definition of special commutators is not useful since these +commutators will allways be 0. + +@u +lisp operator print_liebracket; +lisp procedure print_liebracket bracketname; +begin scalar properties_for_direct_access,vector_i,commutator_i_j; + check_if_bracketname_is_a_liebracket_in("PRINT_LIEBRACKET:");@/ + @<Initialize properties for dir...@>; + for i:=-n_used:m_used do + begin vector_i:=getv(vector_structure,n+i); + for j:=i:m_used do + if (i neq 0) and (j neq 0) and (i neq j or i<0) and @| + (commutator_i_j:=getv(vector_i,m-j)) and + (commutator_i_j:=aeval commutator_part_of commutator_i_j) then @| + varpri(commutator_i_j,@| + list('setk,mkquote list(bracketname,i,j),mkquote commutator_i_j), + 'only); + end; +end$ + +@*1 Changing the dimensions of a liebracket. Until now the dimensions +of a liebracket have to be given on declaration and cannot be changed +anymore. It would be very inconvenient if the only way to enlarge the +dimensions is to declare a larger liebracket and do all computations +again. Therefore we will write a procedure |change_dimensions_of| +which does a better job. It can be used both to enlarge or diminish +the dimensions of the Lie algebra. It should be available in algebraic +mode. + +Essentially the only actions necessary for ``enlarging'' a liebracket are +the construction of a larger/smaller |vector_structure|, putting all +information from the old to the new vector structure and update the +properties containing information about the dimensions. + +Moreover, if the new dimensions are bigger than the old ones, some of +the newly introduced commutators may have to be adjusted according to +linear dependencies found before and, moreover, the length of the +degrees of the newly introduced generators has to be adapted. + +@u +lisp operator change_dimensions_of; +lisp procedure change_dimensions_of(bracketname,m,n); +begin scalar old_vector_structure,old_m,old_n,new_m,new_n,old_vector_i,entry_i_j, + vector_structure,old_info_list,info_list,vector_i,m_used,n_used, + degree_length,kernel_list; + check_if_bracketname_is_a_liebracket_in("CHANGE_DIMENSIONS_OF:");@/ + old_m:=get(bracketname,'even_dimension); + old_n:=get(bracketname,'odd_dimension);@/ + new_m:=min(m,old_m);new_n:=min(n,old_n);@/ + m_used:=min(new_m,get(bracketname,'even_used)); + n_used:=min(new_m,get(bracketname,'odd_used));@/ + old_vector_structure:=get(bracketname,'vector_structure); + old_info_list:=get(bracketname,'info_list); + @<Initialize the vectors |vector...@>; + @<Transfer all known commutators and degrees to the larger vectors@>; + put(bracketname,'vector_structure,vector_structure);@/ + put(bracketname,'info_list,info_list); + put(bracketname,'even_dimension,m); + put(bracketname,'odd_dimension,n);@/ + put(bracketname,'even_used,m_used); + put(bracketname,'odd_used,n_used); + @<Take care of the eventual linear dependencies and the degree length@>; +end$ + +@ We have to transfer all known commutators |bracketname(i,j)| with +|-new_n|${}\leq i,j\leq{}$|new_m| and also all degrees of +|generatorname(i)| for |-new_n|${}\leq i\leq{}$|new_m|. + +@<Transfer all known...@>= +for i:=-new_n:new_m do +begin + old_vector_i:=getv(old_vector_structure,old_n+i);@/ + vector_i:=getv(vector_structure,n+i); + for j:=i:new_m do + if (entry_i_j:=getv(old_vector_i,old_m-j)) then + putv(vector_i,m-j,entry_i_j);@/ + putv(info_list,n+i,getv(old_info_list,old_n+i)); +end @; + +@ We take care of eventual linear dependencies in a very pragmatic +way: if the new dimensions are larger than the old ones, we just do +the assignments for the generators again. The adjustment of the new +commutators will then be taken care of automatically. + +If |degree_length| is the current degree length, changing the degree +length for the newly introduced generators can be taken care of by two +subsequent calls of |change_degree_length| with |2*degree_length| and +|degree_length|, respectively. + +Notice that before taking care of the eventual dependencies the degree +length has to possess its proper length since |relation_analysis| uses +this to decide which kernel to solve for. + +@<Take care of the eventu...@>= +if m>old_m or n>old_n then +begin +degree_length:=get(bracketname,'degree_length); +change_degree_length(bracketname,2*degree_length); +change_degree_length(bracketname,degree_length); +kernel_list:= + for each dependency in get(get(bracketname,'generatorname),'kvalue) collect@| + first_element_of dependency; +for each kernel in kernel_list do setk(kernel,aeval kernel); +end + +@*= Printing and parsing of commutators. The next subject to be dealt +with is the preparation of facilities for a ``default'' liebracket +whose commutators can be typed in and will be printed out using square +brackets. For this we will introduce a global variable +|default_liebracket!*|, which is the name of the liebracket known to +REDUCE as the default liebracket. We initialize it to |lie|, since +this is the name we usually use. + +@<Lisp ini...@>=@/ +initialize_global(default_liebracket!*,'lie)$ + +@ REDUCE input is parsed by the procedure |xread1|, which converts +it to a form that can be translated to lisp by the procedure |form|. +If we want REDUCE to translate expressions in square brackets as +commutators of the default liebracket |default_liebracket!*|, we can +do this by giving the token |![| the property |stat| with value +|liebracket_stat|, indicating to the parser |xread1| that expressions +in square brackets are to be dealt with by a separate procedure +|liebracket_stat|, and flagging |!]| as a delimiter, again indicating +to |xread1| that the expression currently being parsed has ended. + +@<Lisp ini...@>=@/ +put('![,'stat,'liebracket_stat)$@/ +flag(list '!],'delim)$ + +@ If |xread1| encounters the token |![|, it calls the procedure +|liebracket_stat|, which will take control over the parsing of the +commutator that follows the opening bracket. The argument(s) of the +commutator can be read by recursively calling |xread| which will parse +until it encounters the delimiter |!]| and return the parsed +arguments. + +Before returning the list representing the commutator of the default +liebracket we must scan another token in order to keep the parsing +process in a correct state. + +@u +lisp procedure liebracket_stat; +begin scalar arguments; + arguments := xread nil;@/ + arguments :=@+ + if atom arguments or car arguments neq '!*comma!* @| then + arguments @+ + else cdr arguments;@/ + scan(); + return default_liebracket!* . arguments; +end$ + +@ If some algebraic operatorname has the property |prifn|, the printing +routines of REDUCE will transfer the control over the printing of an +element of such operatorname to the procedure which name is the value of +the property |prifn|. So by introducing a |prifn| |liebracket_prifn| +we can print the commutators of some liebracket using square brackets. + +If we want to print a commutator using square brackets we can print +``['' and ``]'' and in between the arguments of the commutator +separated by commas. + +@u +lisp procedure liebracket_prifn commutator; +begin + prin2!* "[";@/ + inprint('!*comma!*,0,arguments_of commutator);@/ + prin2!* "]"; +end$ + +@ The operatorname initially declared default liebracket must have the +right |prifn|. + +@<Lisp ini...@>=@/ +put(default_liebracket!*,'prifn,'liebracket_prifn)$ + +@ The default liebracket can be changed by using the procedure +|default_liebracket|, which is available in algebraic mode and takes +all necessary actions. + +@u lisp operator default_liebracket; + +lisp procedure default_liebracket bracketname; +begin + remprop(default_liebracket!*,'prifn);@/ + default_liebracket!*:=bracketname;@/ + put(default_liebracket!*,'prifn,'liebracket_prifn); +end$ + +@*= Basis transformations of Lie superalgebras. If one is working with +a Lie superalgebra, the structure of which is partially determined and +partially is to be determined, it may be very convenient to perform a +basis transformation of this algebra. Proceeding this way the +structure of the remaining part might become clearer. Of course if we +perform a basis transformation, we also want to have all (known) +commutators expressed in elements of the new basis. Hence we have to +perform a transformation of the commutator table, i.e., the +vectorstructure, too. + +For this suppose we are given a Lie (super)algebra with basis $x_i$ +$(i\in I)$, and furthermore suppose we have a basis transformation +given by $y_j=a^i_j x_i$ $(j\in I)$, where we have used the sommation +convention. Then in general a commutator $[x_k,x_l]$ $(k,l\in I,k\leq +l)$ is given by +$$[x_k,x_l]=c^i_{kl}x_i+\sum_{k',l'} [x_{k'},x_{l'}]_u$$ +where the subscript $u$ denotes (yet) unknown commutators, i.e., +commutators having empty entries in the vectorstructure. Using the +basis transformation given above, we are interested in the commutators +$$[y_p,y_q]=a^k_p a^l_q [x_k,x_l]$$ +with all commutators on the right hand side expressed in terms of the +new basis $y_j$. Therefore we can perform the transformation of a Lie +product table in two steps:\medskip + +\item{1.} Express all commutators $[x_k,x_l]$ in terms of the new +basis. +\item{2.} Express all commutators $[y_p,y_q]$ in terms of the new +basis using the result of the first step. +\enditem +It seems clear that we need the inverse transformation +$b^j_i=(a^i_j)^{-1}$ in order to perform the first step. Using the +inverse transformation we get +$$[x_k,x_l]=c^i_{kl}b^j_i y_j+\sum b^p_{k'}b^q_{l'}[y_p,y_q]$$ + +For the implementation in REDUCE of this rather simple exercise there +are some additional points involved. For instance, the newly created +commutators should be stored in another liebracket since the +generatorname changed from, let's say, $x$ to $y$. And, how exactly to +perform the transformation and the inverse transformation. As we will +see later on, we will use some rather tricky temporary demolishing of +the old liebracket structure to get everything right. Moreover, for +reasons of efficiency, we will temporarily bypass all kinds of checks +performed on the assignment of commutators and instead perform one +sufficient check for all assignments beforehand. + +@ The first point to be taken care of is how to deal with the +transformation and inverse transformation. Points involved are {\it +a\/}) how to represent the transformation, {\it b\/}) how to compute the +inverse transformation and finally, in the light of the last remark of +the previous section, {\it c\/}) how to see to it that the transformation +leaves no elements untransformed. + +By a basis transformation we understand a (possibly empty) algebraic +list of equations of the form $y_j=a^i_j x_j$, where $(a^i_j)$ is +invertible. Notice that we do not require a basis transformation to +comprise all old generators $x_i$, but also a subset is allowed. +Nevertheless if we are transforming commutators to a new basis, such +non occuring generators may appear in the computation of some +commutators. Hence, in order to get a correct new commutator table, +we must find the remaining non transformed generators and transform +them into new generators. + +In ordinary cases it will be sufficient only to transform the used +generators, by which we mean generators in one of the ranges +$1,\dots,$|even_used| or $-1,\dots,$|odd_used|. However, for whatever +reason, some generator outside these ranges may also be used, in which +case transforming the used generators will not be sufficient. +Therefore we will introduce a switch |full_transformation| indicating +if transformation of the used generators is sufficient or if +transformation of the whole algebra is necessary. We put +|full_transformation| \&{off} be default. + +@<Lisp ini...@>=@/ +new_switch(full_transformation,nil)$ + +@ Depending on the switch |full_transformation| we have different +upperbounds for the even and odd generators to be transformed, namely +the properties |even_used| and |odd_used| if |full_transformation| is +\&{off}, or |even_dimension| and |odd_dimension| if +|full_transformation| is \&{on}, of the liebracket under consideration. +In both cases we will use vectors |transform_vector| and +|inverse_vector| to store the basis transformation and its inverse. + +@<Get |even_bound| and |odd_bound| and initialize the vectors@>= + if null !*full_transformation then + begin even_bound:=get(bracketname,'even_used); + odd_bound:=get(bracketname,'odd_used); + end + else + begin even_bound:=get(bracketname,'even_dimension); + odd_bound:=get(bracketname,'odd_dimension); + end;@/ + transform_vector:=mkvect(even_bound+odd_bound); + inverse_vector:=mkvect(even_bound+odd_bound) @; + + +@ The outline of the top level transformation procedure +|transform_liebracket| is very easy: extend and process the basis +transformation, compute the inverse transformation, and transform +the commutator table using these transformations. + +@u +lisp operator transform_liebracket; +lisp procedure transform_liebracket(bracketname,new_bracketname, + new_generatorname,basis_transformation); +begin scalar generatorname,even_bound,odd_bound,transform_vector,inverse_vector, + new_generator,transformed_sq,splitted_sf,generator_list,x_gap,y_gap, + new_even_used,new_odd_used,result; + check_if_bracketname_is_a_liebracket_in("TRANSFORM_LIEBRACKET:"); + generatorname:=get(bracketname,'generatorname); + @<Get |even_bound|...@>; + @<Extend and compute the basis transformation and its inverse@>; + @<Transform the liebracket |bracketname| into |new_bracketname|@>; +end$ + +@*1 Storage and extension of the transformation. Given the algebraic +list |basis_transformation| representing the basis transformation we +have to fill the vectors |transform_vector| and |inverse_vector|. +Processing the transformation essentially consists of three steps: +read in and process |basis_transformation|, compute the inverse +transformation and extend the transformation to the whole range of +generators that must be transformed. + +@<Extend and compute the ...@>= +@<Read in and process |basis_transformation|@>; +@<Compute and store the inverse transformation@>; +@<Extend the transformation to |even_bound| and |odd_bound|@> @; + +@ A basis transformation consists of a number of transformation rules +of the form $y_j=a^i_jx_i$, which we have to check for their validity +and store in the vector |transform_vector|. These checks consist of: +\medskip + +\item{1.} checking if the transformation rule is of the +proper form. + +\item{2.} checking that the new generator $y_j$ lies +within the proper range. + +\item{3.} checking that the right hand side of the transformation rule +is indeed a sum of generators. This can for instance be done using +the procedure |operator_coeff|. We will, however, use the low level +procedure |split_form|, which underlies the procedure |operator_coeff| +and acts on standard forms, since we can use the splitted forms +returned by |split_form|, as we will see further on. The right hand +side of the transformation rule is a sum of generators if the +independent part, i.e., the |car|, of the result of |split_form| is +|nil|. +\item{4.} checking that the sign of the generators on the right hand +side of the tranformation rules is the same as on the left hand side. +\enditem +Moreover, in order to know for which old generators we have to solve +the set of transformation rules we store all occuring generators on +|generator_list|. + +For each transformation rule we will store the right hand side as a +standard quotient |transformed_sq| as well as the splitted list returned by +|split_form|, |splitted_sf|. + +@d lhs=cadr +@d rhs=caddr +@d valid_transformation_rule = @/ + (eqexpr transformation_rule and + not atom lhs transformation_rule and @| + operator_name_of lhs transformation_rule = new_generatorname) @; +@d valid_generator(generator) = @/ + (fixp generator and generator neq 0 and generator <= even_bound and +generator >= -odd_bound)@; +@d get_new_generator_ok= @/ + <<new_generator:=first_argument_of lhs(transformation_rule); + valid_generator(new_generator)>>@; +@d sign_and_bound_check= @/ + for each generator in cdr splitted_sf product + if (generator:=first_argument_of car generator)*new_generator>0 and @| + valid_generator(generator) then 1 @+else 0 @; +@d valid_transformed_sq = @/ + null car splitted_sf and sign_and_bound_check=1 @; +@d extend_used_generator_list= @/ + for each generator in cdr splitted_sf do + if not member(generator:=car generator,generator_list) then + generator_list:=generator . generator_list @; +@d store_transformation_rule(i,value)=@/putv(transform_vector,odd_bound+i,value)@; +@d store_inverse_rule(i,value)=@/putv(inverse_vector,odd_bound+i,value)@; +@d get_transform(i)=@/getv(transform_vector,odd_bound+i) @; +@d get_inverse(i)=@/getv(inverse_vector,odd_bound+i) @; + +@ Given |basis_transformation| we need to process +all transformation rules in order to get all generators to solve for. +Solving the resulting system can be done by applying |solve|, but since our +checks computed the transformations in quite a lot of ways and +ensure us that we have a linear system of equations (due to the use of +|split_form| which checks for linearity), we can also use the +underlying solver for systems of linear equations |solvesys|. The +arguments of |solvsys| are a list of standard forms to be solved and a +list of kernels to solve for. Hence we have to generate a list of +standard forms representing the transformation rules. + +Recall that the second argument of |split_form| is the list of +operators with respect to which to split. Moreover, notice that the +arguments of |transform_liebracket| are already simplified, since it +is a lisp operator. Therefore, we can use |simp| without harm. + +@d return_transformation_as_sf=@/ + numr subtrsq(!*k2q lhs(transformation_rule),transformed_sq) @; + +@<Read in and process |bas...@>= +if atom basis_transformation or operator_name_of basis_transformation neq 'list +then stop_with_error("TRANSFORM_LIEBRACKET",basis_transformation, + "not valid as a basis transformation",nil); @/ +basis_transformation:= +for each transformation_rule in arguments_of basis_transformation collect + <<if not valid_transformation_rule or not get_new_generator_ok + then @| stop_with_error("TRANSFORM_LIEBRACKET:",lhs(transformation_rule), + "not allowed as a new generator",nil);@/ + transformed_sq:=simp rhs(transformation_rule); + splitted_sf:=split_form(numr transformed_sq,list(generatorname)); + if not valid_transformed_sq then + stop_with_error("TRANSFORM_LIEBRACKET",lhs(transformation_rule), + "must be a sum of generators with right sign",nil);@/ + extend_used_generator_list; + store_transformation_rule(new_generator,transformed_sq . splitted_sf); + return_transformation_as_sf>> @; + +@ The result of |solvesys| is a list of a list of standard quotients +being the solutions of the system for the list of kernels given as its +second argument preceded by |t| if the system is found to be linear. +If the system is inconsistent |solvesys| will return with an error. +For the inverse transformation we will also store the standard +quotient as well as the list of splitted standard forms returned by +|split_form|. + +If the number of dependent variables of the system does not equal the +number of equations, the system is not consistent and we can stop +without trying to solve it. + +@<Compute and store the inverse...@>= +if length generator_list neq length basis_transformation then + rederr "TRANSFORM_LIEBRACKET: inconsistent transformation"; +if basis_transformation then + basis_transformation:=caadr solvesys(basis_transformation,generator_list); +for each generator in generator_list do + <<transformed_sq:=first_element_of basis_transformation; + store_inverse_rule(first_argument_of generator, + transformed_sq . @|split_form(numr transformed_sq,list(new_generatorname))); + @/ basis_transformation:=rest_of basis_transformation>> @; + +@ After the preceding steps we are left with two (possibly partially +filled) vectors |transform_vector| and |inverse_vector| representing +the basis transformation and its inverse. For a proper transformation +of the commutator tables, however, we must be sure that both vectors +are filled completely, as far as some old generators are not already +found to be linear dependent. In other words, we have to extend the +basis transformation to the full range $1,\dots,|even_bound|$ and +$-1,\dots,-|odd_bound|$ of generators. + +Since we didn't require that the generators of the preceding steps be +successive in any way, this boils down to filling in the gaps in both +|transform_vector| and |inverse_vector|. Since we want to fill in the gaps +from low to high for both even and odd generators, we have to deal with even +and odd generators separately, that is to say we will use an additional +variable |direction| to indicate whether we look at even or odd gaps and a +variable |bound| being |even_bound| or |odd_bound|, respectively. + +So it is our task to go through both positive and negative ranges of +generators and check if there is a gap, i.e., there is no transformation rule +associated to a generator or there is a linear dependency for a generator +(since these generators will never occur again). If we have found a gap +|x_gap| in the transformation for the old generators, then there must +also be a gap |y_gap| for the new generators, and we can extend the +transformation by transforming |x_gap| into |y_gap| and vice versa. + +@d find_next_x_gap=@/ + repeat x_gap:=x_gap+direction + until abs(x_gap)>bound or @|(null getv(inverse_vector,odd_bound+x_gap) + and @| null assoc(list(generatorname,x_gap),get(generatorname,'kvalue))); + if abs(x_gap)>bound then x_gap:=nil @; + +@d find_next_y_gap=@/ + repeat y_gap:=y_gap+direction + until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap) @; + +@d exchange_gaps=@/ + store_inverse_rule(x_gap, mksq(list(new_generatorname,y_gap),1) . @| + list(nil,list(new_generatorname,y_gap) . 1));@/ + store_transformation_rule(y_gap, mksq(list(generatorname,x_gap),1) . @| + list(nil,list(generatorname,x_gap) . 1)) @; + +@d fill_in_the_gaps=@/ +x_gap:=y_gap:=0; find_next_x_gap; find_next_y_gap; +while x_gap do @+<<exchange_gaps; find_next_x_gap; find_next_y_gap>> @; + +@<Extend the transform...@>= +<<fill_in_the_gaps; new_even_used:=y_gap-1>> where direction=1,bound=even_bound; +<<fill_in_the_gaps; new_odd_used:=-y_gap-1>> where direction=-1,bound=odd_bound @; + +@*1 Transformation of the Lie product table. Now we have dealt with +the most intricate part of the transformation, we can start earning +from our efforts, since the remaining work merely consists of +simplifying expressions. However, in order to save work as much as +possible we will temporarily redefine some of the simplification +functions and data structures associated to the old liebracket +|bracketname|. Since we want to be sure to restore these changes +afterwards, we will perform this part in a procedure |transform_table| +and surround it by |errorset| in order to keep full control over +|transform_table| in case of errors, i.e., if an error occurs +|errorset| will return control to the calling procedure. In this way +we can be sure that the original data structures can be restored. + +The result of |errorset| is a list containing the result of the +procedure called by |errorset|. + +@<Transform the liebracket...@>= +@<Save the original data structures of |bracketname|@>; +result:=errorset(list('transform_table,mkquote bracketname,mkquote generatorname, + mkquote new_bracketname,mkquote new_generatorname, + mkquote even_bound,mkquote odd_bound, + mkquote new_even_used,mkquote new_odd_used, + mkquote transform_vector,mkquote inverse_vector),t,t); +@<Restore the data structures of |bracketname|@>; +if result then return + list('list, + @|('list . @+for i:=1:new_even_used collect mk!*sq car get_transform(i)), + @|('list . @+for i:=1:new_odd_used collect mk!*sq car get_transform(-i))) @; + +@ In particular, the vector structure of the old liebracket must be +saved. We save it as the property |save_vector_structure|. + +@<Save the original...@>= +put(bracketname,'save_vector_structure,get(bracketname,'vector_structure)) @; + +@ Transforming the commutator table can be done in two steps: first we have to +express all old commutators in terms of the new generators, after that +the new commutators can be expressed in terms of the old ones and then +simplified to expressions in new generators. + +However, before that we have to declare |new_bracketname| a Lie +(super)algebra. Notice that we have to take the same set of operators +as |algebra_elements| and |parameters|, respectively. Since a +liebracket declaration checks if its generator isn't already an +algebraic operator and if so, returns with an error message, we have +to remove the property |simpfn| for |new_generatorname|. + +Finally we will construct a grading for |new_bracketname|, using the +grading of |bracketname|. Notice that this is only useful when all the +transformation rules are homogeneous. + +@u +lisp procedure transform_table(bracketname,generatorname, + new_bracketname,new_generatorname,even_bound,odd_bound, + new_even_used,new_odd_used, + transform_vector,inverse_vector); +begin scalar m,n,vector_structure,vector_i, + save_vector_structure,save_vector_i,save_entry_i_j,arg_i,arg_j,degree_length; + remprop(new_generatorname,'simpfn); + apply1('liebracket,list list(new_bracketname,new_generatorname, + even_bound,odd_bound, + get(bracketname,'algebra_elements),get(bracketname,'parameters))); + @<Redefine the old vector structure@>; + @<Compute and store the new vector structure@>; + @<Construct a grading for |new_bracketname|@>; +end$ + +@ An entry of the vector structure may or may not have a value. If it +has a value we have to simplify it in such a way that all occurences +of old generators are replaced by new generators. It is clear that we +can use |inverse_vector| to this purpose. More specifically, we will +replace the original |simpfn| |simpiden| by |simp_transform_vector| +that takes it values from |inverse_vector|. + +Since we have to be sure that the generators to be simplified lie +within the range covered by |inverse_vector|, we check for this. +Moreover, we need to know where to get |inverse_vector|. For this +purpose we will flag |generatorname| |full|, in which way the +generatorname will be added to the arguments of its simplication +function. We store |inverse_vector| on the property list of +|generatorname|, as well as |bounds|, i.e. the even and odd bound of +before, as we need these quantities to access |inverse_vector|. + +Notice that |inverse_vector| may contain empty entries, namely for +those entries that correspond to linear dependent generators. For +these generators, we may simply apply |simpiden| for further +simplification. + +@u + +lisp procedure simp_transform_vector generator; +begin scalar generatorname,i,bounds,inverse_vector,value; + generatorname:=car generator; + i:=cadr generator; + bounds:=get(generatorname,'bounds); + inverse_vector:=get(generatorname,'inverse_vector); + if i<-car bounds or i>cdr bounds then + stop_with_error("TRANSFORM_LIEBRACKET:",generator, + "out of the transformation range. Use 'on fulltransformation;'.",nil); + return + if value:=getv(inverse_vector,car bounds+i) then car value + else simpiden generator +end$ + +@ Of course we have to put some additional properties on the property +list of |generatorname|. Moreover we have to apply |rmsubs| so that we +can be sure that the result of |simpiden| will be resimplified. + +@<Take preparations for temporary simplification@>=@/ +put(generatorname,'inverse_vector,inverse_vector);@/ +put(generatorname,'bounds,odd_bound . even_bound);@/ +put(generatorname,'simpfn,'simp_transform_vector);@/ +flag(list generatorname,'full); +rmsubs() @; + +@ If an entry of |vector_structure| has no value, i.e., the commutator +corresponding to it is not known, we have to express it in terms of +the new liebracket and generators. To this purpose we will write a +procedure |transform_commutator|, which computes, given two entries of +|transform_vector| or |inverse_vector|, the commutator $[y_i,y_j]$ +expressed in old generators or $[x_i,x_j]$ expressed in new +generators, respectively. + +The entries of both of the vectors mentioned above contain a dotted +pair, the |car| of which is the generator as standard quotient, the +|cdr| a list applicable by the procedure |build_sum| of the TOOLS +package, used to compute the outcome of a multilinear operator applied +to the numerators of its arguments, as a standard quotient. Therefore, +we have to divide the result by the denominators of the standard +quotients. Notice that the second argument of |build_sum| is a stack +of splitted arguments, hence we have to reverse the arguments. + +@u +lisp procedure transform_commutator(bracketname,transformed_i,transformed_j); +quotsq(build_sum(bracketname,list(cdr transformed_j,cdr transformed_i)),@| + !*f2q multf(denr car transformed_i,denr car transformed_j))$ + +@ With the above preparations redefining the |vector_structure| is +utterly simple. Recall that entries of a vector structure are dotted +pairs, the |car| of which is the informative part, to be initialized +to |nil|, the |cadr| the klist info part, which for the temporary +vector structure may be also be set to |nil|. Moreover, recall that +|vector_structure| entries whose informative part is |'(special)| +should not be changed. + +The reader should be aware that a |arg_i| in the code below +will only be used if has a value, namely all commutators containing +linear dependent generators have a value according to this dependency, +so will be dealt with in the ``known part''. The same applies to the +call of |get_inverse(j)|. + +After installing the temporary vector structure, we have to call +|rmsubs| again, in order effectuate the resubstitution of the unknown +commutators into commutators of the new liebracket. + +@<Redefine the old vector...@>= +@<Take preparations for ...@>; +save_vector_structure:=get(bracketname,'save_vector_structure); +m:=get(bracketname,'even_dimension); n:=get(bracketname,'odd_dimension); +@<Initialize |vector_structure|@>; +for i:=-odd_bound:even_bound do begin + save_vector_i:=getv(save_vector_structure,n+i); + vector_i:=getv(vector_structure,n+i); + arg_i:=get_inverse(i); + for j:=i:even_bound do + if (save_entry_i_j:=getv(save_vector_i,m-j)) and + commutator_part_of(save_entry_i_j) then @/ + (if not_special(save_entry_i_j) then @| + putv(vector_i,m-j,nil . nil . aeval commutator_part_of save_entry_i_j)) + else putv(vector_i,m-j,@| + nil . nil . mk!*sq transform_commutator(new_bracketname,arg_i,get_inverse(j))) +end; +put(bracketname,'vector_structure,vector_structure); +rmsubs() @; + +@ After the redefinition of the vector structure of |bracketname| any +commutator of |bracketname| will be automatically simplified to an +expression in commutators and generators of the new liebracket. Hence +a commutator $[y_i,y_j]$ of the transformed liebracket can be computed +in two ways: using the transformation it can be expressed in terms of +the old generators, which will be simplified to an expression in the +new generators, or just as |new_bracketname(i,j)|. This gives rise to +relation for |new_bracketname| which can be solved and stored using +|relation_analysis|. As we will use !*SQ prefix forms, which will not +be simplified again, to represent the relation, we must be sure that +full simplication has taken place, i.e., we have to apply |subs2| or +|simp!*| at the right places. + +Notice that due to linear dependencies of the old generators the +vector |transform_vector| need not be filled entirely. Due to +|fill_in_the_gaps| we know, however, that with the exception of 0 +|transform_vector| is exactly filled from |-new_odd_used| to +|new_even_used|. Of course we don't have to compute commutators +outside of this range. ``Special'' commutators need to be solved +neither. Since we don't use the vector structure here to see if a +commutator is special we will check using |i| and |j| directly. + +Finally we will set |even_used| and |odd_used| to |new_even_used| and +|new_odd_used|, respectively, for the newly created +liebracket, as these are the actual numbers of used even and odd generators. + +@d no_special_pair_i_j= @/ + i neq 0 and j neq 0 and (i neq j or i<0) @; + +@<Compute and store the new...@>= +for i:=-new_odd_used:new_even_used do + if (arg_i:=get_transform(i)) then + for j:=i:new_even_used do + if (arg_j:=get_transform(j)) and no_special_pair_i_j then @| + relation_analysis(mk!*sq subtrsq(simp!* list(new_bracketname,i,j),@| + subs2 transform_commutator(bracketname,arg_i,arg_j)), + new_bracketname); +put(new_bracketname,'even_used,new_even_used); +put(new_bracketname,'odd_used,new_odd_used)@; + +@ Using |transform_vector| and the procedure |degree_of| and +|define_degree| it is not very hard to construct a grading for +|new_bracketname|, under the assumption that the transformation is +homogeneous w.r.t.\ this grading. Notice that all elements of +|transform_vector| are filled consecutively from |-new_odd_used| to +|new_even_used|, with the exception of 0. + +Before doing anything we should, however, change the length of the +grading of |new_bracketname| to the length of the grading of +|bracketname|, that is, to the length of the list of currently used +components of the grading of |bracketname|. + +@<Construct a grading...@>=@/ +degree_length:=if get(bracketname,'degree_sequence) then + length get(bracketname,'degree_sequence) + else get(bracketname,'degree_length); +change_degree_length(new_bracketname,degree_length); +for i:=-new_odd_used:new_even_used do + if i neq 0 then + define_degree(list(new_generatorname,i),degree_of(mk!*sq car get_transform(i))) + +@ @<Restore the data stru...@>=@/ +put(bracketname,'vector_structure,get(bracketname,'save_vector_structure)); +remprop(bracketname,'save_vector_structure); +put(generatorname,'simpfn,'simpiden); +remprop(generatorname,'inverse_vector); +remflag(list generatorname,'full); +remprop(generatorname,'bounds) @; + +@*= Necessary changes to the klist mechanism. In one of the previous +sections we already explained that the ordinary klist mechanism of +REDUCE is not very suited for liebrackets, since all occuring +commutators are stored on a linear list, where the number of +commutators may be quit big. Moreover we made some preparations in the +vector structure of a liebracket, in order to replace the ordinary +klist mechanism with an information system which is based on the +vector structure. + +Here, it is our intention to change two basic procedures of the REDUCE +source in such a way that the outer appearance of the system remains +the same, whereas hidden under the surface for liebrackets the klist +mechanism is replaced by a vector structure based counterpart. + +@ The first procedure to be changed is |fkern|. It is used by |mksq| and +checks if there is a klist entry for some kernel, if not, it generates one, +and eventually, returns this entry. + +Changes are obvious: if the operatorname of the kernel is a liebracket +and both arguments are integers, not the klist should be used but the +vector structure of the concerning liebracket. If not both arguments +are integers, we can only use the klist mechanism. + +@u +symbolic procedure fkern u; + begin scalar x,y; + if atom u then @+return list(u,nil); + if get(operator_name_of u,'rtype)='liebracket and @| + fixp first_argument_of u and fixp second_argument_of u then @+ + return fkern_liebracket u; + y := if atom car u then get(car u,'klist) @+else exlist!*; + if not (x := assoc(u,y)) + then <<x := list(u,nil); + y := ordad(x,y); + if atom car u + then <<kprops!* := union(list car u,kprops!*); + put(car u,'klist,y)>> + else exlist!* := y>>; + return x + end$ + +@ The procedure |fkern_liebracket| is fairly simple. If the +|k_info_of| the vector structure entry of the considered +commutator exists, return it, otherwise construct it and adapt the +vector structure accordingly. For the last action we shall use +|rplaca|. It is easily seen that the use of |rplaca| causes no harm. + +Since the |k_info| can be found directly in the vector structure, and +doesn't have to be found by association, one would expect that the +kernel can be removed from the |k_info| entry. This, however, is not +true: the kernel in the |k_info| is used by |mksq| to obtain an identical +address for the considered kernel in all standard quotients. Thus a +lot of memory can be saved. + +Notice that the arguments of the considered commutator need not be +checked to lie within proper bounds. This is due to the fact that +|fkern| (indirectly) only is called from procedures which have already +checked the bounds. + +@u symbolic procedure fkern_liebracket commutator; +begin scalar bracketname,i,j,entry_i_j; + bracketname:=operator_name_of commutator; + i:=first_argument_of commutator; + j:=second_argument_of commutator; + entry_i_j:=get_vector_structure(bracketname,i,j); + if null entry_i_j then @|entry_i_j:= + put_vector_structure(bracketname,i,j,nil . list(commutator,nil) . nil) + else if null k_info_of entry_i_j then @| + rplaca(k_info_and_commutator_part_of entry_i_j,list(commutator,nil)); + return k_info_of entry_i_j; +end$ + +@ The procedure |prepsq!*| is used to reorder an algebraic expression +for output. After |factor O;| the expression is ordered w.r.t. all +kernels of the operator $O$. The order of the kernels of the operator +$O$ is governed by its klist. Since the klist of a liebracket is not +complete, in fact it only contains info about commutators containing +non integer arguments, we have to choose a different method here. We +do this as follows: we find all the kernels of the concerning +liebracket using the procedure |find_all_kernels| of the TOOLS package +and order the thus obtained list of kernels w.r.t.\ the standard +kernel ordering of REDUCE, by calling the procedure |ordn|. This list +can now be used as a replacement for the klist. + +@u +symbolic procedure prepsq!* u; + begin scalar x,!*combinelogs; + if null numr u then return 0; + x := setkorder + append((for each j in factors!* + join if not idp j then nil + else if get(j,'rtype)='liebracket then + ordn get_all_kernels(numr u,j) + else for each k in get(j,'klist) collect car k), + append(factors!*,ordl!*)); + if kord!* neq x or wtl!* + then u := formop numr u . formop denr u; + u := if !*rat or !*div + or upl!* or dnl!* + then replus prepsq!*1(numr u,denr u,nil) + else sqform(u,function prepsq!*2); + setkorder x; + return u + end$ + +@ The end of a REDUCE input file must be marked with |end|. +@u end@+; + +@*= Index. This section contains the cross reference index of all +identifiers, together with the numbers of the modules in which they +are used. Underlined entries correspond to module numbers where the +identifier was declared. +\bigskip diff --git a/web/reduce/rweb/appl/liesuperconvert.web b/web/reduce/rweb/appl/liesuperconvert.web new file mode 100644 index 0000000000..1c03f50920 --- /dev/null +++ b/web/reduce/rweb/appl/liesuperconvert.web @@ -0,0 +1,51 @@ +% Copyright (c) 1991 Marcel Roelofs, University of Twente, Enschede, +% The Netherlands. +% +% $Header: liesuperconvert.web,v 1.1 91/09/18 17:49:54 roelofs Exp $ +% + +@* Conversion of vector structures. In the latest version of the +LIESUPER package, the klist mechanism has been replaced by a vector +structure based mechanism to check wether a commutator has been used +in any other algebraic expression or not. Due to this change the +entries of a vector structure also have changed. As a consequence, +save files of liebrackets written by the old package cannot be used by +the current package anymore. + +Fortunately, it is still possible to read saved liebrackets without +damaging any information. The following procedure will convert the +vector structure of former liebrackets to the corresponding vector +structure of the current liebrackets. In order to understand what +happens we refer to the documentation of the LIESUPER package. + +@d old_informative_part_of=car +@d old_commutator_part_of=cdr + +@u lisp operator convert_liebracket; +lisp procedure convert_liebracket bracketname; +begin scalar m,n,klist,vector_structure,vector_i,entry_i_j,k_info_i_j; + if get(bracketname,'rtype) neq 'liebracket then + rederr "CONVERT_LIEBRACKET: argument must be a liebracket"; + m:=get(bracketname,'even_dimension); + n:=get(bracketname,'odd_dimension); + klist:=get(bracketname,'klist); + vector_structure:=get(bracketname,'vector_structure); + for i:=-n:m do + begin vector_i:=getv(vector_structure,n+i); + for j:=i:m do + begin entry_i_j:=getv(vector_i,m-j); + k_info_i_j:=assoc(list(bracketname,i,j),klist); + if entry_i_j then + putv(vector_i,m-j,old_informative_part_of entry_i_j . k_info_i_j . + old_commutator_part_of entry_i_j) + else if k_info_i_j then + putv(vector_i,m-j,nil . k_info_i_j . nil); + if k_info_i_j then klist:=delete(k_info_i_j,klist) + end + end; + put(bracketname,'klist,klist) +end$ + +@ Any REDUCE file must end with |end@;|. + +@u end; diff --git a/web/reduce/rweb/appl/list2vector.ch b/web/reduce/rweb/appl/list2vector.ch new file mode 100644 index 0000000000..cb6df64e33 --- /dev/null +++ b/web/reduce/rweb/appl/list2vector.ch @@ -0,0 +1,107 @@ +% Copyright (c) 1991 Marcel Roelofs, University of Twente, Enschede, +% The Netherlands. +% +% $Header: list2vector.ch,v 1.2 91/10/23 09:37:31 roelofs Exp $ +% +@x +One should be aware of the fact that the standard REDUCE token reader +|token1| is not able to recognize and return a vector as a token. +However, on our system |token1| has been replaced by a token reader +based on the lisp underneath REDUCE, which \`{\i}s able to read +vectors. Moreover, on another configuration at our site which did use +|token1| as the token reader, we could patch it in such way that it +was also able to read vectors without too much difficulty. + +The implementation of |save_liebracket| beneath explicitly uses the +fact that the token reader used is able to read vectors. If this is +not the case |save_liebracket| has to be rewritten in such a way that +all commutators to be saved are temporarily stored on a list which can +be read by |token1|. In that case the vector structure has to be build +up again. This case will be dealt with in a separate change file +belonging to this package. + +The procedure |save_liebracket| has to be available in algebraic mode. + +@d print_this_property_of(bracketname)=@/ +<<prin2 "put('"; prin1 bracketname; prin2 ",'"; prin1 property; prin2 ",'"; + prin1 get(bracketname,property); prin2 ")$"; terpri(); terpri()>> @; + +@u +lisp operator save_liebracket; +lisp procedure save_liebracket(bracketname,savefile); +begin scalar generatorname; + check_if_bracketname_is_a_liebracket_in("SAVE_LIEBRACKET:");@/ + generatorname:=get(bracketname,'generatorname);@/ + rmsubs(); + out savefile;@/ + write "lisp$"; %Reading the properties should be done in symbolic mode% + terpri(); terpri();@/ + @<Check if this package has been loaded@>; + for each property in 'klist . list_of_properties_of_a_liebracket do + print_this_property_of(bracketname);@/ + write "flag('(",bracketname,"),'full)$"; terpri(); terpri(); + for each property in 'klist . list_of_properties_of_a_generator do + print_this_property_of(generatorname); + @<Incorporate statements to repair the |vector_structure|@>; + write "algebraic$ end$";@/ + shut savefile; +end$ +@y +One should be aware of the fact that the standard REDUCE token reader +|token1| is not able to recognize and return a vector as a token. +However, on our system |token1| has been replaced by a token reader +based on the lisp underneath REDUCE, which \`{\i}s able to read +vectors. Moreover, on another configuration at our site which did use +|token1| as the token reader, we could patch it in such way that it +was also able to read vectors without too much difficulty. + +Here, however, we will give an implementation for those systems which have +|token1| as their token reader, or which have another token reader +uncapable of reading vectors. This means that we have to transform the +vectors |info_list| and |vector_structure| into a list and a list of +lists, respectively, hence have to be dealt with separately. + +The procedure |save_liebracket| has to be available in algebraic mode. + +@d print_this_property_of(bracketname)=@/ +<<prin2 "put('"; prin1 bracketname; prin2 ",'"; prin1 property; prin2 ",'"; + prin1 get(bracketname,property); prin2 ")$"; terpri(); terpri()>> @; + +@u +lisp operator save_liebracket; +lisp procedure save_liebracket(bracketname,savefile); +begin scalar generatorname,vector_list; + check_if_bracketname_is_a_liebracket_in("SAVE_LIEBRACKET:");@/ + generatorname:=get(bracketname,'generatorname);@/ + rmsubs(); + out savefile;@/ + write "lisp$"; %Reading the properties should be done in symbolic mode% + terpri(); terpri();@/ + @<Check if this package has been loaded@>; + for each property in 'klist . cddr list_of_properties_of_a_liebracket do + print_this_property_of(bracketname);@/ + @<Save the vectors |vector_structure| and |info_list| as lists@>; + write "flag('(",bracketname,"),'full)$"; terpri(); terpri(); + for each property in 'klist . list_of_properties_of_a_generator do + print_this_property_of(generatorname); + @<Incorporate statements to repair the |vector_structure|@>; + write "algebraic$ end$";@/ + shut savefile; +end$ + +@ With the above procedures saving the vectors |vector_structure| and +|info_list| as lists and reading these lists in as vectors is peanuts. +The procedures |list2vector| and |vector2list| are already available +in PSL, for which this changefile is meant primarily. + +@<Save the vectors ...@>= +vector_list:=for each el in vector2list get(bracketname,'vector_structure) + collect vector2list el; +prin2 "put('"; prin1 bracketname; +prin2 ",'VECTOR_STRUCTURE,list2vector(for each el in '"; +prin1 vector_list; prin2 " collect list2vector el))$"; terpri(); terpri(); +vector_list:=vector2list get(bracketname,'info_list); +prin2 "put('"; prin1 bracketname; prin2 ",'INFO_LIST,list2vector '"; + prin1 vector_list; prin2 ")$"; terpri(); terpri() + +@z diff --git a/web/reduce/rweb/appl/source/integrator.red b/web/reduce/rweb/appl/source/integrator.red new file mode 100644 index 0000000000..9cc67dd711 --- /dev/null +++ b/web/reduce/rweb/appl/source/integrator.red @@ -0,0 +1,991 @@ +%5:% +%line 72 "integrator.web" + +symbolic$ +write"Integrator package for REDUCE 3.4, $Revision: 0.92 $"$terpri()$ +%9:% +%line 213 "integrator.web" + +%line 214 "integrator.web" +put( 'initialize_equations, 'psopfn, 'initialize_equations1)$ + +%:9%%13:% +%line 294 "integrator.web" + + +global '(current_equation_set!*)$ +current_equation_set!*:= 'equ$ + +%:13%%18:% +%line 382 "integrator.web" + + + +fluid '(!*coefficient_check)$ +!*coefficient_check:=t$ +flag( '(coefficient_check), 'switch)$ + +%:18%%30:% +%line 597 "integrator.web" + +%line 598 "integrator.web" + + +fluid '(!*polynomial_check)$ +!*polynomial_check:=nil$ +flag( '(polynomial_check), 'switch)$ + +%:30%%50:% +%line 955 "integrator.web" + +%line 956 "integrator.web" + + +fluid '(!*allow_differentiation)$ +!*allow_differentiation:=nil$ +flag( '(allow_differentiation), 'switch)$ + +%:50%%61:% +%line 1185 "integrator.web" + +%line 1186 "integrator.web" + +fluid '(listpri_depth!*)$ +listpri_depth!*:=40$ + +%:61% +%line 75 "integrator.web" + +algebraic$ + +%:5%%10:% +%line 217 "integrator.web" + +%line 218 "integrator.web" +lisp procedure initialize_equations1 specification_list; +begin scalar operator_name,total_used,variable_list, +specification,even_used,odd_used, +constant_operator,bracketname,function_name,function_list; +if length specification_list<5 then +rederr("INITIALIZE_EQUATIONS: wrong number of parameters"); +if not idp(operator_name:=car specification_list)then +rederr("INITIALIZE_EQUATIONS: equations operator must be identifier"); +if not fixp(total_used:= +reval car(specification_list:=cdr specification_list)) +or total_used<0 then +rederr("INITIALIZE_EQUATIONS: total number of equations must be positive"); +put(operator_name, 'total_used,total_used); +variable_list:=reval car( +specification_list:=cdr specification_list); +if atom variable_list or car variable_list neq 'list then +rederr("INITIALIZE_EQUATIONS: variable list must be algebraic list"); +put(operator_name, 'variable_list,cdr variable_list); +%11:% +%line 265 "integrator.web" + +specification_list:=cdr specification_list; +specification:=car specification_list; + +if atom specification or length specification neq 4 or car specification neq 'list +or not idp(constant_operator:=cadr specification)or +not fixp(even_used:=reval caddr specification)or +not fixp(odd_used:=reval cadddr specification) +or even_used<0 or odd_used<0 then + +msgpri("INITIALIZE_EQUATIONS: invalid declaration of", +specification,nil,nil,t); +put(operator_name, 'constant_operator,constant_operator); +if get(constant_operator, 'rtype)= 'algebra_generator then +put(operator_name, 'bracketname, +bracketname:=get(constant_operator, 'bracketname)); + +if get(constant_operator, 'rtype)= 'algebra_generator then +define_used(bracketname,list( 'list,even_used,odd_used)) +else +begin +put(constant_operator, 'even_used,even_used); +put(constant_operator, 'odd_used,odd_used); +end + +%:11% +%line 236 "integrator.web" +; +%12:% +%line 276 "integrator.web" + +%line 277 "integrator.web" +for each function_specification in cdr specification_list do +begin + +if atom function_specification or length function_specification neq 4 or car function_specification neq 'list +or not idp(function_name:=cadr function_specification)or +not fixp(even_used:=reval caddr function_specification)or +not fixp(odd_used:=reval cadddr function_specification) +or even_used<0 or odd_used<0 then + +msgpri("INITIALIZE_EQUATIONS: invalid declaration of", +function_specification,nil,nil,t); + +if get(function_name, 'rtype)= 'algebra_generator then +define_used(bracketname,list( 'list,even_used,odd_used)) +else +begin +put(function_name, 'even_used,even_used); +put(function_name, 'odd_used,odd_used); +end; +function_list:=function_name . function_list; +end; +put(operator_name, 'function_list,function_list) + +%:12% +%line 237 "integrator.web" +; +end$ + +%:10%%14:% +%line 298 "integrator.web" + +%line 299 "integrator.web" +lisp operator use_equations; +lisp procedure use_equations operator_name; +begin +if idp operator_name then +current_equation_set!*:=operator_name +else rederr("USE_EQUATIONS: argument must be identifier"); +end$ + +%:14%%15:% +%line 315 "integrator.web" + +%line 316 "integrator.web" +lisp operator integrate_equation; +lisp procedure integrate_equation n; +begin scalar listpri_depth!*,total_used,equation,denominator, +solvable_kernel,solvable_kernels,df_list,df_kernel, +function_list,present_functions_list,variable_list,absent_variables, +polynomial_variables,equations_list,linear_functions_list,constants_list, +bracketname,df_terms,df_functions, +linear_functions,functions_and_constants_list,commutator_functions, +present_variables, +inhomogeneous_term,nr_of_variables,integration_variables, +forbidden_functions,differentiations_list,polynomial_order; +listpri_depth!*:=200; +terpri!* t; +%16:% +%line 348 "integrator.web" + +if null(total_used:=get(current_equation_set!*, 'total_used))or +n>total_used then + +msgpri("INTEGRATE_EQUATIONS: properly initialize", +current_equation_set!*,nil,nil,t); +if null(equation:=cadr assoc(list(current_equation_set!*,n), +get(current_equation_set!*, 'kvalue)))then + +msgpri("INTEGRATE_EQUATION:",list(current_equation_set!*,n), +"is non-existent",nil,t); +denominator:=denr(equation:=simp!* equation); +equation:=numr equation; +if null equation then + <<write current_equation_set!*,"(",n,") = 0";terpri!* t; + +setk(list(current_equation_set!*,n),0);goto solved>> + +%:16% +%line 329 "integrator.web" +; +%19:% +%line 398 "integrator.web" + +df_list:=split_form(equation, '(df)); +if null car df_list and +(cdr df_list)and length(cdr df_list)=1 +then +if(solvable_kernel:=find_solvable_kernel( +solvable_kernels:=list(car car cdr df_list), +cdr df_list,denominator))then + <<df_kernel:=cadr solvable_kernel; +setk(df_kernel,homogeneous_integration_of(solvable_kernel)); +depl!*:= +delete(assoc(df_kernel,depl!*),depl!*); + + + <<write current_equation_set!*,"(",n,"): ","Homogeneous integration of ";maprin solvable_kernel;terpri!* nil; + +setk(list(current_equation_set!*,n),0);goto solved>> >> +else + <<write"*** ",current_equation_set!*,"(",n,"): ","Homogeneous integration"," failed:";terpri!* t; +write" coefficient not a number for "; +maprin +car solvable_kernels;terpri!* nil; +write" Solvable with 'off coefficient_check'"; +terpri!* t;goto solved>> + +%:19% +%line 330 "integrator.web" +; +%27:% +%line 568 "integrator.web" + +%28:% +%line 576 "integrator.web" + +%line 577 "integrator.web" +function_list:=get(current_equation_set!*, 'function_list); +present_functions_list:=get_recursive_kernels(equation,function_list); +variable_list:=get(current_equation_set!*, 'variable_list); +absent_variables:=variable_list; +for each function in present_functions_list do +for each variable in +((if depl_entry then cdr depl_entry)where depl_entry=assoc(function,depl!*))do +absent_variables:=delete(variable,absent_variables) + +%:28% +%line 569 "integrator.web" +; +%29:% +%line 591 "integrator.web" + +%line 592 "integrator.web" +polynomial_variables:=absent_variables; +if !*polynomial_check then +polynomial_variables:=for each variable in polynomial_variables join +if polynomialp(equation,variable)then list(variable) + +%:29% +%line 570 "integrator.web" +; +%32:% +%line 614 "integrator.web" + +%line 615 "integrator.web" +equations_list:=multi_split_form(equation,polynomial_variables); +if length equations_list>1 then + <<for each pc_pair in cdr +equations_list do +setk(list(current_equation_set!*,(total_used:=total_used+1)), +mk!*sq((cdr pc_pair) ./ 1)); +if car equations_list then +setk(list(current_equation_set!*,(total_used:=total_used+1)), +mk!*sq((car equations_list) ./ 1)); +write current_equation_set!*,"(",n,") breaks into ", +current_equation_set!*,"(",get(current_equation_set!*, 'total_used)+1, +"),...,",current_equation_set!*,"(",total_used,") by "; +maprin partial_list(polynomial_variables,5); +terpri!* nil; + +setk(list(current_equation_set!*,n),0); +put(current_equation_set!*, 'total_used,total_used); +goto solved +>> + +%:32% +%line 571 "integrator.web" + + +%:27% +%line 331 "integrator.web" +; +%34:% +%line 652 "integrator.web" + +%line 653 "integrator.web" +linear_functions_list:=split_form(car df_list, +function_list); +df_list:=cdr df_list; +constants_list:=split_form(car linear_functions_list, +list get(current_equation_set!*, 'constant_operator)); +linear_functions_list:=cdr linear_functions_list; +if(bracketname:=get(current_equation_set!*, 'bracketname))then +%35:% +%line 669 "integrator.web" + +%line 670 "integrator.web" +if length(df_list)=0 and +length(linear_functions_list)=0 then + << +if atom(solvable_kernel:= +relation_analysis(!*ff2a(equation,denominator),bracketname)) +then <<write current_equation_set!*,"(",n,") is a non-solvable Lie relation"; +terpri!* t>> +else <<write current_equation_set!*,"(",n,") solved for ";maprin solvable_kernel; +terpri!* t; +setk(list(current_equation_set!*,n),0)>> ; +goto solved +>> + +%:35% +%line 660 "integrator.web" + + +%:34% +%line 332 "integrator.web" +; +%36:% +%line 710 "integrator.web" + +%line 711 "integrator.web" +%37:% +%line 725 "integrator.web" + +%line 726 "integrator.web" +df_terms:=for each df_term in df_list join +if member(car cadr car df_term,function_list) +then list car df_term; +for each df_term in df_terms do if not member(cadr +df_term,df_functions)then df_functions:=cadr(df_term) . df_functions; +functions_and_constants_list:=append(linear_functions_list, +cdr constants_list); +linear_functions:=for each linear_function in +functions_and_constants_list collect car linear_function; +if bracketname then commutator_functions:= +get_recursive_kernels(car constants_list, +get(current_equation_set!*, 'function_list)); + +%:37% +%line 712 "integrator.web" +; +%38:% +%line 739 "integrator.web" + +%line 740 "integrator.web" +present_variables:=variable_list; +for each variable in absent_variables do +present_variables:=delete(variable,present_variables); +nr_of_variables:=length present_variables + +%:38% +%line 713 "integrator.web" +; +for each kernel in linear_functions do if length + +((if depl_entry then cdr depl_entry)where depl_entry=assoc(kernel,depl!*))=nr_of_variables then +solvable_kernels:=kernel . solvable_kernels; +for each kernel in append(df_functions,commutator_functions)do +solvable_kernels:=delete(kernel,solvable_kernels); +if solvable_kernels then +%39:% +%line 745 "integrator.web" + +%line 746 "integrator.web" + <<solvable_kernel:= +find_solvable_kernel(solvable_kernels,functions_and_constants_list,denominator); +if solvable_kernel then + <<linear_solve_and_assign(!*ff2a(equation,1),solvable_kernel); +depl!*:= +delete(assoc(solvable_kernel,depl!*),depl!*); + + + <<write current_equation_set!*,"(",n,"): ","Solved for ";maprin solvable_kernel;terpri!* nil; + +setk(list(current_equation_set!*,n),0);goto solved>> +>> +else + <<write"*** ",current_equation_set!*,"(",n,"): ","Solving a function"," failed:";terpri!* t; +write" coefficient not a number for "; +maprin +partial_list(solvable_kernels,3);terpri!* nil; +write" Solvable with 'off coefficient_check'"; +terpri!* t;goto solved>> +>> + +%:39% +%line 720 "integrator.web" + + +%:36% +%line 333 "integrator.web" +; +%40:% +%line 772 "integrator.web" + +%line 773 "integrator.web" +%41:% +%line 784 "integrator.web" + +%line 785 "integrator.web" +integration_variables:=present_variables; +for each kernel in append(linear_functions,commutator_functions)do +for each variable in +((if depl_entry then cdr depl_entry)where depl_entry=assoc(kernel,depl!*))do +integration_variables:=delete(variable,integration_variables); +for each df_function in df_functions do +if not length +((if depl_entry then cdr depl_entry)where depl_entry=assoc(df_function,depl!*))=nr_of_variables then +for each variable in +((if depl_entry then cdr depl_entry)where depl_entry=assoc(df_function,depl!*))do +integration_variables:=delete(variable,integration_variables) + +%:41% +%line 773 "integrator.web" +; +%43:% +%line 813 "integrator.web" + +%line 814 "integrator.web" +%44:% +%line 824 "integrator.web" + +%line 825 "integrator.web" +for each df_term in df_terms do + <<if length +((if depl_entry then cdr depl_entry)where depl_entry=assoc(cadr df_term,depl!*))=nr_of_variables +and(check_differentiation_sequence(cdr cdr df_term, +integration_variables) +or member(cadr df_term,forbidden_functions)) +then solvable_kernels:=if member(cadr df_term,forbidden_functions) +then list(nil,nil)else df_term . solvable_kernels; +forbidden_functions:=(cadr df_term) . forbidden_functions>> ; + +%:44% +%line 814 "integrator.web" +; +%45:% +%line 834 "integrator.web" + +%line 835 "integrator.web" +if solvable_kernels then +if length(solvable_kernels)=1 then +if(solvable_kernel:=find_solvable_kernel(solvable_kernels,df_list,denominator)) +then +if(inhomogeneous_term:=linear_solve(mk!*sq(equation ./ 1),solvable_kernel)) +and(not !*polynomial_check or +check_polynomial_integration(solvable_kernel,inhomogeneous_term)) +then + <<df_kernel:=cadr solvable_kernel; +setk(df_kernel, +inhomogeneous_integration_of(solvable_kernel,inhomogeneous_term)); +depl!*:= +delete(assoc(df_kernel,depl!*),depl!*); + + + <<write current_equation_set!*,"(",n,"): ","Inhomogeneous integration of ";maprin solvable_kernel;terpri!* nil; + +setk(list(current_equation_set!*,n),0);goto solved>> >> +else + <<write current_equation_set!*,"(",n,"): Inhomogeneous integration failed: ";terpri!* t; +write"inhomogeneous term not polynomial in integration variables"; +terpri!* t;goto solved>> +else + <<write"*** ",current_equation_set!*,"(",n,"): ","Inhomogeneous integration"," failed:";terpri!* t; +write" coefficient not a number for "; +maprin +car solvable_kernels;terpri!* nil; +write" Solvable with 'off coefficient_check'"; +terpri!* t;goto solved>> +else <<write current_equation_set!*,"(",n,"): Inhomogeneous integration failed: ";terpri!* t; +write"more terms with maximal dependency";terpri!* t;goto solved>> + +%:45% +%line 815 "integrator.web" + + +%:43% +%line 774 "integrator.web" + + +%:40% +%line 334 "integrator.web" +; +%51:% +%line 960 "integrator.web" + +%line 961 "integrator.web" +%52:% +%line 993 "integrator.web" + + +present_variables:=for each variable in present_variables collect +(variable . nil . 0); + +for each kernel in df_terms do +for each variable in +((if depl_entry then cdr depl_entry)where depl_entry=assoc(cadr(kernel),depl!*))do + +rplacd(entry,kernel . (cddr entry+1)) +where entry=assoc(variable,present_variables);; + +for each kernel in linear_functions do +for each variable in +((if depl_entry then cdr depl_entry)where depl_entry=assoc(kernel,depl!*))do + +rplacd(entry,kernel . (cddr entry+1)) +where entry=assoc(variable,present_variables);; +if bracketname then +for each kernel in commutator_functions do +for each variable in +((if depl_entry then cdr depl_entry)where depl_entry=assoc( +kernel,depl!*))do + +rplacd(entry,nil . (cddr entry+1)) +where entry=assoc(variable,present_variables); + +%:52% +%line 961 "integrator.web" +; +%53:% +%line 1007 "integrator.web" + +%line 1008 "integrator.web" +differentiations_list:= +for each entry in present_variables join +if cadr entry and cddr entry=1 and +(polynomial_order:=get_polynomial_order( +linear_solve(mk!*sq(equation ./ 1),cadr entry),car entry)) +then list(car entry . cadr entry . (polynomial_order+1)); +if differentiations_list then +if !*allow_differentiation then + <<for each entry in differentiations_list do +setk(list(current_equation_set!*,(total_used:=total_used+1)), +mk!*sq simpdf list(mk!*sq(equation ./ 1), +car entry,cddr entry)); +write current_equation_set!*,"(",n,"): Generation of ",current_equation_set!*,"(",get(current_equation_set!*, 'total_used)+1, +"),...,",current_equation_set!*,"(",total_used,") by differentiation w.r.t. "; +terpri!* t; +maprin partial_list(for each entry in differentiations_list collect +list( 'list,car entry,cddr entry),10); +terpri!* nil; +put(current_equation_set!*, 'total_used,total_used); +goto solved +>> +else << +write"*** ",current_equation_set!*,"(",n, +"): Generation of new equations by differentiation possible."; +terpri!* t;write" Solvable with 'on allow_differentiation'"; +terpri!* t;goto solved>> + +%:53% +%line 962 "integrator.web" + + +%:51% +%line 335 "integrator.web" +; +%55:% +%line 1054 "integrator.web" + +%line 1055 "integrator.web" +write current_equation_set!*,"(",n,") not solved";terpri!* t + +%:55% +%line 336 "integrator.web" +; +solved: +end$ + +%:15%%20:% +%line 421 "integrator.web" + +%line 422 "integrator.web" +lisp procedure find_solvable_kernel(kernel_list,kc_list,denominator); +if !*coefficient_check then first_solvable_kernel(kernel_list,kc_list,denominator) +else car kernel_list$ + + +lisp procedure first_solvable_kernel(kernel_list,kc_list,denominator); +if kernel_list then +(if numberp cdr kc_pair or +numberp !*ff2a(cdr kc_pair,denominator) +then car kc_pair +else first_solvable_kernel(cdr kernel_list,kc_list,denominator)) +where kc_pair=assoc(car kernel_list,kc_list)$ + +%:20%%21:% +%line 458 "integrator.web" + +lisp procedure homogeneous_integration_of df_term; +begin scalar df_function,function_number,dependency_list,integration_list, +coefficient_name,bracketname,even_used,odd_used, +integration_variable, +number_of_integrations,solution,new_dependency_list; +%22:% +%line 483 "integrator.web" + +df_function:=cadr df_term; +if not member(car df_function,get(current_equation_set!*, 'function_list)) +or not fixp(function_number:=cadr df_function)or function_number=0 then + +msgpri("PERFORM_HOMOGENEOUS_INTEGRATION: integration of", +df_function,"not allowed",nil,t) + +%:22% +%line 465 "integrator.web" +; +dependency_list:= +((if depl_entry then cdr depl_entry)where depl_entry=assoc(df_function,depl!*)); +if length dependency_list=1 then +coefficient_name:=get(current_equation_set!*, 'constant_operator) +else coefficient_name:=car df_function; +%23:% +%line 493 "integrator.web" + +%line 494 "integrator.web" +if get(coefficient_name, 'rtype)= 'algebra_generator then +begin bracketname:=get(current_equation_set!*, 'bracketname); +even_used:=get(bracketname, 'even_used); +odd_used:=get(bracketname, 'odd_used); +end +else +begin +even_used:=get(coefficient_name, 'even_used); +odd_used:=get(coefficient_name, 'odd_used); +end + +%:23% +%line 470 "integrator.web" +; +integration_list:=cdr cdr df_term; +%24:% +%line 507 "integrator.web" + +%line 508 "integrator.web" +if integration_list then integration_variable:=car +integration_list else integration_variable:=nil; +if integration_variable and(integration_list:=cdr integration_list) +and fixp car integration_list then + <<number_of_integrations:=car integration_list; +integration_list:=cdr integration_list>> +else number_of_integrations:=1 + +%:24% +%line 472 "integrator.web" +; +if bracketname then +%25:% +%line 521 "integrator.web" + +%line 522 "integrator.web" +if function_number>0 then +(if even_used+number_of_integrations>get(bracketname, 'even_dimension)then +change_dimensions_of(bracketname,even_used+number_of_integrations, +get(bracketname, 'odd_dimension))) +else +(if odd_used+number_of_integrations>get(bracketname, 'odd_dimension)then +change_dimensions_of(bracketname,get(bracketname, 'even_dimension), +odd_used+number_of_integrations)) + +%:25% +%line 474 "integrator.web" +; +%26:% +%line 544 "integrator.web" + +solution:=nil ./ 1; +while integration_variable do +begin new_dependency_list:=delete(integration_variable,dependency_list); +for i:=0:number_of_integrations-1 do + <<solution:=addsq(solution,multsq( +if i=0 then 1 ./ 1 else mksq(integration_variable,i), +mksq( +list(coefficient_name,if function_number>0 then +(even_used:=even_used+1)else-(odd_used:=odd_used+1)),1))); +if new_dependency_list then +depl!*:=(list(coefficient_name,if function_number>0 then even_used +else-odd_used) . new_dependency_list) . depl!*; +>> ; +%24:% +%line 507 "integrator.web" + +%line 508 "integrator.web" +if integration_list then integration_variable:=car +integration_list else integration_variable:=nil; +if integration_variable and(integration_list:=cdr integration_list) +and fixp car integration_list then + <<number_of_integrations:=car integration_list; +integration_list:=cdr integration_list>> +else number_of_integrations:=1 + +%:24% +%line 553 "integrator.web" + +end; +solution:=mk!*sq subs2 solution; + +if get(coefficient_name, 'rtype)= 'algebra_generator then +define_used(bracketname,list( 'list,even_used,odd_used)) +else +begin +put(coefficient_name, 'even_used,even_used); +put(coefficient_name, 'odd_used,odd_used); +end + +%:26% +%line 475 "integrator.web" +; +return solution +end$ + +%:21%%31:% +%line 604 "integrator.web" + +%line 605 "integrator.web" +lisp procedure polynomialp(expression,kernel); +if domainp expression then t +else((main_variable=kernel or not depends(main_variable,kernel))and +polynomialp(lc expression,kernel)and polynomialp(red expression,kernel)) +where main_variable=mvar expression$ + +%:31%%33:% +%line 636 "integrator.web" + +%line 637 "integrator.web" +lisp procedure partial_list(printed_list,nr_of_items); + 'list . broken_list(printed_list,nr_of_items)$ + +lisp procedure broken_list(list,n); +if list then if n=0 then '(!.!.!.) +else car list . broken_list(cdr list,n-1)$ + +%:33%%42:% +%line 806 "integrator.web" + +%line 807 "integrator.web" +lisp procedure check_differentiation_sequence(sequence,variable_list); +if null sequence then t +else if fixp car sequence or +member(car sequence,variable_list)then +check_differentiation_sequence(cdr sequence,variable_list)$ + +%:42%%46:% +%line 863 "integrator.web" +lisp procedure check_polynomial_integration(df_term,integration_term); +%line 864 "integrator.web" +begin scalar numerator,denominator,integration_variables,variable,ok; +numerator:=numr simp integration_term; +denominator:=denr simp integration_term; +integration_variables:= +for each argument in cdr cdr df_term join +if not fixp argument then list argument; +ok:=t; +while ok and integration_variables do + <<variable:=car integration_variables; +ok:=(not depends(denominator,variable)and polynomialp(numerator,variable)); +integration_variables:=cdr integration_variables +>> ; +return ok; +end$ + +%:46%%47:% +%line 884 "integrator.web" + +%line 885 "integrator.web" +lisp procedure inhomogeneous_integration_of(df_term,inhomogeneous_term); +begin scalar df_sequence,integration_variables,int_sequence, +variable,nr_of_integrations,integration_terms,solution, +powers,coefficient,int_factor,solution_term,n,k; +df_sequence:=cdr cdr df_term; +%48:% +%line 905 "integrator.web" + +%line 906 "integrator.web" +while df_sequence do + <<variable:=car df_sequence; +df_sequence:=cdr df_sequence; +if df_sequence and fixp car df_sequence then + <<nr_of_integrations:=car df_sequence; +df_sequence:=cdr df_sequence>> +else nr_of_integrations:=1; +integration_variables:=variable . integration_variables; +int_sequence:=(variable . nr_of_integrations) . int_sequence +>> + +%:48% +%line 890 "integrator.web" +; +integration_terms:=multi_split_form(numr simp inhomogeneous_term, +integration_variables); +integration_terms:=(nil . car integration_terms) . +cdr +integration_terms; + +%49:% +%line 924 "integrator.web" + +%line 925 "integrator.web" +solution:=nil ./ 1; +for each term in integration_terms do + <<powers:=car +term;coefficient:=cdr term; +int_factor:=1;solution_term:=1 ./ 1; +for each integration in int_sequence do + <<variable:=car integration;k:=cdr integration; +n:=(if power then cdr power else 0)where power=assoc(variable,powers); + +for i:=1:k do int_factor:=(n+i)*int_factor; +solution_term:=multsq(solution_term,mksq(variable,n+k)) +>> ; +solution_term:=multsq(solution_term,coefficient ./ int_factor); +solution:=addsq(solution,solution_term) +>> + +%:49% +%line 896 "integrator.web" +; +solution:=multsq(solution,1 ./ denr simp inhomogeneous_term); +solution:=mk!*sq subs2 addsq(solution,simp homogeneous_integration_of df_term); +return solution +end$ + +%:47%%54:% +%line 1041 "integrator.web" + +%line 1042 "integrator.web" +lisp procedure get_polynomial_order(expression,variable); +if not depends(denr(expression:=simp expression),variable)and +(not !*polynomial_check or polynomialp(numr expression,variable))then +begin scalar kord!*; +setkorder list !*a2k variable; +expression:=reorder numr expression; +return if mvar expression=variable then ldeg expression else 0; +end$ + +%:54%%56:% +%line 1063 "integrator.web" + +%line 1064 "integrator.web" +algebraic procedure integrate_equations(m,n); +for i:=m:n do integrate_equation(i)$ + + +lisp operator integrate_exceptional_equation; +lisp procedure integrate_exceptional_equation(n); +integrate_equation(n) +where +!*coefficient_check=nil, +!*polynomial_check=nil, +!*allow_differentiation=t$ + + +%:56%%57:% +%line 1085 "integrator.web" +lisp operator show_equation; +%line 1086 "integrator.web" +lisp procedure show_equation n; +begin scalar equation,total_used,function_list; +if null(total_used:=get(current_equation_set!*, 'total_used))or +n>total_used then + +msgpri("SHOW_EQUATION: properly initialize", +current_equation_set!*,nil,nil,t); +if(equation:=assoc(list(current_equation_set!*,n),get(current_equation_set!*, 'kvalue)))then +begin +equation:=setk(list(current_equation_set!*,n),aeval cadr equation); +varpri(equation,list( 'setk,mkquote list(current_equation_set!*,n),mkquote equation), 'only); +function_list:=get_recursive_kernels(numr simp equation, +get(current_equation_set!*, 'function_list)); +if function_list then + <<terpri!* t; +for each fn in function_list do + <<maprin(fn . +((if depl_entry then cdr depl_entry)where depl_entry=assoc(fn,depl!*)));terpri!* nil>> +>> +else terpri!* nil +end +end$ + + +algebraic procedure show_equations(m,n); +for i:=m:n do show_equation i$ + +%:57%%58:% +%line 1112 "integrator.web" + +%line 1113 "integrator.web" +lisp operator functions_used,put_functions_used,equations_used,put_equations_used; + + +lisp procedure functions_used function_name; +list( 'list,get(function_name, 'even_used),get(function_name, 'odd_used))$ + + +lisp procedure put_functions_used(function_name,even_used,odd_used); +begin +if not fixp even_used or even_used<0 or +not fixp odd_used or odd_used<0 then + +msgpri("PUT_FUNCTIONS_USED: used functions number invalid",nil,nil,nil,t); +put(function_name, 'even_used,even_used); +put(function_name, 'odd_used,odd_used); +end$ + + +lisp procedure equations_used; +get(current_equation_set!*, 'total_used)$ + + +lisp procedure put_equations_used(n); +if not fixp n or n<0 then + +msgpri("PUT_EQUATIONS_USED: used equation number invalid",nil,nil,nil,t) +else put(current_equation_set!*, 'total_used,n)$ + +%:58%%59:% +%line 1149 "integrator.web" + +%line 1150 "integrator.web" +lisp operator df_acts_as_derivation_on; + +lisp procedure df_acts_as_derivation_on operator_name; +begin +put(operator_name, 'dfform, 'df_as_derivation); +end$ + +%:59%%60:% +%line 1161 "integrator.web" + +%line 1162 "integrator.web" +lisp procedure df_as_derivation(kernel,variable,power); +begin scalar left_part,right_part,argument,derivative; +if power neq 1 then + +msgpri("DF_AS_DERIVATION:",kernel,"must occur linearly",nil,t); +left_part:=list car kernel;right_part:=cdr kernel; +derivative:=nil . 1; +while right_part do + <<argument:=car right_part;right_part:=cdr right_part; +derivative:=addsq(derivative, +simp append(reverse left_part,list( 'df,argument,variable) . right_part)); +left_part:=argument . left_part; +>> ; +return derivative; +end$ + +%:60%%62:% +%line 1191 "integrator.web" + +%line 1192 "integrator.web" +lisp operator listlength$ +lisp procedure listlength l; +listpri_depth!*:=l$ + +%:62%%63:% +%line 1200 "integrator.web" + +%line 1201 "integrator.web" +symbolic procedure listpri l; +begin scalar orig,split,u; +u:=l; +l:=cdr l; +prin2!* get( '!*lcbkt!*, 'prtch); + +orig:=orig!*; +orig!*:=if posn!*<18 then posn!* else orig!*+3; +if null l then go to b; +split:=treesizep(l,listpri_depth!*); +a:maprint(negnumberchk car l,0); +l:=cdr l; +if null l then go to b; +oprin '!*comma!*; +if split then terpri!* t; +go to a; +b:prin2!* get( '!*rcbkt!*, 'prtch); +orig!*:=orig; +return u +end$ + +%:63%%64:% +%line 1224 "integrator.web" +end; +%line 1225 "integrator.web" + +%:64% diff --git a/web/reduce/rweb/appl/source/liesuper.red b/web/reduce/rweb/appl/source/liesuper.red new file mode 100644 index 0000000000..e8c33d7efc --- /dev/null +++ b/web/reduce/rweb/appl/source/liesuper.red @@ -0,0 +1,2908 @@ +%5:% +%line 108 "liesuper.web" + +symbolic$ +write"Lie (super)algebra package for REDUCE 3.4, $Revision: 1.5 $"$terpri()$ +%6:% +%line 120 "liesuper.web" + +%line 121 "liesuper.web" +if not getd 'operator_coeff then + +msgpri("LIESUPER_INIT: load the TOOLS package before continuing",nil,nil,nil,nil) + + +%:6% +%line 111 "liesuper.web" +$ +%33:% +%line 844 "liesuper.web" + +%line 845 "liesuper.web" +put( 'liebracket, 'rtypefn, 'liebracket_rtypefn)$ +put( 'liebracket, 'setelemfn, 'set_liebracket)$ + +%:33%%43:% +%line 1097 "liesuper.web" + +%line 1098 "liesuper.web" +put( 'liebracket, 'clearfn, 'clear_liebracket)$ + + +%:43%%80:% +%line 2099 "liesuper.web" + +%line 2100 "liesuper.web" + + +global '(!*solve_parameters)$ +!*solve_parameters:=nil$ +flag( '(solve_parameters), 'switch)$ + +%:80%%82:% +%line 2133 "liesuper.web" + +%line 2134 "liesuper.web" + + +global '(!*print_identities)$ +!*print_identities:=nil$ +flag( '(print_identities), 'switch)$ + +%:82%%87:% +%line 2233 "liesuper.web" + +global '(indentation_level!*)$ +initl!*:= 'indentation_level!* . initl!*$ +put( 'indentation_level!*, 'initl,0)$ + +%:87%%97:% +%line 2388 "liesuper.web" + +put( 'algebra_generator, 'setelemfn, 'set_generator)$ +put( 'algebra_generator, 'clearfn, 'clear_generator)$ +put( 'algebra_generator, 'rtypefn, 'generator_rtypefn)$ + +%:97%%120:% +%line 2879 "liesuper.web" + +%line 2880 "liesuper.web" +put( 'definition_of, 'psopfn, 'definition_of1)$ +put( 'history_of, 'psopfn, 'history_of1)$ + + +%:120%%137:% +%line 3198 "liesuper.web" + +%line 3199 "liesuper.web" +put( 'liebracket, 'stat, 'rlis)$ + +%:137%%154:% +%line 3559 "liesuper.web" + +%line 3560 "liesuper.web" + +global '(default_liebracket!*)$ +default_liebracket!*:= 'lie$ + +%:154%%155:% +%line 3572 "liesuper.web" + +%line 3573 "liesuper.web" +put( '![, 'stat, 'liebracket_stat)$ +flag(list '!], 'delim)$ + +%:155%%158:% +%line 3620 "liesuper.web" + +%line 3621 "liesuper.web" +put(default_liebracket!*, 'prifn, 'liebracket_prifn)$ + +%:158%%161:% +%line 3708 "liesuper.web" + +%line 3709 "liesuper.web" + + +global '(!*full_transformation)$ +!*full_transformation:=nil$ +flag( '(full_transformation), 'switch)$ + +%:161% +%line 112 "liesuper.web" + +algebraic$ + +%:5%%17:% +%line 490 "liesuper.web" + +%line 491 "liesuper.web" +lisp procedure simp_liebracket val; +if length val=3 then%18:% +%line 503 "liesuper.web" + +%line 504 "liesuper.web" + begin scalar bracketname,arg1,arg2; +bracketname:=car val; +arg1:=mk!*sq simp!* cadr val; +arg2:=mk!*sq simp!* caddr val; +return +if fixp arg1 and fixp arg2 then simp_liebracket_vector(bracketname,arg1,arg2) +else%19:% +%line 535 "liesuper.web" + +%line 536 "liesuper.web" + simp_multilinear list(bracketname, +if fixp arg1 and arg1 neq 0 then list(generatorname,arg1)else arg1, +if fixp arg2 and arg2 neq 0 then list(generatorname,arg2)else arg2) +where generatorname=get(bracketname, 'generatorname) + +%:19% +%line 510 "liesuper.web" +; +end + +%:18% +%line 492 "liesuper.web" + +else if length val>3 then%22:% +%line 592 "liesuper.web" + +%line 593 "liesuper.web" + begin scalar bracketname,arguments,result; +bracketname:=car val; +arguments:=reverse cdr val; +result:=simp_liebracket list(bracketname,second arguments,first arguments); +arguments:=cddr arguments; +for each arg in arguments do +result:=simp_liebracket list(bracketname,arg,mk!*sq result); +return result; +end + +%:22% +%line 493 "liesuper.web" + +else rederr("SIMP_LIEBRACKET: wrong number of arguments")$ + +%:17%%21:% +%line 570 "liesuper.web" +lisp procedure resimp_liebracket val; +begin scalar bracketname,generatorname,arg1,arg2,resimplify; +bracketname:=car val; +generatorname:=get(bracketname, 'generatorname); +arg1:=cadr val;arg2:=caddr val; + +if fixp arg1 then rederr("SIMP_LIEBRACKET: argument contains a non algebra element") +else if car arg1=generatorname then arg1:=cadr arg1 +else if car arg1= 'list then + <<resimplify:=t;arg1:=bracketname . cdr arg1>> ; +if fixp arg2 then rederr("SIMP_LIEBRACKET: argument contains a non algebra element") +else if car arg2=generatorname then arg2:=cadr arg2 +else if car arg2= 'list then + <<resimplify:=t;arg2:=bracketname . cdr arg2>> ; +return +if resimplify then simp_liebracket list(bracketname,arg1,arg2) +else +if fixp arg1 and fixp arg2 +then simp_liebracket_vector(bracketname,arg1,arg2) +else simp_liebracket_kvalue(bracketname,arg1,arg2); +end$ + +%:21%%27:% +%line 732 "liesuper.web" + +lisp procedure even_element(bracketname,exprn); +if fixp exprn then exprn>0 +else if car exprn=bracketname then +((b1 and b2)or(not b1 and not b2))where +b1=even_element(bracketname,cadr exprn), +b2=even_element(bracketname,caddr exprn) +else if car exprn= 'df then +even_element(bracketname,cadr exprn) +else if fixp cadr exprn then +cadr exprn>0 +else +msgpri("EVEN_ELEMENT: impossible to determine sign of", +exprn,nil,nil,t)$ + +%:27%%30:% +%line 787 "liesuper.web" + +%line 788 "liesuper.web" +lisp procedure simp_liebracket_vector(bracketname,arg1,arg2); +begin scalar sign,commutator; +%28:% +%line 751 "liesuper.web" + +%line 752 "liesuper.web" +if +(if fixp arg1 and fixp arg2 then arg1>arg2 else +ordp(arg1,arg2)and arg1 neq arg2)then +begin scalar h; +sign:=(even_element(bracketname,arg1)or even_element(bracketname,arg2)); +h:=arg1;arg1:=arg2;arg2:=h; +end + +%:28% +%line 790 "liesuper.web" +; +%29:% +%line 763 "liesuper.web" + +%line 764 "liesuper.web" +if arg1<-get(bracketname, 'odd_dimension)or arg2>get(bracketname, 'even_dimension)then + +msgpri("SIMP_LIEBRACKET:",list(bracketname,arg1,arg2),"out of range",nil,t) + +%:29% +%line 791 "liesuper.web" +; +%68:% +%line 1840 "liesuper.web" + +%line 1841 "liesuper.web" +commutator:= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2); +commutator:= +if commutator and cddr commutator then +if +(car commutator and caar commutator neq 's +)then +if cddr commutator=0 then nil . 1 +else resimp cadr cddr commutator +else simp cddr commutator +else mksq(list(bracketname,arg1,arg2),1) + + +%:68% +%line 792 "liesuper.web" +; +return +if sign then negsq commutator +else commutator; +end$ + +%:30%%31:% +%line 805 "liesuper.web" + +%line 806 "liesuper.web" +lisp procedure simp_liebracket_kvalue(bracketname,arg1,arg2); +begin scalar sign,commutator; +%28:% +%line 751 "liesuper.web" + +%line 752 "liesuper.web" +if +(if fixp arg1 and fixp arg2 then arg1>arg2 else +ordp(arg1,arg2)and arg1 neq arg2)then +begin scalar h; +sign:=(even_element(bracketname,arg1)or even_element(bracketname,arg2)); +h:=arg1;arg1:=arg2;arg2:=h; +end + +%:28% +%line 808 "liesuper.web" +; +commutator:=assoc(list(bracketname,arg1,arg2),get(bracketname, 'kvalue)); +commutator:= +if commutator then simp cadr commutator +else mksq(list(bracketname,arg1,arg2),1); +return +if sign then negsq commutator +else commutator; +end$ + +%:31%%34:% +%line 849 "liesuper.web" + +%line 850 "liesuper.web" +lisp procedure liebracket_rtypefn u;nil$ + +%:34%%38:% +%line 950 "liesuper.web" + +%line 951 "liesuper.web" +lisp procedure set_liebracket(val,value); +if length val neq 3 then +rederr("SET_LIEBRACKET: assignment only possible to commutators") +else begin scalar bracketname,generatorname,algebra_elements,arg1,arg2, +error,sign; +bracketname:=car val; +generatorname:=get(bracketname, 'generatorname); +algebra_elements:=bracketname . generatorname . get(bracketname, 'algebra_elements); +arg1:=reval cadr val; +arg2:=reval caddr val; +%36:% +%line 910 "liesuper.web" + + +if atom arg1 then error:= +((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension) +or arg1>get(bracketname, 'even_dimension)) +else begin +error:=not member(car arg1,algebra_elements); +if not error and car arg1=generatorname then +begin +arg1:=cadr arg1; +error:=not atom arg1 or +((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension) +or arg1>get(bracketname, 'even_dimension)); +end; +end; +if not error then +if atom arg2 then error:= +((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension) +or arg2>get(bracketname, 'even_dimension)) +else begin +error:=not member(car arg2,algebra_elements); +if not error and car arg2=generatorname then +begin +arg2:=cadr arg2; +error:=not atom arg2 or +((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension) +or arg2>get(bracketname, 'even_dimension)); +end; +end; +if error then +rederr("SET_/CLEAR_LIEBRACKET: argument(s) invalid or out of range") + +%:36% +%line 961 "liesuper.web" +; +%28:% +%line 751 "liesuper.web" + +%line 752 "liesuper.web" +if +(if fixp arg1 and fixp arg2 then arg1>arg2 else +ordp(arg1,arg2)and arg1 neq arg2)then +begin scalar h; +sign:=(even_element(bracketname,arg1)or even_element(bracketname,arg2)); +h:=arg1;arg1:=arg2;arg2:=h; +end + +%:28% +%line 962 "liesuper.web" +; +%37:% +%line 934 "liesuper.web" + +error:=if fixp arg1 and fixp arg2 then +(if entry then car entry) +where entry= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2); +if error then +if car error= 's +then +rederr("SET_/CLEAR_LIEBRACKET: commutator can not be changed") +else +msgpri("SET_/CLEAR_LIEBRACKET: changing", +list(bracketname,arg1,arg2),"may lead to errors",nil,nil) + +%:37% +%line 963 "liesuper.web" +; +value:=aeval value; +%35:% +%line 866 "liesuper.web" + +%line 867 "liesuper.web" +if independent_part(value,algebra_elements)neq 0 then +rederr("SET_LIEBRACKET: assigned value invalid as algebra element") + +%:35% +%line 965 "liesuper.web" +; +if sign then value:=mk!*sq negsq simp value; +%41:% +%line 1033 "liesuper.web" + +if fixp arg1 and fixp arg2 then +begin +if + 'used!* memq cddr fkern list(bracketname,arg1,arg2)then rmsubs(); + +(if old_value then + +putv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2,nil . (cadr old_value) . value) +else +putv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2,nil . nil . value)) +where old_value= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2); +end else +setk1(list(bracketname,arg1,arg2),value,t) + +%:41% +%line 967 "liesuper.web" +; +end$ + +%:38%%42:% +%line 1075 "liesuper.web" + +%line 1076 "liesuper.web" +lisp procedure clear1 u; +begin scalar x,xx; +while u do + <<if flagp(x:=car u, 'share) +then if not flagp(x, 'reserved)then set(x,x)else rsverr x +else if eqcar(x, 'list) +then u:=nil . append(cdr x,cdr u) +else if eqcar(x, 'replaceby)then rule!-list(list x,nil) +else if smemq( '!~,x) +then if eqcar(x, 'equal)then rule!-list(list x,nil) +else rule!-list(list list( 'replaceby,x,nil),nil) +else if(xx:=get(if atom x then x else car x, 'rtype)) +and(xx:=get(xx, 'clearfn)) +then apply1(xx,x) +else <<let2(x,nil,nil,nil);let2(x,nil,t,nil)>> ; +u:=cdr u>> +end$ + +%:42%%44:% +%line 1105 "liesuper.web" + +%line 1106 "liesuper.web" +lisp procedure clear_liebracket val; +if atom val then%142:% +%line 3306 "liesuper.web" + +%line 3307 "liesuper.web" + begin scalar bracketname,generatorname; +bracketname:=val; +generatorname:=get(bracketname, 'generatorname); +for each property in + '(vector_structure info_list !*jacobi_var!* even_dimension odd_dimension +even_used odd_used degree_length degree_sequence algebra_elements +parameters oplist resimp_fn +generatorname rtype simpfn commutator_list identity_list +unsolved_identities kvalue)do +remprop(bracketname,property); +for each property in + '(bracketname rtype simpfn kvalue)do +remprop(generatorname,property); +remflag(list bracketname, 'full); +end + +%:142% +%line 1107 "liesuper.web" + +else if length val=3 then%45:% +%line 1117 "liesuper.web" + +%line 1118 "liesuper.web" + begin scalar bracketname,generatorname,algebra_elements,arg1,arg2,error,h; +bracketname:=car val; +generatorname:=get(bracketname, 'generatorname); +algebra_elements:=bracketname . generatorname . get(bracketname, 'algebra_elements); +arg1:=reval cadr val; +arg2:=reval caddr val; +%36:% +%line 910 "liesuper.web" + + +if atom arg1 then error:= +((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension) +or arg1>get(bracketname, 'even_dimension)) +else begin +error:=not member(car arg1,algebra_elements); +if not error and car arg1=generatorname then +begin +arg1:=cadr arg1; +error:=not atom arg1 or +((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension) +or arg1>get(bracketname, 'even_dimension)); +end; +end; +if not error then +if atom arg2 then error:= +((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension) +or arg2>get(bracketname, 'even_dimension)) +else begin +error:=not member(car arg2,algebra_elements); +if not error and car arg2=generatorname then +begin +arg2:=cadr arg2; +error:=not atom arg2 or +((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension) +or arg2>get(bracketname, 'even_dimension)); +end; +end; +if error then +rederr("SET_/CLEAR_LIEBRACKET: argument(s) invalid or out of range") + +%:36% +%line 1124 "liesuper.web" +; +if +(if fixp arg1 and fixp arg2 then arg1>arg2 else +ordp(arg1,arg2)and arg1 neq arg2)then +begin +h:=arg1;arg1:=arg2;arg2:=h; +end; +%37:% +%line 934 "liesuper.web" + +error:=if fixp arg1 and fixp arg2 then +(if entry then car entry) +where entry= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2); +if error then +if car error= 's +then +rederr("SET_/CLEAR_LIEBRACKET: commutator can not be changed") +else +msgpri("SET_/CLEAR_LIEBRACKET: changing", +list(bracketname,arg1,arg2),"may lead to errors",nil,nil) + +%:37% +%line 1129 "liesuper.web" +; +%46:% +%line 1140 "liesuper.web" + +%line 1141 "liesuper.web" +val:=list(bracketname,arg1,arg2); +if fixp arg1 and fixp arg2 then +if +(if entry then cddr entry) +where entry= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2)then + +(if old_value then + +putv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2,nil . (cadr old_value) . nil) +else +putv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2,nil . nil . nil)) +where old_value= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+arg1), +get(bracketname, 'even_dimension)-arg2) +else +msgpri("CLEAR_LIEBRACKET:",val,"not found",nil,nil) +else begin scalar kvalue; +kvalue:=get(bracketname, 'kvalue); +if(h:=assoc(val,kvalue))then +put(bracketname, 'kvalue,delete(h,kvalue)) +else +msgpri("CLEAR_LIEBRACKET:",val,"not found",nil,nil); +end + +%:46% +%line 1130 "liesuper.web" +; +end + +%:45% +%line 1108 "liesuper.web" + +else rederr("CLEAR_LIEBRACKET: wrong number of arguments to commutator")$ + + +%:44%%48:% +%line 1303 "liesuper.web" + +lisp operator recompute_jacobi_identities_of; + +lisp procedure recompute_jacobi_identities_of bracketname; +begin scalar !*jacobi_var!*; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("RECOMPUTE_JACOBI_IDENTITIES:",bracketname,"is not a liebracket",nil,t); +!*jacobi_var!*:=get(bracketname, '!*jacobi_var!*); +rplaca(!*jacobi_var!*,nil); +put(bracketname, '!*jacobi_var!*,list t); +end$ + +%:48%%51:% +%line 1395 "liesuper.web" + +%line 1396 "liesuper.web" +lisp procedure find_unprocessed_commutators_of bracketname; +begin scalar vector_i,entry_i_j,k_info_i_j,commutator,form,kord!*, + + +vector_structure,m,m_used,n,n_used +,generatorname,non_generators, +commutator_list,!*jacobi_var!* +,comm_list_i, +dependent_generators; +%50:% +%line 1370 "liesuper.web" + +%49:% +%line 1355 "liesuper.web" + +vector_structure:=get(bracketname, 'vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used) + +%:49% +%line 1371 "liesuper.web" +; +generatorname:=get(bracketname, 'generatorname); +non_generators:=bracketname . get(bracketname, 'algebra_elements); +commutator_list:=get(bracketname, 'commutator_list); +!*jacobi_var!*:=get(bracketname, '!*jacobi_var!*) + +%:50% +%line 1400 "liesuper.web" +; +%52:% +%line 1417 "liesuper.web" + +%line 1418 "liesuper.web" +dependent_generators:= +for each entry in get(generatorname, 'kvalue)collect +cadr car entry + +%:52% +%line 1401 "liesuper.web" +; +for i:=-n_used:m_used do +if not memq(i,dependent_generators)then +begin +vector_i:=getv(vector_structure,n+i); +for j:=i:m_used do +if not memq(j,dependent_generators)then +%56:% +%line 1492 "liesuper.web" + +begin +entry_i_j:=getv(vector_i,m-j); +if entry_i_j and cddr entry_i_j then +if null car entry_i_j then +begin +commutator:=simp!* cddr entry_i_j; +k_info_i_j:=cadr entry_i_j; +form:=numr commutator; +if +null get_all_kernels(form,non_generators)then begin + +setkorder get_all_kernels(form,generatorname); +commutator:=!*ff2a(reorder form,denr commutator); + +if(comm_list_i:=assoc(i,commutator_list))then +(if not member(j,comm_list_i)then +rplacd(comm_list_i,j . cdr comm_list_i)) +else + <<commutator_list:=list(i,j) . commutator_list; +put(bracketname, 'commutator_list,commutator_list)>> ; + +putv(vector_i,m-j,!*jacobi_var!* . k_info_i_j . commutator); +end; +end +else if null caar +entry_i_j then begin +commutator:=cddr entry_i_j; +k_info_i_j:=cadr entry_i_j; + +if(comm_list_i:=assoc(i,commutator_list))then +(if not member(j,comm_list_i)then +rplacd(comm_list_i,j . cdr comm_list_i)) +else + <<commutator_list:=list(i,j) . commutator_list; +put(bracketname, 'commutator_list,commutator_list)>> ; + +putv(vector_i,m-j,!*jacobi_var!* . k_info_i_j . commutator); +end; +end + +%:56% +%line 1408 "liesuper.web" +; +end; +return commutator_list; +end$ + +%:51%%60:% +%line 1611 "liesuper.web" + +lisp procedure find_Jacobi_identities_of bracketname; +begin scalar comm_list_i,i,j,vector_i,vector_j,vector_k, +entry_i_k,entry_j_k, + + +vector_structure,m,m_used,n,n_used +,commutator_list,identity_list +, +id_list_i,id_list_i_j; +%58:% +%line 1575 "liesuper.web" + +%49:% +%line 1355 "liesuper.web" + +vector_structure:=get(bracketname, 'vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used) + +%:49% +%line 1576 "liesuper.web" +; +commutator_list:=get(bracketname, 'commutator_list); +identity_list:=get(bracketname, 'identity_list) + +%:58% +%line 1617 "liesuper.web" +; +while commutator_list do begin +comm_list_i:=car commutator_list; +i:=car comm_list_i; +while cdr comm_list_i do begin +j:=cadr comm_list_i; +%61:% +%line 1641 "liesuper.web" + +%line 1642 "liesuper.web" +vector_i:=getv(vector_structure,n+i); +vector_j:=getv(vector_structure,n+j); +for k:=-n_used:i-1 do begin +vector_k:=getv(vector_structure,n+k); +if(entry_i_k:=getv(vector_k,m-i))and(entry_j_k:=getv(vector_k,m-j))then + +if +(car entry_i_k and caar entry_i_k neq 's +)and + +(car entry_j_k and caar entry_j_k neq 's +) +then +if(id_list_i:=assoc(k,identity_list))then +if(id_list_i_j:=assoc(i,cdr id_list_i))then +(if not member(j,cdr id_list_i_j)then +rplacd(id_list_i_j,j . cdr id_list_i_j)) +else rplacd(id_list_i,list(i,j) . cdr id_list_i) +else identity_list:=list(k,list(i,j)) . identity_list +; +end; +for k:=i:j-1 do begin +vector_k:=getv(vector_structure,n+k); +if(entry_i_k:=getv(vector_i,m-k))and(entry_j_k:=getv(vector_k,m-j))then + +if +(car entry_i_k and caar entry_i_k neq 's +)and + +(car entry_j_k and caar entry_j_k neq 's +) +then +if(id_list_i:=assoc(i,identity_list))then +if(id_list_i_j:=assoc(k,cdr id_list_i))then +(if not member(j,cdr id_list_i_j)then +rplacd(id_list_i_j,j . cdr id_list_i_j)) +else rplacd(id_list_i,list(k,j) . cdr id_list_i) +else identity_list:=list(i,list(k,j)) . identity_list +; +end; +for k:=j:m_used do begin +if(entry_i_k:=getv(vector_i,m-k))and(entry_j_k:=getv(vector_j,m-k))then + +if +(car entry_i_k and caar entry_i_k neq 's +)and + +(car entry_j_k and caar entry_j_k neq 's +) +then +if(id_list_i:=assoc(i,identity_list))then +if(id_list_i_j:=assoc(j,cdr id_list_i))then +(if not member(k,cdr id_list_i_j)then +rplacd(id_list_i_j,k . cdr id_list_i_j)) +else rplacd(id_list_i,list(j,k) . cdr id_list_i) +else identity_list:=list(i,list(j,k)) . identity_list +; +end; +put(bracketname, 'identity_list,identity_list) + +%:61% +%line 1623 "liesuper.web" +; +rplacd(comm_list_i,cddr comm_list_i); +end; +commutator_list:=cdr commutator_list; +put(bracketname, 'commutator_list,commutator_list); +end; +return identity_list; +end$ + +%:60%%63:% +%line 1725 "liesuper.web" + +lisp procedure sub_identity(bracketname,i,j,k); +begin scalar comm_j_k,denr_j_k,coeff_l,l,comm_i_l,term; +comm_j_k:= +(if entry then cddr entry) +where entry= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+j), +get(bracketname, 'even_dimension)-k); +return if comm_j_k=0 then nil . 1 else +begin +comm_j_k:=cadr comm_j_k; +denr_j_k:=subf1(denr comm_j_k,nil); +comm_j_k:=numr comm_j_k; +%64:% +%line 1747 "liesuper.web" + +term:=nil . 1; +while comm_j_k do begin +l:=cadr mvar comm_j_k; +coeff_l:=subf1(lc comm_j_k,nil); +if not fixp l then + +msgpri("SOLVE_JACOBI_IDENTITIES:",list(bracketname,j,k), +"contains invalid generator",mvar comm_j_k,t); +comm_i_l:=simp_liebracket_vector(bracketname,i,l); +term:=addsq(term,multsq(coeff_l,comm_i_l)); +comm_j_k:=red comm_j_k; +end + +%:64% +%line 1734 "liesuper.web" +; +if i<0 and k<0 then term:=negsq term; + +return quotsq(term,denr_j_k); +end; +end$ + +%:63%%65:% +%line 1768 "liesuper.web" + +%line 1769 "liesuper.web" +lisp procedure special_Jacobi_identity(bracketname,i,j,k); +mk!*sq subs2 negsq +addsq(sub_identity(bracketname,i,j,k), +addsq(multsq((if j>0 then-1 else 1) . 1, +sub_identity(bracketname,j,i,k)), +sub_identity(bracketname,k,i,j)))$ + +%:65%%66:% +%line 1785 "liesuper.web" + +%line 1786 "liesuper.web" +lisp operator update_vector_structure_of; +lisp procedure update_vector_structure_of bracketname; +begin scalar vector_i,entry_i_j, +commutator,form,kord!*,generatorname, +vector_structure,m,m_used,n,n_used +; +%49:% +%line 1355 "liesuper.web" + +vector_structure:=get(bracketname, 'vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used) + +%:49% +%line 1790 "liesuper.web" +; +generatorname:=get(bracketname, 'generatorname); +for i:=-n_used:m_used do begin +vector_i:=getv(vector_structure,n+i); +for j:=i:m_used do begin +entry_i_j:=getv(vector_i,m-j); +%67:% +%line 1805 "liesuper.web" + +%line 1806 "liesuper.web" +if entry_i_j and cddr entry_i_j then +if null car entry_i_j then +putv(vector_i,m-j,nil . cadr(entry_i_j) . +aeval cddr entry_i_j) +else if +(car entry_i_j and caar entry_i_j neq 's +)then begin +commutator:=simp!* cddr entry_i_j; +form:=numr commutator; + +setkorder get_all_kernels(form,generatorname); +commutator:=!*ff2a(reorder form,denr commutator); +putv(vector_i,m-j,car(entry_i_j) . +cadr(entry_i_j) . commutator); +end + +%:67% +%line 1796 "liesuper.web" +; +end; +end; +end$ + +%:66%%70:% +%line 1912 "liesuper.web" +lisp operator relation_analysis; +lisp procedure relation_analysis(relation,bracketname); +begin scalar generatorname,parameters,kernel_list,solvable_kernels, +test,kernel,optimal_kernel,coefficient,clear_list; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("RELATION_ANALYSIS:",bracketname,"is not a liebracket",nil,t); +generatorname:=get(bracketname, 'generatorname); +parameters:=get(bracketname, 'parameters); +kernel_list:=operator_coeff(relation,generatorname); +return +if kernel_list= '(list 0)then 0 +else if cadr kernel_list neq 0 then +%71:% +%line 1933 "liesuper.web" + +begin +solvable_kernels:=cdr solvable_kernels(cadr +kernel_list,bracketname,parameters); +return +if null solvable_kernels then 'unsolvable +else begin +%76:% +%line 2011 "liesuper.web" + +%line 2012 "liesuper.web" +optimal_kernel:=0 . nil; +while solvable_kernels and car optimal_kernel do begin +kernel:=car solvable_kernels; +if not fixp cadr kernel or +not fixp caddr kernel then optimal_kernel:=nil . nil +else +if not((test:=highest_degree(extended_commutator_degree(kernel,bracketname), +car optimal_kernel))eq car optimal_kernel)then +optimal_kernel:=test . kernel; +solvable_kernels:=cdr solvable_kernels; +end; +optimal_kernel:=cdr optimal_kernel + +%:76% +%line 1940 "liesuper.web" +; +return +if optimal_kernel then + <<linear_solve_and_assign(relation,optimal_kernel);optimal_kernel>> +else 'nested_commutator; +end; +end + +%:71% +%line 1923 "liesuper.web" + +else%77:% +%line 2032 "liesuper.web" + +%line 2033 "liesuper.web" + begin +solvable_kernels:=cdr +solvable_kernels(relation,generatorname,parameters); +return +if null solvable_kernels then +%81:% +%line 2106 "liesuper.web" + +%line 2107 "liesuper.web" +if !*solve_parameters then +begin +kernel_list:=cddr kernel_list; +%79:% +%line 2077 "liesuper.web" + +%line 2078 "liesuper.web" +repeat begin +coefficient:=caddr car kernel_list; +solvable_kernels:=cdr +solvable_kernels(coefficient,parameters,parameters); +if null solvable_kernels then +begin +apply1( 'clear,clear_list); +clear_list:=nil +end +else begin +kernel:=car solvable_kernels; +linear_solve_and_assign(coefficient,kernel); +clear_list:=kernel . clear_list; +kernel_list:=cdr kernel_list; +end end +until null kernel_list or null clear_list + +%:79% +%line 2110 "liesuper.web" +; +return if clear_list then 'list . clear_list else 'unsolvable; +end +else 'unsolvable + +%:81% +%line 2038 "liesuper.web" + +else +begin +%78:% +%line 2050 "liesuper.web" + +%line 2051 "liesuper.web" +optimal_kernel:=0 . nil; +while solvable_kernels and car optimal_kernel do begin +kernel:=car solvable_kernels; +if not fixp cadr kernel then +optimal_kernel:=nil . nil +else +if not((test:=highest_degree(extended_generator_degree(kernel,bracketname), +car optimal_kernel))eq car optimal_kernel)then +optimal_kernel:=test . kernel; +solvable_kernels:=cdr solvable_kernels; +end; +optimal_kernel:=cdr optimal_kernel + +%:78% +%line 2041 "liesuper.web" +; +return +if optimal_kernel then + <<linear_solve_and_assign(relation,optimal_kernel);optimal_kernel>> +else 'invalid_generator; +end; +end + +%:77% +%line 1924 "liesuper.web" +; +end$ + +%:70%%72:% +%line 1964 "liesuper.web" + +%line 1965 "liesuper.web" +lisp procedure first_degree_higher(degree_1,degree_2); +if null degree_1 then nil +else if car degree_1>car degree_2 then t +else first_degree_higher(cdr degree_1,cdr degree_2)$ + +%:72%%73:% +%line 1975 "liesuper.web" + +%line 1976 "liesuper.web" +lisp procedure extended_commutator_degree(commutator,bracketname); +nconc(add_degrees( +permuted_degree(car +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i), +get(bracketname, 'degree_sequence)), + +permuted_degree(car +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+j), +get(bracketname, 'degree_sequence))), +list(i,j)) +where i=cadr commutator,j=caddr commutator$ + + +%:73%%74:% +%line 1988 "liesuper.web" + +%line 1989 "liesuper.web" +lisp procedure extended_generator_degree(generator,bracketname); +append( +permuted_degree(car +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i), +get(bracketname, 'degree_sequence)),list abs(i)) +where i=cadr generator$ + +%:74%%75:% +%line 1998 "liesuper.web" + +%line 1999 "liesuper.web" +lisp procedure highest_degree(degree_1,degree_2); +if atom degree_2 then degree_1 +else if first_degree_higher(degree_1,degree_2)then degree_1 +else degree_2$ + +%:75%%83:% +%line 2149 "liesuper.web" + +%line 2150 "liesuper.web" +lisp operator solve_Jacobi_identities_of; +lisp procedure solve_Jacobi_identities_of bracketname; +begin scalar generatorname,stage,identity_list,i,j,identity, +solution,nr_computed,nr_solved,environment,origin; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("SOLVE_JACOBI_IDENTITIES_OF:",bracketname,"is not a liebracket",nil,t); +generatorname:=get(bracketname, 'generatorname); +environment:=!*nat;!*nat:=t;stage:=0; +%84:% +%line 2168 "liesuper.web" + +%line 2169 "liesuper.web" +%88:% +%line 2241 "liesuper.web" + +%line 2242 "liesuper.web" +prin2!*"Starting stage ";prin2!*(stage:=stage+1);prin2!*":";terpri!* nil; +prin2!*"Reordering the commutators...";terpri!* nil + +%:88% +%line 2169 "liesuper.web" +; +find_unprocessed_commutators_of bracketname; +%89:% +%line 2245 "liesuper.web" + +%line 2246 "liesuper.web" +prin2!*"Searching for identities...";terpri!* nil + +%:89% +%line 2171 "liesuper.web" +; +identity_list:=find_Jacobi_identities_of bracketname + +%:84% +%line 2157 "liesuper.web" +; +while identity_list do +%85:% +%line 2174 "liesuper.web" + +%line 2175 "liesuper.web" +begin +nr_computed:=0;nr_solved:=0; +%90:% +%line 2248 "liesuper.web" + +%line 2249 "liesuper.web" +prin2!*"Solving the identities...";terpri!* nil; +if !*print_identities then + <<prin2!*"=========================="; +terpri!* nil>> + +%:90% +%line 2177 "liesuper.web" +; +%86:% +%line 2189 "liesuper.web" + +%line 2190 "liesuper.web" +for each id_list_i in identity_list do begin +i:=car id_list_i;id_list_i:=cdr id_list_i; +for each id_list_i_j in id_list_i do begin +j:=car id_list_i_j;id_list_i_j:=cdr id_list_i_j; +for each k in id_list_i_j do begin +(nr_computed:=nr_computed+1); +identity:=special_Jacobi_identity(bracketname,i,j,k); +origin:=list( 'list,i,j,k); +%91:% +%line 2254 "liesuper.web" + +%line 2255 "liesuper.web" +if !*print_identities and identity neq 0 then +begin +for i:=1:indentation_level!* do prin2!*"| ";maprin origin;terpri!* nil; + +for i:=1:indentation_level!* do prin2!*"| ";maprin identity;terpri!* nil; +end + +%:91% +%line 2198 "liesuper.web" +; +solution:=relation_analysis(identity,bracketname); +%94:% +%line 2293 "liesuper.web" + +if solution neq 0 then +if member(solution, '(unsolvable nested_commutator invalid_generator))then + +put(bracketname, 'unsolved_identities, +list( 'list,origin,identity) . get(bracketname, 'unsolved_identities)) +else if car solution=generatorname or car solution= 'list then +begin(nr_solved:=nr_solved+1); +if not !*print_identities then + << + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Identity ">> ;maprin origin; +prin2!*" solved for: ";maprin solution;terpri!* nil>> +end +else(nr_solved:=nr_solved+1) + +%:94% +%line 2200 "liesuper.web" +; +%92:% +%line 2260 "liesuper.web" + +%line 2261 "liesuper.web" +if !*print_identities and solution neq 0 then +begin +if member(solution, '(unsolvable nested_commutator invalid_generator)) +then + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Not solved.">> +else <<if car solution=generatorname or car solution= 'list then + + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Solved for: ">> +else + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Solved for: ">> ; +maprin solution>> ; + +if indentation_level!*=0 then terpri!* t else + <<terpri!* nil; +for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> ; +end + +%:92% +%line 2201 "liesuper.web" +; +end; +end; +end + +%:86% +%line 2178 "liesuper.web" +; +put(bracketname, 'identity_list,nil); +%93:% +%line 2272 "liesuper.web" + +%line 2273 "liesuper.web" + + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!* nr_solved>> ;prin2!*" identities solved of "; +prin2!* nr_computed; +if indentation_level!*=0 then terpri!* t else + <<terpri!* nil; +for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> + +%:93% +%line 2180 "liesuper.web" +; +%84:% +%line 2168 "liesuper.web" + +%line 2169 "liesuper.web" +%88:% +%line 2241 "liesuper.web" + +%line 2242 "liesuper.web" +prin2!*"Starting stage ";prin2!*(stage:=stage+1);prin2!*":";terpri!* nil; +prin2!*"Reordering the commutators...";terpri!* nil + +%:88% +%line 2169 "liesuper.web" +; +find_unprocessed_commutators_of bracketname; +%89:% +%line 2245 "liesuper.web" + +%line 2246 "liesuper.web" +prin2!*"Searching for identities...";terpri!* nil + +%:89% +%line 2171 "liesuper.web" +; +identity_list:=find_Jacobi_identities_of bracketname + +%:84% +%line 2181 "liesuper.web" +; +end + +%:85% +%line 2159 "liesuper.web" +; +print_statistics_of bracketname; +!*nat:=environment; +end$ + +%:83%%95:% +%line 2316 "liesuper.web" + +%line 2317 "liesuper.web" +lisp operator unsolved_identities_of; +lisp procedure unsolved_identities_of bracketname; +begin scalar unsolved_identities,id; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("UNSOLVED_IDENTITIES_OF:",bracketname,"is not a liebracket",nil,t); +unsolved_identities:=get(bracketname, 'unsolved_identities); +unsolved_identities:= +for each identity in unsolved_identities join +if(id:=aeval caddr identity)neq 0 then +list list( 'list,cadr identity,id); +put(bracketname, 'unsolved_identities,unsolved_identities); +return 'list . unsolved_identities; +end$ + +%:95%%96:% +%line 2341 "liesuper.web" + +lisp operator print_statistics_of; +lisp procedure print_statistics_of bracketname; +begin scalar +vector_structure,m,m_used,n,n_used +,vector_i,entry_i_j,nr_solved,total; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("PRINTS_STATISTICS_OF:",bracketname,"is not a liebracket",nil,t); +%49:% +%line 1355 "liesuper.web" + +vector_structure:=get(bracketname, 'vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used) + +%:49% +%line 2346 "liesuper.web" +; +nr_solved:=0; +for i:=-n_used:m_used do begin +vector_i:=getv(vector_structure,n+i); +for j:=i:m_used do +if(entry_i_j:=getv(vector_i,m-j))and +cddr(entry_i_j)and car entry_i_j neq '(s +) +then(nr_solved:=nr_solved+1); +end; +total:=((m_used+n_used)^2-m_used+n_used)/2; +if total=0 then rederr("PRINT_STATISTICS_OF: first define used area"); +terpri!* t; +prin2!*"Statistics for liebracket ";maprin bracketname;terpri!* nil; +prin2!* m_used;prin2!*" even and ";prin2!* n_used; +prin2!*" odd generators used";terpri!* nil; +prin2!* nr_solved;prin2!*" commutators solved of ";prin2!* total; +prin2!*" (";prin2!*((nr_solved*100)/total);prin2!*" %)";terpri!* nil; +prin2!* length get(get(bracketname, 'generatorname), 'kvalue); +prin2!*" linear dependencies found";terpri!* nil; +total:=for each parameter in get(bracketname, 'parameters)sum +length get(parameter, 'kvalue); +prin2!* total;prin2!*" parameters solved";terpri!* nil; +prin2!* length get(bracketname, 'unsolved_identities); +prin2!*" unsolved identities";terpri!* t; +end$ + + +%:96%%98:% +%line 2398 "liesuper.web" + +%line 2399 "liesuper.web" +lisp procedure generator_rtypefn u; +nil$ + +%:98%%99:% +%line 2415 "liesuper.web" +lisp procedure set_generator(val,value);if length val neq 2 then +%line 2416 "liesuper.web" + rederr("SET_GENERATOR: generator must have one integer argument") +else begin scalar generatorname,bracketname,i,valuelist, +identity,solution, +nr_computed,nr_solved,environment,origin; +generatorname:=car val; +bracketname:=get(generatorname, 'bracketname); +i:=reval cadr val; +value:=aeval value; +%100:% +%line 2438 "liesuper.web" + +%line 2439 "liesuper.web" +if not atom i or +((not fixp i)or i<-get(bracketname, 'odd_dimension) +or i>get(bracketname, 'even_dimension))then + +msgpri("SET_GENERATOR:",val,"invalid or out of range",nil,t); +valuelist:=operator_coeff(value,generatorname); +if cadr valuelist neq 0 then + +msgpri("SET_GENERATOR:",cadr valuelist, +"not a sum of generators",nil,t); +for each term in cddr valuelist do +if length(term:=cadr term)neq 2 or +not atom cadr term or + +((not fixp cadr term)or cadr term<-get(bracketname, 'odd_dimension) +or cadr term>get(bracketname, 'even_dimension))then + +msgpri("SET_GENERATOR:",term,"invalid or out of range",nil,t) + +%:100% +%line 2424 "liesuper.web" +; +if + 'used!* memq cddr fkern val then rmsubs(); +setk1(val,value,t); +%101:% +%line 2475 "liesuper.web" + +%line 2476 "liesuper.web" +environment:=!*nat;!*nat:=t; +%102:% +%line 2495 "liesuper.web" + +%line 2496 "liesuper.web" + + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Adjusting the commutators of ">> ;maprin val;prin2!*"..."; +terpri!* nil; +if !*print_identities then + << + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"| ========================">> ; +terpri!* nil;>> + +%:102% +%line 2477 "liesuper.web" +; +(indentation_level!*:=indentation_level!*+1); +nr_computed:=0;nr_solved:=0; +for j:=-get(bracketname, 'odd_dimension):get(bracketname, 'even_dimension)do +if j neq 0 and(i neq j or i<0)then +begin +(nr_computed:=nr_computed+1); +identity:=%103:% +%line 2510 "liesuper.web" + +%line 2511 "liesuper.web" +mk!*sq subs2 subtrsq(simp_liebracket(list(bracketname,i,j)), +simp_liebracket(list(bracketname,value,j))) + +%:103% +%line 2484 "liesuper.web" +; +origin:=list( 'list,i,j); +%91:% +%line 2254 "liesuper.web" + +%line 2255 "liesuper.web" +if !*print_identities and identity neq 0 then +begin +for i:=1:indentation_level!* do prin2!*"| ";maprin origin;terpri!* nil; + +for i:=1:indentation_level!* do prin2!*"| ";maprin identity;terpri!* nil; +end + +%:91% +%line 2486 "liesuper.web" +; +solution:=relation_analysis(identity,bracketname); +%94:% +%line 2293 "liesuper.web" + +if solution neq 0 then +if member(solution, '(unsolvable nested_commutator invalid_generator))then + +put(bracketname, 'unsolved_identities, +list( 'list,origin,identity) . get(bracketname, 'unsolved_identities)) +else if car solution=generatorname or car solution= 'list then +begin(nr_solved:=nr_solved+1); +if not !*print_identities then + << + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Identity ">> ;maprin origin; +prin2!*" solved for: ";maprin solution;terpri!* nil>> +end +else(nr_solved:=nr_solved+1) + +%:94% +%line 2488 "liesuper.web" +; +%92:% +%line 2260 "liesuper.web" + +%line 2261 "liesuper.web" +if !*print_identities and solution neq 0 then +begin +if member(solution, '(unsolvable nested_commutator invalid_generator)) +then + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Not solved.">> +else <<if car solution=generatorname or car solution= 'list then + + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"*** Solved for: ">> +else + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!*"Solved for: ">> ; +maprin solution>> ; + +if indentation_level!*=0 then terpri!* t else + <<terpri!* nil; +for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> ; +end + +%:92% +%line 2489 "liesuper.web" +; +end; +%93:% +%line 2272 "liesuper.web" + +%line 2273 "liesuper.web" + + << +for i:=1:indentation_level!* do prin2!*"| ";prin2!* nr_solved>> ;prin2!*" identities solved of "; +prin2!* nr_computed; +if indentation_level!*=0 then terpri!* t else + <<terpri!* nil; +for i:=1:indentation_level!* do prin2!*"| ";terpri!* nil>> + +%:93% +%line 2491 "liesuper.web" +; +(indentation_level!*:=indentation_level!*-1); +!*nat:=environment + +%:101% +%line 2427 "liesuper.web" +; +end$ + +%:99%%104:% +%line 2526 "liesuper.web" + +%line 2527 "liesuper.web" +lisp procedure clear_generator val; +if atom val then rederr("CLEAR_GENERATOR: clear associated liebracket instead") +else if length val neq 2 then +rederr("CLEAR_GENERATOR: generator must have one integer argument") +else begin scalar generatorname,kvalue,h; +generatorname:=car val; +val:=list(generatorname,reval cadr val); +kvalue:=get(generatorname, 'kvalue); +if(h:=assoc(val,kvalue))then +begin +put(generatorname, 'kvalue,delete(h,kvalue)); + +msgpri("CLEAR_GENERATOR: clearing",val,"may lead to errors",nil,nil); +end +else +msgpri("CLEAR_GENERATOR:",val,"not found",nil,nil); +end$ + +%:104%%106:% +%line 2592 "liesuper.web" +lisp procedure add_degrees(degree1,degree2); +if degree1 then(car degree1+car degree2) . add_degrees(cdr +degree1,cdr degree2)$ + +%:106%%107:% +%line 2611 "liesuper.web" +lisp operator degree_component_sequence; +%line 2612 "liesuper.web" +lisp procedure degree_component_sequence(bracketname,degree_sequence); +begin scalar degree_length; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("DEGREE_COMPONENT_SEQUENCE:",bracketname,"is not a liebracket",nil,t); +degree_sequence:=if null degree_sequence then degree_sequence else if atom +degree_sequence then list degree_sequence else if +car degree_sequence= 'list then cdr degree_sequence else degree_sequence; +degree_length:=get(bracketname, 'degree_length); +degree_sequence:= +for each component in degree_sequence collect +if fixp component and component>0 and component leq degree_length then +component +else + +msgpri("DEGREE_COMPONENT_SEQUENCE: multigrading has no component", +component,nil,nil,t); +put(bracketname, 'degree_sequence,degree_sequence); +end$ + +%:107%%108:% +%line 2635 "liesuper.web" +lisp procedure permuted_degree(degree,sequence); +if null sequence then degree else permute_degree(degree,sequence)$ + +lisp procedure permute_degree(degree,sequence); +if sequence then +nth(degree,car sequence) . permute_degree(degree,cdr sequence)$ + +%:108%%109:% +%line 2661 "liesuper.web" +lisp procedure degree_of1(bracketname,element); +if atom element then +if +((not fixp element)or element<-get(bracketname, 'odd_dimension) +or element>get(bracketname, 'even_dimension))then + +msgpri("DEGREE_OF: cannot determine degree of",element,nil,nil,t) +else +permuted_degree(car +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+element), +get(bracketname, 'degree_sequence)) +else +if car element=bracketname or car element= 'list then +add_degrees(degree_of1(bracketname,cadr element), +degree_of1(bracketname,caddr element)) +else if car element=get(bracketname, 'generatorname)then +degree_of1(bracketname,cadr element) +else +msgpri("DEGREE_OF: cannot determine degree of",element,nil,nil,t)$ + +%:109%%110:% +%line 2686 "liesuper.web" +lisp operator degree_of; +%line 2687 "liesuper.web" +lisp procedure degree_of element; +begin scalar operatorname,bracketname,check_element; +if(element:=reval element)=0 then return nil; +if not atom element then +begin +operatorname:=car element; +if get(operatorname, 'rtype)= 'liebracket then bracketname:=operatorname +else if get(operatorname, 'rtype)= 'algebra_generator then +bracketname:=get(operatorname, 'bracketname) +end; +if null bracketname then%111:% +%line 2708 "liesuper.web" + +%line 2709 "liesuper.web" + begin +check_element:=element; +while not atom check_element and +member(car check_element, '(quotient plus minus difference))do +check_element:=cadr check_element; +if not atom check_element then +(if car check_element= 'times then +%112:% +%line 2727 "liesuper.web" + +%line 2728 "liesuper.web" +while null bracketname and(check_element:=cdr check_element)do + <<if not atom car check_element then +begin +operatorname:=car car check_element; +if get(operatorname, 'rtype)= 'liebracket then bracketname:=operatorname +else if get(operatorname, 'rtype)= 'algebra_generator then +bracketname:=get(operatorname, 'bracketname) +end; +if bracketname then element:=car check_element>> + + +%:112% +%line 2716 "liesuper.web" + +else +begin +operatorname:=car check_element; +if get(operatorname, 'rtype)= 'liebracket then bracketname:=operatorname +else if get(operatorname, 'rtype)= 'algebra_generator then +bracketname:=get(operatorname, 'bracketname); +if bracketname then element:=check_element +end) +end + +%:111% +%line 2697 "liesuper.web" +; +if null bracketname then + +msgpri("DEGREE_OF: cannot determine degree of",element,nil,nil,t); +return 'list . degree_of1(bracketname,element) +end$ + +%:110%%114:% +%line 2769 "liesuper.web" + +%line 2770 "liesuper.web" +lisp procedure integer_valued degree; +if null degree then t +else if fixp car degree then integer_valued cdr degree$ + +%:114%%115:% +%line 2778 "liesuper.web" +lisp operator define_degree; +%line 2779 "liesuper.web" +lisp procedure define_degree(generator,degree); +begin scalar generatorname,bracketname,info; +%116:% +%line 2795 "liesuper.web" + +%line 2796 "liesuper.web" +if atom generator then + +msgpri("DEGREE:",generator,"invalid generator",nil,t); +generatorname:=car generator; + +if get(generatorname, 'rtype)neq 'algebra_generator then + +msgpri("DEGREE:",generatorname,"is not an algebra generator",nil,t); +bracketname:=get(generatorname, 'bracketname); +generator:=reval cadr generator; +if +((not fixp generator)or generator<-get(bracketname, 'odd_dimension) +or generator>get(bracketname, 'even_dimension))then + +msgpri("DEGREE: generator index", +generator,"out of range",nil,t) + +%:116% +%line 2781 "liesuper.web" +; +%113:% +%line 2761 "liesuper.web" + +if not integer_valued(degree:=if null degree then degree else if atom +degree then list degree else if +car degree= 'list then cdr degree else degree)or +length degree neq get(bracketname, 'degree_length)then + +msgpri("DEGREE:", 'list . degree,"invalid degree",nil,t) + +%:113% +%line 2782 "liesuper.web" +; +info:= +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator); + +putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator, +degree . cadr info . cddr info); +end$ + +%:115%%117:% +%line 2815 "liesuper.web" + +%line 2816 "liesuper.web" +lisp operator change_degree_length; +lisp procedure change_degree_length(bracketname,degree_length); +begin scalar m,n,old_length,shortage,extension,info,degree; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("CHANGE_DEGREE_LENGTH:",bracketname,"is not a liebracket",nil,t); +if not fixp degree_length or degree_length<=0 then +rederr("CHANGE_DEGREE_LENGTH: degree length should be >= 0"); +m:=get(bracketname, 'even_dimension); +n:=get(bracketname, 'odd_dimension); +old_length:=get(bracketname, 'degree_length); +shortage:=degree_length-old_length; +if shortage>0 then extension:=for i:=1:shortage collect 0; +%118:% +%line 2831 "liesuper.web" + +%line 2832 "liesuper.web" +for i:=-n:m do +begin info:= +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i); +degree:=if extension then append(car info,extension) +else sub_list(car info,degree_length); + +putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i, +degree . cadr info . cddr info) +end + +%:118% +%line 2827 "liesuper.web" +; +put(bracketname, 'degree_length,degree_length); +end$ + +%:117%%119:% +%line 2843 "liesuper.web" + +%line 2844 "liesuper.web" +lisp procedure sub_list(l,n); +if l and n>0 then car l . sub_list(cdr l,n-1)$ + +%:119%%121:% +%line 2885 "liesuper.web" +lisp procedure definition_of1 listed_generator; +%line 2886 "liesuper.web" +definition_of car listed_generator$ + +lisp procedure definition_of generator; +begin scalar generatorname,bracketname; +%116:% +%line 2795 "liesuper.web" + +%line 2796 "liesuper.web" +if atom generator then + +msgpri("DEGREE:",generator,"invalid generator",nil,t); +generatorname:=car generator; + +if get(generatorname, 'rtype)neq 'algebra_generator then + +msgpri("DEGREE:",generatorname,"is not an algebra generator",nil,t); +bracketname:=get(generatorname, 'bracketname); +generator:=reval cadr generator; +if +((not fixp generator)or generator<-get(bracketname, 'odd_dimension) +or generator>get(bracketname, 'even_dimension))then + +msgpri("DEGREE: generator index", +generator,"out of range",nil,t) + +%:116% +%line 2890 "liesuper.web" +; +return cadr +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator); +end$ + +lisp procedure history_of1 listed_generator; +history_of car listed_generator$ + +lisp procedure history_of generator; +begin scalar generatorname,bracketname; +%116:% +%line 2795 "liesuper.web" + +%line 2796 "liesuper.web" +if atom generator then + +msgpri("DEGREE:",generator,"invalid generator",nil,t); +generatorname:=car generator; + +if get(generatorname, 'rtype)neq 'algebra_generator then + +msgpri("DEGREE:",generatorname,"is not an algebra generator",nil,t); +bracketname:=get(generatorname, 'bracketname); +generator:=reval cadr generator; +if +((not fixp generator)or generator<-get(bracketname, 'odd_dimension) +or generator>get(bracketname, 'even_dimension))then + +msgpri("DEGREE: generator index", +generator,"out of range",nil,t) + +%:116% +%line 2899 "liesuper.web" +; +return cddr +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+generator); +end$ + +%:121%%122:% +%line 2918 "liesuper.web" + +%line 2919 "liesuper.web" +lisp procedure sub_degree(degree1,degree2); +if null degree1 then t +else if null degree2 then nil +else if car degree1=car degree2 then +sub_degree(cdr degree1,cdr degree2)$ + +%:122%%123:% +%line 2934 "liesuper.web" + +%line 2935 "liesuper.web" +lisp operator generators_of_degree; +lisp procedure generators_of_degree(bracketname,degree); +begin scalar even_used,odd_used,generatorname,kvalue; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("GENERATORS_OF_DEGREE:",bracketname,"is not a liebracket",nil,t); +if not integer_valued(degree:=if null degree then degree else if atom +degree then list degree else if +car degree= 'list then cdr degree else degree)then + +msgpri("DEGREE:", 'list . degree,"invalid degree",nil,t); +even_used:=get(bracketname, 'even_used); +odd_used:=get(bracketname, 'odd_used); +generatorname:=get(bracketname, 'generatorname); +kvalue:=get(generatorname, 'kvalue); +%124:% +%line 2957 "liesuper.web" + +%line 2958 "liesuper.web" +return 'list . +for i:=-odd_used:even_used join +if i neq 0 and null assoc(list(generatorname,i),kvalue)and +sub_degree(degree, +permuted_degree(car +getv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+i), +get(bracketname, 'degree_sequence))) +then +list list(generatorname,i) + +%:124% +%line 2945 "liesuper.web" +; +end$ + +%:123%%125:% +%line 2973 "liesuper.web" + +%line 2974 "liesuper.web" +lisp operator commutators_of_degree; +lisp procedure commutators_of_degree(bracketname,degree); +begin scalar +vector_structure,m,m_used,n,n_used +,vector_i,entry_i_j,info_list, +degree_sequence,degree_i; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("COMMUTATORS_OF_DEGREE:",bracketname,"is not a liebracket",nil,t); +%49:% +%line 1355 "liesuper.web" + +vector_structure:=get(bracketname, 'vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used) + +%:49% +%line 2979 "liesuper.web" +; +info_list:=get(bracketname, 'info_list); +if not integer_valued(degree:=if null degree then degree else if atom +degree then list degree else if +car degree= 'list then cdr degree else degree)then + +msgpri("DEGREE:", 'list . degree,"invalid degree",nil,t); +degree_sequence:=get(bracketname, 'degree_sequence); +%126:% +%line 2990 "liesuper.web" + +%line 2991 "liesuper.web" +return 'list . +for i:=-n_used:m_used join + <<vector_i:=getv(vector_structure,n+i); +degree_i:=car getv(info_list,n+i); +for j:=i:m_used join +if(null(entry_i_j:=getv(vector_i,m-j))or +null cddr(entry_i_j))and +sub_degree(degree, +permuted_degree(add_degrees(degree_i, +car getv(info_list,n+j)), +degree_sequence)) +then +list list(bracketname,i,j) +>> + +%:126% +%line 2984 "liesuper.web" +; +end$ + +%:125%%127:% +%line 3054 "liesuper.web" + +%line 3055 "liesuper.web" +lisp operator new_generators; +lisp procedure new_generators commutator_list; +begin scalar operatorname,bracketname,arg1,arg2,indx, +generator,degree,definition,history; +return +if atom commutator_list then commutator_list +else << +operatorname:=car commutator_list; +if operatorname= 'list then + 'list . for each commutator in cdr commutator_list collect +new_generators reval commutator +else +if not get(operatorname, 'rtype)= 'liebracket then commutator_list +else +%128:% +%line 3075 "liesuper.web" + +%line 3076 "liesuper.web" +begin +bracketname:=operatorname; +arg1:=cadr commutator_list; +arg2:=caddr commutator_list; +if +((not fixp arg1)or arg1<-get(bracketname, 'odd_dimension) +or arg1>get(bracketname, 'even_dimension))or +((not fixp arg2)or arg2<-get(bracketname, 'odd_dimension) +or arg2>get(bracketname, 'even_dimension))then +return commutator_list; +%129:% +%line 3091 "liesuper.web" + +%line 3092 "liesuper.web" +if even_element(operatorname,commutator_list)then +%130:% +%line 3100 "liesuper.web" + +%line 3101 "liesuper.web" +begin +indx:=get(operatorname, 'even_used)+1; +if indx<=get(operatorname, 'even_dimension) +then + <<put(operatorname, 'even_used,indx); +generator:=list(get(operatorname, 'generatorname),indx); +%132:% +%line 3127 "liesuper.web" + +%line 3128 "liesuper.web" +degree:=add_degrees(car +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1), +car +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2)); +history:=add_histories(cddr +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1), +cddr +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2)); +definition:=list( 'list,arg1,arg2); + +putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+indx,degree . definition . history) + +%:132% +%line 3107 "liesuper.web" +>> ; +end + +%:130% +%line 3093 "liesuper.web" + +else +%131:% +%line 3110 "liesuper.web" + +%line 3111 "liesuper.web" +begin +indx:=get(operatorname, 'odd_used)+1; +if indx<=get(operatorname, 'odd_dimension) +then + <<put(operatorname, 'odd_used,indx); +indx:=-indx; +generator:=list(get(operatorname, 'generatorname),indx); +%132:% +%line 3127 "liesuper.web" + +%line 3128 "liesuper.web" +degree:=add_degrees(car +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1), +car +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2)); +history:=add_histories(cddr +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg1), +cddr +getv(get(operatorname, 'info_list),get(operatorname, 'odd_dimension)+arg2)); +definition:=list( 'list,arg1,arg2); + +putv(get(bracketname, 'info_list),get(bracketname, 'odd_dimension)+indx,degree . definition . history) + +%:132% +%line 3118 "liesuper.web" +>> ; +end + +%:131% +%line 3095 "liesuper.web" + + +%:129% +%line 3082 "liesuper.web" +; +return if generator then +setk(commutator_list,generator) +else commutator_list +end + +%:128% +%line 3069 "liesuper.web" +>> ; +end$ + +%:127%%133:% +%line 3139 "liesuper.web" +lisp procedure add_histories(history1,history2); +%line 3140 "liesuper.web" +if fixp history2 then list( 'list,history1,history2) +else +if fixp history1 then 'list . history1 . cdr history2 +else 'list . append(list history1,cdr history2)$ + +%:133%%134:% +%line 3150 "liesuper.web" +lisp operator list_used; +%line 3151 "liesuper.web" +lisp procedure list_used bracketname; + << +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("LIST_USED:",bracketname,"is not a liebracket",nil,t); +list( 'list,get(bracketname, 'even_used),get(bracketname, 'odd_used))>> $ + +%:134%%135:% +%line 3158 "liesuper.web" + +%line 3159 "liesuper.web" +lisp operator define_used; +lisp procedure define_used(bracketname,used_list); +begin scalar even_used,odd_used; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("DEFINE_USED:",bracketname,"is not a liebracket",nil,t); +if atom(used_list)or car(used_list)neq 'list or +length(used_list)neq 3 then + +msgpri("DEFINE_USED:",used_list,"invalid list of dimensions",nil,t); +even_used:=cadr used_list; +odd_used:=caddr used_list; +if even_used>get(bracketname, 'even_dimension)or +odd_used>get(bracketname, 'odd_dimension) +then rederr("DEFINE_USED: dimensions out of range"); +put(bracketname, 'even_used,even_used); +put(bracketname, 'odd_used,odd_used); +end$ + +%:135%%138:% +%line 3206 "liesuper.web" +lisp procedure liebracket decl_list; +%line 3207 "liesuper.web" +begin scalar bracketname,generatorname,m,n, +algebra_elements,parameters,rtype,vector_structure,info_list; +for each decl in decl_list do +begin if length decl<4 then + +msgpri("LIEBRACKET:",decl,"invalid liebracket declaration",nil,t); +%139:% +%line 3226 "liesuper.web" + +%line 3227 "liesuper.web" +bracketname:=car decl;generatorname:=cadr decl; +m:=reval caddr decl;n:=reval cadddr decl; +if decl:=cddddr decl then + <<algebra_elements:=car decl;algebra_elements:=if null algebra_elements then algebra_elements else if atom +algebra_elements then list algebra_elements else if +car algebra_elements= 'list then cdr algebra_elements else algebra_elements; +if cdr decl then parameters:=cadr decl;parameters:=if null parameters then parameters else if atom +parameters then list parameters else if +car parameters= 'list then cdr parameters else parameters>> + +%:139% +%line 3213 "liesuper.web" +; +%140:% +%line 3240 "liesuper.web" + +%line 3241 "liesuper.web" +if not idp bracketname or not idp generatorname or not fixp m or not +fixp n or m<0 or n<0 then + +msgpri("LIEBRACKET:",decl,"invalid liebracket declaration",nil,t); +if get(bracketname, 'simpfn)then + +msgpri("LIEBRACKET: operator",bracketname, +"invalid as liebracket",nil,t); +if rtype:=get(bracketname, 'rtype)then + +msgpri("LIEBRACKET:",rtype,bracketname,"invalid as liebracket",t); +if get(generatorname, 'simpfn)then + +msgpri("LIEBRACKET: operator",generatorname, +"invalid as generator",nil,t); +if rtype:=get(generatorname, 'rtype)then + +msgpri("LIEBRACKET:",rtype,generatorname,"invalid as generator",t) + +%:140% +%line 3214 "liesuper.web" +; +%141:% +%line 3277 "liesuper.web" + +%144:% +%line 3338 "liesuper.web" + +%line 3339 "liesuper.web" +%143:% +%line 3327 "liesuper.web" + +%line 3328 "liesuper.web" +vector_structure:=mkvect(m+n); +for i:=-n:m do putv(vector_structure,n+i,mkvect(m-i)); +for i:=-n:0 do putv(getv(vector_structure,n+i),m, '(s +) . nil . 0); +for j:=1:m do + <<putv(getv(vector_structure,n),m-j, '(s +) . nil . 0); +putv(getv(vector_structure,n+j),m-j, '(s +) . nil . 0)>> + +%:143% +%line 3339 "liesuper.web" +; +info_list:=mkvect(m+n); +for i:=-n:m do putv(info_list,n+i, '(0) . i . i) + +%:144% +%line 3278 "liesuper.web" +; +put(bracketname, 'vector_structure,vector_structure); +put(bracketname, 'info_list,info_list); +put(bracketname, '!*jacobi_var!*,list t); +put(bracketname, 'even_dimension,m); +put(bracketname, 'odd_dimension,n); +put(bracketname, 'even_used,0); +put(bracketname, 'odd_used,0); +put(bracketname, 'degree_length,1); +put(bracketname, 'algebra_elements,algebra_elements); +put(bracketname, 'parameters,parameters); +put(bracketname, 'oplist, +bracketname . generatorname . 'list . 'df . algebra_elements); +put(bracketname, 'resimp_fn, 'resimp_liebracket); +put(bracketname, 'generatorname,generatorname); +put(bracketname, 'rtype, 'liebracket); +put(bracketname, 'simpfn, 'simp_liebracket); +put(generatorname, 'bracketname,bracketname); +put(generatorname, 'rtype, 'algebra_generator); +put(generatorname, 'simpfn, 'simpiden); +flag(list bracketname, 'full) + +%:141% +%line 3215 "liesuper.web" +; +end; +end$ + +%:138%%145:% +%line 70 "list2vector.ch" + +lisp operator save_liebracket; +lisp procedure save_liebracket(bracketname,savefile); +begin scalar generatorname,vector_list; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("SAVE_LIEBRACKET:",bracketname,"is not a liebracket",nil,t); +generatorname:=get(bracketname, 'generatorname); +rmsubs(); +out savefile; +write"lisp$"; +terpri();terpri(); +%147:% +%line 3398 "liesuper.web" + +%line 3399 "liesuper.web" +write"if not getd 'simp_liebracket then";terpri(); +write"rederr(", +"""Load the Lie superalgebra package before reading this file""",")$"; +terpri();terpri() + +%:147% +%line 80 "list2vector.ch" +; +for each property in 'klist . cddr + '(vector_structure info_list !*jacobi_var!* even_dimension odd_dimension +even_used odd_used degree_length degree_sequence algebra_elements +parameters oplist resimp_fn +generatorname rtype simpfn commutator_list identity_list +unsolved_identities kvalue)do + + <<prin2"put('";prin1 bracketname;prin2",'";prin1 property;prin2",'"; +prin1 get(bracketname,property);prin2")$";terpri();terpri()>> ; +%146:% +%line 97 "list2vector.ch" + +vector_list:=for each el in vector2list get(bracketname, 'vector_structure) +collect vector2list el; +prin2"put('";prin1 bracketname; +prin2",'VECTOR_STRUCTURE,list2vector(for each el in '"; +prin1 vector_list;prin2" collect list2vector el))$";terpri();terpri(); +vector_list:=vector2list get(bracketname, 'info_list); +prin2"put('";prin1 bracketname;prin2",'INFO_LIST,list2vector '"; +prin1 vector_list;prin2")$";terpri();terpri() + +%line 3394 "liesuper.web" + +%:146% +%line 83 "list2vector.ch" +; +write"flag('(",bracketname,"),'full)$";terpri();terpri(); +for each property in 'klist . + '(bracketname rtype simpfn kvalue)do + + <<prin2"put('";prin1 generatorname;prin2",'";prin1 property;prin2",'"; +prin1 get(generatorname,property);prin2")$";terpri();terpri()>> ; +%149:% +%line 3434 "liesuper.web" + +%line 3435 "liesuper.web" +write"repair_vector_structure_of '",bracketname,"$";terpri();terpri() + +%:149% +%line 87 "list2vector.ch" +; +write"algebraic$ end$"; +shut savefile; +end$ + +%:145%%148:% +%line 3420 "liesuper.web" + +%line 3421 "liesuper.web" +lisp procedure repair_vector_structure_of bracketname; +begin scalar +vector_structure,m,m_used,n,n_used +,!*jacobi_var!*,vector_i,entry_i_j; +%49:% +%line 1355 "liesuper.web" + +vector_structure:=get(bracketname, 'vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used) + +%:49% +%line 3423 "liesuper.web" +; +!*jacobi_var!*:=get(bracketname, '!*jacobi_var!*); +for i:=-n_used:m_used do +begin vector_i:=getv(vector_structure,n+i); +for j:=i:m_used do +if(entry_i_j:=getv(vector_i,m-j))and car(entry_i_j)= '(t) +then +putv(vector_i,m-j,!*jacobi_var!* . cdr entry_i_j); +end; +end$ + +%:148%%150:% +%line 3448 "liesuper.web" + +%line 3449 "liesuper.web" +lisp operator print_liebracket; +lisp procedure print_liebracket bracketname; +begin scalar +vector_structure,m,m_used,n,n_used +,vector_i,commutator_i_j; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("PRINT_LIEBRACKET:",bracketname,"is not a liebracket",nil,t); +%49:% +%line 1355 "liesuper.web" + +vector_structure:=get(bracketname, 'vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +m_used:=get(bracketname, 'even_used);n_used:=get(bracketname, 'odd_used) + +%:49% +%line 3453 "liesuper.web" +; +for i:=-n_used:m_used do +begin vector_i:=getv(vector_structure,n+i); +for j:=i:m_used do +if(i neq 0)and(j neq 0)and(i neq j or i<0)and +(commutator_i_j:=getv(vector_i,m-j))and +(commutator_i_j:=aeval cddr commutator_i_j)then +varpri(commutator_i_j, +list( 'setk,mkquote list(bracketname,i,j),mkquote commutator_i_j), + 'only); +end; +end$ + +%:150%%151:% +%line 3485 "liesuper.web" + +%line 3486 "liesuper.web" +lisp operator change_dimensions_of; +lisp procedure change_dimensions_of(bracketname,m,n); +begin scalar old_vector_structure,old_m,old_n,new_m,new_n,old_vector_i,entry_i_j, +vector_structure,old_info_list,info_list,vector_i,m_used,n_used, +degree_length,kernel_list; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("CHANGE_DIMENSIONS_OF:",bracketname,"is not a liebracket",nil,t); +old_m:=get(bracketname, 'even_dimension); +old_n:=get(bracketname, 'odd_dimension); +new_m:=min(m,old_m);new_n:=min(n,old_n); +m_used:=min(new_m,get(bracketname, 'even_used)); +n_used:=min(new_m,get(bracketname, 'odd_used)); +old_vector_structure:=get(bracketname, 'vector_structure); +old_info_list:=get(bracketname, 'info_list); +%144:% +%line 3338 "liesuper.web" + +%line 3339 "liesuper.web" +%143:% +%line 3327 "liesuper.web" + +%line 3328 "liesuper.web" +vector_structure:=mkvect(m+n); +for i:=-n:m do putv(vector_structure,n+i,mkvect(m-i)); +for i:=-n:0 do putv(getv(vector_structure,n+i),m, '(s +) . nil . 0); +for j:=1:m do + <<putv(getv(vector_structure,n),m-j, '(s +) . nil . 0); +putv(getv(vector_structure,n+j),m-j, '(s +) . nil . 0)>> + +%:143% +%line 3339 "liesuper.web" +; +info_list:=mkvect(m+n); +for i:=-n:m do putv(info_list,n+i, '(0) . i . i) + +%:144% +%line 3499 "liesuper.web" +; +%152:% +%line 3514 "liesuper.web" + +%line 3515 "liesuper.web" +for i:=-new_n:new_m do +begin +old_vector_i:=getv(old_vector_structure,old_n+i); +vector_i:=getv(vector_structure,n+i); +for j:=i:new_m do +if(entry_i_j:=getv(old_vector_i,old_m-j))then +putv(vector_i,m-j,entry_i_j); +putv(info_list,n+i,getv(old_info_list,old_n+i)); +end + +%:152% +%line 3500 "liesuper.web" +; +put(bracketname, 'vector_structure,vector_structure); +put(bracketname, 'info_list,info_list); +put(bracketname, 'even_dimension,m); +put(bracketname, 'odd_dimension,n); +put(bracketname, 'even_used,m_used); +put(bracketname, 'odd_used,n_used); +%153:% +%line 3539 "liesuper.web" + +%line 3540 "liesuper.web" +if m>old_m or n>old_n then +begin +degree_length:=get(bracketname, 'degree_length); +change_degree_length(bracketname,2*degree_length); +change_degree_length(bracketname,degree_length); +kernel_list:= +for each dependency in get(get(bracketname, 'generatorname), 'kvalue)collect +car dependency; +for each kernel in kernel_list do setk(kernel,aeval kernel); +end + +%:153% +%line 3507 "liesuper.web" +; +end$ + +%:151%%156:% +%line 3587 "liesuper.web" + +%line 3588 "liesuper.web" +lisp procedure liebracket_stat; +begin scalar arguments; +arguments:=xread nil; +arguments:= +if atom arguments or car arguments neq '!*comma!* then +arguments +else cdr arguments; +scan(); +return default_liebracket!* . arguments; +end$ + +%:156%%157:% +%line 3609 "liesuper.web" + +%line 3610 "liesuper.web" +lisp procedure liebracket_prifn commutator; +begin +prin2!*"["; +inprint( '!*comma!*,0,cdr commutator); +prin2!*"]"; +end$ + +%:157%%159:% +%line 3627 "liesuper.web" +lisp operator default_liebracket; +%line 3628 "liesuper.web" + +lisp procedure default_liebracket bracketname; +begin +remprop(default_liebracket!*, 'prifn); +default_liebracket!*:=bracketname; +put(default_liebracket!*, 'prifn, 'liebracket_prifn); +end$ + +%:159%%163:% +%line 3737 "liesuper.web" + +%line 3738 "liesuper.web" +lisp operator transform_liebracket; +lisp procedure transform_liebracket(bracketname,new_bracketname, +new_generatorname,basis_transformation); +begin scalar generatorname,even_bound,odd_bound,transform_vector,inverse_vector, +new_generator,transformed_sq,splitted_sf,generator_list,x_gap,y_gap, +new_even_used,new_odd_used,result; + +if get(bracketname, 'rtype)neq 'liebracket then + +msgpri("TRANSFORM_LIEBRACKET:",bracketname,"is not a liebracket",nil,t); +generatorname:=get(bracketname, 'generatorname); +%162:% +%line 3719 "liesuper.web" + +%line 3720 "liesuper.web" +if null !*full_transformation then +begin even_bound:=get(bracketname, 'even_used); +odd_bound:=get(bracketname, 'odd_used); +end +else +begin even_bound:=get(bracketname, 'even_dimension); +odd_bound:=get(bracketname, 'odd_dimension); +end; +transform_vector:=mkvect(even_bound+odd_bound); +inverse_vector:=mkvect(even_bound+odd_bound) + + +%:162% +%line 3746 "liesuper.web" +; +%164:% +%line 3759 "liesuper.web" + +%line 3760 "liesuper.web" +%166:% +%line 3841 "liesuper.web" + +if atom basis_transformation or car basis_transformation neq 'list +then +msgpri("TRANSFORM_LIEBRACKET",basis_transformation, +"not valid as a basis transformation",nil,t); +basis_transformation:= +for each transformation_rule in cdr basis_transformation collect + <<if not +(eqexpr transformation_rule and +not atom cadr transformation_rule and +car cadr transformation_rule=new_generatorname)or not + <<new_generator:=cadr cadr(transformation_rule); + +(fixp new_generator and new_generator neq 0 and new_generator<=even_bound and +new_generator>=-odd_bound)>> +then +msgpri("TRANSFORM_LIEBRACKET:",cadr(transformation_rule), +"not allowed as a new generator",nil,t); +transformed_sq:=simp caddr(transformation_rule); +splitted_sf:=split_form(numr transformed_sq,list(generatorname)); +if not +null car splitted_sf and +for each generator in cdr splitted_sf product +if(generator:=cadr car generator)*new_generator>0 and + +(fixp generator and generator neq 0 and generator<=even_bound and +generator>=-odd_bound)then 1 else 0=1 then + +msgpri("TRANSFORM_LIEBRACKET",cadr(transformation_rule), +"must be a sum of generators with right sign",nil,t); + +for each generator in cdr splitted_sf do +if not member(generator:=car generator,generator_list)then +generator_list:=generator . generator_list +; +putv(transform_vector,odd_bound+new_generator,transformed_sq . splitted_sf); + +numr subtrsq(!*k2q cadr(transformation_rule),transformed_sq)>> + +%:166% +%line 3760 "liesuper.web" +; +%167:% +%line 3871 "liesuper.web" + +%line 3872 "liesuper.web" +if length generator_list neq length basis_transformation then +rederr"TRANSFORM_LIEBRACKET: inconsistent transformation"; +if basis_transformation then +basis_transformation:=caadr solvesys(basis_transformation,generator_list); +for each generator in generator_list do + <<transformed_sq:=car basis_transformation; +putv(inverse_vector,odd_bound+cadr generator, +transformed_sq . split_form(numr transformed_sq,list(new_generatorname))); +basis_transformation:=cdr basis_transformation>> + +%:167% +%line 3761 "liesuper.web" +; +%168:% +%line 3927 "liesuper.web" + + << +x_gap:=y_gap:=0; +repeat x_gap:=x_gap+direction +until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap) +and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue))); +if abs(x_gap)>bound then x_gap:=nil; +repeat y_gap:=y_gap+direction +until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap); +while x_gap do << +putv(inverse_vector,odd_bound+x_gap,mksq(list(new_generatorname,y_gap),1) . +list(nil,list(new_generatorname,y_gap) . 1)); +putv(transform_vector,odd_bound+y_gap,mksq(list(generatorname,x_gap),1) . +list(nil,list(generatorname,x_gap) . 1)); +repeat x_gap:=x_gap+direction +until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap) +and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue))); +if abs(x_gap)>bound then x_gap:=nil; +repeat y_gap:=y_gap+direction +until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap)>> ;new_even_used:=y_gap-1>> where direction=1,bound=even_bound; + << +x_gap:=y_gap:=0; +repeat x_gap:=x_gap+direction +until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap) +and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue))); +if abs(x_gap)>bound then x_gap:=nil; +repeat y_gap:=y_gap+direction +until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap); +while x_gap do << +putv(inverse_vector,odd_bound+x_gap,mksq(list(new_generatorname,y_gap),1) . +list(nil,list(new_generatorname,y_gap) . 1)); +putv(transform_vector,odd_bound+y_gap,mksq(list(generatorname,x_gap),1) . +list(nil,list(generatorname,x_gap) . 1)); +repeat x_gap:=x_gap+direction +until abs(x_gap)>bound or(null getv(inverse_vector,odd_bound+x_gap) +and null assoc(list(generatorname,x_gap),get(generatorname, 'kvalue))); +if abs(x_gap)>bound then x_gap:=nil; +repeat y_gap:=y_gap+direction +until abs(y_gap)>bound or null getv(transform_vector,odd_bound+y_gap)>> ;new_odd_used:=-y_gap-1>> where direction=-1,bound=odd_bound + +%:168% +%line 3762 "liesuper.web" + + +%:164% +%line 3747 "liesuper.web" +; +%169:% +%line 3947 "liesuper.web" + +%line 3948 "liesuper.web" +%170:% +%line 3963 "liesuper.web" + +%line 3964 "liesuper.web" +put(bracketname, 'save_vector_structure,get(bracketname, 'vector_structure)) + +%:170% +%line 3948 "liesuper.web" +; +result:=errorset(list( 'transform_table,mkquote bracketname,mkquote generatorname, +mkquote new_bracketname,mkquote new_generatorname, +mkquote even_bound,mkquote odd_bound, +mkquote new_even_used,mkquote new_odd_used, +mkquote transform_vector,mkquote inverse_vector),t,t); +%178:% +%line 4167 "liesuper.web" + +%line 4168 "liesuper.web" +put(bracketname, 'vector_structure,get(bracketname, 'save_vector_structure)); +remprop(bracketname, 'save_vector_structure); +put(generatorname, 'simpfn, 'simpiden); +remprop(generatorname, 'inverse_vector); +remflag(list generatorname, 'full); +remprop(generatorname, 'bounds) + +%:178% +%line 3954 "liesuper.web" +; +if result then return +list( 'list, +( 'list . for i:=1:new_even_used collect mk!*sq car getv(transform_vector,odd_bound+i)), +( 'list . for i:=1:new_odd_used collect mk!*sq car getv(transform_vector,odd_bound+-i))) + +%:169% +%line 3748 "liesuper.web" +; +end$ + +%:163%%171:% +%line 3982 "liesuper.web" + +%line 3983 "liesuper.web" +lisp procedure transform_table(bracketname,generatorname, +new_bracketname,new_generatorname,even_bound,odd_bound, +new_even_used,new_odd_used, +transform_vector,inverse_vector); +begin scalar m,n,vector_structure,vector_i, +save_vector_structure,save_vector_i,save_entry_i_j,arg_i,arg_j,degree_length; +remprop(new_generatorname, 'simpfn); +apply1( 'liebracket,list list(new_bracketname,new_generatorname, +even_bound,odd_bound, +get(bracketname, 'algebra_elements),get(bracketname, 'parameters))); +%175:% +%line 4086 "liesuper.web" + +%line 4087 "liesuper.web" +%173:% +%line 4039 "liesuper.web" + +%line 4040 "liesuper.web" +put(generatorname, 'inverse_vector,inverse_vector); +put(generatorname, 'bounds,odd_bound . even_bound); +put(generatorname, 'simpfn, 'simp_transform_vector); +flag(list generatorname, 'full); +rmsubs() + +%:173% +%line 4087 "liesuper.web" +; +save_vector_structure:=get(bracketname, 'save_vector_structure); +m:=get(bracketname, 'even_dimension);n:=get(bracketname, 'odd_dimension); +%143:% +%line 3327 "liesuper.web" + +%line 3328 "liesuper.web" +vector_structure:=mkvect(m+n); +for i:=-n:m do putv(vector_structure,n+i,mkvect(m-i)); +for i:=-n:0 do putv(getv(vector_structure,n+i),m, '(s +) . nil . 0); +for j:=1:m do + <<putv(getv(vector_structure,n),m-j, '(s +) . nil . 0); +putv(getv(vector_structure,n+j),m-j, '(s +) . nil . 0)>> + +%:143% +%line 4090 "liesuper.web" +; +for i:=-odd_bound:even_bound do begin +save_vector_i:=getv(save_vector_structure,n+i); +vector_i:=getv(vector_structure,n+i); +arg_i:=getv(inverse_vector,odd_bound+i); +for j:=i:even_bound do +if(save_entry_i_j:=getv(save_vector_i,m-j))and +cddr(save_entry_i_j)then +(if car save_entry_i_j neq '(s +)then +putv(vector_i,m-j,nil . nil . aeval cddr save_entry_i_j)) +else putv(vector_i,m-j, +nil . nil . mk!*sq transform_commutator(new_bracketname,arg_i,getv(inverse_vector,odd_bound+j))) +end; +put(bracketname, 'vector_structure,vector_structure); +rmsubs() + +%:175% +%line 3993 "liesuper.web" +; +%176:% +%line 4135 "liesuper.web" + +for i:=-new_odd_used:new_even_used do +if(arg_i:=getv(transform_vector,odd_bound+i))then +for j:=i:new_even_used do +if(arg_j:=getv(transform_vector,odd_bound+j))and +i neq 0 and j neq 0 and(i neq j or i<0)then +relation_analysis(mk!*sq subtrsq(simp!* list(new_bracketname,i,j), +subs2 transform_commutator(bracketname,arg_i,arg_j)), +new_bracketname); +put(new_bracketname, 'even_used,new_even_used); +put(new_bracketname, 'odd_used,new_odd_used) + +%:176% +%line 3994 "liesuper.web" +; +%177:% +%line 4158 "liesuper.web" + +%line 4159 "liesuper.web" +degree_length:=if get(bracketname, 'degree_sequence)then +length get(bracketname, 'degree_sequence) +else get(bracketname, 'degree_length); +change_degree_length(new_bracketname,degree_length); +for i:=-new_odd_used:new_even_used do +if i neq 0 then +define_degree(list(new_generatorname,i),degree_of(mk!*sq car getv(transform_vector,odd_bound+i))) + +%:177% +%line 3995 "liesuper.web" +; +end$ + +%:171%%172:% +%line 4019 "liesuper.web" + +%line 4020 "liesuper.web" + +lisp procedure simp_transform_vector generator; +begin scalar generatorname,i,bounds,inverse_vector,value; +generatorname:=car generator; +i:=cadr generator; +bounds:=get(generatorname, 'bounds); +inverse_vector:=get(generatorname, 'inverse_vector); +if i<-car bounds or i>cdr bounds then + +msgpri("TRANSFORM_LIEBRACKET:",generator, +"out of the transformation range. Use 'on fulltransformation;'.",nil,t); +return +if value:=getv(inverse_vector,car bounds+i)then car value +else simpiden generator +end$ + +%:172%%174:% +%line 4063 "liesuper.web" + +%line 4064 "liesuper.web" +lisp procedure transform_commutator(bracketname,transformed_i,transformed_j); +quotsq(build_sum(bracketname,list(cdr transformed_j,cdr transformed_i)), +!*f2q multf(denr car transformed_i,denr car transformed_j))$ + +%:174%%180:% +%line 4198 "liesuper.web" + +%line 4199 "liesuper.web" +symbolic procedure fkern u; +begin scalar x,y; +if atom u then return list(u,nil); +if get(car u, 'rtype)= 'liebracket and +fixp cadr u and fixp caddr u then +return fkern_liebracket u; +y:=if atom car u then get(car u, 'klist)else exlist!*; +if not(x:=assoc(u,y)) +then <<x:=list(u,nil); +y:=ordad(x,y); +if atom car u +then <<kprops!*:=union(list car u,kprops!*); +put(car u, 'klist,y)>> +else exlist!*:=y>> ; +return x +end$ + +%:180%%181:% +%line 4234 "liesuper.web" +symbolic procedure fkern_liebracket commutator; +%line 4235 "liesuper.web" +begin scalar bracketname,i,j,entry_i_j; +bracketname:=car commutator; +i:=cadr commutator; +j:=caddr commutator; +entry_i_j:= +getv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+i), +get(bracketname, 'even_dimension)-j); +if null entry_i_j then entry_i_j:= + +putv(getv(get(bracketname, 'vector_structure), +get(bracketname, 'odd_dimension)+i), +get(bracketname, 'even_dimension)-j,nil . list(commutator,nil) . nil) +else if null cadr entry_i_j then +rplaca(cdr entry_i_j,list(commutator,nil)); +return cadr entry_i_j; +end$ + +%:181%%182:% +%line 4259 "liesuper.web" + +%line 4260 "liesuper.web" +symbolic procedure prepsq!* u; +begin scalar x,!*combinelogs; +if null numr u then return 0; +x:=setkorder +append((for each j in factors!* +join if not idp j then nil +else if get(j, 'rtype)= 'liebracket then +ordn get_all_kernels(numr u,j) +else for each k in get(j, 'klist)collect car k), +append(factors!*,ordl!*)); +if kord!* neq x or wtl!* +then u:=formop numr u . formop denr u; +u:=if !*rat or !*div +or upl!* or dnl!* +then replus prepsq!*1(numr u,denr u,nil) +else sqform(u,function prepsq!*2); +setkorder x; +return u +end$ + +%:182%%183:% +%line 4281 "liesuper.web" +end; +%line 4282 "liesuper.web" + +%:183% diff --git a/web/reduce/rweb/appl/source/supervf.red b/web/reduce/rweb/appl/source/supervf.red new file mode 100644 index 0000000000..621117e5ef --- /dev/null +++ b/web/reduce/rweb/appl/source/supervf.red @@ -0,0 +1,330 @@ +%5:% +%line 70 "supervf.web" + +symbolic$ +write"Super vectorfield package for REDUCE 3.4, $Revision: 0.94 $"$terpri()$ +%7:% +%line 120 "supervf.web" + +%line 121 "supervf.web" +algebraic operator ext$ + +%:7% +%line 73 "supervf.web" + +algebraic$ + +%:5%%8:% +%line 144 "supervf.web" +lisp operator super_vectorfield; +lisp procedure super_vectorfield(operator_name,even_dimension, +odd_dimension,variables); +begin +if not idp operator_name then + +msgpri("SUPER_VECTORFIELD:",operator_name,"is not an identifier",nil,t); +if not fixp even_dimension or even_dimension<0 or +not fixp odd_dimension or odd_dimension<0 then +rederr("SUPER_VECTORFIELD: improper dimensions"); +put(operator_name, 'simpfn, 'super_der_simp); +flag(list(operator_name), 'full); +put(operator_name, 'even_dimension,even_dimension); +put(operator_name, 'odd_dimension,odd_dimension); +put(operator_name, 'variables,if null variables then variables else if atom +variables then list variables else if +car variables= 'list then cdr variables else variables); +end$ + +%:8%%9:% +%line 212 "supervf.web" +lisp procedure merge_lists(x1,x2); +begin scalar cx1,cx2,lx2,clx2,oddskip,sign; +%10:% +%line 219 "supervf.web" + +%line 220 "supervf.web" +sign:=1; +x1:=reverse x1; +if x1 then cx1:=car x1 else goto b; +a:if x2 then cx2:=car x2 else goto b; +if cx1<cx2 then goto b; +lx2:=cx2 . lx2; +oddskip:=not oddskip; +x2:=cdr x2; +goto a + +%:10% +%line 214 "supervf.web" +; +b:%11:% +%line 231 "supervf.web" + +%line 232 "supervf.web" +if null x1 then return sign . nconc(reversip lx2,x2); +if null lx2 then return sign . nconc(reversip x1,x2); +clx2:=car lx2; +if cx1=clx2 and cx1>0 then return nil; +if cx1>clx2 then goto b1; +%12:% +%line 241 "supervf.web" + +%line 242 "supervf.web" +x2:=clx2 . x2; +lx2:=cdr lx2; +oddskip:=not oddskip; +goto b + +%:12% +%line 237 "supervf.web" +; +b1:%13:% +%line 248 "supervf.web" + +%line 249 "supervf.web" +x2:=cx1 . x2; +x1:=cdr x1; +if oddskip and cx1>0 then sign:=-sign; +cx1:=car x1; +goto b + +%:13% +%line 238 "supervf.web" + + +%:11% +%line 215 "supervf.web" +; +end$ + +%:9%%14:% +%line 262 "supervf.web" + +lisp procedure ext_mult(x1,x2); +(if null x then nil ./ 1 +else if null cdr x then 1 ./ 1 +else(((!*a2k( 'ext . cdr x) .^ 1) .* car x) .+ nil) ./ 1) +where x=merge_lists(cdr x1,cdr x2)$ + +%:14%%15:% +%line 283 "supervf.web" + +lisp procedure super_der_simp u; +if length u=2 then%16:% +%line 296 "supervf.web" + +%line 297 "supervf.web" + begin scalar derivation_name,variables,even_components,odd_components, +splitted_numr,splitted_denr; +derivation_name:=reval car u; +variables:=get(derivation_name, 'variables); +u:=simp!* cadr u; +%18:% +%line 345 "supervf.web" + +splitted_numr:=split_form(numr u, '(ext)); +splitted_numr:= +(list( 'ext) . car splitted_numr) . cdr splitted_numr; +splitted_denr:=split_form(denr u, '(ext)); +splitted_denr:= +(list( 'ext) . car splitted_denr) . cdr splitted_denr; +even_components:=for i:=1:get(derivation_name, 'even_dimension)collect +(nth(variables,i) . split_ext(component, '(ext))) +where component=simp!* list(derivation_name,0,i); +odd_components:=for i:=1:get(derivation_name, 'odd_dimension)collect +(i . split_ext(component, '(ext))) +where component=simp!* list(derivation_name,1,i) + +%:18% +%line 303 "supervf.web" +; +return subtrsq( +quotsq(addsq(even_action(even_components,splitted_numr), +odd_action(odd_components,splitted_numr)),denr u ./ 1), +quotsq(multsq(numr u ./ 1,even_action(even_components,splitted_denr)), +multf(denr u,denr u) ./ 1)); +end + +%:16% +%line 285 "supervf.web" + +else simpiden u$ + +%:15%%17:% +%line 329 "supervf.web" + +lisp procedure split_ext(sq,op_list); +begin scalar denr_sq,splitted_form; +denr_sq:=denr sq; +splitted_form:=split_form(numr sq,op_list); +return(list( 'ext) . cancel(car splitted_form ./ denr_sq)) . +for each kc_pair in cdr splitted_form collect +(car kc_pair . cancel(cdr kc_pair ./ denr_sq)) +end$ + +%:17%%19:% +%line 363 "supervf.web" + +%line 364 "supervf.web" +lisp procedure even_action(components,splitted_form); +begin scalar action; +action:=nil ./ 1; +for each kc_pair in splitted_form do +action:=addsq(action, +even_action_sf(components,cdr kc_pair,car kc_pair,1)); +return action; +end$ + +%:19%%20:% +%line 377 "supervf.web" + +%line 378 "supervf.web" +lisp procedure even_action_sf(components,sf,ext_kernel,fac); +begin scalar action; +action:=nil ./ 1; +while not domainp sf do + <<action:=addsq(action,even_action_term(components,lt sf,ext_kernel,fac)); +sf:=red sf>> ; +return action; +end$ + +%:20%%21:% +%line 399 "supervf.web" + +lisp procedure even_action_term(components,term,ext_kernel,fac); +addsq(even_action_pow(components,car term, +ext_kernel,!*f2q multf(fac,cdr term)), +even_action_sf(components,cdr term, +ext_kernel,multf(fac,!*p2f car term)))$ + +%:21%%22:% +%line 410 "supervf.web" + +lisp procedure even_action_pow(components,pow,ext_kernel,fac); +begin scalar kernel,n,component,derivative,action,active_components; +kernel:=car pow;n:=cdr pow; +%23:% +%line 422 "supervf.web" + +%line 423 "supervf.web" +if(component:=assoc(kernel,components))then +return + <<derivative:=if n=1 then 1 ./ 1 else((((kernel .^ n-1) .* n) .+ nil) ./ 1); +action:=component_action(component,ext_kernel,derivative); +multsq(action,fac)>> + +%:23% +%line 414 "supervf.web" +; +%27:% +%line 490 "supervf.web" + +%line 491 "supervf.web" +active_components:=find_active_components(kernel,components,nil) + +%:27% +%line 415 "supervf.web" +; +%28:% +%line 498 "supervf.web" + +%line 499 "supervf.web" +action:=nil ./ 1; +for each component in active_components do + <<derivative:=diffp(pow,car component); +action:=addsq(action,component_action(component,ext_kernel,derivative))>> ; +return multsq(action,fac) + +%:28% +%line 416 "supervf.web" +; +end$ + +%:22%%24:% +%line 442 "supervf.web" + +lisp procedure component_action(component,ext_kernel,coefficient); +begin scalar action; +action:=nil ./ 1; +for each kc_pair in cdr component do +(if numr ext_product then +action:=addsq(action, +multsq(multsq(ext_product,even_coefficient),coefficient))) +where ext_product=ext_mult(car kc_pair,ext_kernel), +even_coefficient=cdr kc_pair; +return action; +end$ + +%:24%%25:% +%line 464 "supervf.web" + +lisp procedure find_active_components(kernel,components,components_found); +begin +components_found:= +update_components(kernel . +((if depl_entry then cdr depl_entry)where depl_entry=assoc(kernel,depl!*)), +components,components_found)$ +if not atom kernel then +for each element in kernel do +components_found:=find_active_components(element,components,components_found); +return components_found; +end$ + +%:25%%26:% +%line 479 "supervf.web" + +lisp procedure update_components(dependencies,components,components_found); +begin scalar component; +for each kernel in dependencies do +if(component:=assoc(kernel,components)) +and not assoc(kernel,components_found)then +components_found:=component . components_found; +return components_found; +end$ + +%:26%%29:% +%line 519 "supervf.web" + +%line 520 "supervf.web" +lisp procedure odd_action(components,splitted_form); +begin scalar action,sign,derivative,kernel,coefficient,component; +action:=nil ./ 1; +for each kc_pair in splitted_form do + <<kernel:=car kc_pair; +coefficient:=!*f2q cdr kc_pair; +sign:=t; +for each i in cdr kernel do + <<sign:=not sign; +derivative:=!*a2k delete(i,kernel); +component:=assoc(i,components); +action:=addsq(action, +component_action(component,derivative, +if sign then negsq coefficient else coefficient)) +>> +>> ; +return action; +end$ + +%:29%%30:% +%line 544 "supervf.web" + +%line 545 "supervf.web" +lisp operator super_product; +lisp procedure super_product(x,y); +begin scalar splitted_x,splitted_y,product; +splitted_x:=split_ext(simp x, '(ext)); +splitted_y:=split_ext(simp y, '(ext)); +product:=nil ./ 1; +for each term_x in splitted_x do +for each term_y in splitted_y do +product:=addsq(product, +multsq(multsq(cdr term_x,cdr term_y), +ext_mult(car term_x,car term_y))); +return mk!*sq subs2 product; +end$ + +%:30%%31:% +%line 561 "supervf.web" +end; +%line 562 "supervf.web" + +%:31% diff --git a/web/reduce/rweb/appl/source/tools.red b/web/reduce/rweb/appl/source/tools.red new file mode 100644 index 0000000000..0dfa537ee9 --- /dev/null +++ b/web/reduce/rweb/appl/source/tools.red @@ -0,0 +1,446 @@ +%2:% +%line 64 "tools.web" +symbolic$ +write"Algebraic operator tools for REDUCE 3.4, $Revision: 1.4 $"$terpri()$ +algebraic$ + +%:2%%7:% +%line 129 "tools.web" +lisp procedure get_first_kernel(form,oplist); +gfk(form,if null oplist then oplist else if atom +oplist then list oplist else if +car oplist= 'list then cdr oplist else oplist,nil)$ + +lisp procedure gfk(form,oplist,l); +if l or domainp form then l +else gfk(red form,oplist, +gfk(lc form,oplist, +if not atom x and member(car x,oplist) +then x else l)) +where x=mvar form$ + +%:7%%8:% +%line 146 "tools.web" + +%line 147 "tools.web" +lisp procedure get_all_kernels(form,oplist); +gak(form,if null oplist then oplist else if atom +oplist then list oplist else if +car oplist= 'list then cdr oplist else oplist,nil)$ + +lisp procedure gak(form,oplist,l); +if domainp form +then l +else gak(red form,oplist, +gak(lc form,oplist, +if not atom x and member(car x,oplist)and not member(x,l) +then l:=aconc(l,x)else l)) +where x=mvar form$ + +%:8%%9:% +%line 163 "tools.web" + +%line 164 "tools.web" +lisp procedure get_recursive_kernels(form,oplist); +grk(form,if null oplist then oplist else if atom +oplist then list oplist else if +car oplist= 'list then cdr oplist else oplist,nil)$ + +lisp procedure grk(form,oplist,l); +if domainp form +then l else grk(red form,oplist, +grk(lc form,oplist, +%10:% +%line 177 "tools.web" + +%line 178 "tools.web" +if not atom x +then begin scalar y; +for each arg in cdr x do +if(y:=simp arg)neq 0 then +l:=grk(numr y,oplist,l); +return if member(car x,oplist)and not member(x,l) +then x . l else l end +else l + +%:10% +%line 171 "tools.web" +)) +where x=mvar form$ + +%:9%%14:% +%line 280 "tools.web" + +%line 281 "tools.web" +lisp procedure split_f(form,oplist,fact,kc_list); +if null form then kc_list +else if domainp form then +addf(multf(fact,form), +car kc_list) . cdr kc_list +else if not atom mvar form and member(car mvar form,oplist)then +if not ldeg form=1 or get_first_kernel(lc form,oplist)then + +msgpri("SPLIT_F: expression not linear w.r.t.", + 'list . oplist,nil,nil,t) +else split_f(red form,oplist,fact, +update_kc_list(kc_list,mvar form,multf(fact,lc form))) +else split_f(red form,oplist,fact, +split_f(lc form,oplist, +multf(fact,!*p2f lpow form),kc_list))$ + +%:14%%15:% +%line 300 "tools.web" + +%line 301 "tools.web" +lisp procedure split_form(form,oplist); +split_f(form,oplist,1,nil . nil)$ + +%:15%%16:% +%line 309 "tools.web" +lisp procedure list_assoc(car_exprn,a_list); +%line 310 "tools.web" +if null a_list then a_list else if caar a_list=car_exprn then a_list +else list_assoc(car_exprn,cdr a_list)$ + +%:16%%17:% +%line 322 "tools.web" +lisp procedure update_kc_list(kc_list,kernel,coefficient); +%line 323 "tools.web" +(if rest_list then <<rplaca(rest_list,caar rest_list . addf(cdar +rest_list,coefficient));kc_list>> else +car kc_list . (kernel . coefficient) . cdr kc_list) +where rest_list=list_assoc(kernel,cdr kc_list)$ + +%:17%%18:% +%line 347 "tools.web" + +%line 348 "tools.web" +put( 'operator_coeff, 'psopfn, 'operator_coeff_1)$ + +lisp procedure operator_coeff_1 u; +if length u neq 2 then rederr("OPERATOR_COEFF: wrong number of arguments") +else operator_coeff(car u,reval cadr u)$ + +%:18%%19:% +%line 370 "tools.web" + +%line 371 "tools.web" +lisp procedure operator_coeff(exprn,oplist); +begin scalar numr_ex,denr_ex,kc_list; +oplist:=if null oplist then oplist else if atom +oplist then list oplist else if +car oplist= 'list then cdr oplist else oplist; +exprn:=simp!* exprn;numr_ex:=numr exprn;denr_ex:=denr exprn; +kc_list:=split_form(numr_ex,oplist); +return 'list . !*ff2a(car kc_list,denr_ex) . +for each kc_pair in cdr kc_list collect +list( 'list,car kc_pair,!*ff2a(cdr kc_pair,denr_ex)); +end$ + +%:19%%20:% +%line 402 "tools.web" + +%line 403 "tools.web" +lisp procedure dump_operators(form,oplist,fact); +if null form then nil +else if domainp form then multf(fact,form) +else if not atom mvar form and member(car mvar form,oplist)then +dump_operators(red form,oplist,fact) +else +addf(dump_operators(red form,oplist,fact), +dump_operators(lc form,oplist,multf(fact,!*p2f lpow form)))$ + +%:20%%21:% +%line 413 "tools.web" + +%line 414 "tools.web" +put( 'independent_part, 'psopfn, 'independent_part_1)$ + +lisp procedure independent_part_1 u; +if length u neq 2 then rederr("INDEPENDENT_PART: wrong number of arguments") +else independent_part(car u,reval cadr u)$ + +lisp procedure independent_part(exprn,oplist); +begin scalar numr_ex,denr_ex; +oplist:=if null oplist then oplist else if atom +oplist then list oplist else if +car oplist= 'list then cdr oplist else oplist; +exprn:=simp!* exprn;numr_ex:=numr exprn;denr_ex:=denr exprn; +return !*ff2a(dump_operators(numr_ex,oplist,1),denr_ex); +end$ + +%:21%%22:% +%line 464 "tools.web" + +lisp procedure multi_split_f(form,kernel_list,multi_power,fact,pc_list); +if null form then pc_list +else if domainp form then +if multi_power then update_kc_list(pc_list,multi_power,multf(fact,form)) +else addf(multf(fact,form),car pc_list) . cdr pc_list +else multi_split_f(red form,kernel_list,multi_power,fact, +if member(mvar form,kernel_list)then +multi_split_f(lc form,kernel_list,lpow form . multi_power,fact,pc_list) +else multi_split_f(lc form,kernel_list,multi_power, +multf(fact,!*p2f lpow form),pc_list))$ + + +%:22%%23:% +%line 481 "tools.web" + +lisp procedure multi_split_form(form,kernel_list); +multi_split_f(form,kernel_list,nil,1,nil . nil)$ + +%:23%%24:% +%line 496 "tools.web" + +%line 497 "tools.web" +put( 'multi_coeff, 'psopfn, 'multi_coeff_1)$ + +lisp procedure multi_coeff_1 u; +if length u neq 2 then rederr("MULTI_COEFF: wrong number of arguments") +else multi_coeff(car u,reval cadr u)$ + +%:24%%25:% +%line 509 "tools.web" +lisp procedure multi_coeff(exprn,kernel_list); +%line 510 "tools.web" +begin scalar numr_ex,denr_ex,pc_list; +kernel_list:=if null kernel_list then kernel_list else if atom +kernel_list then list kernel_list else if +car kernel_list= 'list then cdr kernel_list else kernel_list; +exprn:=simp!* exprn; +numr_ex:=numr exprn;denr_ex:=denr exprn; +for each generator in kernel_list do if depends(denr_ex,generator) +then +msgpri("MULTI_COEFF: expression is not polynomial w.r.t. ", + 'list . kernel_list,nil,nil,t); +pc_list:=multi_split_form(numr_ex,kernel_list); +return 'list . !*ff2a(car pc_list,denr_ex) . +for each pc_pair in cdr pc_list collect +list( 'list,convert_multi_power car pc_pair,!*ff2a(cdr pc_pair,denr_ex)); +end$ + +%:25%%26:% +%line 529 "tools.web" + +%line 530 "tools.web" +lisp procedure convert_multi_power multi_power; + 'times . for each power in multi_power collect +if cdr power=1 then car power else list( 'expt,car power,cdr power)$ + +%:26%%28:% +%line 588 "tools.web" + +%line 589 "tools.web" +lisp procedure split_arguments(arg_list,oplist,splitted_list); +if null arg_list then splitted_list +else split_arguments(cdr arg_list,oplist, +multf(denr first_arg,car splitted_list) . +split_form(numr first_arg,oplist) . +cdr splitted_list)where first_arg=simp!* car arg_list$ + +%:28%%29:% +%line 604 "tools.web" +lisp procedure split_operator u; +%line 605 "tools.web" +split_arguments(cdr u,get(car u, 'oplist),1 . nil)$ + +%:29%%31:% +%line 669 "tools.web" +lisp procedure process_arg_stack(arg_stack,op_name,arg_list,fact); +%line 670 "tools.web" +if null arg_stack then multsq(!*f2q fact, +apply1(get(op_name, 'resimp_fn),op_name . arg_list)) +else process_comp_list(car arg_stack,cdr arg_stack,op_name,arg_list,fact)$ + +%:31%%32:% +%line 678 "tools.web" + +%line 679 "tools.web" +lisp procedure process_comp_list(comp_list,arg_stack,op_name,arg_list,fact); +addsq(process_independent_part(car comp_list,arg_stack,op_name,arg_list,fact), +process_components(cdr comp_list,arg_stack,op_name,arg_list,fact))$ + +%:32%%33:% +%line 691 "tools.web" +lisp procedure process_independent_part(independent_part,arg_stack, +%line 692 "tools.web" +op_name,arg_list,fact); +if null independent_part then nil . 1 +else +process_arg_stack(arg_stack,op_name,1 . arg_list,multf(fact,independent_part))$ + + +%:33%%34:% +%line 701 "tools.web" +lisp procedure process_components(comp_list,arg_stack,op_name,arg_list,fact); +%line 702 "tools.web" +if null comp_list then nil . 1 +else +addsq(process_components(cdr comp_list,arg_stack,op_name,arg_list,fact), +process_arg_stack(arg_stack,op_name,caar comp_list . arg_list, +multf(fact,cdar comp_list)))$ + +%:34%%35:% +%line 713 "tools.web" +lisp procedure build_sum(op_name,arg_stack); +%line 714 "tools.web" +process_arg_stack(arg_stack,op_name,nil,1)$ + +%:35%%36:% +%line 727 "tools.web" +lisp procedure simp_multilinear u; +%line 728 "tools.web" +quotsq(build_sum(car u,cdr splitted_list),!*f2q car splitted_list) +where splitted_list=split_operator u$ + +%:36%%38:% +%line 750 "tools.web" + +%line 751 "tools.web" +put( 'multilinear, 'stat, 'rlis)$ + +lisp procedure multilinear u; +for each decl in u do +begin scalar op_name,resimp_fn; +if length decl neq 2 and length decl neq 3 then + +msgpri(nil,decl,"invalid multilinear declaration",nil,t); +if not idp(op_name:=car decl)then + +msgpri(nil,op_name,"invalid as operator",nil,t); +put(op_name, 'oplist,if null cadr decl then cadr decl else if atom +cadr decl then list cadr decl else if +car cadr decl= 'list then cdr cadr decl else cadr decl); +if(length decl=3 and(resimp_fn:=caddr decl))or +(resimp_fn:=get(op_name, 'resimp_fn))or +(resimp_fn:=get(op_name, 'simpfn))then put(op_name, 'resimp_fn,resimp_fn) +else put(op_name, 'resimp_fn, 'simpiden); +put(op_name, 'simpfn, 'simp_multilinear); +flag(list(op_name), 'full); +end$ + +%:38%%41:% +%line 795 "tools.web" + +%line 796 "tools.web" +put( 'linear_solve, 'psopfn, 'linear_solve_1)$ + +lisp procedure linear_solve_1 u; +if length u neq 2 then +rederr("LINEAR_SOLVE: wrong number of arguments") +else linear_solve(car u,cadr u)$ + +%:41%%43:% +%line 845 "tools.web" + +%line 846 "tools.web" +lisp procedure linear_solve(exprn,kernel); +begin scalar kord!*,form; +kernel:=!*a2k kernel; +%42:% +%line 814 "tools.web" + +%line 815 "tools.web" +exprn:=fctrf numr simp!* exprn; +exprn:=if domainp car exprn then cdr exprn else(car exprn . 1) . cdr exprn; +form:=for each factor in exprn join +if depends(factor,kernel)then list factor; +if length form=1 then form:=numr car form else + +msgpri("LINEAR_SOLVE: expression not linear with respect to", +kernel,nil,nil,t) + +%:42% +%line 849 "tools.web" +; +setkorder list kernel; +form:=reorder form; +if(mvar form=kernel)and(ldeg form=1)and +not depends(lc form,kernel)and not depends(red form,kernel)then +return !*ff2a(negf red form,lc form) +else +msgpri("LINEAR_SOLVE: expression not linear with respect to", +kernel,nil,nil,t); +end$ + +%:43%%44:% +%line 863 "tools.web" + +%line 864 "tools.web" +put( 'linear_solve_and_assign, 'psopfn, 'linear_solve_and_assign_1)$ + +lisp procedure linear_solve_and_assign_1 u; +if length u neq 2 then +rederr("LINEAR_SOLVE_AND_ASSIGN: wrong number of arguments") +else linear_solve_and_assign(car u,cadr u)$ + +lisp procedure linear_solve_and_assign(exprn,kernel); +setk(kernel,linear_solve(exprn,kernel))$ + +%:44%%47:% +%line 926 "tools.web" + +%line 927 "tools.web" +put( 'solvable_kernels, 'psopfn, 'solvable_kernels_1)$ + +lisp procedure solvable_kernels_1 u; +if length u neq 3 then +rederr("SOLVABLE_KERNELS: wrong number of arguments") +else solvable_kernels(car u,cadr u,caddr u)$ + +%:47%%49:% +%line 964 "tools.web" + +%line 965 "tools.web" +lisp procedure list_merge(element,merge_list); +if member(element,merge_list)then merge_list else element . +merge_list$ + +%:49%%50:% +%line 984 "tools.web" +lisp procedure mk_kernel_list(form,k_oplist,c_oplist,forbidden,kernel_list); +%line 985 "tools.web" +if domainp form then kernel_list +else( +if not atom kernel then +mk_kernel_list(red form,k_oplist,c_oplist,forbidden, +mk_kernel_list(lc form,k_oplist,c_oplist, +if member(car kernel,c_oplist)then t else forbidden, +if member(car kernel,k_oplist)then +if not forbidden and ldeg form=1 and +not get_first_kernel(lc form,c_oplist)then +list_merge(kernel,car kernel_list) . cdr kernel_list +else +car kernel_list . list_merge(kernel,cdr kernel_list) +else kernel_list)) +else mk_kernel_list(red form,k_oplist,c_oplist,forbidden, +mk_kernel_list(lc form,k_oplist,c_oplist,forbidden,kernel_list)) +)where kernel=mvar form$ + +%:50%%51:% +%line 1012 "tools.web" + +%line 1013 "tools.web" +lisp procedure solvable_kernels(exprn,k_oplist,c_oplist); +begin scalar form,kernel_list,forbidden_kernels; +form:=numr simp!* exprn; +k_oplist:=if null k_oplist then k_oplist else if atom +k_oplist then list k_oplist else if +car k_oplist= 'list then cdr k_oplist else k_oplist; +c_oplist:=if null c_oplist then c_oplist else if atom +c_oplist then list c_oplist else if +car c_oplist= 'list then cdr c_oplist else c_oplist; +kernel_list:=mk_kernel_list(form,k_oplist,c_oplist,nil,nil . nil); +forbidden_kernels:=cdr kernel_list; +kernel_list:=car kernel_list; +for each kernel in forbidden_kernels do kernel_list:=delete(kernel,kernel_list); +return 'list . kernel_list; +end$ + +%:51%%52:% +%line 1027 "tools.web" +end; +%line 1028 "tools.web" + +%:52% diff --git a/web/reduce/rweb/appl/supervf.web b/web/reduce/rweb/appl/supervf.web new file mode 100644 index 0000000000..838a6445c2 --- /dev/null +++ b/web/reduce/rweb/appl/supervf.web @@ -0,0 +1,569 @@ +% Copyright (c) 1991 Marcel Roelofs, University of Twente, Enschede, +% The Netherlands. +% +% $Header: supervf.web,v 0.94 92/02/26 17:29:57 roelofs Exp $ +% +\input specification +\def\Version$#1Revision: #2 ${Version #2} +\def\title{SUPER VECTORFIELD} +\font\titlefont=cmcsc10 scaled\magstep3 +\font\ttitlefont=cmtt10 scaled\magstep4 +\def\topofcontents{\null\vfill +\centerline{\titlefont The {\ttitlefont SUPER VECTORFIELD} package for REDUCE} +\vskip15pt\centerline{\Version$Revision: 0.94 $} +\vskip15pt\centerline{\sc Marcel Roelofs}\vfill} +\def\enditem{\medskip\noindent\ignorespaces} +% single control sequences are used by WEB +\def\BZ{{\bf Z}} +\def\BN{{\bf N}} +\def\BR{{\bf R}} +\def\CinfU{C^\infty(U)} +\def\dd#1#2{{\displaystyle{\partial #1\over\partial #2}}} + +@*=Super vectorfields in REDUCE. In this \.{WEB} file we shall implement +the action of $\BZ_2$ graded vectorfields on $\BZ_2$ graded functions. +The package is partially based on a former package by Gragert and +Kersten, which also implemented $\BZ_2$ graded forms and operators +like exterior differentiation, Lie derivatives, etc. Since our methods +nowadays mainly consist of using vectorfields, there is no direct +need for an implementation of these operators. + +\medskip + +\noindent The ``banner line'' defined here is intended for +indentification purposes on loading. It should be changed whenever +this file is modified. System dependent changes, however, should be +made in a separate change file. + +@d banner="Super vectorfield package for REDUCE 3.4, $Revision: 0.94 $" + +@ We define the following macros for clarity. +@d change_to_symbolic_mode =symbolic +@d change_to_algebraic_mode =algebraic +@d stop_with_error(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,t) @; +@d message(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,nil) @; +@d operator_name_of=car +@d arguments_of=cdr +@d first_argument_of=cadr +@d second_argument_of=caddr +@d first_element_of=car +@d rest_of=cdr +@d skip_list=cdr %Skip the |'list| in front of an algebraic list% + +@ The following macros are intended as common programming idioms. +@d incr(x) = (x:=x+1)@; +@d decr(x) = (x:=x-1)@; + +@ A new REDUCE switch can be introduced using the following code. + +@d initialize_global(global_name,value)=@/ +global '(global_name)$@/ +global_name:=value + +@d new_switch(switch_name,value)=@/ +initialize_global(!* @& switch_name,value)$@/ +flag('(switch_name),'switch) + +@ We do all initializations in the beginning of the package. +@u +change_to_symbolic_mode$@/ +write banner$terpri()$@/ +@<Lisp initializations@> +change_to_algebraic_mode$ + +@ We shall start with a (very) short description of the local picture of a +graded manifold and vectorfields on these graded manifolds. For a more +detailed description we refer to B. Kostant, Lecture Notes in +Mathematics 570 (1977). + +The local picture of a {\it graded manifold} is $U\subset\BR^m$ open +together with the {\it graded commutative algebra} +$ +\CinfU\otimes\Lambda(n) +$ +where $\Lambda(n)$ is the antisymmetric (exterior) algebra on $n$ +elements $s_1,\dots,s_n$, with $\BZ_2$-degree $\vert s_i\vert=1$ and $s_i +s_j=-s_j s_i$. +A particular element $f\in\CinfU\otimes\Lambda(n)$ is represented by +$ +f=\sum_\mu f_\mu s_\mu +$ +where +$$\mu\in M_n=\{\mu=(\mu_1,\dots,\mu_k) \mid +\mu_i\in\BN,1\leq\mu_1<\mu_2<\cdots< \mu_k\leq n\},$$ +$s_\mu=s_{\mu_1}s_{\mu_2}\cdots s_{\mu_k}$ and $f_\mu\in\CinfU$. + +{\it Graded vectorfields} on a graded manifold +$(U,\CinfU\otimes\Lambda(n))$ are introduced as graded derivations of +the algebra $\CinfU\otimes\Lambda(n)$. It can be shown that they +constitute a left $\CinfU\otimes\Lambda(n)$-module. Locally a graded +vectorfield $V$ is represented as +$$ +V=\sum_{i=1}^m f_i\dd{}{x_i} + \sum_{j=1}^n g_j\dd{}{s_j} +$$ +with $f_i,g_j\in\CinfU\otimes\Lambda(n)$ and $x_i$ $(i=1,\dots,m)$ a +local coordinate system on $U$. + +The derivations $\dd{}{x_i}$ are even, while the derivation +$\dd{}{s_j}$ are odd; they satisfy the relations +$$ + \dd{x_i}{x_k}=\delta_{ik},\qquad \dd{s_j}{x_k}=0,\qquad + \dd{x_i}{x_\ell}=0,\qquad \dd{s_j}{s_\ell}=\delta_{j\ell}. +$$ + +@ In REDUCE we shall represent the elements $s_\mu\in\Lambda(n)$ by +EXT($\mu_1,\dots,\mu_k$). Thus elements of $\CinfU\otimes\Lambda(n)$ +can be implemented in REDUCE as ordinary algebraic expressions. + +@<Lisp ini...@>= +algebraic operator ext$ + +@*1 Initializing vectorfields. +In order to introduce graded vectorfields, we need to know the +local coordinates $x_i$ on $U$, as well as the components of +$\dd{}{x_i}$ and $\dd{}{s_j}$. + +In this file we want to implement vectorfields as algebraic operators +with a simplification procedure which takes care of the action on a function. +It is our purpose to keep the local coordinates and the components +local to one vectorfield at a time. + +The following procedure initializes a super vectorfield. The macro +|make_oplist| is taken from the TOOLS package; it transforms algebraic +and lisp lists and identifiers into the appropriate lisp lists. + +We will not give all components of the vectorfield here: it is much +easier to give them separately, as we shall see in the sequel. + +@d make_oplist(op_list)=@/if null op_list then op_list else if atom +op_list then list op_list else if +car op_list='list then cdr op_list else op_list @; + +@u lisp operator super_vectorfield; +lisp procedure super_vectorfield(operator_name,even_dimension, + odd_dimension,variables); +begin + if not idp operator_name then @/ + stop_with_error("SUPER_VECTORFIELD:",operator_name,"is not an identifier",nil); + if not fixp even_dimension or even_dimension<0 or + not fixp odd_dimension or odd_dimension<0 then@/ + rederr("SUPER_VECTORFIELD: improper dimensions"); + put(operator_name,'simpfn,'super_der_simp); + flag(list(operator_name),'full);@/ + put(operator_name,'even_dimension,even_dimension);@/ + put(operator_name,'odd_dimension,odd_dimension);@/ + put(operator_name,'variables,make_oplist(variables)); +end$ + +@*1 Implementation of exterior multiplication. +Before we can implement the action of a graded vectorfield on a +graded function we need to have a function that computes the +(exterior) multiplication of two elements of $\Lambda(n)$. + +If we have two elements EXT($i_1,\dots,i_n$) and +EXT($j_1,\dots,j_m$) then the product will be 0 or an expression of +the form $\pm{}$EXT(\dots). In order to find this result we need to +merge the lists $(i_1,\dots,i_n)$ and $(j_1,\dots,j_m)$ into one +ordered list, taking into account the signs that occur due to the +switching of all pairs of elements of the lists. + +In fact, since it is needed for cohomology computations by van den +Hijligenberg and Post, we shall implement an even more general +procedure: given two {\it ordered} lists $(i_1,\dots,i_m)$ and +$(j_1,\dots,j_m)$, return the list which results from merging the two +lists into one ordered lists, together with a sign due to the +switching of indices. The elements of the list need, however, not only +be positive integers anymore, but may also be negative integers, with +the proviso that switching two negative integers does {\it not} cause +a sign. + +The algorithm is rather simple: given two lists |x1| and |x2| we +construct the merged list |x2| as follows (the notation |cx1| is an +abbreviation for |car x1|, and the same for all other lists): + +\medskip +\item{1.} reverse |x1| (|x1| is now ordered reversely) and move all +the elements of |x2|, with which the first element of |x1| (i.e.\ the +highest element) has to be interchanged for merging both lists, in +reverse order on the list |lx2|. Keep track if the number of elements +of |lx2| is odd or even with help of the boolean |oddskip|. + +\item{2.} if either |x1| or |lx2| is empty return the appropriate +result. + +\item{3.} if |cx1=clx2| then we can return |nil| if both are positive, +due to the anticommutativity. + +\item{4.} if |cx1>clx2| put |cx1| in front of |x2| and adjust the sign +according to |oddskip| only if |cx1| is positive: if |cx1| is +negative, so are all elements of |lx2| and thus no sign need to be added. +Continue with 2. + +\item{5.} if |cx1<=clx2| put |clx2| in front of |x2| and adjust +|oddskip|. Continue with 2. + +\enditem +Since it is used quite frequently, we shall implement this procedure +using labels in order to prevent overhead caused by (recursive) +function calls. + +@u lisp procedure merge_lists(x1,x2); +begin scalar cx1,cx2,lx2,clx2,oddskip,sign; +@<Prepare |x1|, |x2| and |lx2|, if ready |goto b|@>; +b: @<Weave all elements of |x1| and |lx2| in front of |x2|, return if done@>; +end$ + +@ The implementation of step 1. +@<Prepare |x1|, |x2| and |lx2|, if ready |goto b|@>= + sign:=1; + x1:=reverse x1; + if x1 then cx1:=car x1 @+else goto b; +a: if x2 then cx2:=car x2 @+else goto b; + if cx1<cx2 then goto b; + lx2:=cx2 . lx2;@/ + oddskip:=not oddskip;@/ + x2:=cdr x2;@/ + goto a + +@ The implementation of steps 2 and 3. +@<Weave all elements of |x1| and |lx2| in front of |x2|, return if done@>= + if null x1 then @+return sign . nconc(reversip lx2,x2); + if null lx2 then @+return sign . nconc(reversip x1,x2); + clx2:=car lx2; + if cx1=clx2 and cx1>0 then @+return nil; + if cx1>clx2 then goto b1; + @<Move first element of |lx2| to |x2| and |goto b|@>; +b1: @<Move first element of |x1| to |x2| and |goto b|@> + +@ The implementation of step 5. +@<Move first element of |lx2| to |x2| and |goto b|@>= + x2:=clx2 . x2;@/ + lx2:=cdr lx2;@/ + oddskip:=not oddskip;@/ + goto b + +@ And finally step 4. +@<Move first element of |x1| to |x2| and |goto b|@>=@/ + x2:=cx1 . x2;@/ + x1:=cdr x1; + if oddskip and cx1>0 then sign:=-sign; + cx1:=car x1;@/ + goto b + +@ It's a piece of cake now the write a procedure for the +multiplication of two ``EXT'' kernels. By definition |ext()| is equal +to 1. + +@d sign_of=car +@d arg_list_of=cdr + +@u +lisp procedure ext_mult(x1,x2); +(if null x then nil ./ 1 + else @+if null arg_list_of x then 1 ./ 1 + else (((!*a2k('ext . arg_list_of x) .^ 1) .* sign_of x) .+ nil) ./ 1)@/ +where x=merge_lists(arguments_of x1,arguments_of x2)$ + +@*=The simplification procedure for vectorfields. +The only thing left now is to implement the action of a vectorfield +on a function by means of the simplification procedure +|super_der_simp|. + +If $V$ is a vectorfield we shall assume that the components of +$\dd{}{x_i}$ and $\dd{}{s_j}$ are given by $V(0,i)$ and $V(1,j)$, +respectively. + +Since we want to be able to look at the value of the components, we have to make +the following distinction: if a vectorfield has just one argument it +is the action on a function, otherwise we just have to return the +value of the kernel. + +@u +lisp procedure super_der_simp u; +if length u=2 then @<Return the action of the vectorfield on a function@> +else simpiden u$ + +@ The action is not very complicated: collect all the even and odd +components of the vectorfield and apply the vectorfield to the +numerator and denominator of the function, using the quotient rule. + +Notice that we don't want denominators of any function to contain +odd variables, since such an expression can always be rewritten to a +finite expression without odd variables in the denominator. + +@<Return the action of the vectorfield...@>= +begin scalar derivation_name,variables,even_components,odd_components,@| + splitted_numr,splitted_denr; + derivation_name:=reval operator_name_of u;@/ + variables:=get(derivation_name,'variables);@/ + u:=simp!* first_argument_of u; + @<Get the lists |splitted_numr|, |splitted_denr|, |even_components| +and |odd_components|@>; + return subtrsq(@| + quotsq(addsq(even_action(even_components,splitted_numr),@| + odd_action(odd_components,splitted_numr)), denr u ./ 1),@| + quotsq(multsq(numr u ./ 1, even_action(even_components,splitted_denr)),@| + multf(denr u,denr u) ./ 1)); +end + +@*1 Getting the vectorfield components. +Finding all linear kernels of an algebraic operator and their +coefficients in a standard form is performed by the procedure +|split_form| of the TOOLS package, which acts on standard forms. +Since it is more convenient for the components of the vectorfield to +have the coefficients returned by |split_form| as standard quotients +instead of standard forms, the following procedure applies +|split_form| to the numerator of a standard quotient and takes care of +the necessary conversion of the coefficients to standard quotients. + +In order to allow simple processing of the lists the independent part +must be preceded by |ext()|. + +@d independent_part_of=car +@d kc_list_of=cdr +@d kernel_of=car +@d coefficient_of=cdr + +@u +lisp procedure split_ext(sq,op_list); +begin scalar denr_sq,splitted_form; + denr_sq:=denr sq; + splitted_form:=split_form(numr sq,op_list); + return (list('ext) . cancel(independent_part_of splitted_form ./ denr_sq)) . + for each kc_pair in kc_list_of splitted_form collect@/ + (kernel_of kc_pair . cancel(coefficient_of kc_pair ./ denr_sq)) +end$ + +@ For a proper action of |even_action| and |odd_action| all components +need to be decomposed into ``EXT'' kernels and their coefficients. +Since the action is most conveniently performed recursively on +standard forms, the numerator and denominator are decomposed at +standard form level. + +@<Get the lists ...@>= + splitted_numr:=split_form(numr u,'(ext));@/ + splitted_numr:= + (list('ext) . independent_part_of splitted_numr) . kc_list_of splitted_numr;@/ + splitted_denr:=split_form(denr u,'(ext));@/ + splitted_denr:= + (list('ext) . independent_part_of splitted_denr) . kc_list_of splitted_denr;@/ + even_components:=for i:=1:get(derivation_name,'even_dimension) collect@/ + (nth(variables,i) . split_ext(component,'(ext)))@| + where component=simp!* list(derivation_name,0,i);@/ + odd_components:=for i:=1:get(derivation_name,'odd_dimension) collect@/ + (i . split_ext(component,'(ext)))@| + where component=simp!* list(derivation_name,1,i) + +@*1 Action of the even components. +The action of the even part of a vectorfield on a function is fairly +simple at top level: just add the actions on all kernel-coefficient pairs. + +@u +lisp procedure even_action(components,splitted_form); +begin scalar action; + action:=nil ./ 1; + for each kc_pair in splitted_form do@/ + action:=addsq(action, + even_action_sf(components,coefficient_of kc_pair,kernel_of kc_pair,1)); + return action; +end$ + +@ The action on a standard form is the sum of the actions on all +terms. If the last term is a domain element we don't have to take it +into consideration. + +@u +lisp procedure even_action_sf(components,sf,ext_kernel,fac); +begin scalar action; + action:=nil ./ 1; + while not domainp sf do + <<action:=addsq(action,even_action_term(components,lt sf,ext_kernel,fac)); + sf:=red sf>>; + return action; +end$ + +@ For the action on the leading term we use the derivation property: the +action on the leading power has to be added to the action on the +leading coefficient. The last argument of |even_action_sf| is the +product of all leading powers which have already been treated and with +which the result has to be multiplied. + +For reasons of efficiency it is more convenient to have the factor as +in standard quotient in |even_action_pow|. + +@d term_pow=car +@d term_coeff=cdr + +@u +lisp procedure even_action_term(components,term,ext_kernel,fac); +addsq(even_action_pow(components,term_pow term, + ext_kernel,!*f2q multf(fac,term_coeff term)),@| + even_action_sf(components,term_coeff term, + ext_kernel,multf(fac,!*p2f term_pow term)))$ + +@ Finally we have to implement the action on leading powers. For this +we have to find all dependencies of the main variable on local coordinates +occuring in the vectorfield, and act accordingly. + +@u +lisp procedure even_action_pow(components,pow,ext_kernel,fac); +begin scalar kernel,n,component,derivative,action,active_components; + kernel:=car pow; n:=cdr pow; %|pow=kernel^n|% + @<If |kernel| is one the even local coordinates, return the action on |pow|@>; + @<Find all the dependencies of |kernel| and construct |active_components|@>; + @<Return the sum of the actions of |active_components| on |pow|@>; +end$ + +@ We can check if |kernel| is one of the local coordinates by a simple +|assoc| on |components|. + +@<If |kernel| is one the even ...@>= +if (component:=assoc(kernel,components)) then +return + <<derivative:=if n=1 then 1 ./ 1 @+else ((((kernel .^ n-1 ) .* n) .+ nil) ./ 1); + action:=component_action(component,ext_kernel,derivative);@/ + multsq(action,fac)>> + +@ The procedure |component_action| takes care of returning the sum of all +products of the |kc_pairs| in |component| with |ext_kernel| and +|derivative|. + +Recall that super vectorfields have a left $\CinfU\otimes\Lambda(n)$ +module structure. This means that we have to take care that the +arguments in the |ext_mult| call have to be in the right order: +components of the vectorfield left and the |ext_kernel|'s from the +function right. Of course, if the product of the two ``EXT'' kernels +is zero, there is no need to consider the summand. + +@d combined_product(x,y,z)=@/multsq(multsq(x,y),z) + +@u +lisp procedure component_action(component,ext_kernel,coefficient); +begin scalar action; + action:=nil ./ 1; + for each kc_pair in kc_list_of component do@/ + (if numr ext_product then@/ + action:=addsq(action, + combined_product(ext_product,even_coefficient,coefficient)))@| + where ext_product=ext_mult(kernel_of kc_pair,ext_kernel),@| + even_coefficient=coefficient_of kc_pair; + return action; +end$ + +@ If a kernel is not one of the local coordinates, it may still depend +on them, in which case we can still differentiate it w.r.t. such a coordinate. + +The following procedure tries finds all active components in |kernel| +as completely as possible. + +@d get_dependencies_of(kernel)= + ((if depl_entry then cdr depl_entry) where depl_entry=assoc(kernel,depl!*)) + +@u +lisp procedure find_active_components(kernel,components,components_found); +begin + components_found:=@| + update_components(kernel . get_dependencies_of(kernel), + components,components_found)$ + if not atom kernel then + for each element in kernel do@/ + components_found:=find_active_components(element,components,components_found); + return components_found; +end$ + +@ The procedure |update_components| takes care that |components_found| +contains all active components just once. + +@u +lisp procedure update_components(dependencies,components,components_found); +begin scalar component; + for each kernel in dependencies do + if (component:=assoc(kernel,components)) + and not assoc(kernel,components_found) then@/ + components_found:=component . components_found; + return components_found; +end$ + +@ +@<Find all the dependencies of |kernel| and construct |active_components|@>=@/ +active_components:=find_active_components(kernel,components,nil) + +@ Once we know all active components we can simply apply |diffp| to +compute the derivatives of |pow| and |component_action| to compute the +action of the different components. Recall that the final result has +to be multiplied with |fac|. + +@<Return the sum of the actions of |active_components| on |pow|@>= +action:=nil ./ 1; +for each component in active_components do + <<derivative:=diffp(pow,kernel_of component); + action:=addsq(action,component_action(component,ext_kernel,derivative))>>; +return multsq(action,fac) + +@*1 Action of the odd components. +The action of the odd components is much simpler than the action of +the even components since the dependencies are clear at once: the only +dependency on odd variables are the indices of the ``EXT'' kernels. + +Odd differentiations can cause an additional sign: +$$ + \dd{}{s_{i_j}}s_{i_1}\dots,s_{i_j},\dots,s_{i_n}= + (-1)^{j-1}s_{i_1}\dots,\widehat{s_{i_j}},\dots,s_{i_n} +$$ +Additional signs are governed by the boolean |sign|. +After the deletion of one index we have to apply |!*a2k| in order to +get a unique kernel. + +@u +lisp procedure odd_action(components,splitted_form); +begin scalar action,sign,derivative,kernel,coefficient,component; + action:=nil ./ 1; + for each kc_pair in splitted_form do + <<kernel:=kernel_of kc_pair;@/ + coefficient:=!*f2q coefficient_of kc_pair;@/ + sign:=t;@/ + for each i in arguments_of kernel do + <<sign:=not sign;@/ + derivative:=!*a2k delete(i,kernel);@/ + component:=assoc(i,components);@/ + action:=addsq(action, + component_action(component,derivative, + if sign then negsq coefficient @+else coefficient)) + >> + >>; + return action; +end$ + +@*=Multiplication of graded expressions. Since it is useful in +practical problems, we shall finally implement a procedure +|super_product| for multiplying two graded expressions. Using some of +the above procedures this is not difficult at all. + +@u +lisp operator super_product; +lisp procedure super_product(x,y); +begin scalar splitted_x,splitted_y,product; + splitted_x:=split_ext(simp x,'(ext)); + splitted_y:=split_ext(simp y,'(ext));@/ + product:=nil ./ 1; + for each term_x in splitted_x do + for each term_y in splitted_y do@/ + product:=addsq(product,@| + combined_product(coefficient_of term_x,coefficient_of term_y,@| + ext_mult(kernel_of term_x,kernel_of term_y))); + return mk!*sq subs2 product; +end$ + +@ The end of a REDUCE input file must be marked with |end|. + +@u end; + +@*=Index. This section contains a cross reference index of all +identifiers, together with the numbers of the mdules in which they are +used. Underlined entries correspond to module numbers where the +identifier was declared. + + + diff --git a/web/reduce/rweb/appl/sym_cond_example b/web/reduce/rweb/appl/sym_cond_example new file mode 100644 index 0000000000..b455a6b763 --- /dev/null +++ b/web/reduce/rweb/appl/sym_cond_example @@ -0,0 +1,200 @@ +% This file contains all the necessary statements for computing the +% symmetries of the KdV equations up to a certain order. By changing +% some of the statements in the first part of the file, it may be easily +% adapted to compute symmetries of other (systems of) equations. + +load tools,integrator,supervf; + +% Give the set of dependent variables u,v,... etc. +dependent_variables := {u}$ + +% Since for the odd variable numbers are given instead of variables we introduce +% odd_offset, the number after which the dependent odd variables start (and continue +% consecutively) and the number of odd variables: +odd_offset:=0$ +nr_odd_variables:=0$ + +% Give the order of the system of pde's +order_pde := 3$ + +% Give the order of the symmetries one wants to consider +order_sym := 5$ + +% Give the expressions for the t derivatives ut,vt,... of the dependent variables +ut:=u3+u*u1$ + +% Give the set of nonlocal variables to be considered as well. +nonlocal_variables := {}$ +nonlocal_odd_offset := 0$ +nr_odd_nonlocal := 0$ + +% Give the x and t derivatives px and pt of all nonlocal variables p. + +% Specify the functions f(1),...,f(n), f(-1),...,f(-m) here. +% If not specified, the functions will be made dependent on +% the proper variables further on. + +algebraic operator f,c; + +nr_odd_f:=nr_odd_variables$ +nr_even_f:=nr_variables$ +nr_odd_c:=0$ +nr_even_c:=0$ + +% Give or give not information during construction of equations +% Useful when computing large examples. +write_mke:=nil$ + +%-------------------------------------------------------------------------------- +% Make no changes behind this line. We will now compute the symmetry conditions +% for the vectorfield f(1)*d/du + f(2)*d/dv + ... + D_x(f(1))*d/du_1 + ..., +% where f(1),f(2),... depend on the variables +% x,t, u,v,... ,u1,v1,..., un,vn,..., p1,...,pm, if n is the order of the +% symmetry and p1,...,pm are all the nonlocal variables considered; + +nr_variables := length dependent_variables$ +nr_nonlocal := length nonlocal_variables$ + +dim_vars := 2 + nr_nonlocal + nr_variables*(order_pde + order_sym + 1)$ +dim_odd_vars := max(odd_offset + nr_odd_variables*(order_pde + order_sym + 1), + nonlocal_odd_offset + nr_odd_nonlocal)$ + +vars := for i:=1:order_pde + order_sym + 1 join + for j:=1:nr_variables collect mkid(part(dependent_variables,j),i)$ +vars := x . t . append(nonlocal_variables, append(dependent_variables,vars))$ + +algebraic operator equ,var_x; + +initialize_equations(equ,nr_variables+nr_odd_variables,vars, + {c,nr_even_c,nr_odd_c},{f,nr_even_f,nr_odd_f}); + +vectorfield(ddx,vars); +vectorfield(ddt,vars); + +% The following procedure gives the number of D_x^n(ui) if ui is the i-th +% local variable +algebraic procedure var_nr(i,n); + 2+nr_nonlocal+n*nr_variables+i$ + +algebraic procedure odd_var_nr(i,n); + odd_offset+n*nr_odd_variables+i$ + +for i:=1:dim_vars do var_x i:=part(vars,i); + +% We construct the components of the total derivatives D_x and D_t +ddx(0,1) := 1$ +ddx(0,2) := 0$ +for i:=1:nr_nonlocal do + ddx(0,2+i) := mkid(part(nonlocal_variables,i),x); +for i:=1:nr_variables do + for n:=0:order_pde + order_sym do + ddx(0,var_nr(i,n)) := var_x(var_nr(i,n+1)); +for i:=1:nr_odd_nonlocal do + ddx(1,nonlocal_odd_offset+i):=mkid(mkid(ext,nonlocal_odd_offset+i),x); +for i:=1:nr_odd_variables do + for n:=0:order_pde + order_sym do + ddx(1,odd_var_nr(i,n)) := ext(odd_var_nr(i,n+1)); + +procedure mk_ddt; +begin + ddt(0,1) := 0$ + ddt(0,2) := 1$ + for i:=1:nr_nonlocal do + ddt(0,2+i) := mkid(part(nonlocal_variables,i),t); + for i:=1:nr_variables do + ddt(0,var_nr(i,0)) := mkid(part(dependent_variables,i),t); + for i:=1:nr_variables do + for n:=1:order_sym do + ddt(0,var_nr(i,n)) := ddx ddt(0,var_nr(i,n-1)); + for i:=1:nr_odd_nonlocal do + ddt(1,nonlocal_odd_offset+i):=mkid(mkid(ext,nonlocal_odd_offset+i),t); + for i:=1:nr_odd_variables do + ddt(1,odd_var_nr(i,0)) := mkid(mkid(ext,odd_offset+i),t); + for i:=1:nr_odd_variables do + for n:=1:order_sym do + ddt(1,odd_var_nr(i,n)) := ddx ddt(1,odd_var_nr(i,n-1)); +end$ + +% For the construction of the symmetry condition we need to compute +% the action of the linearisator of the system of pde's on +% f(1),...,f(n),f(-1),...,f(-m) +% We will save these as equ(1),...,equ(n+m) + +vectorfield(symmetry,vars); + +procedure make_prolongation; +begin + for i:=1:nr_variables do + begin + symmetry(0,var_nr(i,0)) := f(i); + for n:=1:order_pde do << + if write_mke then write "Prolongation of f(",i,") up to order ",n; + symmetry(0,var_nr(i,n)):=ddx symmetry(0,var_nr(i,n-1))>>; + end; + for i:=1:nr_odd_variables do + begin + symmetry(1,odd_var_nr(i,0)) := f(-i); + for n:=1:order_pde do << + if write_mke then write "Prolongation of f(",-i,") up to order ",n; + symmetry(1,odd_var_nr(i,n)):=ddx symmetry(1,odd_var_nr(i,n-1))>>; + end; +end$ + +procedure make_equations; +begin + for i:=1:nr_variables do + begin scalar evolution; + evolution:=mkid(part(dependent_variables,i),t); + if write_mke then write "Computing equation for f(",i,")"; + equ(i):=ddt f(i) - symmetry evolution; + end; + for i:=1:nr_odd_variables do + begin scalar evolution; + evolution:=mkid(mkid(ext,odd_offset+i),t); + if write_mke then write "Computing equation for f(",-i,")"; + equ(nr_variables+i):=ddt f(-i) - symmetry evolution; + end; + if not write_mke then + if (nr_variables+nr_odd_variables)=1 then write "Introduced equation 1" + else write "Introduced equations ",1,",...,",nr_variables+nr_odd_variables; +end$ + +% Check if f(-m),...,f(n) are already defined, if not make them +% dependent on the proper variables. + +lisp operator has_no_definition; +lisp procedure has_no_definition(opr,i); +if assoc(list(opr,i),get(opr,'kvalue)) then nil else t$ + +for i:=-nr_odd_variables:nr_variables do + if i neq 0 and has_no_definition(f,i) then + <<for k:=1:nr_variables do + for l:=0:order_sym do depend f(i),var_x(var_nr(k,l)); + depend f(i),x,t + >>; + +% Define some handy abbreviations +define es=integrate_equation, + seq=integrate_equations, + xes=integrate_exceptional_equation, + pr=show_equation, + preq=show_equations, + te=equations_used(), + pte=put_equations_used, + fu=functions_used, + pfu=put_functions_used; + +% Compute the prolongation of the vectorfield, the components of D_t +% and finally all the equations. + +make_prolongation(); +mk_ddt(); +make_equations(); + +% For the KdV, cracking the problem is utterly simple: +% (other systems require more skill !!) + +auto_solve 1; + +end; + diff --git a/web/reduce/rweb/appl/symmetry.tex b/web/reduce/rweb/appl/symmetry.tex new file mode 100644 index 0000000000..eb79fe7509 --- /dev/null +++ b/web/reduce/rweb/appl/symmetry.tex @@ -0,0 +1,974 @@ +\documentstyle[a4wide,fleqn]{article} + +\input mssymb + +\renewcommand{\theequation}{\thesection.\arabic{equation}} +\setlength{\parindent}{0pt} +\newtheorem{df}{Definition}[section] +\newtheorem{lemma}[df]{Lemma} +\newtheorem{th}[df]{Theorem} +\newtheorem{rem}[df]{Remark} +%\newtheorem{proof}[df]{Proof} +\newtheorem{prop}[df]{Proposition} +\newtheorem{cor}[df]{Corollary} +\newtheorem{ex}[df]{Example} +\newcommand{\Ng}{\setcounter{df}{0}} +\newcommand{\rbox}{\begin{flushright} $ \Box $ \end{flushright}} + +\newcommand{\groot}{\displaystyle} +\newcommand{\skipline}{\vspace{4mm}} + +\def\h{\hbox{$\goth h$}} +\def\g{\hbox{$\goth g$}} +\newtheorem{Definition}{Definition}[section] +\newtheorem{Proposition}[Definition]{Proposition} + +\begin{document} + +\title{Lecture\\ Generalized Symmetries} \author{Paul H.M. Kersten \\ +Department of Applied Mathematics\\ University of Twente\\ +P.O. Box 217\\ 7500 AE Enschede\\ The Netherlands} + + +\date{} +\maketitle + +\begin{abstract} +\mbox{\ } +\end{abstract} + +\section{Introduction.} +The classical notion of symmetry of a system of differential equations +was based on transformations in the space of independent en dependent +variables, transforming solutions into solutions. These symmetries are +called {\it point} symmetries. The first generalization of this +concept is to consider transformations of independent, dependent +variables and first order partial derivatives, and transforming +solutions into solutions. This leads to the socalled {\it contact} +symmetries. Generalized symmetries, the subject of this lecture, can +be understood as transformations in the space of independent, +dependent variables and {\it all} partial derivatives \cite{O,V}.\\ + +Notations will be as follows.\\ +$X$ is the space of independent variables, local coordinates being +\begin{displaymath} + (x_1,...,x_p) +\end{displaymath} +$U$ is the space of dependent variables where local coordinates are +\begin{displaymath} + (u^1,...,u^q) +\end{displaymath} +The $k^{th}$ order jetbundle $J^k(x,u)$ has local coordinates +\begin{equation} +\label{1.1a} + (x_i,u^{\alpha},u^{\alpha}_I) \qquad (|I| \leq k,i=1,...,p ; \alpha = 1,...,q) +\end{equation} +while the infinite jetbundle $J(x,u) = J^{\infty}(x,u)$ has local +coordinates +\begin{equation} +\label{1.1b} + (x_i,u^{\alpha},u_I ^{\alpha}) \; \; |I| < \infty +\end{equation} +In (\ref{1.1a}),(\ref{1.1b}) we used the multiindex notation +$I=(i_1,...,i_p) \; |I| = \sum\limits_{k=1}^p i_r$\\ + +Throughout we shall use summation convention in case an index occurs +twice; latin indices run from $1$ to $p$ while greek indices run from +$1$ to $q$.\\ + +Functions $f:J^k(x,u) \rightarrow \Bbb R$ are supposed to be +$C^{\infty}$, while functions $g:J(x,u) \rightarrow \Bbb R$ are just +those dependent on a {\it finite} number of variables, so in effect +\begin{displaymath} + g = \pi_k^* f \mbox{ for some } f \mbox{ and } k, +\end{displaymath} +(see previous lectures). +notation $f = f[u], g = g[u]$.\\ +A system of $k-th$ order differential equations is denoted by +\begin{equation} +\label{1.1c} + \Delta_j[u] = 0 \; (j=1,...,\l) +\end{equation} +where $\Delta_j$ is defined on $J^k(x,u)$.\\ +The total partial derivative operators $D_i$ are given by +\begin{equation} +\label{1.1d} + D_i = \frac{\partial}{\partial x _ {i}} + u^\alpha_{I,i} +\frac{\partial}{\partial u_I^\alpha} \; \; (i=1,...,q) +\end{equation} +and they re-create in an algebraic way, what is realized classically +by partial differentiation, using chain-rule.\\ + +In section 2 we give a short recapitulation of the notion of +infinitesimal symmetry. In section 3 the concept of generalized +symmetry is given, some theorems are proved and an explicit example is +given.\\ +In section 4 the notion of nonlocal symmetry, \cite{KV,KV2} being a +generalization of generalized symmetry, is introduced and an illustration +through the famous Korteweg-de Vries equation (KdV) is +discussed. In the conclusions we point out that even generalizations +of this concept are very interesting.\\ + +Applications of symmetries to construct explicit solutions, +conservation laws etc are beyond the scope of this lecture, and are +dealt with in p.e. ref \cite{O}, \cite{KB}. + +\setcounter{equation}{0} +\section{Classical Symmetries.} +We give a short review of classical (infinitesimal) symmetries of +differential equations.\\ +We start at a $k$-th order system of differential equations +\begin{equation} +\label{1.1} + \Delta_j[u] = 0 \; \; j = 1,\ldots,\l. +\end{equation} +A vector field $V \epsilon T(J^0(x,u))$ is given by +\begin{equation} +\label{1.2} + V = \xi^i(x,u) \frac{\partial}{\partial x ^ {i}} + +\varphi_{\alpha}(x,u) \frac{\partial}{\partial u ^ {\alpha}} +\end{equation} +The $k^{th}$ prolongation of the vector field $V$ defined in +$T(J^k(x,u))$ and denoted $pr^{k}(V)$ is given by +\begin{equation} +\label{1.3} + pr^{k}(V) = \xi^i (x,u) \frac{\partial}{\partial x ^ {i}} + +\Phi_{\alpha}^I [u] \frac{\partial}{\partial u +_{I} ^ {\alpha}} +\end{equation} +where +\begin{equation} +\label{1.4} + \Phi_{\alpha}^I [u] = D^I (\varphi_{\alpha}(x,u) - u_i^{\alpha} +\xi^i (x,u)) + u_{I,i} ^{\alpha} \xi^i (x,u) +\end{equation} +and +\begin{equation} +\label{1.4a} + D^I = D_1^{i _{1}} o D_2^{i _ {2}} ... o D_p^{i _ {p}} +\end{equation} + +Formula (\ref{1.4}) can be obtained by the conditions that the +prolongation of the vector field $V$ leaves the contact structure +\begin{equation} +\label{1.5} + \omega_J^{\alpha} = du_J^{\alpha} - u_{J,i}^\alpha dx^i \; \; +(|J| \leq k-1) +\end{equation} +invariant \cite{O}.\\ +We now arrive at the following definition. + +\begin{df} +A vector field $V$ (\ref{1.2}) is a (infinitesimal) symmetry of the +system of differential equations (\ref{1.1}) if +\begin{equation} +\label{1.6} + \hspace{5cm} pr^{(k)}(V)(\Delta_j) = 0 \; \; \mbox{ on } \Delta = 0 +\end{equation} +We shall not compute symmetries here; but postpone it to the next +section.\\ +Computerprograms to construct solutions of the symmetry condition +(\ref{1.6}) are discussed in p.e. \cite{K}. +\end{df} + +\setcounter{equation}{0} +\section{Generalized Symmetries.} + +In this section we generalize the classical notion of infinitesimal +symmetries to generalized symmetries, sometimes called +Lie-B\"{a}cklund transformations: not te be confused with B\"{a}cklund +transformations which are of a completely different nature.\\ +Remind that classically a vector field $V \epsilon T(J^0(x,u))$ is +given by +\begin{equation} +\label{2.1} + V = \xi^i(x,u) \frac{\partial}{\partial x^{i}} + \varphi_\alpha(x,u) +\frac{\partial}{\partial u_{\alpha}} +\end{equation} +We now pass to the infinite jetbundle $J(x,u)$ where local coordinates +are given by +\begin{displaymath} + (x^i,u^{\alpha},u^{\alpha}_I) \; \; I = (i_1,...,i_p) \; i_k \geq 0(k=1,...,p) +\end{displaymath} +functions $F:J(x,u) \rightarrow \Bbb R$ are to be understood to depend +on an arbitrary but finite number of variables, $F=F[u]$. + +\begin{df} +A (formal) generalized vector field is given by the following +expression +\begin{equation} +\label{2.2} + V = \xi^i[u] \frac{\partial}{\partial x ^ {i}} + +\varphi_{\alpha}[u] \frac{\partial}{\partial u ^ {\alpha}} +\end{equation} +The formal prolongation of $V$ to the infinite jetbundle is defined by +\begin{equation} +\label{2.3} + pr(V) = \xi^i[u] \frac{\partial}{\partial x ^{i}} + +\Phi^J_{\alpha}[u] \frac{\partial}{\partial u^{\alpha}_{J}} +\end{equation} +whereas in the second term summation runs over $\alpha$ and all +possible multiindices $J$ and +\begin{equation} +\label{2.4} + \Phi^J_{\alpha} = D^J(\varphi_{\alpha}[u] - \xi^i [u] u^{\alpha}_i) + +\xi^i [u] u^{\alpha}_{J,i}, +\end{equation} +compare this with formula (\ref{1.4}).\\ + +{\bf Note} there arise no convergence problems in defining the action +of an (infinitely) prolonged vector field on a function $F[u]$ +since the latter only depends on a finite number of variables.\\ + +We now arrive at the definition of generalized symmetry. +\end{df} + +\begin{df} +A generalized vector field $V$ is a generalized symmetry of a system of +differential equations +\begin{displaymath} + \Delta_j[u] = 0 \; \; (j=1,...,\l) +\end{displaymath} +if and only if +\begin{equation} +\label{2.5} + pr(V)(\Delta_j) = 0 \; \; (j=1,...,\l) +\end{equation} +for solutions $u = f(x)$.\\ + +{\bf Note} it can be proved that for applications one has in mind +that condition (\ref{2.5}) results in +\begin{equation} +\label{2.6} + pr(V)(\Delta_j) = \sum P_{k,j}^J [u]D^J (\Delta_k) \; \; +j=k=1,\ldots l \qquad |J|< \infty, \; \; P^J_{k,j}[u]\in C^\infty(J(x,u)) +\end{equation} +or $pr(V)(\Delta_j) = 0$ when restricted to the manifold $Y \subset +J(x,u)$ defined by the system of differential equations and all its +differential consequences.\\ + +The concept of evolutionary or vertical vector field is a great +advantage in the computation of generalized symmetries. +\end{df} + +\begin{df} + A generalized vector field +\begin{equation} +\label{2.7} + V = V_F = F_{\alpha}[u] \frac{\partial}{\partial u^\alpha} +\end{equation} +is called an evolutionary or vertical vector field.\\ +The set of functions $(F_{\alpha})$ is called the {\em characteristic} of the +vector field $V$.\\ + +Note that for evolutionary vector fields we have a very elegant way for +the expression of the infinite prolongation (\ref{2.4}) i.e. +\begin{equation} +\label{2.8} + pr(V_F) = D^J(F_{\alpha} [u]) \frac{\partial}{\partial u ^{\alpha} _ {J}} +\end{equation} +because $\xi^i [u] \equiv 0 \; \; (i=1,\ldots,p)$.\\ +\end{df} + +Moreover every infinitely prolonged vector field $V$ (\ref{2.2},\ref{2.3}) +can be written as a sum of an evolutionary vector field and total +partial derivative vector fields i.e. +\begin{equation} +\label{2.9} + pr(V) = pr(V_F) + \xi^i[u]D_i +\end{equation} +where the characteristic $F$ of the evolutionary vector field is given +by +\begin{equation} +\label{2.10} + F_{\alpha}[u] = \varphi_{\alpha}[u] - u^{\alpha}_i \xi^i [u] \; \; +(\alpha=1,\ldots,q) +\end{equation} +Since vector fields $\xi^i[u]D_i$ satisfy the symmetry condition +(\ref{2.5}),(\ref{2.6}) in a trivial way; we can restrict the search for +generalized symmetries to the search for {\it evolutionary} vector fields.\\ + +To show the complexity of the computations involved in constructing +generalized symmetries we compute {\it third} order symmetries of the +potential form of Burgers' equation. + +\begin{ex} +Burgers' equation is the following partial differential equation +\begin{equation} +\label{2.11} + u_t = u_1^2 + u_2 \; \; (u_1=u_x,u_2=u_{xx}) +\end{equation} +Note that differential consequences are given by +\begin{eqnarray} +\label{2.11b} + u_{1t} & = & 2u_1u_2 + u_3 \qquad (u_{1t} = u_{xt})\\\nonumber + u_{2t} & = & 2u_2^2 + 2u_1u_3 + u_4\\ + u_{3t} & = & 6u_2u_3 + 2u_1u_4 + u_5\nonumber +\end{eqnarray} +The characteristic of the evolutionary vector field $V_F$ is +\begin{equation} +\label{2.12} + F[u] = F(x,t,u,u_1,u_2,u_3) +\end{equation} +Since we restrict to the solution manifold $u_t,u_{1t},..$ can be +eliminated by (\ref{2.11}),(\ref{2.11b}) +\end{ex} +Now due to (\ref{2.8}) the symmetry condition (\ref{2.5}),(\ref{2.6}) +reduces to +\begin{equation} +\label{2.13} + D_tF - 2u_1 D_xF - D_x^2 F = 0 +\end{equation} + +\begin{equation} +\begin{array}{ll} +\label{2.14} + \mbox{i.e. }& F_t + F_u(u_1^2 + u_2) + F_{u_1} (2u_1u_2 + u_3) + + F_{u_2} (2u_2^2 + 2u_1u_3 + u_4)\\ + &+ F_{u_3} (6u_2u_3 + 2u_1u_4 + u_5)\\ + &- 2u_1(F_x + F_u u_1 + F_{u_1} u_2 + F_{u_2} u_3 + F_{u_3} u_4)\\ + &- \{F_{xx} + F_{xu} u_1 + F_{xu_1} u_2 + F_{xu_2} + F_{xu_3} u_4\\ + &+ u_1(F_{xu} + F_{uu} u_1 + F_{uu_1} u_2 + F_{uu_2} u_3 + F_{uu3} u_4)\\ + &+ u_2(F_{xu_1} + F_{uu_1} u_1 + F_{u_1u_1} u_2 + F_{u_1u_2} + u_3 + F_{u_1u_3} u_4)\\ + &+ u_3(F_{xu_2} + F_{uu_2} u_1 + F_{u_1u_2} u_2 + F_{u_2u_2} u_3 + + F_{u_2u_3} u_4)\\ + &+ u_4(F_{xu_3} + F_{uu_3} u_1 + F_{u_1u_3} u_2 + F_{u_2u_3} u_3 + + F_{u_3u_3} u_4)\\ + &+ F_u u_2 + F_{u_1} u_3 + F_{u_2} u_4 + F_{u_3} u_5 \} = 0 +\end{array} +\end{equation} + +>From (\ref{2.14}) we see that the coefficient of $u_5$ vanishes +identically. The vanishing of the coefficients of $u_4,u_4^2$ lead to +\begin{eqnarray} +\label{2.15} + u_4^2 : F_{u_3u_3} = 0 +\end{eqnarray} +\begin{eqnarray} +\label{2.16} + u_4 : -F_{xu_3} - u_1 F_{uu_3} - u_2 F_{u_1u_3} - u_3 F_{u_2u_3} = u_4 +\end{eqnarray} + +The first equation leads to the fact that $F_3$ is a polynomial of +degree $\leq 1$ in $u_3$ while the second equation results in + +\begin{equation} +\label{2.17} + F = \alpha(t)u_3 + \bar F(x,t,u,u_1,u_2) + \end{equation} + +Substitution of (\ref{2.17}) into (\ref{2.14}) leads to a polynomial +of degree 2 in $u_3$, the coefficients of which have to vanish i.e. +\begin{eqnarray} +\label{2.18} + u_3^2 : \bar F_{u_2u_2} = 0 +\end{eqnarray} +\begin{eqnarray} +\label{2.19} + u_3 : \alpha'(t) + 6u_2\alpha(t) = 2 \bar F_{xu_2} + 2 \bar F{_uu_2} u_1 + + 2u_2 \bar F_{u_1u_2} +\end{eqnarray} +which results in + +\begin{equation} +\label{2.20} + \bar F(x,t,u,u_1,u_2) = 3\alpha u_1u_2 + (\frac{1}{2} \alpha'x + +\beta(t))u_2 + \tilde F(x,t,u,u_1) +\end{equation} +proceeding in this way we finally arrive at the fact that the solution +of (\ref{2.13}) is a linear combination of 10 vector fields whose +characteristics are given by + +\begin{equation} +\label{2.21a} + \begin{array}{rcl} + F_0 &=& 1\\ + F_1 &=& u_1\\ + F_2 &=& tu_1 + \frac{1}{2} x\\ + F_3 &=& u_2 + u_1^2\\ + F_4 &=& t(u_2 + u_1^2) + \frac{1}{2} xu_1 + \end{array} +\end{equation} +\begin{equation} +\label{2.21b} + \begin{array}{rcl} + F_5 &=& t^2(u_2 + u_1^2) + txu_1 + (\frac{1}{2} t + \frac{1}{4} x^2)\\ + F_6 &=& u_3 + 3u_1u_2 + u_1^3\\ + F_7 &=& tF_6 + \frac{1}{2} x F_3\\ + F_8 &=& t^2F_6 + txF_3 + (\frac{1}{2} t + \frac{1}{4} x^2)F_1\\ + F_9 &=& t^3F_6 + \frac{3}{2} t^2 xF_3 + (\frac{3}{2} t^2 + \frac{3}{4} + tx^2)F_1 + \frac{3}{4} tx + \frac{1}{8} x^3\\ + \end{array} +\end{equation} + and\\ +\begin{eqnarray*} + F_{10} &=& \rho (x,t)e^{-u} +\end{eqnarray*} +whereas in (\ref{2.21b}) $\rho(x,t)$ is an arbitrary solution of the +heat equation $\rho_t = \rho_{xx}$. + +The existence of a symmetry (\ref{2.21b}) reflects the fact that the +equation at hand (\ref{2.11}) is in 1-1 correspondence with the heat +equation. The general theorem concerning this was proved by Kumei \& +Bluman \cite{KB}.\\ +At the moment a number of computerprograms is available in +REDUCE,...,to handle the computations for symmetries p.e. \cite{K}.\\ +In order to introduce the Lie bracket of generalized vector fields we +first prove the following lemma. + +\begin{lemma} + If $V_F$ is an evolutionary vector field then + +\begin{equation} +\label{2.22} + [pr(V_F),D_i] = 0 +\end{equation} +interpreted as componentwise. +\end{lemma} + +\noindent{\bf Proof.} First of all $\frac{\partial}{\partial + u_j^\alpha} (D_iP) = \frac{\partial P}{\partial u_{J\backslash + i}^\alpha} + D_i(\frac{\partial}{\partial u_J^\alpha}P)$\\ +where $J\backslash i = (j_1,\ldots,j_{i-1},\ldots,j_p)$.\\ +This implies that + +\begin{equation} +\label{2.23} + pr(V_F)(D_iP) = (D^J F_\alpha)\cdot \frac{\partial}{\partial + u_J^\alpha}(D_iP) = (D^J F_\alpha)D_i(\frac{\partial}{\partial + u_J^\alpha}P) + D^J F_\alpha \cdot \frac{\partial P}{\partial + u^\alpha_{J\backslash i}} +\end{equation} +We know that + +\begin{equation} +\label{2.24} + D_i(pr(V_F)P) = D_i((D^J F_\alpha) \cdot \frac{\partial P}{\partial + u_J^\alpha}) = (D^J F\alpha)D_i(\frac{\partial + P}{\partial u_J^\alpha}) + (D_iD_JF_\alpha) \frac{\partial P}{\partial + u_J^\alpha}. +\end{equation} + +By changing summation index $J$ tot $J\backslash i$ we see that the +right hand sides in (\ref{2.23},\ref{2.24}) are equal, which proves +the Lemma.\\ +As a corollary to this lemma we have +\begin{equation} +\label{2.25} + pr(V_F)(D^JP) = D^J(pr(V_F)P) +\end{equation} + +\begin{th} +Let $V_Q,V_R$ be two evolutionary vector fields and $pr(V_Q)$, +$pr(V_R)$ their prolongations to $J(x,u)$ then the formal commutator is + +\begin{equation} +\label{2.26} + [pr(V_Q),pr(V_R)] = \tilde S +\end{equation} +where $\tilde S$ is the prolongation of an evolutionary vector field + +\begin{equation} +\label{2.27} + \tilde S = pr(V_S) +\end{equation} +and $S$ is defined by + +\begin{equation} +\label{2.28} + S_\alpha = pr(V_Q)(R_\alpha) - pr(V_R)(Q_\alpha) \qquad \alpha=1,\ldots,q +\end{equation} +\end{th} + +\noindent{\bf Proof.} The definition of $S$ in (\ref{2.28}) is just +the computation of the $\frac{\partial}{\partial u^\alpha}$ component in +(\ref{2.26}).\\ + +The component of $\partial_{u_J^\alpha}$ in $\tilde S$ (\ref{2.26}) is +obtained from + +\begin{displaymath} + \tilde S_{u_J^\alpha} = pr(V_Q)D^J(R_\alpha) - pr(V_R)D^JQ_\alpha +\end{displaymath} +and by Lemma 2.1 +\begin{displaymath} + \tilde S_{u_J^\alpha} = D^J\{pr(V_Q)R_\alpha - pr(V_R)Q_\alpha\} = +D^J S_\alpha +\end{displaymath} +stating that $\tilde S$ is just the prolongation of $V_S$ (cf.\ref{2.8}).\\ +>From theorem 6 and the symmetry condition (3.5,6), we now have the +following + +\begin{th} +the evolutionary generalized symmetries of a system of differential +equations +\begin{displaymath} + \Delta_J[u]=0 \qquad (j=1,\ldots,\ell +\end{displaymath} +constitute a Lie algebra by the Lie bracket (\ref{2.26}). +\end{th} + +\begin{ex} (Burgers' equations) +We compute some Lie brackets of evolutionary symmetries of example +3.4, (\ref{2.21a}),(\ref{2.21b}).\\ +Take +\begin{eqnarray*} + &Z_1=F_6=t(u_3+3u_1u_2+u^3_1) + \frac{1}{2} + x(u_2+u^2_1)\\ + &X_1=u_1\\ + &X_2=u_2+u^2_1\\ + &X_3=u_3+3u_1u_2+u^3_1 +\end{eqnarray*} +We now have the following result +\begin{eqnarray*} + \left[V_{Z_1},V_{X_1}\right] &=& \frac{1}{2}V_{X_2}\\ + \left[V_{Z_1},V_{X_2}\right] &=& V_{X_3}\\ + \left[V_{Z_1},V_{X_3}\right] &=& \frac{3}{2}V_{X_4} +\end{eqnarray*} +where $V_{X_4}$ is a fourth-order generalized symmetry and +\begin{displaymath} + X_4=u_4+3u^2_2+4u_1u_3+6u^2_1u_2+u^4_1 +\end{displaymath} +In effect the generalized symmetries of example 3.4 +(\ref{2.21a}),(\ref{2.21b}) constitute on {\em infinite dimensional +Lie algebra}. +\end{ex} + +\setcounter{equation}{0} +\section{Nonlocal symmetries.} + +Here we shall discuss special types of nonlocal symmetries as they +arise in certain special types of coverings. The notion of covering +has been introduced in \cite{KV} and \cite{KV2} (also called +Wahlquist-Estabrook prolongation) and has been discussed by +P. Gragert in his lecture \cite {G}.\\ +For simplicity we restrict to two independent variables +$(x,t)(p=2)$.\\ + +In the discussion of coverings or prolongation one starts at the +infinite prolongation $Y$ of a $k$-th-order system of partial +differential equations, i.e. the original system together with all of +its differential consequences, defined on the infinite jet bundle +$J((x,t),u)$ i.e. + +\begin{equation} +\label{3.1} + D^J(\Delta_j[u]) = 0 \qquad j=1,\ldots,\ell,|J|<\infty +\end{equation} + +An $s$-dimensional covering of (\ref{3.1}), with $(y_1,\ldots,y_s)$ as +local coordinates in the fibres, requires the existence of functions +\begin{displaymath} + X_r([u],y_1,\ldots,y_s),T_r([u],y_1,\ldots,y_s) \qquad r=1,\ldots,s +\end{displaymath} +such that the extended or generalized total partial derivative +operators + +\begin{eqnarray} +\label{3.2} + \tilde D_x & = & D_x + X_r \frac{\partial}{\partial_{y_r}}\nonumber\\ + & & \hspace{5cm} \mbox{(summation $r=1,\ldots,s$)}\\ + \tilde D_t & = & D_t + T_r \frac{\partial}{\partial_{y_r}}\nonumber +\end{eqnarray} +commute, i.e. + +\begin{equation} +\label{3.3} + [\tilde D_x,\tilde D_t] = 0 +\end{equation} +which yields besides (\ref{3.1}) the covering condition + +\begin{equation} +\label{3.4} + \tilde D_xT_r - \tilde D_tX_r = 0 \; \; \; \mbox{ on (\ref{3.1}) } +\end{equation} +i.e. + +\begin{equation} +\label{3.4a} + D_xT - D_tX + [X,T] = 0 +\end{equation} +where $X=(X_1,\ldots,X_s) T=(T_1,\ldots,T_s)$ and the bracket in +(\ref{3.4a}) is taken with respect to the fibre coordinates +$y=(y_1,\ldots,y_s)$.\\ + +As a special case we now consider coverings (\ref{3.2}),(\ref{3.4}) +where $X_r,T_r$ are independent of $y=(y_1,\dots,y_s)$; (\ref{3.4}) +then reduces to + +\begin{equation} +\label{3.5} + D_x(T_r) - D_t(X_r) = 0 \; \; \; \mbox{ on (\ref{3.1}) } (r=1,\ldots,s) +\end{equation} +i.e. $X_r,T_r$ determines a conservation law for (\ref{3.1}) +and $Y_r=D_x^{-1}(X_r)$, as formal integral.\\ + +Analogously to (\ref{2.6}) we now introduce a {\em nonlocal} vertical +(generalized) vector field + +\begin{equation} +\label{3.6} + V_F = F_\alpha([u],y_1,\ldots,y_s) \frac{\partial}{\partial u_\alpha} +\end{equation} +and its prolongation to the infinite jetbundle + +\begin{equation} +\label{3.7} + pr(V_F) = \tilde D^J(F_\alpha([u],y_1,\ldots,y_s)) +\frac{\partial}{\partial u_J^\alpha} +\end{equation} + +We now define the notion of nonlocal symmetry. + +\begin{df} + +A nonlocal vector field $V_F$ (\ref{3.6}) determines a nonlocal +symmetry of (\ref{3.1}) if and only if + +\begin{equation} +\label{3.8} + pr(V_F)(\Delta_j) = 0 \; \; \; \mbox{ on (\ref{3.1}) }, +j=1,\ldots,\ell +\end{equation} +where $pr(V_F)$ is defined by (\ref{3.7}).\\ + +{\bf Note:} The interested reader, comparing this definition with the +one given in Vinogradov \& Krasilshchik's work \cite{KV2}, might notice a +difference; in order to keep things simple and to outline the ideas we +just use this simplified definition.\\ + +We apply the notion of nonlocal symmetries to the construction of +nonlocal symmetries of the famous Korteweg-de Vries equation +(KdV-equation). +\end{df} + +\begin{ex} +We start at the infinite prolongation of the KdV-equation i.e., + +\begin{equation} +\label{3.9} + u_t = uu_1 + u_3 \qquad (u_1=u_x,u_3=u_{xxx}) +\end{equation} +and its differential consequences.\\ + +If we apply the technique of the preceding section and search for +generalized symmetries of (\ref{3.9}) with characteristic +$F=F(u,u_1,\ldots,u_5)$, we arrive at the existence of + +\begin{equation} +\label{3.10} + \begin{array}{rclrcl} + F_1 &=& u_1 &F_4 &=& 2u+xu_1+3t(uu_1+u_3)\nonumber\\ + F_2 &=& uu_1+u_3 &F_5 &=& 1+tu_1\\ + F_3 &=& \frac{5}{6} u_1u^2+\frac{10}{3}u_1u_2+\frac{5}{3}uu_3+u_5\nonumber + \end{array} +\end{equation} +being the characteristics of $5$ generalized symmetries $V_{F_i} \; +(i=1,\ldots,5)$.\\ +\end{ex} + +Note that (\ref{2.3}),(\ref{2.4}) + +\begin{equation} +\label{3.11} + \begin{array}{rcll} + V_{F_1} &\doteq& \frac{\partial}{\partial x} , \qquad V_{F_2} + \doteq \frac{\partial}{\partial t} &(x,t \mbox{-translation + )}\\ + V_{F_3} &\doteq& -x \frac{\partial}{\partial x} - 3t + \frac{\partial}{\partial t} + 2u \frac{\partial}{\partial u} + &(\mbox{scale transformation )}\\ + V_{F_4} &\doteq& t \frac{\partial}{\partial x} + + \frac{\partial}{\partial u} &(\mbox{Gallilean Boost)} +\end{array} +\end{equation} + +It is an easy observation that $X_1=u, \; \; T_1=\frac{1}{2}u^2+u_2$ +yield a conservation law for KdV-equation (\ref{3.9}) + +\begin{equation} +\label{3.12} + D_xT_1-D_tX_1=0 \qquad \mbox{on (\ref{3.9}) } +\end{equation} + +We introduce the {\em 1-dimensional covering} of (\ref{3.9}) with +$y=D_x^{-1}(u)$, and we are interested in the existence of a nonlocal +symmetry of (\ref{3.9}) i.e. solution of (\ref{3.8}) where + +\begin{equation} +\label{3.13} + H=H(x,t,u,\ldots,u_s,y) +\end{equation} +i.e. +\begin{equation} +\label{3.14} + \tilde D_tH - u_1H - u \tilde D_xH - \tilde D_x^3H = 0 +\end{equation} +\begin{eqnarray*} + \tilde D_x &=& D_x + u\frac{\partial}{\partial y}\\ + \tilde D_t &=& D_t + (\frac{1}{2}u^2+u_2)\frac{\partial}{\partial y} +\end{eqnarray*} + +Using an integration package the solution can be constructed in a +straightforward way, but since this would be very lengthy we proceed +in a more convenient way.\\ +First of all, note that KdV-equation is graded due to the scale +transformation (\ref{3.11}).\\ +i.e. +\begin{displaymath} + [u]=2 \; ; \; [x]=-1 \; ; \; [t]=-3 \; ; \; [D_x]=1 \; ; \; + [D_t]=3 +\end{displaymath} +which implies + +\begin{equation} +\label{3.15} + [F_1]=3 \; ; \; [F_2]=5 \; ; \; [F_3]=7 \; ; \; [F_4]=2 \; ; \; [F_5]=0. +\end{equation} + +We now search for a nonlocal symmetry whose characteristic is of +degree 4 and which is of polynomial degree 1 in $x,t,y$.\\ + +>From this we arrive at the Ansatz, based on the grading (\ref{3.15}) + +\begin{equation} +\label{3.16} + H=t(F_3) + \alpha xF_2 + \beta {\bf y}u_1 + \gamma u_2 + \delta u^2u_1 +\end{equation} +where $F_2,F_3$ are defined by (\ref{3.10}) and +$\alpha,\beta,\gamma,\delta$ constants to be determined. The symmetry +condition, due to the fact that $F_3,F_2$ satisfy (\ref{3.14}) +themselves, reduces to + +\begin{equation} +\label{3.17} + \begin{array}{ll} + &F_3 - \alpha uF_2 - 3\alpha D_x^2F_2 + \beta(\frac{1}{2}u^2+\beta + {\bf y}(u_1^2+uu_2+u_4)\\ + &+ \gamma(3u_1u_2+uu_3+u_5) + 2\delta u(uu_1+u_3)-u_1(\beta + {\bf y}u_1+\gamma u_2+\delta u^2)\\ + &-u(\beta uu_1+\beta {\bf y}u_2+\gamma u_3+2\delta uu_1)\\ + &-[4\beta u_1u_2+3\beta uu_3+\beta {\bf y}u_4+\gamma u_5+2\delta + uu_3+6\delta u_1u_2] = 0 + \end{array} +\end{equation} + +This condition leads to the following conditions for +$\alpha,\beta,\gamma,\delta$ + +\begin{equation} +\label{3.18} + \begin{array}{rcl} + u_5 &:& 1-3\alpha + \gamma-\gamma = 0\\ + uu_3 &:& + \frac{5}{3}-\alpha-3\alpha+\gamma+2\delta-\gamma-3\beta-2\delta=0\\ + u_1u_2 &:& + \frac{10}{3}-9\alpha+\beta+3\gamma-\gamma-4\beta-6\delta=0\\ + u^2u_1 &:& + \frac{5}{6}-\alpha+\frac{1}{2}\beta+2\delta-\delta-\beta-2\delta=0 + \end{array} +\end{equation} +or equivalently + +\begin{equation} +\label{3.19} + \begin{array}{l} + 1-3\alpha=0\\ + \frac{5}{3}-4\alpha-3\beta=0\\ + \frac{10}{3}-9\alpha-3\beta+2\gamma-6\delta=0\\ + \frac{5}{6}-\alpha-\frac{1}{2}\beta-\delta=0 + \end{array} +\end{equation} +solving (\ref{3.19}) we arrive at +\begin{displaymath} + \alpha=\frac{1}{3} \; ,\; \beta=\frac{1}{9} \; ,\; \gamma=\frac{4}{3} + \; ,\; \delta=\frac{4}{9} +\end{displaymath} +which leads to the characteristic ({\em nonlocal}) of a symmetry of +KdV-equation + +\begin{equation} +\label{3.20} + H=tF_3+\frac{1}{3}xF_2+\frac{1}{9}yu_1+\frac{4}{3}u_2+\frac{4}{9}u^2u_1 +\end{equation} + +\setcounter{equation}{0} +\section{Recursion Operators and Nonlocal Symmetries.} + +In this section we indicate the importance of nonlocal symmetries in +connection with the existence of recursion operators.\\ +For simplicity we restrict to the case of (\ref{3.9}) two independent and one +dependent variable, keeping the KdV-equation as principal example in +mind.\\ + +Let us take a deeper look at the (generalized) symmetry condition +(\ref{2.5}),(\ref{3.8}) i.e. + +\begin{equation} +\label{4.1} + pr(V)(\Delta)=0 \mbox{ on } Y. +\end{equation} + +If we use the prolongation formula (\ref{2.8}),(\ref{3.7}) it is a +straightforward procedure to see that the symmetry condition can be +rewritten as + +\begin{equation} +\label{4.2} + \sum(\frac{\partial\Delta}{\partial u_J}) D^J(F)=0 +\end{equation} +which is reflected in (\ref{2.13}),(\ref{3.14}).\\ +This observation urges us to introduce the socalled {\it linearization +operator} \cite{KV} + +\begin{equation} +\label{4.3} + \ell_\Delta = \sum(\frac{\partial\Delta}{\partial u_J}) D^J +\end{equation} +while (\ref{4.1}),(\ref{2.5}) can be written as + +\begin{equation} +\label{4.4} + \ell_\Delta F=0 +\end{equation} + +Suppose there exists a differential or integro- differential operator +$\cal R$, and associated to it some $\cal S$ such that the following relation +for operators, $\cal R,\cal S,$ hold + +\begin{equation} +\label{4.5} + \ell_\Delta {\cal R}={\cal S}\ell_\Delta +\end{equation} + +Now assume that $F_0$ is a characteristic of a generalized symmetry of +$\Delta$ i.e. + +\begin{equation} +\label{4.6}\ + \ell_\Delta F_0=0 +\end{equation} + +We then have + +\begin{equation} +\label{4.7} + \ell_\Delta({\cal R}F_0) = {\cal S}(\ell_\Delta F_0)=0 +\end{equation} +i.e. ${\cal R}(F_0)$ is a characteristic of a generalized symmetry.\\ + +More generally, if an {\bf operator $\cal R$ satisfying (\ref{4.5})} +for some $\cal S$ exists then starting from a {\bf characteristic +$F_0$} of a symmetry we obtain a {\bf infinite hierarchy} (if not +zero) of generalized symmetrics whose {\bf characteristics} are +defined by + +\begin{equation} +\label{4.8} + {\cal F}_n={\cal R}^n(F_0) \qquad n=0,\ldots +\end{equation} +Such an operator $\cal R$ is called a {\bf recursion operator} for +generalized symmetries + +\begin{ex} +The KdV-equation + +\begin{equation} +\label{4.9} + \Delta(u)=u_t-uu_1-u_3=0 +\end{equation} +admits a recursion operator for symmetries + +\begin{equation} +\label{4.10} + {\cal R}=D_x^2 + \frac{2}{3}u + \frac{1}{3}u_1D_x^{-1} +\end{equation} +where $D^{-1}_x$ has to be understood as a formal integral [1]. +It is a somewhat tedious calculation to show that + +\begin{equation} +\label{4.11} + \ell_\Delta {\cal R} = {\cal R}\ell_\Delta +\end{equation} +i.e. ${\cal S}={\cal R}$.\\ + +If we start with $F_1=u_1$ then + +\begin{equation} +\label{4.12} +\begin{array}{rcccccl} + F_2 &=& {\cal R}F_1 &=& {\cal R}u_1 &=& uu_1 + u_3\\ + F_3 &=& {\cal R}^2F_1 &=& {\cal R}F_2 &=& + \frac{5}{6}u_1u^2+\frac{10}{3}u_1u_2+\frac{5}{3}uu_3+u_5 +\end{array} +\end{equation} +and so on. +\end{ex} + +We are now in a position underlign the importance of the notion of +nonlocal symmetry.\\ +First of all, if we would apply the recursion formula (\ref{4.8}) +starting at $F_4$ or $F_5$ (in effect $F_4={\cal R}F_5$) then in order to +compute ${\cal R}F_4$ we would have to allow nonlocal variables $y$ to come +in.\\ +Moreover the nonlocal characteristic $H$ (\ref{3.20}) is just nothing +else but + +\begin{equation} +\label{4.13} + H=3{\cal R}F_4 +\end{equation} + +Secondly, if we compute the generalized Lie-Bracket for generalized +vector field (\ref{2.28}) and compute Lie-Brackets with the non local +vector field $V_H$ we arrive at + +\begin{equation} +\label{4.14} + \begin{array}{rcl} + \left[V_H,V_{F_1}\right] &=& c_1F_2\\ + \left[V_H,V_{F_2}\right] &=& c_2F_3 + \end{array} +\end{equation} +$c_1,c_2$ being some nonzero constants.\\ + +In effect the nonlocal generalized symmetry $V_H$ acts as {\bf +recursion symmetry}.\\ + +{\bf Final Remarks.}\\ +In this lecture I have tried to give you an introduction to and an +impression of the beautiful world of symmetries of differential +equations, where a lot of research is needed to explore the beautiful +structures in this field of applied mathematics.\\ + +For the interested reader I would recommend the book of Bluman-Kumei +\cite{KB} as a starting point, the book by Olver as a rigorous and +deep discussion of all the mathematics involved, and the work of my +Russian friends Vinagradov, Krasil'shchik for the beautiful and rich +geometrical structures underlying all the notions. + +\begin{thebibliography}{999} +\bibitem{O} Olver P.J.A., Applications of Lie Groups to Differential +Equations Graduatem Texts in Mathematics 107. Springer Verlag, New +York-Berlin-Heidelberg (1986). +\bibitem{V} Vinagradov A.M., Local symmetries and conversation laws. +Acta Applicandae Mathematicae Vol 3 (1984), pp. 21-78. +\bibitem{KV} Krasil'shchik I.S. \& Vinagradov A.M., Nonlocal +symmetries and the theory of coverings. Acta Applicandae Mathematicae +Vol 3 (1984), pp. 79-96. +\bibitem{KV2} Krasil'shchik I.S. \& Vinagradov A.M., Nonlocal Trends +in the Geometry of Differential Equations: Symmetries, Conservation +Laws, and B\"{a}cklund Transformations Acta Applicandae Mathematicae +Vol 15 (1989), pp. 161-209. +\bibitem{K} Kersten P.H.M., Infinitesimal Symmetries: a Computational +Approach C.W.I. Tract 34. Centre for Mathematics and Computer Science, +Amsterdam (1987). +\bibitem{G} Gragert P.K.H., Prolongation algebras of nonlinear PDE, +These Notes. +\bibitem{KB} Kumei S. \& Bluman G., Symmetries and Differential +Equations. Applied Mathematical Sciences 81. Springer Verlag, New +York-Berlin-Heidelberg (1989). +\end{thebibliography} + +\end{document} diff --git a/web/reduce/rweb/appl/tools.web b/web/reduce/rweb/appl/tools.web new file mode 100644 index 0000000000..8429c276c1 --- /dev/null +++ b/web/reduce/rweb/appl/tools.web @@ -0,0 +1,1032 @@ +% Copyright (c) 1991 Marcel Roelofs, University of Twente, Enschede, +% The Netherlands. +% +% $Header: tools.web,v 1.4 92/02/06 17:32:32 roelofs Exp $ +% +\input specification +\def\Version$#1Revision: #2 ${Version #2} +\def\title{TOOLS} +\font\titlefont=cmcsc10 scaled\magstep3 +\font\ttitlefont=cmtt10 scaled\magstep4 +\def\topofcontents{\null\vfill +\centerline{\titlefont The {\ttitlefont TOOLS} package for REDUCE} +\vskip15pt\centerline{\Version$Revision: 1.4 $} +\vskip15pt\centerline{\sc Marcel Roelofs}\vfill} + +@* Introduction. In this \.{RWEB} file we will describe some tools +which facilitate working with algebraic operators and can be seen as +rather general extensions to REDUCE. At the moment these tools +are:\medskip + +\item{1.}Procedures to find one or all kernels of some specified +algebraic operators in a standard form. + +\item{2.}The procedure |operator_coeff|, which is the analogue of the +standard REDUCE procedure |coeff| for kernels of operators. The +procedure |operator_coeff| is intended for expressions which are +linear with respect to kernels of some specified algebraic operators +and returns a list of these kernels, together with their coefficients. +Related to this procedure is the procedure |independent_part| which +extracts the part of an expression, not being a polynomial expression +in kernels of some operators. + +\item{3.} The procedure |multi_coeff|, for finding the coefficients of +the basis elements of a polynomial ring in an arbitrary number of +variables. + +\item{4.} The procedure |simp_multilinear| to simplify a multilinear +operator. + +\item{5.}The procedure |linear_solve| to solve linear expressions +with respect to some specified kernel. + +\item{6.}The procedure |solvable_kernels| which analyses if an +algebraic expression is linear with respect to kernels of some +specified operators and returns all those kernels for which the +coefficients do not depend on other operators. \medskip + +The ``banner line'' defined here is intended for indentification +purposes on loading. It should be changed whenever this file is +modified. System dependent changes, however, should be made in a +separate change file. + +@d banner="Algebraic operator tools for REDUCE 3.4, $Revision: 1.4 $" + +@ We define the following macros for clarity. The reading of the file +is done in symbolic mode. +@d change_to_symbolic_mode =symbolic@; +@d change_to_algebraic_mode =algebraic@; +@d stop_with_error(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,t) @; +@d message(string_1,expr_1,string_2,expr_2) = @/ + msgpri(string_1,expr_1,string_2,expr_2,nil) @; + +@u change_to_symbolic_mode$@/ +write banner$ terpri()$@/ +change_to_algebraic_mode$ + +@ The following macros are intended as common programming idioms. +@d incr(x) = (x:=x+1)@; +@d decr(x) = (x:=x-1)@; + +@* Finding kernels of operators in standard forms. If one wants +perform a lot of automated computations on algebraic expressions +containing algebraic operators, it is very convenient to have a +procedure that extracts one or more kernels of some specified +operator(s) from these algebraic expressions automatically. For this +purpose we will write the procedures |get_first_kernel|, +|get_all_kernels| and |get_recursive_kernels| which extract one or all +kernels from standard forms. We have chosen to let the procedures act +on standard forms, because algebraic expressions are recursively built +up out of standard forms. Therefore, in doing so, the searching can +be done in an easy to understand recursive manner. + +A kernel of an operator looks like |a(1,2)| or |a()|, in general an +algebraic operator together with its arguments. In lisp mode these +kernels look like lists, the |car| of which is an algebraic +operator, the |cdr| being its arguments. + + +@ \specs |@!get_first_kernel|, |@!get_all_kernels| and |@!get_recursive_kernels|. +\descr Syntax: \descno 1.|get_first_kernel(form,oplist)|,\nl + \descno 2.|get_all_kernels(form,oplist)|,\nl + \descno 3.|get_recursive_kernels(form,oplist)|. +\descr Arguments: + \arg |form|: standard form. + \arg |oplist|: identifier or (algebraic or lisp) list of identifiers, + which should be algebraic operator(s). +\descr Result: \descno 1. + the first kernel of operator(s) on + |oplist| occuring in |form| at top level, + i.e.\ not occuring as argument of another + operator.\nl + \descno 2.a (lisp) list of all kernels of + operator(s) on |oplist| occuring in |form| at + top level.\nl + \descno 3.a (lisp) list of all kernels of + operator(s) on |oplist| ocurring in + |form| at any level. + +@ The actual work of the procedures described above is done by +recursive procedures one level below, which examines the main variable +for the desired kernels and recursively examines the leading +coefficient and the reductum (which are also standard forms). These +recursive procedures have three arguments, the standard form involved, +the list of operators and a list of kernels found so far +(initially |nil|). + +The following macro definition makes sure that the second argument +becomes a lisp list of identifiers. +@d make_oplist(op_list)=@/if null op_list then op_list else if atom +op_list then list op_list else if +car op_list='list then cdr op_list else op_list @; + +@ The first procedure we want to discuss is +|get_first_kernel(form,oplist)|. It returns the first occurence of a +kernel of the specified operators occuring at top level. We can stop +examining the standard form if we encounter a domain element. + +@u lisp procedure get_first_kernel(form,oplist); +gfk(form,make_oplist(oplist),nil)$@# + +lisp procedure gfk(form,oplist,l); + if l or domainp form then l + else gfk(red form,oplist, + gfk(lc form,oplist, + if not atom x and member(car x,oplist) + then x @+else l)) + where x=mvar form$ + +@ The procedure |get_all_kernels(form,oplist)| returns a list of all kernels +of the specified operators occuring in |form| at top level. In |gak| +we use |aconc| instead of |cons| to add new kernels to |l|. We do +this because most times we want to actually use the list obtained to +reorder the standard form and in this way the reordering can be minimized. + +@u +lisp procedure get_all_kernels(form,oplist); +gak(form,make_oplist(oplist),nil)$@# + +lisp procedure gak(form,oplist,l); + if domainp form + then l + else gak(red form,oplist, + gak(lc form,oplist, + if not atom x and member(car x,oplist) and not member(x,l) + then l:=aconc(l,x) @+else l))@| + where x=mvar form$ + +@ The procedure |get_recursive_kernels(form,oplist)| returns a list of all +kernels of the specified operators occuring at any level in |form| +(i.e. as main variables, arguments, arguments of arguments, etc). + +@u +lisp procedure get_recursive_kernels(form,oplist); +grk(form,make_oplist(oplist),nil)$@# + +lisp procedure grk(form,oplist,l); + if domainp form + then l @+else grk(red form,oplist, + grk(lc form,oplist,@| + @<Add all kernels occuring in |x| at any level@>)) + where x=mvar form$ + +@ We don't want to use the list obtained by |grk| +for reordering, so here new operator elements are simply added to |l| by +|cons|. +@<Add all kernels...@>= + if not atom x + then begin scalar y; + for each arg in cdr x do + if (y:=simp arg) neq 0 then + l:=grk(numr y,oplist,l); + return if member(car x,oplist) and not member(x,l) + then x . l @+else l end + else l@; + +@* Finding coefficients of operator expressions. In REDUCE there is +an easy way to get all coefficients of an algebraic expression +regarded as polynomial expression w.r.t.\ some kernel, namely the +procedure |coeff|. However, there is no mechanism available to get +all coefficients of an algebraic expression regarded as a linear +expression w.r.t.\ kernels of some specified operators, whereas such a +mechanism is very often needed if one wants to do automated +computations on expressions containing algebraic operators. + +Therefore, in this section we will write the analogue of the procedure +|coeff| for kernels of some specified operators, the procedure +|operator_coeff|. + +@ +\spec |@!operator_coeff|. + \descr Syntax:|operator_coeff(exprn,oplist)|. + \descr Arguments: + \arg |exprn|: algebraic expression. + \arg |oplist|: identifier or (algebraic or lisp) list of identifiers, + which should be algebraic operator(s). + \descr Result: returns an algebraic list, the first element of which + is the part of |exprn| being independent of + operator(s) on |oplist|, followed by zero or more + algebraic lists consisting of kernels of operators on + |oplist| and their coefficients in |exprn|. Here we + regard |exprn| to be a linear expression with respect + to all kernels of operator(s) on |oplist|. Before + the analysis, |exprn| is simplified. + \descr Errors: stops with an error message if |exprn| is not linear with + respect to all kernels of operator(s) on |oplist|. + \descr Examples: the call |operator_coeff(2*x(1)+3*y(2)+5*z(3),{x,y})| returns + the list \30|{5*z(3),{x(1),2},@/{y(2),3}}|, whereas + |operator_coeff(x(1)*x(2),x)| stops with an error message. + +@ Keeping in mind the procedure |get_all_kernels| we have written +above, it is not difficult to think of how the procedure +|operator_coeff| could act: first get a list of all desired kernels +with help of |get_all_kernels| and reorder the numerator of |exprn| +w.r.t.\ this list. Once one has done so, one is sure that, in case of +linearity, all desired kernels occur as a main variable in a reduced +part of the numerator and it's a piece of cake to check the linearity +and to construct the desired list. In fact this is the way the first +version of |operator_coeff| worked. +Unfortunately it is not the most efficient way to obtain the +desired result, since the numerator of |exprn| is scanned twice, +namely in the procedures |get_all_kernels| and |reorder|. + +In the current version we will scan the expression $E$ only +once and at the same time construct a list $L$, which contains the +part of $E$ independent of operators on |oplist| together with all +kernels of operators on |oplist| and their coefficients and which is +almost ready for returning. + +As in the first version scanning is performed on standard forms. The +actual version is based on the following fact: a standard form consist +of a number of standard terms $T_i$, each of which is the product of a +leading power $P_i$ and its coefficient $C_i$ which again is a +standard form. In the sequel we will assume that the switch |exp| is +|on|; this a legal assumption because otherwise |coeff|'ing and also +|operator_coeff|'ing would become rather useless. We can now find all +the kernels of operators on |oplist| and their coefficients in a +standard term $T_i$ if we distinguish between the following +situations:\medskip + +\item{1.} $T_i$ is |nil|. We have to take no action. +\item{2.} $T_i$ is a domain element. In particular it is not a kernel +of one of the operators on |oplist|, hence we can add up $T_i$ to the +independent part of $L$. + +\item{3.} The main variable of $P_i$ is a kernel of one of the +operators on |oplist| (the fact that |exp| is |on| assures us that +the main variable is a kernel). If the leading degree is 1 and $C_i$ +does not contain kernels of operators on |oplist|, we can update $L$, +otherwise we have to stop with an error message because the expression +is not linear w.r.t. the operators on |oplist|. + +\item{4.} The main variable of $P_i$ is not a kernel of one of the +operators on |oplist|. We can recursively examine $C_i$ for the +occurence of appropriate kernels, if we keep in mind that the +coefficients of kernels found there have to be multiplied with the +additional factor $P_i$. \medskip + +@ The actions described above are implemented in the procedure +|split_f|, which examines the leading term and recursively the +reductum. The third argument |fact| is the standard form +representing the product of all previous factors, by which the +coefficients of kernels found in |form| have to be multiplied. Hence at +top level it has to be initialized to 1. |kc_list| is a +dotted pair the |car| of which is the part of the expression +independent of operators on |oplist|, the |cdr| an association list of +kernels and (standard form) coefficients. At top level it has to be +initialized to |nil . nil|. + +@u +lisp procedure split_f(form,oplist,fact,kc_list); +if null form then kc_list +else if domainp form then + addf(multf(fact,form), + car kc_list) . cdr kc_list +else if not atom mvar form and member(car mvar form,oplist) then +if not ldeg form = 1 or get_first_kernel(lc form,oplist) then +stop_with_error("SPLIT_F: expression not linear w.r.t.", + 'list . oplist,nil,nil) +else split_f(red form,oplist,fact, + update_kc_list(kc_list,mvar form,multf(fact,lc form))) +else split_f(red form,oplist,fact, + split_f(lc form,oplist, + multf(fact,!*p2f lpow form),kc_list))$ + +@ For convenience we will write a surrounding procedure +|split_form|, which can be called at top level and initializes the +third and fourth argument of |split_f| + +@u +lisp procedure split_form(form,oplist); +split_f(form,oplist,1,nil . nil)$ + +@ For updating the |kc_list| as efficient as possible we +need an |assoc|-like procedure |list_assoc|. If applied to an +association list $L$, this procedure returns the remainder of $L$, the +|car| of which would be the result of |assoc| applied to $L$. + +@u lisp procedure list_assoc(car_exprn,a_list); +if null a_list then a_list else if caar a_list= car_exprn then a_list +else list_assoc(car_exprn,cdr a_list)$ + +@ In order to update the |kc_list| we first have to find out +if the kernel w.r.t.\ which we update the list, is already occuring on +it. If so, we have to adjust its coefficient, otherwise we can |cons| +the kernel and coefficient in front of the list. Adjusting a +coefficient is performed by using the procedures |list_assoc| and +|rplaca| in order to avoid rebuilding of the entire list. The reader +should verify that |rplaca| does not do any harm in this application, +since it is replacing a list. + +@u lisp procedure update_kc_list(kc_list,kernel,coefficient); +(if rest_list then @+<<rplaca(rest_list,caar rest_list . addf(cdar +rest_list,coefficient)); kc_list>> else +car kc_list . (kernel . coefficient) . cdr kc_list) +where rest_list=list_assoc(kernel,cdr kc_list)$ + +@ The procedure |operator_coeff| should be available in algebraic mode. +We will, however, not make it an ordinary lisp operator, since this +leads to unnecessary simplifications of the arguments and the result +of |operator_coeff| (this is done in the standard REDUCE procedure +|reval1|). Instead we will give |operator_coeff| the property |psopfn| +with value |operator_coeff_1|. By this declaration the arguments of +|operator_coeff| are passed to the procedure |operator_coeff_1| as one +unevaluated list and the result is returned without further +simplification. + +The procedure |operator_coeff_1| only checks for the right number of +arguments, and passes them as genuine arguments to the lisp procedure +|operator_coeff|. This means that we have access to |operator_coeff| +in both algebraic and symbolic mode with the same appearance. In +algebraic mode, however, the lisp procedure |operator_coeff| is not +directly accessible (since it is not an lisp operator) but only via +the construction described above. In symbolic mode |operator_coeff| is +called directly. + +@u +put('operator_coeff,'psopfn,'operator_coeff_1)$ +@# +lisp procedure operator_coeff_1 u; +if length u neq 2 then rederr("OPERATOR_COEFF: wrong number of arguments") +else operator_coeff(car u,reval cadr u)$ + +@ The real work is done by the procedure |operator_coeff|, which +is quite simple: simplify the expression |exprn|, get its numerator, +and finally apply |split_form| to it. After that we have to divide all +coefficients by the denominator of |exprn| and convert the list +returned by |split_form| into a list of algebraic lists. + +To simplify |exprn| we use |simp!*| instead of |simp| because |exprn| +may sometimes be an expression which hasn't been simplified before +(like an argument of some other simplification procedure), so we want +a full simplification of |exprn| including a call of |subs2|, which is +done by |simp!*|. + +In order to admit the second argument of |operator_coeff| to be a +single operator as well as a list of operators we use the macro +|make_oplist| described above. + +@u +lisp procedure operator_coeff(exprn,oplist); +begin scalar numr_ex,denr_ex,kc_list; + oplist:=make_oplist(oplist); + exprn:=simp!* exprn;numr_ex:=numr exprn;denr_ex:=denr exprn; + kc_list:=split_form(numr_ex,oplist); + return 'list . !*ff2a(car kc_list,denr_ex) . + for each kc_pair in cdr kc_list collect@| + list('list,car kc_pair,!*ff2a(cdr kc_pair,denr_ex)); +end$ + +@ Sometimes we are only interested in the part of an expression +independent of some operators instead of in the whole kernel +coefficient list. Of course one can apply |operator_coeff| to the +expression and get the independent part of it, but in time critical +applications it is better to have a procedure |dump_operators| that +only performs the essential actions of the procedure |split_f|, +together with surrounding procedures |independent_part| and +|independent_part_1|. + +The basic ideas to get the independent part of an expression during +the scan of a standard form are exactly those underlying the procedure +|split_f|, except that updating the kernel coefficient list is +replaced by doing nothing. Notice that we have skipped the checks for +linearity, hence |independent_part| is even more general than +|operator_coeff| in the sense that we can also get the independent +part of an expression which is not linear w.r.t.\ all kernels of the +specified operator(s). + +However, we can get rid of the last argument |kc_list| of |split_f|, +since we can simply add up all independent parts using |addf|. + +@u +lisp procedure dump_operators(form,oplist,fact); +if null form then nil +else if domainp form then multf(fact,form) +else if not atom mvar form and member(car mvar form,oplist) then @| + dump_operators(red form,oplist,fact) +else + addf(dump_operators(red form,oplist,fact),@| + dump_operators(lc form,oplist,multf(fact,!*p2f lpow form)))$ + +@ We copy the surrounding procedures without further comment. +@u +put('independent_part,'psopfn,'independent_part_1)$ +@# +lisp procedure independent_part_1 u; +if length u neq 2 then rederr("INDEPENDENT_PART: wrong number of arguments") +else independent_part(car u,reval cadr u)$ +@# +lisp procedure independent_part(exprn,oplist); +begin scalar numr_ex,denr_ex; + oplist:=make_oplist(oplist); + exprn:=simp!* exprn;@/numr_ex:=numr exprn;denr_ex:=denr exprn; + return !*ff2a(dump_operators(numr_ex,oplist,1),denr_ex); +end$ + +@ The successful implementation of |operator_coeff| inspires us to +also introduce a more general version of |coeff|, namely a procedure +for finding the coefficients of basis elements of polynomial rings in +an arbitrary number of variables. Given a list |kernel_list| of +generators of such a ring, we can find all all basis elements and +their coefficients together with the independent part of a standard +form $F$ by analysing each standard term $T_i$ in $F$ in the following +way, where $P_i$ and $C_i$ have the same meaning as in the +introduction to the procedure |split_f|:\medskip + +\item{1.} $T_i$ is |nil|. We have to take no action. + +\item{2.} $T_i$ is a domain element. In particular does not contain a +kernel of one of the generators on |kernel_list|, hence we can add up +$T_i$ to the independent part of $L$. + +\item{3.} The main variable of $P_i$ is a kernel occuring in +|kernel_list| (again the fact that |exp| is |on| assures us that the +main variable is a kernel). Hence $T_i$ will give rise to at least one +basis element. At the time being we cannot, however, be sure about the +final form of the basis element, since $C_i$ may contain additional +factors. Therefore we will add $P_i$ to the variable |multi_power| +which is the list of powers found so far. Here we explicitly use the +fact that the ordering of standard forms assures us that the powers of +basis elements found twice in $F$ will be stored on |multi_power| in +exactly the same order. + +\item{4.} The main variable of $P_i$ is not a kernel occuring in +|kernel_list|. We can recursively examine $C_i$ for the occurence of +appropriate kernels, if we keep in mind that the coefficients of +kernels found there have to be multiplied with the additional factor +$P_i$. \medskip + +The analysis described above is implement in the procedure +|multi_split_f|. + +@d update_pc_list=update_kc_list +@u +lisp procedure multi_split_f(form,kernel_list,multi_power,fact,pc_list); +if null form then pc_list +else if domainp form then + if multi_power then update_pc_list(pc_list,multi_power,multf(fact,form)) + else addf(multf(fact,form),car pc_list) . cdr pc_list +else multi_split_f(red form,kernel_list,multi_power,fact, + if member(mvar form,kernel_list) then @| + multi_split_f(lc form,kernel_list,lpow form . multi_power,fact,pc_list) + else multi_split_f(lc form,kernel_list,multi_power, + multf(fact,!*p2f lpow form),pc_list))$ + + +@ As usual |multi_power|, |fact| and |pc_list| have to initialized to +1 and |nil . nil|, respectively, at top level. Again we have a +surrounding procedure |multi_split_form| to take care of this. + +@u +lisp procedure multi_split_form(form,kernel_list); +multi_split_f(form,kernel_list,nil,1,nil . nil)$ + +@ At algebraic level we want to have a procedure +|multi_coeff(exprn,kernel_list)| to our disposal, with |exprn| the +multivariate expression to be analysed and |kernel_list| the list +generators of the polynomial ring. The result of |multi_coeff| is a +list, the first part of which is the independent part, followed by +zero or more pairs of basis elements with their coefficients. Notice +that unlike |coeff| returns its result in a sparse way. + +In order to avoid unnecessary simplification we will again use the +|psopfn| mechanism to make |multi_coeff| available in algebraic mode. + +@u +put('multi_coeff,'psopfn,'multi_coeff_1)$ +@# +lisp procedure multi_coeff_1 u; +if length u neq 2 then rederr("MULTI_COEFF: wrong number of arguments") +else multi_coeff(car u,reval cadr u)$ + +@ There is no use of analysing the numerator of |exprn| if it is +not polynomial in the variables in |kernel_list|. Therefore we have to +check that the denominator of |exprn| does not depend on any of the +variables in |kernel_list|, before applying |multi_split_form| to the +numerator of |exprn|. + +@u lisp procedure multi_coeff(exprn,kernel_list); +begin scalar numr_ex,denr_ex,pc_list; + kernel_list:=make_oplist(kernel_list); + exprn:=simp!* exprn;@/ + numr_ex:=numr exprn;denr_ex:=denr exprn; + for each generator in kernel_list do if depends(denr_ex,generator) + then stop_with_error(@|"MULTI_COEFF: expression is not polynomial w.r.t. ", + 'list . kernel_list,nil,nil); + pc_list:=multi_split_form(numr_ex,kernel_list); + return 'list . !*ff2a(car pc_list,denr_ex) . + for each pc_pair in cdr pc_list collect@| + list('list,convert_multi_power car pc_pair,!*ff2a(cdr pc_pair,denr_ex)); +end$ + +@ A |multi_power| returned by |multi_split_f| is a list of standard +powers, i.e. dotted pairs, the |car| of which are leading variables, the +|cdr| leading degrees. For use in algebraic expression we have to +convert it to the proper product of powers. Of course if the leading +degree is 1, we can omit it from the result. + +@u +lisp procedure convert_multi_power multi_power; +'times . for each power in multi_power collect +if cdr power=1 then car power else list('expt,car power,cdr power)$ + +@* Simplifying multilinear operators. In REDUCE there is a rather +elementary construct for dealing with operators that are linear in one +argument. Using the procedures written above it is not very hard to +deal with multilinear operators, if we take the notion of linearity as +introduced above. Therefore we will introduce multilinear operators +as a new type of operators in REDUCE by implementing a new +simplification procedure |simp_multilinear| for multilinear operators +and at the same time implement a |multilinear| statement to set up an +environment for multilinear operators. + +Before we continue, let us give a more detailed description of what we +understand by multilinearity exactly. If $P$ is multilinear operator +w.r.t.\ operators $P_1,\dots,P_n$ and the result of |operator_coeff| +applied to an expression $a_k$ w.r.t.\ the operators $P_1,\dots,P_n$ +is $$ a_k=f_{k,0}+\sum_{i_k=1}^{N_k} f_{k,i_k}p_{k,i_k}= +\sum_{i_k=0}^{N_k} f_{k,i_k}p_{k,i_k}\qquad\hbox{with $p_{k,0}=1$}$$ +where $f_{k,0}$ is the part of $a_k$ independent of one of the +operators $P_1,\dots,P_n$ and $p_{k,i_k}$ are operator elements of one +of the operators $P_1,\dots,P_n$, then $P(a_1,\dots,a_m)$ must be +simplified to +$$P(a_1,\dots,a_m)=\sum_{i_1=0}^{N_1}\cdots\sum_{i_m=0}^{N_m} +f_{1,i_1}\cdots f_{m,i_m} P(p_{1,i_1},\dots,p_{m,i_m})$$ To give an +example, suppose that \\{wedge} is an operator representing the +exterior multiplication of differential geometry and suppose that we +have declared \\{wedge} to be multilinear w.r.t.\ to \\{wedge} and $d$, +then $\\{wedge}(x+f(1)+d(1),wedge(d(1),d(2)))$ will be simplified to +$(x+f(1))*\\{wedge}(1,wedge(d(1),d(2)))+\\{wedge}(d(1),\\{wedge}(d(1),d(2)))$ +where the components have to be simplified separately to take account +for any other properties of exterior multiplication. + +@ The first step of simplifying a multilinear operator is splitting up +its arguments. We can do this by applying |split_form| to the +numerators of all arguments and at the same time keep track of the +product of the denominators of all arguments, since the final result +of the simplification has to be divided by this product. + +The actions necessary for splitting the arguments and keeping track of +the denominators are implemented in the procedure |split_arguments|. +The result (and third argument) |splitted_list| of |split_arguments| +is a dotted pair, the |car| of which is the product of all +denominators as a standard form, the |cdr| being the list of results +of |split_form| applied to the numerator of all arguments in reverse +order. |split_arguments| applied to a list of arguments |arg_list|, +processes the first argument by updating the product of denominators +and |cons|'ing the result of |split_form| applied to the numerator of it +in front of the list of splitted arguments, and recursively splits the +rest of the arguments. Hence at top level |splitted_list| has to be +initialized to |1 . nil|. + +The procedure |split_arguments| is normally called from within a +simplification procedure. This means that the arguments have not been +simplified before. Therefore we must enforce full simplication of +these arguments by applying |simp!*| to them before processing. + +@u +lisp procedure split_arguments(arg_list,oplist,splitted_list); +if null arg_list then splitted_list +else split_arguments(cdr arg_list,oplist, + multf(denr first_arg,car splitted_list) . @| + split_form(numr first_arg,oplist) . + cdr splitted_list) @|where first_arg=simp!* car arg_list$ + +@ For convenience we will write a surrounding procedure +|split_operator|, in order to hide the last two arguments of +|split_arguments|. Its only argument is an operator element, the +arguments of which are to be splitted. For its proper operation it +assumes that the multilinear operator under consideration has the +property |oplist|, which is the list of operators w.r.t.\ which the +operator is multilinear. + +@u lisp procedure split_operator u;@/ +split_arguments(cdr u,get(car u,'oplist),1 . nil)$ + +@ Once we have a list of splitted arguments we can build up the sum of +operator elements of all possible combinations of components of the +(splitted) arguments. Since the list of splitted arguments is stored +in reverse order, this can be done most conveniently by recursive +procedures. If we consider one (splitted) argument of the operator +under consideration as a list of components, and the whole argument +list of the operator as a stack of component lists, we can build up +the sum by applying two recursive procedures |process_arg_stack|, +|process_comp_list| to the argument stack and component list(s) +respectively. + +The procedure |process_arg_stack| and |process_comp_list| work as follows. +The procedure |process_arg_stack| applies the procedure +|process_comp_list| to the first component list of the argument stack +it has been offered. + +The procedure |process_comp_list| applies the procedure +|process_independent_part| to the independent part of the component +list and adds it to the result of applying |process_components| to the +other components. + +The procedure |process_components| takes the first component of the +component list it has been offered and |cons|'es the kernel part of +this component in front of the argument list of the elementary +operator element being built up and updates the factor with which this +elementary operator element has to be multiplied at the end by +multiplying it with the coefficient part of the component being +processed. Now, if the remaining part of the argument stack is +empty the argument list of the elementary operator element is ready +and we can simplify it, multiply it with the product of the +coefficients and add it to the result (in fact this is done in the +procedure |process_arg_stack|). Otherwise we must continue to build an +argument list of an elementary operator element by applying +|process_arg_stack| to the remaining part of the argument stack. +Finally |process_components| has to be applied on the remaining part of +the component list being processed. The procedure +|process_independent_part| takes the similar actions appropriate for +the independent part of a component list. + +Throughout the calls of all procedures explained above we need to +know what is the current argument list and the current factor being +built up. We therefore pass them to all procedures as the arguments +|arg_list| and |fact|, which is the factor being build up as a +standard form. Hence it is clear that the argument list and the factor +have to be initialized to |nil| and 1, respectively. + +@ We mentioned that the elementary operator elements have to be +simplified before they can be added. It would, however, be unwise +simply to apply |simp| since the operator under consideration will +have the procedure |simp_multilinear| as its simplification +function\dots, leading to an infinite loop. For ordinary cases +applying |simpiden| will be sufficient, but since we wish to take +account for use of multilinear operators in special packages, we will +add to each multilinear operator a property |resimp_fn|, which is the +simplification function to be applied to an elementary operator +element. + +With this knowledge we can implement the procedure |process_arg_stack| +right away. Note that |fact| has to be converted into a standard +quotient before multiplying the (simplified) operator kernel with it. +This is done with help of the procedure |!*f2q|. + +@u lisp procedure process_arg_stack(arg_stack,op_name,arg_list,fact); +if null arg_stack then multsq(!*f2q fact, + apply1(get(op_name,'resimp_fn),op_name . arg_list)) +else process_comp_list(car arg_stack,cdr arg_stack,op_name,arg_list,fact)$ + +@ The procedure |process_comp_list| consists of adding the results of +applying |process_independent_part| and |process_components| to the +current component list. + +@u +lisp procedure process_comp_list(comp_list,arg_stack,op_name,arg_list,fact); +addsq(process_independent_part(car comp_list,arg_stack,op_name,arg_list,fact), + process_components(cdr comp_list,arg_stack,op_name,arg_list,fact))$ + +@ Following our description of multilinearity, processing the +independent part of an argument boils down to multiplying |fact| +with it and adding the argument 1 to |arg_list|. If, however, the +independent part is |nil|, i.e.\ the operator element being built up +will contain a zero argument, thanks to multilinearity this operator +element will not contribute to the result and we can return |result| +immediately. + +@u lisp procedure process_independent_part(independent_part,arg_stack, + op_name,arg_list,fact); +if null independent_part then nil . 1 +else + process_arg_stack(arg_stack,op_name,1 . arg_list,@|multf(fact,independent_part))$ + + +@ The procedure |process_components| has to process the |comp_list| +until there are no more components of the argument being processed. + +@u lisp procedure process_components(comp_list,arg_stack,op_name,arg_list,fact); +if null comp_list then nil . 1 +else + addsq(process_components(cdr comp_list,arg_stack,op_name,arg_list,fact), + process_arg_stack(arg_stack,op_name,caar comp_list . arg_list, + multf(fact,cdar comp_list)))$ + +@ To hide the rather illogical arguments of |process_arg_stack| we will +write a surrounding procedure |build_sum| for it. Recall that +|arg_list| and |fact| have to be initialized to |nil| and 1, +respectively. + +@u lisp procedure build_sum(op_name,arg_stack);@/ +process_arg_stack(arg_stack,op_name,nil,1)$ + +@ With the procedures written above, the simplification function +|simp_multilinear| can be written at once. We recall that the result +of |split_arguments| is a dotted pair, the |car| of which is the +product of the denominators of all arguments, the |cdr| the list of +splitted arguments, a argument stack. + +For simplifying a multilinear operator it is clear that we need to +know the operator name, in other words the |car| of the argument +offered to |simp_multilinear| must be the operator name. To achieve +this we must flag the operator under consideration |full|. + +@u lisp procedure simp_multilinear u; +quotsq(build_sum(car u,cdr splitted_list),!*f2q car splitted_list) @| +where splitted_list=split_operator u$ + +@ The last step towards a successful introduction of multilinear +operators in REDUCE, is the implementation of a procedure +|multilinear| to set up the right environment for multilinear +operators. It is our purpose to give meaning to the declaration +$$\hbox{\\{multilinear} $P$(operator${}\mid{}$list of operators +[,resimplification function]);}$$ as to declare $P$ a multilinear +operator w.r.t.\ the operator(s) of the first argument and, if +present, with the second argument as it's |resimp_fn|, otherwise +|simpiden| if $P$ doesn't already possess a simpliciation or +resimplification function. + +@ If we give |multilinear| the property |stat| with value |rlis| in +order to allow for more multilinear declarations at a time, the +declaration \\{multilinear} $P_1(\dots),\dots,P_n(\dots)$ will lead to +the call $\\{multilinear} ((P_1\ \dots)\ {\dots}\allowbreak (P_n\ \dots))$. With +this knowledge the source of |multilinear| is rather straightforward. +Notice that since |stat=rlis| the procedure |multilinear| need not be +a lisp operator. + +@u +put('multilinear,'stat,'rlis)$@# + +lisp procedure multilinear u; +for each decl in u do +begin scalar op_name,resimp_fn; + if length decl neq 2 and length decl neq 3 then@| + stop_with_error(nil,decl,"invalid multilinear declaration",nil); + if not idp(op_name:=car decl) then + stop_with_error(nil,op_name,"invalid as operator",nil); + put(op_name,'oplist,make_oplist(cadr decl)); + if (length decl=3 and (resimp_fn:=caddr decl)) or + (resimp_fn:=get(op_name,'resimp_fn)) or@| + (resimp_fn:=get(op_name,'simpfn)) then put(op_name,'resimp_fn,resimp_fn) + else put(op_name,'resimp_fn,'simpiden); + put(op_name,'simpfn,'simp_multilinear); + flag(list(op_name),'full); +end$ + +@* Solving linear expressions. We prefer not to use the REDUCE +procedure |solve| for solving a kernel from an algebraic expression +which we demand to be linear w.r.t.\ that kernel, because |solve| +doesn't check for linearity and can give more than one solution in +case of non linearity. Therefore we will write two quite +straightforward procedures which do the job properly. + +@ \specs |@!linear_solve|, |@!linear_solve_and_assign|. + \descr Syntax: \descno 1. |linear_solve(exprn,kernel)|,\nl + \descno 2. |linear_solve_and_assign(exprn,kernel)|. + \descr Arguments: + \arg |exprn|: algebraic expression. + \arg |kernel|: kernel. + \descr Result: + \descno 1. solves |exprn| for |kernel| and returns the + solution, regarding |exprn| to be a linear equation w.r.t.\ + |kernel|. Before solving, |exprn| is simplified.\nl + \descno 2. as |linear_solve|, + but also sets |kernel| equal to this solution. + \descr Errors: stops with an error message if |kernel| is not a + kernel, or if |exprn| is not linear w.r.t.\ |kernel|. + +@ The procedure |linear_solve| should be available in algebraic mode. +We will use the same construction as for |operator_coeff| in order to +avoid unnecessary simplification. + +@u +put('linear_solve,'psopfn,'linear_solve_1)$ +@# +lisp procedure linear_solve_1 u; +if length u neq 2 then +rederr("LINEAR_SOLVE: wrong number of arguments") +else linear_solve(car u,cadr u)$ + +@ If we are given an expression |exprn| linear in some kernel +|kernel|, we should be aware that |exprn| may be multiplied by some +factors, which might give trouble when solving the equation. In order +to prevent this we will first determine the factor depending on +|kernel|. For this purpose we shall use the standard REDUCE procedure +|fctrf| which finds all factors in a standard form as a list +containing the first factor as a standard form and all other factors +as a standard quotient. If there are more factors depending on +|kernel|, the system is not linear and we can return with an error +message. + +@<If possible find the factor |form| of |exprn| that depends on |kernel|@>= +exprn:=fctrf numr simp!* exprn;@/ +exprn:=if domainp car exprn then cdr exprn @+else (car exprn . 1) . cdr exprn; +form:=for each factor in exprn join@+ + if depends(factor,kernel) then list factor; +if length form=1 then form:=numr car form else + stop_with_error("LINEAR_SOLVE: expression not linear with respect to", + kernel,nil,nil) + +@ The linearity of |form| can be checked rather easily: reorder form +w.r.t.\ |kernel|. After this, |form| is linear w.r.t.\ |kernel| if and +only if the main variable of |form| is |kernel|, the leading degree of +|form| is 1 and the leading coefficient and the reductum of |form| do +not depend on |kernel|. + +At this place it is convenient to explain how reordering of kernels is +performed in REDUCE. In algebraic mode the kernel ordering can be +affected by the command |korder|. This command puts all kernels +following it on the list |kord!*| (a fluid system variable) and forces +reevaluation of all algebraic expressions. The actual reordering is +done by the procedure |reorder| which reorders standard forms using +the list |kord!*|. + +If we declare |kord!*| to be local within all procedures where we want +to reorder standard forms, we don't have to worry about the kernel +ordering afterwards, because the values of fluid variables, which are +used locally within a procedure, are saved on a stack when entering +the procedure and restored after leaving it. + +The procedure |!*a2k| checks whether |kernel| is a kernel. + +@u +lisp procedure linear_solve(exprn,kernel); +begin scalar kord!*,form; + kernel:=!*a2k kernel; + @<If possible find the factor |form| of |exprn| that depends on |kernel|@>; + setkorder list kernel; + form:=reorder form; + if (mvar form=kernel) and (ldeg form =1) and + not depends(lc form,kernel) and not depends(red form,kernel) then + return !*ff2a(negf red form,lc form) + else stop_with_error("LINEAR_SOLVE: expression not linear with respect to", + kernel,nil,nil); +end$ + +@ |linear_solve_and_assign| can simply use the procedures |setk| and +|linear_solve|. It will also get the |psopfn| mechanism to make it +available in algebraic mode. + +@u +put('linear_solve_and_assign,'psopfn,'linear_solve_and_assign_1)$ +@# +lisp procedure linear_solve_and_assign_1 u; +if length u neq 2 then +rederr("LINEAR_SOLVE_AND_ASSIGN: wrong number of arguments") +else linear_solve_and_assign(car u,cadr u)$ +@# +lisp procedure linear_solve_and_assign(exprn,kernel); +setk(kernel,linear_solve(exprn,kernel))$ + +@* Restricted solving of linear expressions. In our programs we want +to do a lot of automated computations on algebraic expressions +containing algebraic operators. In particular we think it is +convenient to have, together with the procedures |linear_solve| and +|linear_solve_and_assign|, a procedure that searches an algebraic +expression for kernels of some specified operator with respect to +which the algebraic expression is linear, but with the coefficients of +these kernels not depending on some other operators. + +Let us give an example in which such a procedure can be used +fruitfully. Suppose we have an expression |a(3)*a(2)-a(1)| from which +we want to solve one the |a(i)|'s automatically. Taking the first +operator element at sight, we would get |a(3):=a(1)/a(2)|. This, +however, is undesirable, because |a(2)| may be equated to 0 during the +process, in which case we are in trouble. Therefore the solution +should be |a(1):=a(3)*a(2)|. + +But how can we discover that we must solve for |a(1)|? The answer to +this question is to use the procedure |solvable_kernels|, which +we will specify in a moment: the call +|solvable_kernels(a(3)*a(2)-a(1),a,a)| searches the expression +|a(3)*a(2)-a(1)| for kernels of operator |a| (second argument), but +only those which don't have coefficients containing kernels of +operator |a| (third argument). Hence this call returns the list +|{a(1)}| which is exactly the list of all kernels for which we may +solve without risc. + +@ \spec |@!solvable_kernels|. + \descr Syntax: |solvable_kernels(exprn,k_oplist,c_oplist)|. + \descr Arguments: + \arg |exprn|: algebraic expression. + \arg |k_oplist|: identifier or (algebraic or lisp) list of identifiers, + which should be algebraic operator(s). + \arg |c_oplist|: identifier or (algebraic or lisp) list of identifiers, + which should be algebraic operator(s). + \descr Result: returns an algebraic list of all kernels + |opkern| for wich all the following conditions are + satisfied:\nl + \descno 1. |exprn| contains the kernel |opkern| for + some operator on |k_oplist|\nl + \descno 2. |exprn| is linear w.r.t.\ |opkern|\nl + \descno 3. the coefficient of |opkern| in |exprn| is + not a polynomial expression in any kernel of + operator(s) on |c_oplist|.\nl + Before the analysis, |exprn| is simplified. + \descr Examples: the call + |solvable_kernels(a(1)*(b(1)+c(1))+a(2)*b(2),a,c)| + returns the list |{a(2)}|. + +@ For |solvable_kernels| we will use the same construction as +for |operator_coeff| to make it an lisp operator. + +@u +put('solvable_kernels,'psopfn,'solvable_kernels_1)$ +@# +lisp procedure solvable_kernels_1 u; +if length u neq 3 then +rederr("SOLVABLE_KERNELS: wrong number of arguments") +else solvable_kernels(car u,cadr u,caddr u)$ + +@ As for |operator_coeff| all the essential actions are taken while +scanning the numerator $E$ of |exprn|, which is a standard form. +Seeing $E$ as a sum $E=\sum T_i$ where $T_i=P_i\cdot C_i$, the product +of a leading power and a leading coefficient, again, we can +distinguish the following states for each term $T_i$: \medskip + +\item{1.} $T_i$ is domain element, hence in particular not a kernel of +one of the operators on |k_oplist| or |c_oplist|. We have to take no action. + +\item{2.} The main variable of $P_i$ is a kernel of one of the +operators on |k_oplist|. If the leading degree is one and $C_i$ does +not contain kernels of operators on |c_oplist|, this kernel is a +possible candidate for solving, otherwise it has to be marked as +unsolvable. + +\item{3.} The main variable of $P_i$ is a kernel of one of the +operators on |c_oplist|. We can now recursively examine the standard +form $C_i$ and mark all kernels of operators on |k_oplist| found there +as unsolvable. + +\item{4.} In all other cases we can recursively examine the standard +form $C_i$, ignoring the factor $P_i$. + +\noindent Note that also in case 2.\ we have to check the form $C_i$, +keeping in mind the conditions of case 3.: the main variable of $P_i$ +can be forbidden as well as allowed as a coefficient. + +@ Implementing the actions described above requires a function for +merging an new element into a list. It is rather straightforward. + +@u +lisp procedure list_merge(element,merge_list); +if member(element,merge_list) then merge_list else element . +merge_list$ + +@ The actions described above are implemented in the procedure +|mk_kernel_list|. The procedure examines the leading term and +recursively the reductum of the standard form. + +The fifth argument of the procedure, |kernel_list|, is a dotted pair, +the |car| of which is the list of all possible candidates for solving, +the |cdr| the list of unsolvable kernels and is returned at the end. +It is clear that, at top level, it has to be initialized to |nil . nil|. + +The fourth argument |forbidden| is a flag indicating if, at some +higher level, a kernel of an operator on |c_oplist| has been +encountered, hence that all kernels op operators on |k_oplist| found +have to be marked as unsolvable. At top level is has to be initialized +to |nil|. + +@u lisp procedure mk_kernel_list(form,k_oplist,c_oplist,forbidden,kernel_list); +if domainp form then kernel_list +else ( + if not atom kernel then + mk_kernel_list(red form,k_oplist,c_oplist,forbidden,@| + mk_kernel_list(lc form,k_oplist,c_oplist, + if member(car kernel,c_oplist) then t @+else forbidden, + if member(car kernel,k_oplist) then + if not forbidden and ldeg form=1 and + not get_first_kernel(lc form,c_oplist) then@| + list_merge(kernel,car kernel_list) . cdr kernel_list + else + car kernel_list . list_merge(kernel,cdr kernel_list) + else kernel_list)) + else mk_kernel_list(red form,k_oplist,c_oplist,forbidden,@| + mk_kernel_list(lc form,k_oplist,c_oplist,forbidden,kernel_list)) + ) where kernel=mvar form$ + +@ The procedure |solvable_kernels| is a piece of cake now: +simplify |exprn|, get its numerator, apply |mk_kernel_list| to it and +finally delete all unsolvable kernels from the list of possible +candidates for solving. The list obtained in this way is the list of +all solvable kernels in |exprn|. + +Again we use |simp!*| to simplify |exprn|, because |exprn| hasn't been +simplified before and we want a full simplification including a call +of |subs2|. + +@u +lisp procedure solvable_kernels(exprn,k_oplist,c_oplist); +begin scalar form,kernel_list,forbidden_kernels; + form:=numr simp!* exprn; + k_oplist:=make_oplist(k_oplist); + c_oplist:=make_oplist(c_oplist); + kernel_list:=mk_kernel_list(form,k_oplist,c_oplist,nil,nil . nil); + forbidden_kernels:=cdr kernel_list; + kernel_list:=car kernel_list; + for each kernel in forbidden_kernels do kernel_list:=delete(kernel,kernel_list); + return 'list . kernel_list; +end$ + +@ The end of a REDUCE input file must be marked with |end|. + +@u end; + +@* Index. This section contains the cross reference index of all +identifiers, together with the numbers of the modules in which they +are used. Underlined entries correspond to module numbers where the +identifier was declared. diff --git a/web/reduce/rweb/make b/web/reduce/rweb/make new file mode 100644 index 0000000000..b94655243d --- /dev/null +++ b/web/reduce/rweb/make @@ -0,0 +1,3 @@ +#!/bin/csh -f +/bin/make -f ../reduce/Makefile CPUTYPE=`cputype`\ + THETANGLE=rtangle THEWEAVE=rweave SPIDER=reduce.spider $* diff --git a/web/reduce/rweb/make3.3 b/web/reduce/rweb/make3.3 new file mode 100644 index 0000000000..11df067bf5 --- /dev/null +++ b/web/reduce/rweb/make3.3 @@ -0,0 +1,3 @@ +#!/bin/csh -f +/bin/make -f ../reduce/Makefile3.3 CPUTYPE=`cputype`\ + THETANGLE=rtangle.exe THEWEAVE=rweave3.3 SPIDER=reduce33.spider $* diff --git a/web/reduce/rweb/reduce.spider b/web/reduce/rweb/reduce.spider new file mode 100644 index 0000000000..a4304aaf65 --- /dev/null +++ b/web/reduce/rweb/reduce.spider @@ -0,0 +1,302 @@ +# Copyright (c) 1991: Marcel Roelofs and Peter Gragert +# University of Twente, Enschede, The Netherlands +# +# @(#) reduce.spider (91/03/11) + +language REDUCE extension red + +at_sign @ + +comment begin <"%"> end <"%"> + +default translation <*> mathness no + +line begin <"%line"> end <> + +token identifier category simp +token number category simp +token newline category newline translation <> +token pseudo_semi category terminator translation <"\\rx"> + +module definition stmt use module_scrap + +default translation <"\\ro"-*> mathness no + +token * category binop translation <"\\eo*"> +token / category binop translation <"\\eo/"> +token < category binop +token > category binop +token = category binop +token . category binop tangleto <space-"."-space> + +token .^ category binop translation <"\\ro{.\\^}"> tangleto <space-".^"-space> +token .* category binop translation <"\\ro{.*}"> tangleto <space-".*"-space> +token .+ category binop translation <"\\ro{.+}"> tangleto <space-".+"-space> +token ./ category binop translation <"\\ro{./}"> tangleto <space-"./"-space> +token ^ category binop translation <"\\eo\\^"> +token ** category binop translation <"\\eo\\^"> +token := category binop translation <"\\ro{:=}"> +token != category binop translation <"\\ro\\NEQ"> tangleto <space-"neq"-space> +token <> category binop translation <"\\ro\\NEQ"> tangleto <space-"neq"-space> +token <= category binop translation <"\\ro\\leq"> +token >= category binop translation <"\\ro\\geq"> + +default translation <*> mathness no + +token + category unorbinop +token - category unorbinop +token ' category quote tangleto <space-"'"> +token '( category listopen translation <"'("> tangleto <space-"'("> +token '[ category listopen translation <"'["> tangleto <space-"'["> +token ( category open +token ) category close +token [ category simpopen +token ] category close +token { category simpopen translation <"$\\{$"> +token } category close translation <"$\\}$"> +token , category comma translation <"\\comma"-opt-1> +token ; category terminator translation <";"-break_space> +token $ category terminator translation <"\\$"-break_space> +token : category colon +token << category progn_begin translation <"\\LL"> tangleto <space-"<<"> +token >> category end translation <"\\RR"> tangleto <">>"-space> + +ilk bool_like category simp +ilk goto_like category simp +ilk function_like category simp + +default translation <*-space> + +ilk begin_like category begin +ilk if_like category if +ilk then_like category then +ilk else_like category else +ilk for_like category for +ilk do_like category do +ilk step_like category step +ilk repeat_like category repeat +ilk until_like category until +ilk on_like category switch +ilk return_like category return +ilk modedef_like category mode +ilk procmode_like category procmode +ilk proc_like category proc +ilk where_like category where +ilk decl_like category decl +ilk clear_like category clear +ilk lambda_like category lambda +ilk end_like category end translation <*> + +ilk not_like category unop translation <"\\R"> +ilk neq_like category binop translation <"\\ro\\NEQ"> +ilk and_like category binop translation <"\\ro\\W"> +ilk or_like category binop translation <"\\ro\\V"> +ilk leq_like category binop translation <"\\ro\\leq"> +ilk geq_like category binop translation <"\\ro\\geq"> + +reserved not ilk not_like +reserved neq ilk neq_like +reserved and ilk and_like +reserved or ilk or_like +reserved leq ilk leq_like +reserved geq ilk geq_like + +reserved begin ilk begin_like +reserved end ilk end_like + +reserved if ilk if_like +reserved then ilk then_like +reserved else ilk else_like + +reserved for ilk for_like +reserved each ilk for_like +reserved foreach ilk for_like +reserved all ilk for_like +reserved forall ilk for_like + +reserved do ilk do_like +reserved sum ilk do_like +reserved product ilk do_like +reserved collect ilk do_like +reserved conc ilk do_like +reserved let ilk do_like +reserved join ilk do_like + +reserved in ilk step_like +reserved step ilk step_like +reserved such ilk step_like +reserved that ilk step_like + +reserved repeat ilk repeat_like +reserved until ilk until_like + +reserved on ilk on_like +reserved off ilk on_like + +reserved go ilk goto_like +reserved to ilk goto_like +reserved goto ilk goto_like + +reserved return ilk return_like +reserved while ilk for_like + +reserved algebraic ilk modedef_like +reserved symbolic ilk modedef_like +reserved lisp ilk modedef_like + +reserved expr ilk procmode_like +reserved fexpr ilk procmode_like +reserved macro ilk procmode_like +reserved smacro ilk procmode_like + +reserved procedure ilk proc_like + +reserved where ilk where_like + +reserved scalar ilk decl_like +reserved integer ilk decl_like +reserved real ilk decl_like +reserved operator ilk decl_like +reserved array ilk decl_like +reserved matrix ilk decl_like +reserved linear ilk decl_like +reserved symmetric ilk decl_like +reserved antisymmetric ilk decl_like +reserved clear ilk clear_like + +reserved nil ilk bool_like +reserved t ilk bool_like + +reserved function ilk function_like +reserved lambda ilk lambda_like + +################################## +# The production rules +################################## + +# Emergency rules, WEAVE commands & comments +newline ? --> #2 +<cancel-"\\rx"> ignore_scrap ? --> #2 +<cancel> ignore_scrap --> terminator +terminator --> stmt +end --> simp + +# Simple expressions +simp <"\\Rs"-opt-3> simp --> simp +simp binop simp --> simp +simp <"\\bo"> unorbinop simp --> simp +<"\\uo"> (unop|unorbinop) simp --> simp + +simp <"\\Rs"-indent-cancel> stmt <outdent> --> stmt +simp binop <indent-cancel> stmt <outdent> --> stmt +simp <"\\bo"> unorbinop <indent-cancel> stmt <outdent> --> stmt +<"\\uo"> (unop|unorbinop) <indent-cancel> stmt <outdent> --> stmt + +quote <cancel> ? <cancel> --> simp +simp comma simp --> simp +simp terminator --> stmt +stmt stmt --> stmt + +# Lists and vectors +open <cancel> simp <cancel> close --> simp + +listopen simp [ open ] --> listopen simp simpopen +listopen [ open ] --> listopen simpopen +listopen <"$\\,$"> close --> simp +listopen simp close --> simp + +simpopen <"$\\,$"> close --> simp +simpopen <"\\Ri"-cancel> simp <cancel-"\\Ro"> close --> simp + +# Function calls +simp open <"$\\,$"> close --> simp +simp open <"\\Ri"-cancel> simp <cancel-"\\Ro"> close --> simp + +# Procedure definitions +(mode|procmode) proc --> proc +proc stmt* <force-indent> stmt <outdent-force> --> stmt +(simp|stmt) <force> proc --> proc + +# Declarations +mode <cancel> (terminator|open) --> #2 +mode stmt --> stmt +proc stmt begin [ decl stmt* <force> ] --> proc stmt begin stmt +(decl|clear|switch|do) stmt* <force> --> stmt + +# Blocks +[ simp <break_space> ] end --> stmt end +<force> begin <force> end --> simp +<force> begin <opt-7> stmt <force> end terminator <force> --> stmt +[ <force> begin <opt-7> stmt <force> end ] !terminator --> simp !terminator +progn_begin end --> simp +<force> progn_begin <indent-cancel> stmt <cancel-outdent> end terminator <force> --> stmt +[ <force> progn_begin <indent-cancel> stmt <cancel-outdent> end ] !terminator --> simp !terminator + +# For statements in all flavours +for for --> for +for [ simp colon <opt-3> simp ] --> for simp +for [ simp <"\\Rs"> (step|until|switch) <opt-3> simp ] --> for simp +[ <force> for simp <"\\Rs"> do <opt-1-indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +<force> for simp <"\\Rs"> do <opt-1-indent> simp terminator <outdent-force> --> stmt +<force> for simp <"\\Rs"> do <opt-1-indent> stmt <outdent> --> stmt + +# If statements +if simp <"\\Rs"> then <opt-1> --> ifthen +ifthen <indent> simp <"\\Rs"-outdent-force> else <opt-1> --> ifelse +ifelse [ ifelse <indent> simp <outdent> ] (comma|close|else|end) --> ifelse simp (comma|close|else|end) +ifelse [ (if|ifthen) <indent> simp <outdent> ] (comma|close|end) --> ifelse simp (comma|close|end) +[ <force> ifelse <indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +[ <force> (if|ifthen) <indent> simp <outdent> ] (comma|close|end) --> simp (comma|close|end) +<force> (ifthen|ifelse) <indent> simp terminator <outdent-force> --> stmt +<force> (ifthen|ifelse) <indent> stmt <outdent> --> stmt +ifelse [ (ifthen|ifelse) <indent> simp terminator <outdent-force> ] --> ifelse stmt +ifelse [ (ifthen|ifelse) <indent> stmt <outdent> ] --> ifelse stmt + +# Where +[ simp <"\\Rs"-opt-1> where simp ] (close|else|end) --> simp (close|else|end) +simp <"\\Rs"-opt-1> where stmt <force> --> stmt + +# Return statement +[ <force> return <indent> simp <outdent> ] (close|else|end) --> simp (close|else|end) +<force> return <indent> simp terminator <outdent-force> --> stmt +<force> return <indent> stmt <outdent> --> stmt + +# Repeat statements +[ <force> repeat <"\\Rs"-opt-7-indent> simp <outdent-force> until <indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +<force> repeat <"\\Rs"-opt-7-indent> simp <outdent-force> until <indent> simp terminator <outdent-force> --> stmt + +# Labels +!for [ <force-backup> simp colon <"\\Rs"-cancel> (simp|stmt|end) ] --> !for #4 + +# Module use +stmt <force> module_scrap terminator <force> --> stmt +module_scrap --> simp + +# Lambda calculus (far from complete and probably incorrect) +lambda simp --> lambda +lambda terminator --> lambda +open lambda close --> simp + +macros begin +\def\commentbegin{\{} +\def\commentend{\}} +\def\comma{$,{}$} +\def\uo#1{$#1$} +\def\ro#1{${}\mathrel{#1}{}$} +\def\bo#1{${}\mathbin{#1}{}$} +\def\eo#1{$#1$} +\def\NEQ{\hbox{$\ne$}} +\def\LL{$\ll\,$} +\def\RR{$\,\gg$} +\def\PS{\joinrel{+\equiv}} +\let\rx\relax +\newcount\extraindent +\def\Ri{\global\advance\extraindent by1} +\def\Ro{\global\advance\extraindent by-1} +\def\Rs{{ }} +\def\startline{\noindent\count255=\ind + \ifnum\extraindent=0\advance\count255by-2\fi + \hskip\count255 em} +\def\3#1{\hfil\ifnum#1=0\penalty-100\else\penalty#10\fi\hfilneg} +macros end + diff --git a/web/reduce/rweb/reduce33.spider b/web/reduce/rweb/reduce33.spider new file mode 100644 index 0000000000..e416d656f3 --- /dev/null +++ b/web/reduce/rweb/reduce33.spider @@ -0,0 +1,298 @@ +# Copyright (c) 1991: Marcel Roelofs and Peter Gragert +# University of Twente, Enschede, The Netherlands +# +# @(#) reduce.spider (91/03/11) + +language REDUCE extension r + +at_sign @ + +comment begin <"%"> end <"%"> + +default translation <*> mathness no + +line begin <"%line"> end <> + +token identifier category simp +token number category simp +token newline category newline translation <> +token pseudo_semi category terminator translation <"\\rx"> + +module definition stmt use module_scrap + +default translation <"\\ro"-*> mathness no + +token * category binop translation <"\\eo*"> +token / category binop translation <"\\eo/"> +token < category binop +token > category binop +token = category binop +token . category binop tangleto <space-"."-space> + +token .^ category binop translation <"\\ro{.\\^}"> tangleto <space-".^"-space> +token .* category binop translation <"\\ro{.*}"> tangleto <space-".*"-space> +token .+ category binop translation <"\\ro{.+}"> tangleto <space-".+"-space> +token ./ category binop translation <"\\ro{./}"> tangleto <space-"./"-space> +token ^ category binop translation <"\\eo\\^"> +token ** category binop translation <"\\eo\\^"> +token := category binop translation <"\\ro\\leftarrow"> +token != category binop translation <"\\ro\\NEQ"> tangleto <space-"neq"-space> +token <> category binop translation <"\\ro\\NEQ"> tangleto <space-"neq"-space> +token <= category binop translation <"\\ro\\leq"> +token >= category binop translation <"\\ro\\geq"> + +default translation <*> mathness no + +token + category unorbinop +token - category unorbinop +token ' category quote tangleto <space-"'"> +token '( category listopen translation <"'("> tangleto <space-"'("> +token '[ category listopen translation <"'["> tangleto <space-"'["> +token ( category open +token ) category close +token [ category simpopen +token ] category close +token { category simpopen translation <"$\\{$"> +token } category close translation <"$\\}$"> +token , category comma translation <"\\comma"-opt-1> +token ; category terminator translation <";"-break_space> +token $ category terminator translation <"\\$"-break_space> +token : category colon +token << category progn_begin translation <"\\LL"> tangleto <space-"<<"> +token >> category end translation <"\\RR"> tangleto <">>"-space> + +ilk bool_like category simp +ilk goto_like category simp +ilk function_like category function + +default translation <*-space> + +ilk begin_like category begin +ilk if_like category if +ilk then_like category then +ilk else_like category else +ilk for_like category for +ilk do_like category do +ilk step_like category step +ilk repeat_like category repeat +ilk until_like category until +ilk on_like category switch +ilk return_like category return +ilk modedef_like category mode +ilk procmode_like category procmode +ilk proc_like category proc +ilk where_like category where +ilk decl_like category decl +ilk clear_like category clear +ilk lambda_like category lambda +ilk end_like category end translation <*> + +ilk not_like category unop translation <"\\R"> +ilk neq_like category binop translation <"\\ro\\NEQ"> +ilk and_like category binop translation <"\\ro\\W"> +ilk or_like category binop translation <"\\ro\\V"> +ilk leq_like category binop translation <"\\ro\\leq"> +ilk geq_like category binop translation <"\\ro\\geq"> + +reserved not ilk not_like +reserved neq ilk neq_like +reserved and ilk and_like +reserved or ilk or_like +reserved leq ilk leq_like +reserved geq ilk geq_like + +reserved begin ilk begin_like +reserved end ilk end_like + +reserved if ilk if_like +reserved then ilk then_like +reserved else ilk else_like + +reserved for ilk for_like +reserved each ilk for_like +reserved foreach ilk for_like +reserved all ilk for_like +reserved forall ilk for_like + +reserved do ilk do_like +reserved sum ilk do_like +reserved product ilk do_like +reserved collect ilk do_like +reserved conc ilk do_like +reserved let ilk do_like +reserved join ilk do_like + +reserved in ilk step_like +reserved step ilk step_like +reserved such ilk step_like +reserved that ilk step_like + +reserved repeat ilk repeat_like +reserved until ilk until_like + +reserved on ilk on_like +reserved off ilk on_like + +reserved go ilk goto_like +reserved to ilk goto_like +reserved goto ilk goto_like + +reserved return ilk return_like +reserved while ilk for_like + +reserved algebraic ilk modedef_like +reserved symbolic ilk modedef_like +reserved lisp ilk modedef_like + +reserved expr ilk procmode_like +reserved fexpr ilk procmode_like +reserved macro ilk procmode_like +reserved smacro ilk procmode_like + +reserved procedure ilk proc_like + +reserved where ilk where_like + +reserved scalar ilk decl_like +reserved integer ilk decl_like +reserved real ilk decl_like +reserved operator ilk decl_like +reserved array ilk decl_like +reserved matrix ilk decl_like +reserved linear ilk decl_like +reserved symmetric ilk decl_like +reserved antisymmetric ilk decl_like +reserved clear ilk clear_like + +reserved nil ilk bool_like +reserved t ilk bool_like + +reserved function ilk function_like +reserved lambda ilk lambda_like + +################################## +# The production rules +################################## + +# Emergency rules, WEAVE commands & comments +newline ? --> #2 +<cancel-"\\rx"> ignore_scrap ? --> #2 +<cancel> ignore_scrap --> terminator +terminator --> stmt +end --> simp + +# Simple expressions +simp <"\\Rs"-opt-3> simp --> simp +simp binop simp --> simp +simp <"\\bo"> unorbinop simp --> simp +<"\\uo"> (unop|unorbinop) simp --> simp + +simp <"\\Rs"-indent-cancel> stmt <outdent> --> stmt +simp binop <indent-cancel> stmt <outdent> --> stmt +simp <"\\bo"> unorbinop <indent-cancel> stmt <outdent> --> stmt +<"\\uo"> (unop|unorbinop) <indent-cancel> stmt <outdent> --> stmt + +quote <cancel> ? <cancel> --> simp +simp comma simp --> simp +simp terminator --> stmt +stmt stmt --> stmt + +# Lists and vectors +open <cancel> simp <cancel> close --> simp + +listopen simp [ open ] --> listopen simp simpopen +listopen [ open ] --> listopen simpopen +listopen <"$\\,$"> close --> simp +listopen simp close --> simp + +simpopen <"$\\,$"> close --> simp +simpopen <"\\Ri"-cancel> simp <cancel-"\\Ro"> close --> simp + +# Function calls +simp open <"$\\,$"> close --> simp +simp open <"\\Ri"-cancel> simp <cancel-"\\Ro"> close --> simp + +# Procedure definitions +(mode|procmode) proc --> proc +proc stmt* <force-indent> stmt <outdent-force> --> stmt +(simp|stmt) <force> proc --> proc + +# Declarations +mode <cancel> (terminator|open) --> #2 +mode stmt --> stmt +proc stmt begin [ decl stmt* <force> ] --> proc stmt begin stmt +(decl|clear|switch|do) stmt* <force> --> stmt + +# Blocks +[ simp <break_space> ] end --> stmt end +<force> begin <force> end --> simp +<force> begin <opt-7> stmt <force> end terminator <force> --> stmt +[ <force> begin <opt-7> stmt <force> end ] !terminator --> simp !terminator +progn_begin end --> simp +<force> progn_begin <indent-cancel> stmt <cancel-outdent> end terminator <force> --> stmt +[ <force> progn_begin <indent-cancel> stmt <cancel-outdent> end ] !terminator --> simp !terminator + +# For statements in all flavours +for for --> for +for [ simp colon <opt-3> simp ] --> for simp +for [ simp <"\\Rs"> (step|until|switch) <opt-3> simp ] --> for simp +[ <force> for simp <"\\Rs"> do <opt-1-indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +<force> for simp <"\\Rs"> do <opt-1-indent> simp terminator <outdent-force> --> stmt +<force> for simp <"\\Rs"> do <opt-1-indent> stmt <outdent> --> stmt + +# If statements +if simp <"\\Rs"> then <opt-1> --> ifthen +ifthen <indent> simp <"\\Rs"-outdent-force> else <opt-1> --> ifelse +[ <force> ifelse <indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +[ <force> (if|ifthen) <indent> simp <outdent> ] (comma|close|end) --> simp (comma|close|end) +<force> (ifthen|ifelse) <indent> simp terminator <outdent-force> --> stmt +<force> (ifthen|ifelse) <indent> stmt <outdent> --> stmt + +# Where +[ simp <"\\Rs"-opt-1> where simp ] (close|else|end) --> simp (close|else|end) +simp <"\\Rs"-opt-1> where simp terminator <force> --> stmt + +# Return statement +[ <force> return <indent> simp <outdent> ] (close|else|end) --> simp (close|else|end) +<force> return <indent> simp terminator <outdent-force> --> stmt +<force> return <indent> stmt <outdent> --> stmt + +# Repeat statements +[ <force> repeat <"\\Rs"-opt-7-indent> simp <outdent-force> until <indent> simp <outdent> ] (comma|close|else|end) --> simp (comma|close|else|end) +<force> repeat <"\\Rs"-opt-7-indent> simp <outdent-force> until <indent> simp terminator <outdent-force> --> stmt + +# Labels +!for [ <force-backup> simp colon <"\\Rs"-cancel> (simp|end) ] --> !for #4 + +# Module use +stmt <force> module_scrap terminator <force> --> stmt +module_scrap --> simp + +# Lambda calculus (far from complete and probably incorrect) +lambda simp --> simp +function [ open simp terminator ] --> function open +function open simp close --> simp + +macros begin +\def\commentbegin{\{} +\def\commentend{\}} +\def\comma{$,{}$} +\def\uo#1{$#1$} +\def\ro#1{${}\mathrel{#1}{}$} +\def\bo#1{${}\mathbin{#1}{}$} +\def\eo#1{$#1$} +\def\NEQ{\hbox{$\ne$}} +\def\LL{$\ll\,$} +\def\RR{$\,\gg$} +\def\PS{\joinrel{+\equiv}} +\let\rx\relax +\newcount\extraindent +\def\Ri{\global\advance\extraindent by1} +\def\Ro{\global\advance\extraindent by-1} +\def\Rs{{ }} +\def\startline{\noindent\count255=\ind + \ifnum\extraindent=0\advance\count255by-2\fi + \hskip\count255 em} +\def\3#1{\hfil\ifnum#1=0\penalty-100\else\penalty#10\fi\hfilneg} +macros end + diff --git a/web/reduce/rweb/rtangle b/web/reduce/rweb/rtangle new file mode 100644 index 0000000000..3f5f713c73 --- /dev/null +++ b/web/reduce/rweb/rtangle @@ -0,0 +1,10 @@ +#!/bin/ksh +# Copyright (c) 1991: Marcel Roelofs and Peter Gragert +# University of Twente, Enschede, The Netherlands +# +# @(#) rtangle (91/03/11) + +webfile=$1 +shift +rtangle.exe ${webfile} $* +underscore <${webfile}.r > ${webfile}.red diff --git a/web/reduce/rweb/rtangle.ch b/web/reduce/rweb/rtangle.ch new file mode 100644 index 0000000000..57de6458a6 --- /dev/null +++ b/web/reduce/rweb/rtangle.ch @@ -0,0 +1,135 @@ +% Copyright (c) 1991: Marcel Roelofs and Peter Gragert +% University of Twente, Enschede, The Netherlands +% @@(#) rtangle.ch (91/03/11) + +@x +@u +@<Include files@>@; +@<Common code for \.{WEAVE} and \.{TANGLE}@>@; +@<Typedef declarations@>@; +@<Global variables@>@; +@y +@u +#define NEWLINES_IN_MACROS +@<Include files@>@; +@<Common code for \.{WEAVE} and \.{TANGLE}@>@; +@<Typedef declarations@>@; +@<Global variables@>@; +@z + +@x + if (isdigit(c) || c=='\\' || c=='.') @<Get a constant@>@;/*spider*/ + else if (isalpha(c) || c=='_' || c=='$') @<Get an identifier@>@;/*spider*/ + else if (c=='\'' || c=='\"') @<Get a string@>@;/*spider*/ +@y + if (isdigit(c)) @<Get a constant@>@;/*spider*/ + else if (isalpha(c) || c=='_' || c=='!') @<Get an identifier@>@;/*spider*/ + else if (c=='\"') @<Get a string@>@;/*spider*/ +@z + +@x +@ @<Get an identifier@>= {/*spider*/ + id_first=--loc; + while (isalpha(*++loc) || isdigit(*loc) || *loc=='_'); + if (*loc=='$') while (isdigit(*++loc)||*loc=='$'); + /* make room for \$\$ and \$nnn suffixes */ + id_loc=loc; return(identifier); +} +@y +@ @<Get an identifier@>= {/*spider*/ + id_first=--loc; + if (c=='!') ++loc; + while (isalpha(*++loc) || isdigit(*loc) || *loc=='_' || *loc=='!') + if (*loc=='!') ++loc; + id_loc=loc; return(identifier); +} +@z + +@x +@ \cee\ strings and character constants, delimited by double and single +quotes, respectively, can contain newlines or instances of their own +delimiters if they are protected by a backslash. We follow this +convention, but do not allow the string to be longer than |longest_name|. + +@<Get a string@>= {/*spider*/ + ASCII delim = c; /* what started the string */ +@# +/* if it's not a single-character literal, it's a tick mark or an |at_sign| */ + if (delim=='\'' && (loc+1>=limit || + (*loc != '\\' && *loc!=at_sign && loc[1]!='\'') || + (*loc=='\\' && (loc+2>=limit||loc[2]!='\'')) || + (*loc==at_sign && + (loc+2>=limit||loc[1]!=at_sign||loc[2]!='\'')) + )) goto mistake; + id_first = mod_text+1; + id_loc = mod_text; *++id_loc=delim; + while (1) { + if (loc>=limit) { + if(*(limit-1)!='\\') { + err_print("! String didn't end"); loc=limit; break; +@.String didn't end@> + } + if(get_line()==0) { + err_print("! Input ended in middle of string"); loc=buffer; break; +@.Input ended in middle of string@> + } + else if (++id_loc<=mod_text_end) *id_loc=@`\n'; /* will print as + \.{"\\\\\\n"} */ + } + if ((c=*loc++)==delim) { + if (++id_loc<=mod_text_end) *id_loc=c; + break; + } + if (c=='\\') { + if (loc>=limit) continue; + if (++id_loc<=mod_text_end) *id_loc = '\\'; + c=*loc++; + } + if (++id_loc<=mod_text_end) *id_loc=c; + } + if (id_loc>=mod_text_end) { + printf("\n! String too long: "); +@.String too long@> + ASCII_write(mod_text+1,25); + printf("..."); mark_error; + } + id_loc++; + return(string); +} +@y +@ \cee\ strings are delimited by double quotes and must be restricted +to one line. Double quotes in strings must be doubled and we allow no +string to be longer than |longest_name|. + +@<Get a string@>= {/*spider*/ + ASCII delim = c; /* what started the string */ +@# + id_first = mod_text+1; + id_loc = mod_text; *++id_loc=delim; + while (1) { + if (loc>=limit) { + err_print("! String didn't end"); loc=limit; +@.String didn't end@> + if (get_line()==0) { + err_print("! Input ended in middle of string"); loc=buffer; +@.Input ended in middle of string@> + } + break; + } + if ((c=*loc++)==delim) { + if (++id_loc<=mod_text_end) *id_loc=c; + if (*loc==delim) loc++; + else break; + } + if (++id_loc<=mod_text_end) *id_loc=c; + } + if (id_loc>=mod_text_end) { + printf("\n! String too long: "); +@.String too long@> + ASCII_write(mod_text+1,25); + printf("..."); mark_error; + } + id_loc++; + return(string); +} +@z diff --git a/web/reduce/rweb/rweave.ch b/web/reduce/rweb/rweave.ch new file mode 100644 index 0000000000..7c0c1346b1 --- /dev/null +++ b/web/reduce/rweb/rweave.ch @@ -0,0 +1,209 @@ +% Copyright (c) 1991: Marcel Roelofs and Peter Gragert +% University of Twente, Enschede, The Netherlands +% @@(#) rweave.ch (91/03/11) + +@x + if (isdigit(c)) @<Get a constant@>@; /*spider*/ + else if (isalpha(c) || c=='_') @<Get an identifier@>@;/*spider*/ + else if (c=='\'' || c=='"') @<Get a string@>@;/*spider*/ +@y + if (isdigit(c)) @<Get a constant@>@;/*spider*/ + else if (isalpha(c) || c=='_' || c=='!') @<Get an identifier@>@;/*spider*/ + else if (c=='\"') @<Get a string@>@;/*spider*/ +@z + +@x +@ @<Get an identifier@>= {/*spider*/ + id_first=--loc; + while (isalpha(*++loc) || isdigit(*loc) || *loc=='_'); + id_loc=loc; return(identifier); +} +@y +@ @<Get an identifier@>= {/*spider*/ + id_first=--loc; + if (c=='!') ++loc; + while (isalpha(*++loc) || isdigit(*loc) || *loc=='_' || *loc=='!') + if (*loc=='!') ++loc; + id_loc=loc; return(identifier); +} +@z + +@x +@ \cee\ strings and character constants, delimited by double and single +quotes, respectively, can contain newlines or instances of their own +delimiters if they are protected by a backslash. We follow this +convention, but do not allow the string to be longer than |longest_name|. + +@<Get a string@>= {/*spider*/ + ASCII delim = c; /* what started the string */ + id_first = mod_text+1; + id_loc = mod_text; + if (delim=='`' && *(loc-2)==at_sign) { + /* make string begin with |"@@`"| */ + *++id_loc=at_sign; + *++id_loc=at_sign; + } + /* this is hack for ascii constant */ +@# +/* if it's not a single-character literal, it's a tick mark or an |at_sign| */ + if ((delim=='\'' || delim == '`') && + (loc+1>=limit || + (*loc != '\\' && *loc!=at_sign && loc[1]!='\'') || + (*loc=='\\' && (loc+2>=limit||loc[2]!='\'')) || + (*loc==at_sign && + (loc+2>=limit||loc[1]!=at_sign||loc[2]!='\'')) + ) + ) goto mistake; + *++id_loc=delim; + if (delim=='`') delim='\''; /* for |ascii_constant|s */ + while (1) { + if (loc>=limit) { + if(*(limit-1)!='\\') { + err_print("! String didn't end"); loc=limit; break; +@.String didn't end@> + } + if(get_line()==0) { + err_print("! Input ended in middle of string"); loc=buffer; break; +@.Input ended in middle of string@> + } + } + if ((c=*loc++)==delim) { + if (++id_loc<=mod_text_end) *id_loc=c; + break; + } + if (c=='\\') if (loc>=limit) continue; + else if (++id_loc<=mod_text_end) { + *id_loc = '\\'; c=*loc++; + } + if (++id_loc<=mod_text_end) *id_loc=c; + } + if (id_loc>=mod_text_end) { + printf("\n! String too long: "); +@.String too long@> + ASCII_write(mod_text+1,25); + printf("..."); mark_error; + } + id_loc++; + return(string); +} +@y +@ \cee\ strings are delimited by double quotes and must be restricted +to one line. Double quotes in strings must be doubled and we allow no +string to be longer than |longest_name|. + +@<Get a string@>= {/*spider*/ + ASCII delim = c; /* what started the string */ +@# + id_first = mod_text+1; + id_loc = mod_text; *++id_loc=delim; + while (1) { + if (loc>=limit) { + err_print("! String didn't end"); loc=limit; +@.String didn't end@> + if (get_line()==0) { + err_print("! Input ended in middle of string"); loc=buffer; +@.Input ended in middle of string@> + } + break; + } + if ((c=*loc++)==delim) { + if (++id_loc<=mod_text_end) *id_loc=c; + if (*loc==delim) loc++; + else break; + } + if (++id_loc<=mod_text_end) *id_loc=c; + } + if (id_loc>=mod_text_end) { + printf("\n! String too long: "); +@.String too long@> + ASCII_write(mod_text+1,25); + printf("..."); mark_error; + } + id_loc++; + return(string); +} +@z + +@x + case 1: printf("\\{"); print_id((name_dir+r)); printf("}"); break; + /* |id_flag| */ + case 2: printf("\&{"); print_id((name_dir+r)); printf("}"); break; +@y + case 1: printf("\\\\{"); print_id((name_dir+r)); printf("}"); break; + /* |id_flag| */ + case 2: printf("\\&{"); print_id((name_dir+r)); printf("}"); break; +@z + +@x +@ @<Start a format...@>= { + app_str("\\F"); app_scrap(SP_ignore_scrap,no_math); + /* this will produce `\&{format}' */ +@.\\F@> +@<Set |next_control| to the first non-newline token@>@; +/* claim at this point |scrap_ptr==scrap_info+1| */ + if (scrap_ptr!=scrap_info+1) { + err_print("! This can't happen -- bad scrap_ptr in format definition"); + printf("\n\tscrap_ptr-scrap_info==%d\n",scrap_ptr-scrap_info); + } + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + app_str(" "); + app_scrap(SP_ignore_scrap,no_math); /*spider*/ + /* this is syntactically separate from what follows */ + @<Set |next_control| to the first non-newline token@>@; + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + small_app(@`\n'); + app_scrap(SP_ignore_scrap,no_math); + @<Set |next_control| to the first non-newline token@>@; + } + } + /* if everything went well, we appended two scraps */ + if (scrap_ptr!=scrap_info+3) err_print("! Improper format definition"); +@.Improper format definition@> +} +@y +@ @<Start a format...@>= { + small_app(backup); app_str("\\F"); app_scrap(SP_ignore_scrap,no_math); + /* this will produce `\&{format}' */ +@.\\F@> +@<Set |next_control| to the first non-newline token@>@; +/* claim at this point |scrap_ptr==scrap_info+1| */ + if (scrap_ptr!=scrap_info+1) { + err_print("! This can't happen -- bad scrap_ptr in format definition"); + printf("\n\tscrap_ptr-scrap_info==%d\n",scrap_ptr-scrap_info); + } + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + app_str(" "); + app_scrap(SP_ignore_scrap,no_math); /*spider*/ + /* this is syntactically separate from what follows */ + @<Set |next_control| to the first non-newline token@>@; + if (next_control==identifier) { + small_app(id_flag+id_lookup(id_first, id_loc,normal)-name_dir); + small_app(@`\n'); + app_scrap(SP_ignore_scrap,no_math); + @<Set |next_control| to the first non-newline token@>@; + } + } + /* if everything went well, we appended two scraps */ + if (scrap_ptr!=scrap_info+2) err_print("! Improper format definition"); +@.Improper format definition@> +} +@z + +@x +if (cur_xref->num%def_flag!=module_count) { + app_str("+"); /*module name is multiply defined*/ + this_module=name_dir; /*so we won't give cross-reference info here*/ +} +app_str("\\S"); /* output an equivalence sign */ +@y +if (cur_xref->num%def_flag!=module_count) { + app_str("\\PS"); /*module name is multiply defined*/ + this_module=name_dir; /*so we won't give cross-reference info here*/ +} +else app_str("\\S"); /* output an equivalence sign */ +@z + + diff --git a/web/reduce/rweb/texinputs/specification.tex b/web/reduce/rweb/texinputs/specification.tex new file mode 100644 index 0000000000..92368bb625 --- /dev/null +++ b/web/reduce/rweb/texinputs/specification.tex @@ -0,0 +1,10 @@ +\def\nl{\unskip\hfill\penalty-10000\relax} +\def\spec#1.{{\bf Specification of the procedure} #1.\smallskip} +\def\specs#1.{{\bf Specification of the procedures} #1.\smallskip} +\def\descr#1:{\smallskip\hangindent5em\noindent\hskip5em + \llap{{\bf #1}:\enspace}\ignorespaces} +\def\descno#1.{\hbox to 1.25em{#1.\hss}\ignorespaces} +\def\descrr#1{\par\hangindent5em\noindent\hskip5em + \llap{#1\enspace}\ignorespaces} +\def\arg#1:{\descrr{#1:}} + diff --git a/web/reduce/rweb/underscore.web b/web/reduce/rweb/underscore.web new file mode 100644 index 0000000000..b04b90c5e6 --- /dev/null +++ b/web/reduce/rweb/underscore.web @@ -0,0 +1,32 @@ +% Copyright (c) 1991: Marcel Roelofs and Peter Gragert +% University of Twente, Enschede, The Netherlands +% @@(#) underscore.web (91/03/11) + +@* Filter to remove underscores from REDUCE source. REDUCE does not +allow sole underscores in identifiers. However, underscores preceded +by an exclamation mark are allowed. Also REDUCE strings may contain +underscores. The following C program is a filter that removes the +forbidden underscores. + +@u +#include <stdio.h> + +main (ac, av) +char **av; +{ +char c; +while ((c=getc(stdin)) != EOF) + if (c=='!') { + putc(c,stdout); + c=getc(stdin); + putc(c,stdout); + } + else + if (c=='\"') { + while (putc(c,stdout), (c=getc(stdin)) != '\"') ; + putc(c,stdout); + } + else + if (c != '_') putc(c,stdout); +} + |