
# fjeforms.m	Copyright (C) 1992 by FJE ENTERPRISES     
#                                     Rt. 1, Box 246A
#                                     Potsdam, NY 13676
#                                     ernst@sun.mcs.clarkson.edu
#
#

# coef.m	Copyright (C) 1992 by FJE ENTERPRISES

# 'coef' returns the coefficient of the form 'fm' in the form 'expr'
# Note that 'expr' must be expanded before the call to coef.

`fjeforms/coef` :=
proc(expr,fm)
options remember, `Date: 8-20-92`,
	`Copyright 1992 by FJE ENTERPRISES`;
   if expr=0 then 0
   elif type(expr,form) and type(fm,form) 
	      and (`fjeforms/wdegree`(expr)=`fjeforms/wdegree`(fm)) then 
      if type(expr,function) and op(0,expr)=`&^` then
	 `fjeforms/perm`(expr,fm)
      elif type(expr,`*`) then
	 `fjeforms/scalarpart`(expr) *
	   `fjeforms/coef`(`fjeforms/formpart`(expr),fm)
      elif type(expr,`+`) then
	 map(`fjeforms/coef`,expr,fm)
      elif type(expr,`name`) then
	 if expr=fm then 1
	 else 0
         fi
      else ERROR(`cannot find coefficient`)
      fi
   else ERROR(`parameters must be forms of same order`)
   fi
end;

# complex.m   	Copyright (C) 1992 by FJE ENTERPRISES

#	This is a collection of procedures which enable the user
#	to manipulate complex variables as well as real ones.
#	Note that all standard functions are treated as if they 
#	were analytic functions of complex parameters.

# *****************************************************************

# CLIST is a global list of complex variable names.

`fjeforms/CLIST` := {}:

# complex(a,b,...) inserts the names a,b,... into the list of
# complex variables CLIST.

`fjeforms/complex` := 
proc()
local a;
options `Date: 8-28-92`,
	`Copyright 1992 by FJE ENTERPRISES`;
	for a in args do
	    if not type(a,name) then
	       ERROR(`Parameters must be names`)
            fi
	od;
	`fjeforms/CLIST` := `fjeforms/CLIST` union { args }; 
	NULL
end;

# iscomplex(a) returns true if a is the name of a complex variable,
# and returns false otherwise.

`fjeforms/iscomplex` :=
proc(a)
options `Date: 8-28-92`, 
	`Copyright 1992 by FJE ENTERPRISES`;
	if not type(a,name) then
	   ERROR(`Parameter must be a name`)
        fi;
	member(a,`fjeforms/CLIST`)
end;

# cc(a) returns the complex conjugate of the expression a.

`fjeforms/cc` := 
proc(a)
options remember, `Date: 8-28-92`,
	`Copyright 1992 by FJE ENTERPRISES`;
	if type(a,{list,set,`=`}) then
	   map(`fjeforms/cc`,a)
	elif type(a,'array') then
	   if type(a,'name') then 
	      map(`fjeforms/cc`,op(a))
           else
	      map(`fjeforms/cc`,a)
           fi
	elif type(a,numeric) then
	   a
	elif a=I then 
	   -I
	elif type(a,{`+`,`*`}) then
	   map(`fjeforms/cc`,a) 
	elif type(a,'array') then
	   if type(a,'name') then 
	      map(`fjeforms/cc`,op(a))
           else 
	      map(`fjeforms/cc`,a)
           fi
	elif type(a,name) then
	   if `fjeforms/iscomplex`(a) then 
	      'cc(a)'
           else
	      a
           fi
	elif type(a,function) then
	     if op(0,a)=`cc` then
		op(1,a)
             else
		map(`fjeforms/cc`,a)
             fi
	elif type(a,`^`) and type(op(2,a),integer) then
	   `fjeforms/cc`(op(1,a))^op(2,a)
	elif type(a,`^`) and type(op(1,a),positive) then
	   op(1,a)^`fjeforms/cc`(op(2,a))
	else
	   'cc(a)'
	fi
end;

# re(a) returns the real part of the complex expression a.

`fjeforms/re` := 
proc(a)
options remember, `Date: 8-28-92`,
	`Copyright 1992 by FJE ENTERPRISES`;
	if type(a,{list,set,`=`}) then
	   map(`fjeforms/re`,a)
	elif type(a,'array') then
	   if type(a,'name') then 
	      map(`fjeforms/re`,op(a))
           else
	      map(`fjeforms/re`,a)
           fi
	else
	   (a + `fjeforms/cc`(a))/2
        fi
end;

# im(a) returns the imaginary part of the complex expression a.

`fjeforms/im` := 
proc(a)
options remember, `Date: 8-28-92`,
	`Copyright 1992 by FJE ENTERPRISES`;
	if type(a,{list,set,`=`}) then
	   map(`fjeforms/im`,a)
	elif type(a,'array') then
	   if type(a,'name') then 
	      map(`fjeforms/im`,op(a))
           else
	      map(`fjeforms/im`,a)
           fi
        else
	   (a - `fjeforms/cc`(a))/(2*I)
        fi
end;

# d.m		Copyright (C) 1992 by FJE ENTERPRISES

# In the FJE ENTERPRISES revision of 'difforms/d', we have changed
# the syntax of the multiargument option, giving the user more
# control over notation, and we have eliminated the call to 
# 'defform', because objects are automatically assumed to be 
# scalar if they are not declared otherwise using 'defform'.

`fjeforms/d` :=
proc(fm)
local a,dsum,dum,f,first,i,last,tp,u,w,P,Q;
options remember, `Copyright 1990 by the University of Waterloo`,
		  `Date: 6-3-92`,
	          `Revisions copyright 1992 by FJE ENTERPRISES`;
    if (1 < nargs) and 
        not member(false,map(type,[args[2..nargs]],'list')) and
	not member(false,map(proc(x) evalb(nops(x)=2) end,
	                     [args[2..nargs]])) and
        not member(false,map(proc(x) type(op(1,x),'form'(1)) end,
	                     [args[2..nargs]])) and
        not member(false,map(proc(x) type(op(2,x),'scalar') end,
	                     [args[2..nargs]])) then
        tp := eval(`fjeforms/d`(args[1]));
        map(
        proc(dfm,lst)
            if
            type(dfm,'function') and (op(0,dfm) = d) and type(op(1,dfm),'name')
             and type(op(1,dfm),'scalar') and 
	     not member(dfm,map(proc(x) op(1,x) end,lst)) then
                map(proc(x,y) 
		    cat(op(2,x),`(`,convert(y,string),`)`)*op(1,x) end,
		    lst,op(1,dfm));
                convert(",`+`);
                dfm = "
            fi
        end
        ,indets(tp),[args[2..nargs]]);
        subs(",tp);
	RETURN(fjeforms[simpform]("))
    elif 1 < nargs then ERROR(`wrong number or type of arguments`);
    fi;
    if type(fm,{list,set,`=`}) then RETURN(map(`fjeforms/d`,fm))
    elif type(fm,'array') then
        if type(fm,'name') then RETURN(map(`fjeforms/d`,op(fm)))
        else RETURN(map(`fjeforms/d`,fm))
        fi
    elif type(fm,'const') then RETURN(0)
    elif type(fm,`+`) then `simpform/sum`(map(`fjeforms/d`,fm))
    elif type(fm,`*`) then
        tp := fjeforms[simpform](fm);
        w := fjeforms[formpart](tp);
        f := fjeforms[scalarpart](tp);
        if type(f,`*`) then
            u := 0;
            for a in f do
                tp := fjeforms[`&^`](`fjeforms/d`(a),w);
                if type(tp,`+`) then
                    u := u+map(proc() args[2]*args[1] end,tp,f/a)
                else u := u+f/a*tp
                fi
            od
        else
            tp := `fjeforms/d`(f);
            if type(tp,`+`) then u := map(fjeforms[`&^`],tp,w)
            else u := fjeforms[`&^`](tp,w)
            fi
        fi;
        if type(w,`*`) then `simpform/sum`(u)+f*subs(dum = w,'d(dum)')
        else
            tp := `fjeforms/d`(w);
            if type(tp,`+`) then tp := map(proc() args[2]*args[1] end,tp,f)
            else tp := f*tp
            fi;
            `simpform/sum`(u+tp)
        fi
    elif type(fm,'function') then
        tp := op(0,fm);
        if (tp = wdegree) or (tp = `fjeforms/wdegree`) then 0
        elif (tp = d) or (tp = `fjeforms/d`) then 0
        elif member(tp,{cc,star,step}) then 'd(fm)'
        elif tp = `&^` then
            u := 0;
            dsum := 0;
            first := NULL;
            last := op(map(fjeforms[simpform],fm));
            for i from nops([last]) by -1 to 2 do
                f := last[1];
                P := fjeforms[wdegree](f);
                last := last[2 .. i];
                u := u+(-1)^dsum*fjeforms[`&^`](first,`fjeforms/d`(f),last);
                dsum := fjeforms[parity](dsum+P);
                first := first,f
            od;
            u := u+(-1)^dsum*fjeforms[`&^`](first,`fjeforms/d`(last));
            `simpform/sum`(u)
        else
            tp := map(
               proc(x) if type(x,'name') and not type(x,'const') then x fi end,
               indets(fm) minus {fm});
            u := map(proc(x) if type(x,'scalar') then x fi end,tp);
            if nops(tp) = nops(u) then
                w := 0;
                for a in u do
                    tp := `fjeforms/d`(a);
                    if type(tp,`+`) then
                        w := w+map(proc(x,y) y*x end,tp,diff(fm,a))
                    else w := w+diff(fm,a)*tp
                    fi
                od;
                fjeforms[`&^`](w)
            else RETURN('d(args)')
            fi
        fi
    elif type(fm,`**`) then
        f := op(2,fm);
        w := op(1,fm);
	if type(fm,'scalar') then
          if type(w,'const') then
            tp := `fjeforms/d`(f);
            if type(tp,`+`) then
                map(proc() args[2]*args[1] end,tp,log(w)*w^f)
            else log(w)*w^f*tp
            fi
          else 
            tp := `fjeforms/d`(f);
            if type(tp,`+`) then
                map(proc() args[2]*args[1] end,tp,log(w)*w^f)
            else log(w)*w^f*tp
            fi;
            tp := `fjeforms/d`(w);
            if type(tp,`+`) then
                tp := map(proc() args[2]*args[1] end,tp,f*w^(f-1))
            else tp := f*w^(f-1)*tp
            fi;
            `simpform/sum`(tp+""")
          fi
        else ERROR(`undefined operation`)
	fi
    else RETURN('d(args)')
    fi
end;



# defform.m	Copyright (C) 1992 by FJE ENTERPRISES

# Substantial revision of 'difforms/defform' by FJE ENTERPRISES

# Initialize various tables

_dtab := table();
_wdegtab := table();
_formtab := {};
_consttab := {};

# We insist that all differential forms be declared explicitly and
# the 'wdegree' of each of them specified as a positive integer.
# Scalars need not be declared, but scalar constants are declared using
# the keyword 'const'.  Values may be assigned to exterior derivatives.
# These values are installed in the remember table of 'fjeforms/d'.

`fjeforms/defform` :=
proc()
local a,fm,dg,tp1,tp2,vars;
options `Copyright 1990 by the University of Waterloo`,
		  `Date: 8-20-92`,
	          `Revisions copyright 1992 by FJE ENTERPRISES`;
    for a in args do
        if not type(a,`=`) then
            ERROR(`Parameters must have form  <expr>=<expr>`)
        fi;
        tp1:= op(1,a);
	tp2:= op(2,a);
        if not (((type(tp1,'name') or type(tp1,'indexed')) and
		 ((tp2 = `const`) or 
		  (type(tp2,'integer') and (tp2 >= 0)))) or 
                ((type(tp1,'function') and (op(0,tp1) = d) and
		type(tp2,'algebraic')))) then
          ERROR(`<name>=<non-negative integer>|const or d(<expr>)=<algebraic expr>`)
        fi;
	if tp1='const' then
	    ERROR(`"const" is a reserved name`)
	fi
    od;
    ##### These tables keep track of forms from one invocation of
    #     'defform' to the next; they must be global variables.
    for a in args do
        fm := op(1,a);
        dg := op(2,a);
	if not(type(fm,function)) then 
           if (dg = 'const') then
              _wdegtab[fm] := 0;
	      _formtab := _formtab minus {fm};
	      _consttab := _consttab union {fm}
	   elif dg=0 then
              _wdegtab[fm] := 0;
	      _formtab := _formtab minus {fm};
	      _consttab := _consttab minus {fm}
           elif dg>0 then
              _wdegtab[fm] := dg;
	      _formtab := _formtab union {fm};
	      _consttab := _consttab minus {fm}
	   fi
        fi
    od;
    ##### Erase remember tables of various functions:
    if type(op('`fjeforms/wedge`'),'procedure') then
        `fjeforms/wedge` := subsop(4 = NULL,op(`fjeforms/wedge`))
    fi;
    if type(op('`fjeforms/d`'),'procedure') then
        `fjeforms/d` := subsop(4 = NULL,op(`fjeforms/d`))
    fi;
    if type(op('`fjeforms/formpart`'),'procedure') then
        `fjeforms/formpart` := subsop(4 = NULL,op(`fjeforms/formpart`))
    fi;
    if type(op('`fjeforms/parity`'),'procedure') then
        `fjeforms/parity` := subsop(4 = NULL,op(`fjeforms/parity`))
    fi;
    if type(op('`fjeforms/simpform`'),'procedure') then
        `fjeforms/simpform` := subsop(4 = NULL,op(`fjeforms/simpform`))
    fi;
    if type(op('`simpform/sum`'),'procedure') then
        `simpform/sum` := subsop(4 = NULL,op(`simpform/sum`))
    fi;
    if type(op('simpscalar'),'procedure') then
        simpscalar := subsop(4 = NULL,op(simpscalar))
    fi;
    if type(op('`fjeforms/wdegree`'),'procedure') then
        `fjeforms/wdegree` := subsop(4 = NULL,op(`fjeforms/wdegree`))
    fi;
    if type(op('`type/const`'),'procedure') then
        `type/const` := subsop(4 = NULL,op(`type/const`))
    fi;
    if type(op('`type/scalar`'),'procedure') then
        `type/scalar` := subsop(4 = NULL,op(`type/scalar`))
    fi;
    if type(op('`type/form`'),'procedure') then
        `type/form` := subsop(4 = NULL,op(`type/form`))
    fi;
    if type(op('`fjeforms/step`'),'procedure') then
        `fjeforms/step` := subsop(4 = NULL,op(`fjeforms/step`))
    fi;
    if type(op('`fjeforms/star`'),'procedure') then
        `fjeforms/star` := subsop(4 = NULL,op(`fjeforms/star`))
    fi;
    if type(op('`fjeforms/cc`'),'procedure') then
        `fjeforms/cc` := subsop(4 = NULL,op(`fjeforms/cc`))
    fi;
    if type(op('`fjeforms/re`'),'procedure') then
        `fjeforms/re` := subsop(4 = NULL,op(`fjeforms/re`))
    fi;
    if type(op('`fjeforms/im`'),'procedure') then
        `fjeforms/im` := subsop(4 = NULL,op(`fjeforms/im`))
    fi;
    if type(op('`fjeforms/perm`'),'procedure') then
        `fjeforms/perm` := subsop(4 = NULL,op(`fjeforms/perm`))
    fi;
    if type(op('`fjeforms/coef`'),'procedure') then
        `fjeforms/coef` := subsop(4 = NULL,op(`fjeforms/coef`))
    fi;
    ##### Establish new remember tables for 'wdegree', and 'type/form':
    vars := {indices(_wdegtab)};
    for a in vars do  
       op(a); 
       _wdegtab['"']; 
       `fjeforms/wdegree`("") := " 
    od;
    for a in _formtab do
       `type/form`(a) := true;
       `type/const`(a) := false;
       `type/scalar`(a) := false
    od;
    for a in _consttab do
       `type/const`(a) := true;
       `type/form`(a) := false;
       `type/scalar`(a) := false
    od;
    ##### This table keeps track of forms from one invocation of
    #     'defform' to the next; it must be a global variable.
    for a in args do
        fm := op(1,a);
	dg := op(2,a);
       if type(fm,'function') then
            _dtab[op(fm)] := `fjeforms/stdform`(dg)
	fi;    
    od;
    ##### Establish new remember table for 'd':
    vars := {indices(_dtab)};
    for a in vars do  
       op(a); 
       _dtab["]; 
       `fjeforms/d`("") := " 
    od;
    NULL
end;

# Unchanged utility function

`fjeforms/stdform` :=
proc(expr)
local a,factors,terms;
options `Copyright 1990 by the University of Waterloo`;
    if type(expr,`+`) then map(`fjeforms/stdform`,expr)
    elif type(expr,`*`) then
        terms := 1;
        factors := 1;
        for a in expr do
            `fjeforms/stdform`(a);
            if type(",`+`) then
                if terms = 1 then terms := "
                else
                    terms := map(
                        proc(part,terms) map(proc(a,b) a*b end,terms,part) end,
                        ",terms)
                fi
            else factors := factors*"
            fi
        od;
        if terms = 1 then factors
        else map(proc(a,b) a*b end,terms,factors)
        fi
    else expr
    fi
end;

`fjeforms/formpart` := proc (fm) local u, i, w; options remember, 
`Copyright 1990 by the University of Waterloo`; if type(fm,`*`) then u := 1; 
for i from nops(fm) by -1 to 1 do w := op(i,fm); if type(w,form) and type(fm/w,
{const, scalar}) then RETURN(w) elif not type(w,{const, scalar}) then u := w*u
 fi od; u else if type(fm,{const, scalar}) then 1 else (fjeforms[simpform])(fm)
; if type(",`*`) then `fjeforms/formpart`(") else fm fi fi fi end;
`fjeforms/mixpar` := proc (expr) local dd, expr2; option 
`Copyright 1990 by the University of Waterloo`; if nargs <> 1 or not type(expr,
'algebraic') then ERROR(`wrong number or type of arguments`) elif not has(expr,
diff) or expr = diff then expr elif type(expr,'function') then if op(0,expr) = 
diff then dd := op(2,expr); expr2 := op(1,expr);  while type(expr2,'function')
 and op(0,expr2) = diff do dd := dd, op(2,expr2); expr2 := op(1,expr2) od; 
expr2 := `fjeforms/mixpar`(expr2); sort([dd],'lexorder'); diff(expr2,op("))
 else map(`fjeforms/mixpar`,expr) fi else map(`fjeforms/mixpar`,expr) fi end;
`fjeforms/parity` := proc (p) options remember, 
`Copyright 1990 by the University of Waterloo`; expand(p); if type(",{`+`, `*`}
) then map(parity,") fi; if type(",`**`) then parity(op(1,")) fi; modp(",2) end
;
# perm.m 	Copyright (C) 1992 by FJE ENTERPRISES

# Two products of forms are compared.  The procedure 'perm' returns
# 0 if the two products are linearly independent, 1 if they are equal,
# and -1 if they are opposite in sign.

`fjeforms/perm` :=
proc(fm1,fm2)
options `Date: 6-3-92`,
`Copyright 1992 by FJE ENTERPRISES`;
   if `fjeforms/wdegree`(fm1)<>`fjeforms/wdegree`(fm2) then 0
   elif `fjeforms/simpform`(fm1-fm2)=0 then 1 
   elif `fjeforms/simpform`(fm1+fm2)=0 then -1
   else 0
   fi
end;

`fjeforms/scalarpart` := proc (fm) option 
`Copyright 1990 by the University of Waterloo`; fm/(fjeforms[formpart])(fm); 
if denom(") <> 1 then normal(") else " fi end;
# A problem in the original `simpform/sum` has been corrected here.

`fjeforms/simpform` := proc (fm) 
local i; 
options remember, `Copyright 1990 by the University of Waterloo`; 
   if type(fm,array) then 
      if type(fm,name) then 
	 map(`fjeforms/simpform`,op(fm)) 
      else map(`fjeforms/simpform`,fm)
      fi 
   elif type(fm,{name, numeric}) then 
      fm 
   elif type(fm,{list, set, `=`}) then 
      map(`fjeforms/simpform`,fm) 
   elif type(fm,`*`) then 
      for i to nops(fm) while not type(op(i,fm),`+`) or type(op(i,fm),{const, scalar}) 
	do  
	od; 
      if i <= nops(fm) then 
	 map(proc () [args[3 .. args[2]+1], args[1], args[args[2]+2 .. nargs]] end
             ,op(i,fm),i,op(1 .. i-1,fm),op(i+1 .. nops(fm),fm)); 
	 map(proc (x) `fjeforms/simpform`(convert(x,`*`)) end,"); 
	 RETURN(`simpform/sum`(")) 
      else 
	 (fjeforms[formpart])(fm); 
         if type(",`*`) then 
	    simpscalar((fjeforms[scalarpart])(fm))*map(`fjeforms/simpform`,") 
	 else simpscalar((fjeforms[scalarpart])(fm))*`fjeforms/simpform`(") 
	 fi 
     fi 
  elif type(fm,function) then 
     if op(0,fm) = `&^` then 
	(fjeforms[`&^`])(op(map(`fjeforms/simpform`,fm))) 
     else map(`fjeforms/simpform`,fm) 
     fi 
  elif type(fm,`**`) then 
     simpscalar(`fjeforms/simpform`(op(1,fm))**op(2,fm)) 
  elif type(fm,`+`) then 
     `simpform/sum`(map(`fjeforms/simpform`,fm)) 
  else 
     fm 
  fi 
  end;

`simpform/sum` := proc (fm) 
local a, j, k, n, f, w, u, v, t1, t2, sw, undone, 
	scalartab, formtab, wedgelist, formlist, result, sfsum, bugfix; 
options remember, `Copyright 1990 by the University of Waterloo`,
		`08-28-92`,
		`Correction copyrighted 1992 by FJE ENTERPRISES`;; 
   if not type(fm,`+`) then 
      RETURN(fm) 
   fi; 
   formtab := table(symmetric); 
   scalartab := table(symmetric); 
   bugfix := table(symmetric); 
   formlist := {}; 
   wedgelist := {}; 
   for a in fm 
      do 
	 w := (fjeforms[formpart])(a); 
	 f := (fjeforms[scalarpart])(a); 
	 if type(w,function) and op(0,w) = `&^` then 
	    v := op(w); 
	    if assigned(formtab[op(bugfix[v])]) then 
		u := formtab[v]; 
		if u = v then 
		   scalartab[u] := scalartab[u]+f 
		else 
		   n := nops(w); 
		   sw := table(sparse); 
		   for j to n-1 
		      do 
			 for k from j+1 to n 
			    do 
			       sw[u[k],u[j]] := 1 
			    od 
		      od; 
		   sfsum := 0; 
		   undone := true; 
		   for j from n by -1 to 2 while undone 
		      do 
			 undone := false; 
			 for k to j-1 
			    do 
			       t1 := v[k]; 
			       t2 := v[k+1]; 
			       if sw[t1,t2] = 1 then 
				  sfsum := sfsum
				     +`fjeforms/wdegree`(t1)*`fjeforms/wdegree`(t2); 
				  v := v[1 .. k-1], t2, t1, v[k+2 .. n]; 
				  undone := true 
			       fi 
			    od 
	             od; 
		  if not has(sfsum,'nonhmg') then 
		     scalartab[v] := scalartab[v]
			+simpscalar((-1)**`fjeforms/parity`(sfsum)*f) 
		  elif assigned(scalartab[w]) then 
		     scalartab[w] := scalartab[w]+f 
		  else 
		     scalartab[w] := f; 
		     formlist := `union`(formlist,{w}) 
		  fi 
	       fi 
	    else 
	       formtab[v] := v; 
	       scalartab[v] := f; 
	       wedgelist := `union`(wedgelist,{w}) 
	    fi 
	 else 
	    if assigned(scalartab[w]) then 
	       scalartab[w] := scalartab[w]+f 
	    else 
	       scalartab[w] := f; 
	       formlist := `union`(formlist,{w}) 
	    fi 
	 fi 
      od; 
   result := 0; 
   for a in wedgelist 
      do 
	 result := result+normal(scalartab[op (a)])*a 
      od; 
   for a in formlist 
      do 
	 result := result+normal(scalartab[a])*a 
      od; 
   result 
   end;

simpscalar := proc (sc) 
options remember, `Copyright 1990 by the University of Waterloo`; 
   if type(sc,{name, constant}) then 
      sc 
   elif type(sc,{`+`, `*`}) then 
      map(simpscalar,sc) 
   elif type(sc,`**`) then 
      simpscalar(op(1,sc)); 
      if type(",`**`) then 
	 op(1,")**(op(2,")*op(2,sc)) 
      else "**op(2,sc) 
      fi; 
      if type(",`**`) and op(1,") = -1 
	 then (-1)**(fjeforms[parity])(op(2,")) 
      else " 
      fi 
   else 
      sc 
   fi 
   end;
# star.m	Copyright (C) 1992 by FJE ENTERPRISES

# The procedure 'star' returns the dual of the differential
# form 'fm', as a linear combination of duals of basic forms.  
# See I. Hauser and F. J. Ernst, Journal of Mathematical Physics
# 19, 1316 (1978), Appendix.


`fjeforms/star` :=
proc(fm)
local i,startab,ndcs;
options remember, `Date: 8-28-92`,
	`Copyright 1992 by FJE ENTERPRISES`;
	if not assigned(DIMENSION) or not type(DIMENSION,integer)
	   or (DIMENSION < 1) then
	   ERROR(`DIMENSION not assigned positive integer value`)
	elif type(fm,{list,set,`=`}) then
	   map(`fjeforms/star`,fm)
        elif type(fm,'array') then
	   if type(fm,'name') then
	      map(`fjeforms/star`,op(fm))
           else
	      map(`fjeforms/star`,fm)
           fi
	elif `fjeforms/wdegree`(fm)>DIMENSION then
	   ERROR(`star(fm) not defined for wdegree(fm)>DIMENSION`)
	elif type(fm,{const,scalar}) 
	     or `fjeforms/wdegree`(fm)=0 then
	   fm*'star(1)';
        elif type(fm,`+`) then
	   map(`fjeforms/star`,fm)
	elif type(fm,`*`) then
	   `fjeforms/scalarpart`(fm) *
	      star(`fjeforms/formpart`(fm))
	elif type(fm,function) and op(0,fm)=`&^` then 
#          Has the dual of this basic form been defined?
	   startab := op(4,op(star));
	   if startab=NULL then
	      RETURN('star(fm)')
           fi; 
	   ndcs := indices(startab);
           map(`star/find`,ndcs,fm); 
           for i to nops(ndcs) do
	      if op(i,")<>0 then
		 RETURN(op(i,")*star(op(i,ndcs)))   # <--- star, not `fjeforms/star`!
	      fi
	   od;
           'star(fm)'
        else
	   'star(fm)' 
	fi
end;

# star/find identifies the basic form fm1 as a permutation of the
# basic form fm2, and returns a value +1, -1 or 0.  Used only by
# fjeforms/star.

`star/find` := 
proc(fm1,fm2)
options `Date: 6-3-92`,
	`Copyright 1992 by FJE ENTERPRISES`;
   if type(fm1,function) and op(0,fm1)=`&^` then
      `fjeforms/perm`(fm1,fm2)
   else 0
   fi
end;

# step.m	Copyright (C) 1992 by FJE ENTERPRISES

# The procedure 'step' (alias 'stepup') returns the Grassman
# inner product of the differential forms 'fm1' and 'fm2'.
# Note that this product is asymmetrical, vanishing whenever
# wdegree(fm1) > wdegree(fm2).  When wdegree(fm1) = wdegree(fm2)
# it reduces to the symmetrical dot product.  See I. Hauser
# and F. J. Ernst, Journal of Mathematical Physics 19, 1316 
# (1978), Appendix.

# The following identities are implemented:

#	For forms u,v,w of arbitrary orders
# 	step(u &^ v,w) = step(u,step(v,w))  

#	For 1-forms u,w and form v of arbitrary order
#	step(u,v &^ w) = v &^ step(u,w) - step(u,v) &^ w

# Alternatively, the Grassman inner product may be implemented
# in terms of the duality operator 'star', as was done in the
# Grad Student Rational Calculator program (Copyright (C) 1986
# by Frederick J. Ernst).  This is not implemented here.

#	step(u,v) = phase * star(u &^ star(v))
#	    where phase = star(star(u &^ star(v))).

# Another possibility is to define the duality operator in terms
# of the Grassman inner product.  This is not implemented here.

#       star(u) = sign * step(u,e(DIMENSION))
#	    where sign = star(star(u)) is determined 
#	    by convention, and e(DIMENSION) is a unit
#	    form of degree DIMENSION.

`fjeforms/step` :=
proc(fm1,fm2)
options remember,`Date: 8-28-92`,`Copyright 1992 by FJE ENTERPRISES`;
    if type(fm1,'array') or type(fm2,'array') then `fjeforms/arraystep`(args)
    elif `fjeforms/wdegree`(fm2) < `fjeforms/wdegree`(fm1) then 0
    elif type(fm1,{const,scalar}) then fm1*fm2
    elif (`fjeforms/wdegree`(fm1) = `fjeforms/wdegree`(fm2)) 
	     and not (op(4,op(step)) = NULL) and
        member([fm2,fm1],[indices(op(4,op(step)))]) then
        step(fm2,fm1)  # <--- step, not `fjeforms/step`!
    elif type(fm1,`+`) then map(`fjeforms/step`,fm1,fm2)
    elif type(fm2,`+`) then map(proc(y,x) `fjeforms/step`(x,y) end,fm2,fm1)
    elif type(fm1,`*`) then
        `fjeforms/scalarpart`(fm1)*step(`fjeforms/formpart`(fm1),fm2)
    elif type(fm2,`*`) then
        `fjeforms/scalarpart`(fm2)*step(fm1,`fjeforms/formpart`(fm2))
    elif type(fm1,function) and (op(0,fm1) = `&^`) then
        nops(fm1);
        if " = 2 then `fjeforms/step`(op(1,fm1),`fjeforms/step`(op(2,fm1),fm2))
        else `fjeforms/step`(op(1,fm1),`fjeforms/step`(`&^`(op(2 .. ",fm1)),fm2))
        fi
    elif (`fjeforms/wdegree`(fm1) = 1) and type(fm2,function) and (op(0,fm2) = `&^`) and
        (`fjeforms/wdegree`(op(nops(fm2),fm2)) = 1) then
        `fjeforms/wedge`(op(1 .. nops(fm2)-1,fm2))*`fjeforms/step`(fm1,op(nops(fm2),fm2))
	  - `fjeforms/wedge`(`fjeforms/step`(fm1,`fjeforms/wedge`(op(1 .. nops(fm2)-1,fm2))) 
	    , op(nops(fm2),fm2))
    else 'step(fm1,fm2)'
    fi
end;


# The following is a simple adaptation of the code for
# `difforms/arraywedge` to the needs of `fjeforms/arraystep`.

`fjeforms/arraystep` :=
proc(A,B)
local localA,localB,i,j,k,n,m,l,C;
options `Copyright (arraywedge) 1990 by the University of Waterloo`,
	`Adaptation (arraystep) copyright 1992 by FJE ENTERPRISES`;
    if nargs <> 2 then ERROR(`wrong number of arguments`) fi;
    if not type(A,'matrix') then ERROR(`expecting a matrix`) fi;
    n := linalg['rowdim'](A);
    m := linalg['coldim'](A);
    if type(B,'matrix') then
        if linalg['rowdim'](B) <> m then
            ERROR(`matrix dimensions incompatible`)
        fi;
        l := linalg['coldim'](B);
        C := array(1 .. n,1 .. l);
        localA := A;
        localB := B;
        for i to n do
            if 2 < printlevel then lprint(`linalg multiply: row`,i) fi;
            for j to l do
                C[i,j] :=
                    '`fjeforms/step`(localA[i,k],localB[k,j])' $ (k = 1 .. m);
                C[i,j] := convert([C[i,j]],`+`);
                if type(C[i,j],`+`) then C[i,j] := normal(C[i,j]) fi
            od
        od
    elif type(B,{list,vector}) then
        if linalg['vectdim'](B) <> m then
            ERROR(`matrix/vector dimensions incompatible`)
        fi;
        C := array(1 .. n);
        localA := A;
        localB := B;
        for i to n do
            C[i] := '`fjeforms/step`(localA[i,k],localB[k])' $ (k = 1 .. m);
            C[i] := convert([C[i]],`+`);
            if type(C[i],`+`) then C[i] := normal(C[i]) fi
        od
    else ERROR(`expecting a matrix or a vector`)
    fi;
    subs('localA' = localA,'localB' = localB,op(C));
    if has(",'localA') or has(",'localB') then
        ERROR(`undefined elements in matrix or vector`)
    fi;
    RETURN(")
end;

# wdegree.m	Copyright (C) 1992 by FJE ENTERPRISES

# Revised 'difforms/wdegree' by FJE ENTERPRISES 
# The main difference from difforms/wdegree is in 
# the assignment of a wdegree to functions such as
# cc, star and step.

`fjeforms/wdegree` := proc (fm)
local a, i, P; 
options remember, `Copyright 1990 by the University of Waterloo`, 
		  `Date: 8-28-92`,
	          `Revisions copyright 1992 by FJE ENTERPRISES`;
	if type(fm,indexed) then 
	   P := `fjeforms/wdegree`(op(0,fm)) 
	elif type(fm,{name, const}) then 
	   P := 0 
	elif type(fm,`+`) then 
	   P := `fjeforms/wdegree`(op(1,fm)); 
	   for i from 2 to nops(fm) 
	   while `fjeforms/wdegree`(op(i,fm)) = P do  od; 
	   if i <= nops(fm) then 
	      ERROR(`forms of different degree added`) 
	   fi 
	elif type(fm,`*`) then 
        	(fjeforms[formpart])(fm); 
		if " = 1 then P := 0 
		elif type(",`*`) then 
		   ERROR(`undefined product of forms`) 
		else P := `fjeforms/wdegree`(") 
		fi 
	elif type(fm,function) then 
	     op(0,fm); 
	     if " = `&^` then 
		P := 0; 
	        for a in fm do 
	 	   P := P+`fjeforms/wdegree`(a) 
	        od 
	     elif " = cc then 
		P := `fjeforms/wdegree`(op(fm)) 
             elif " = star then 
		P := DIMENSION-`fjeforms/wdegree`(op(fm)) 
             elif " = step then 
		P := `fjeforms/wdegree`(op(2,fm))
		   -`fjeforms/wdegree`(op(1,fm)); 
		if P < 0 then 0
                else P 
		fi 
             elif " = d then 
	        P := `fjeforms/wdegree`(op(fm))+1 
             elif member(true,map(type,[op(fm)],form)) then 
		ERROR(`Illegal function of form(s)`) 
             else P := 0
             fi 
	elif type(fm,`**`) then 
	     P := op(2,fm)*`fjeforms/wdegree`(op(1,fm)) 
	else P := 0 
	fi; 
	P
 end;
`fjeforms/wedge` :=
proc()
local i,j,parms,cf,nf,t,n,dum;
options remember,`Copyright 1990 by the University of Waterloo`;
    for i to nargs while not type(args[i],`=`) do   od;
    if i <= nargs then
        for j from i to nargs while not type(args[j],`=`) do   od;
        if j <= nargs then ERROR(`two equations in call to &^`)
        else
            `fjeforms/wedge`(args[1 .. i-1],op(1,args[i]),args[i+1 .. nargs])
               =
              `fjeforms/wedge`(args[1 .. i-1],op(2,args[i]),args[i+1 .. nargs])
              ;
            RETURN(")
        fi
    fi;
    if (nargs = 2) and (type(args[1],'array') or type(args[2],'array')) then
        RETURN(`fjeforms/arraywedge`(args))
    fi;
    if member(0,[args[1 .. nargs]]) then RETURN(0) fi;
    cf := 1;
    parms := NULL;
    for t in args while cf <> 0 do
        if
          type(t,function) and ((op(0,t) = `&^`) or (op(0,t) = fjeforms[`&^`]))
           then
            parms := parms,op(t)
        elif type(t,{const,scalar}) then cf := cf*t
        elif type(t,`*`) then
            n := t;
            nf := 1;
            for j from nops(t) by -1 to 1 do
                if type(op(j,t),form) and
                    (type(t/op(j,t),const) or type(t/op(j,t),scalar)) then
                    if type(op(j,t),function) and (op(0,op(j,t)) = `&^`) then
                        n := op(op(j,t))
                    else n := op(j,t)
                    fi;
                    nf := t/op(j,t);
                    break
                elif type(op(j,t),{const,scalar}) then
                    nf := nf*op(j,t); n := n/op(j,t)
                fi
            od;
            cf := cf*nf;
            parms := parms,n
        else parms := parms,t
        fi
    od;
    n := nops([parms]);
    if (n = 1) or (cf = 0) then cf*parms
    elif n = 0 then cf
    else
        if n <> nops({parms}) then
            t := table(sparse);
            for i to n do
                t[parms[i]] := t[parms[i]]+1;
                if
                (" = 2) and (fjeforms[parity](fjeforms[wdegree](parms[i])) = 1)
                 then
                    RETURN(0)
                fi
            od
        fi;
        for i to n while not type(parms[i],`+`) do   od;
        if i <= n then
            map(proc()
                    [args[3 .. args[2]+1],args[1],args[args[2]+2 .. nargs]]
                end                                                        ,
                parms[i],i,parms[1 .. i-1],parms[i+1 .. n]);
            map(proc(x) `fjeforms/wedge`(op(x)) end,");
            `simpform/sum`(");
            if type(",`+`) then map(proc() args[2]*args[1] end,",cf)
            else cf*"
            fi
        else cf*subs(dum = parms,'`&^`(dum)')
        fi
    fi
end:

`fjeforms/arraywedge` :=
proc(A,B)
local localA,localB,i,j,k,n,m,l,C;
options `Copyright 1990 by the University of Waterloo`;
    if nargs <> 2 then ERROR(`wrong number of arguments`) fi;
    if not type(A,'matrix') then ERROR(`expecting a matrix`) fi;
    n := linalg['rowdim'](A);
    m := linalg['coldim'](A);
    if type(B,'matrix') then
        if linalg['rowdim'](B) <> m then
            ERROR(`matrix dimensions incompatible`)
        fi;
        l := linalg['coldim'](B);
        C := array(1 .. n,1 .. l);
        localA := A;
        localB := B;
        for i to n do
            if 2 < printlevel then lprint(`linalg multiply: row`,i) fi;
            for j to l do
                C[i,j] :=
                    '`fjeforms/wedge`(localA[i,k],localB[k,j])' $ (k = 1 .. m);
                C[i,j] := convert([C[i,j]],`+`);
                if type(C[i,j],`+`) then C[i,j] := normal(C[i,j]) fi
            od
        od
    elif type(B,{list,vector}) then
        if linalg['vectdim'](B) <> m then
            ERROR(`matrix/vector dimensions incompatible`)
        fi;
        C := array(1 .. n);
        localA := A;
        localB := B;
        for i to n do
            C[i] := '`fjeforms/wedge`(localA[i,k],localB[k])' $ (k = 1 .. m);
            C[i] := convert([C[i]],`+`);
            if type(C[i],`+`) then C[i] := normal(C[i]) fi
        od
    else ERROR(`expecting a matrix or a vector`)
    fi;
    subs('localA' = localA,'localB' = localB,op(C));
    if has(",'localA') or has(",'localB') then
        ERROR(`undefined elements in matrix or vector`)
    fi;
    RETURN(")
end:
# TABLE

fjeforms[`&^`] := proc() `fjeforms/wedge`(args) end:
fjeforms[mixpar] := proc() `fjeforms/mixpar`(args) end:
fjeforms[formpart] := proc() `fjeforms/formpart`(args) end:
fjeforms[scalarpart] := proc() `fjeforms/scalarpart`(args) end:
fjeforms[parity] := proc() `fjeforms/parity`(args) end:
fjeforms[simpform] := proc() `fjeforms/simpform`(args) end:
fjeforms[defform] := proc() `fjeforms/defform`(args) end:
fjeforms[wdegree] := proc() `fjeforms/wdegree`(args) end:
fjeforms[d] := proc() `fjeforms/d`(args) end:
fjeforms[complex] := proc() `fjeforms/complex`(args) end:
fjeforms[cc] := proc() `fjeforms/cc`(args) end:


fjeforms[re] := proc() `fjeforms/re`(args) end:
fjeforms[im] := proc() `fjeforms/im`(args) end:
fjeforms[coef] := proc() `fjeforms/coef`(args) end:
fjeforms[perm] := proc() `fjeforms/perm`(args) end:
fjeforms[step] := proc() `fjeforms/step`(args) end:
fjeforms[star] := proc() `fjeforms/star`(args) end:

# REVISED TYPES

# type/const --- Revisions copyright (C) 1992 by FJE ENTERPRISES

#	The procedure has been changed substantially.  In particular,
#	it is used to perform various checks, that the user has not
#	attempted to use differential forms in ways that we deem
#	to be illegal.  Thus, for example, forms of different order
#	are not to be added.  Ordinary multiplication or exponentiation
#	of differential forms is considered illegal as well.  The 
# 	procedure has also been modified to handle star and step
#	appropriately.

`type/const` :=
proc(expr)
local i,n;
options remember,`Copyright 1990 by the University of Waterloo`,
    `Date:  6-8-92`,`Revisions copyright 1992 by FJE ENTERPRISES`;
    if type(expr,function) and
        ((op(0,expr) = star) or (op(0,expr) = step) or (op(0,expr) = d)) then
        false
    elif type(expr,constant) then true
    elif type(expr,`**`) and type(op(2,expr),form) then
        ERROR(`form used as exponent`)
    elif type(expr,`**`) and type(op(1,expr),form) then
        ERROR(`form raised to a power`)
    elif type(expr,`+`) then
        for i to nops(expr) while type(op(i,expr),const) do   od;
        if evalb(nops(expr) < i) then true
        else
            wdegree(op(1,expr));
            for i from 2 to nops(expr) while wdegree(op(i,expr)) = " do   od;
            if i <= nops(expr) then ERROR(`forms of different degree added`)
            fi;
            false
        fi
    elif type(expr,`*`) then
        for i to nops(expr) while type(op(i,expr),const) do   od;
        if evalb(nops(expr) < i) then true
        else
            n := 0;
            for i to nops(expr) do
                if type(op(i,expr),form) then
                    n := n+1;
                    if 1 < n then
                        ERROR(`"*" multiplication of forms not permitted`)
                    fi
                fi
            od;
            false
        fi
    elif type(expr,`**`) then
        evalb(type(op(1,expr),const) and type(op(2,expr),const))
    elif type(expr,'function') then
        op(0,expr);
        if (" = fjeforms[wdegree]) or (" = wdegree) then
            ERROR(`undefined wdegree`)
        elif " = cc then type(op(1,expr),const)
        else false
        fi
    else false
    fi
end:


# type/form --- Revisions copyright (C) 1992 by FJE ENTERPRISES

#	We have made type/form handle functions cc, star and step
#	appropriately.

`type/form` :=
proc(expr)
local P,i;
options remember,`Copyright 1990 by the University of Waterloo`,
    `Date:  6-3-92`,`Revisions copyright 1992 by FJE ENTERPRISES`;
    if (nargs = 2) and type(args[2],integer) and (0 < args[2]) then
        evalb(type(expr,form) and (fjeforms[wdegree](expr) = args[2]))
    elif nargs = 1 then
        if type(expr,{name,const}) then RETURN(false)
        elif type(expr,'indexed') then RETURN(type(op(0,expr),form))
        elif type(expr,{`+`,`*`}) then
            P := type(op(nops(expr),expr),form);
            for i to nops(expr)-1 while not P do
                P := type(op(i,expr),form)
            od;
            RETURN(P)
        elif type(expr,`**`) then false
        elif type(expr,'function') then
            op(0,expr);
            if (" = `&^`) or (" = d) then true
            elif " = cc then type(op(1,expr),form)
            elif " = star then evalb(wdegree(op(1,expr)) <> DIMENSION)
            elif " = step then
                evalb(
                  fjeforms[wdegree](op(1,expr)) < fjeforms[wdegree](op(2,expr))
                  )
            else false
            fi
        else false
        fi
    else ERROR(`wrong number or type or arguments`)
    fi
end:

# type/scalar --- Revisions copyright (C) 1992 by FJE ENTERPRISES

#	The procedure has been simplified, since any object not
#	specifically defined as a constant or a form is deemed
#	to be a scalar.

`type/scalar` :=
proc(expr)
local i;
options remember,`Copyright 1990 by the University of Waterloo`,
    `Date:  6-3-92`,`Revisions copyright 1992 by FJE ENTERPRISES`;
    if nargs = 1 then 
       if type(expr,{form,const}) then 
	  false 
       else true 
       fi
    else ERROR(`wrong number or type or arguments`)
    fi
end:

`help/fjeforms/text/cc` := TEXT(
`FUNCTION: cc - returns complex conjugate of Maple expression`,
`      `,
`CALLING SEQUENCE:`,
`   cc(expr)`,
`      `,
`PARAMETERS:`,
`   expr - Maple expression`,
`      `,
`SYNOPSIS:   `,
`- cc returns complex conjugate of expr`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms);`,
`> complex(x,y);`,
`   `,
`> cc(2*(x+I*y)-3*(y+I*z));`,
`                 2 cc(x) - 2 I cc(y) - 3 cc(y) + 3 I z`,
`   `,
`SEE ALSO:  complex, re, im `
):
`help/fjeforms/text/coef` := TEXT(
`FUNCTION: coef - components of differential forms`,
`      `,
`CALLING SEQUENCE:`,
`   coef(expr,fm)`,
`      `,
`PARAMETERS:`,
`   expr - maple expression`,
`   fm - the name, or a &^-product of names of differential forms`,
`      `,
`SYNOPSIS:   `,
`- When wdegree(expr) <> wdegree(fm), coef returns 0.`,
`   `,
`- When wdegree(expr) = wdegree(fm), coef returns the scalar coefficient`,
`  of fm in expr.`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms): defform(u=1,v=1,B=2);`,
`   `,
`> a := x*y*&^(u,v)+z*B;`,
`   `,
`> coef(a,B);`,
`				   z   `,
`   `,
`> coef(a,&^(u,v));`,
`				  x y   `,
`   `,
`   `
):
`help/fjeforms/text/complex` := TEXT(
`LIBRARY:  complex - consists of functions complex, cc, re and im.`,
`   `,
`FUNCTION: complex - declare name to represent complex variable`,
`      `,
`CALLING SEQUENCE:`,
`   complex(x,y,z,...);`,
`      `,
`PARAMETERS:`,
`   x,y,z,...  names of variables to be declared complex`,
`      `,
`SYNOPSIS:   `,
`- complex causes names to be placed upon in an internal set of complex `,
`  variables.`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms):`,
`   `,
`> complex(x,y,z);`,
`			    { x, y, z }`,
`   `,
`SEE ALSO:  cc, re, im `
):
`help/fjeforms/text/const` := TEXT(
`      `,
`FUNCTION: type/const - extension of type/constant`,
`      `,
`CALLING SEQUENCE:`,
`   type(expr, const );`,
`      `,
`PARAMETERS:`,
`   expr - maple expression`,
`      `,
`SYNOPSIS:   `,
`- type/const includes any expr which is type/constant, plus those names which`,
`  are defined to be const through defform.`,
`      `,
`- All sums, products, or powers of objects of type/const are considered to be`,
`  type/const.`,
`      `,
`- type/const, type/form and type/scalar are mutually exclusive.  Any expression`,
`  should belong to at most one of these types.`,
`      `,
`- type/const also performs some checking that the user has not attempted to`,
`  exponentiate forms, to evaluate ordinary products of forms, or to add forms`,
`  of different wdegrees, all of which are considered illegal operations.`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms): defform(a=const,b=const,c=const,d=const);`,
`> type(a,const);        `,
`                                      true`,
`      `,
`> type(a+b*c^d,const);  `,
`                                      true`,
`      `,
`> type(e+a,const);      `,
`                                     false`,
`      `
):
`help/fjeforms/text/d` := TEXT(
`FUNCTION: d - exterior differentiation`,
`      `,
`CALLING SEQUENCE:`,
`   d( expr ) or d( expr, pair1, pair2, ..) `,
`      `,
`PARAMETERS:`,
`   expr    - expression or list of expressions`,
`   pairn - (optional) list, of which the first member is a 1-form`,
`	   and the second member is a string`,
`      `,
`SYNOPSIS:   `,
`- d computes the exterior derivative of an expression.  If the expression is a`,
`  list, then d is applied to each element in the list.`,
`   `,
`  When d is called with additional pairs, pair1, pair2, etc., any scalar in `,
`  the expression will be expanded in the 1-forms identified in the pairs.  It `,
`  is assumed that the 1-forms are independent.  For each 1-form, a new scalar `,
`  function is created, using the name supplied in the associated string, to be `,
`  the component for that 1-form.`,
`      `,
`EXAMPLES:   `,
`> with(fjeforms):`,
`> defform(k=1,m=1,e1=1,e2=1,e3=1);`,
`> d( x^2*y );              `,
`                                            2`,
`                              2 x y d(x) + x  d(y)`,
`      `,
`> d( f(x,y,z) );           `,
`     D[1](f)(x, y, z) d(x) + D[2](f)(x, y, z) d(y) + D[3](f)(x, y, z) d(z)`,
`      `,
`> d( f, [e1,``d[1]``], [e2,``d[2]``], [e3,``d[3]``]);`,
`		     d[1](f) e1 + d[2](f) e2 + d[3](f) e3`,
`   `,
`> d( f, [k,``d[m]``] , [m,``d[k]]);`,
`			     d[m](f) k + d[k](f) m`,
`      `,
`> d( f*&^(w1,w2) );        `,
`              &^(d(f), w1, w2) + f (d(w1) &^ w2) - f (w1 &^ d(w2))`,
`      `,
`> d( [x*y,y^2,w2] );       `,
`                       [y d(x) + x d(y), 2 y d(y), d(w2)]`,
`      `,
`SEE ALSO:  D, diff, difforms, difforms[mixpar]`,
`> quit   `,
`bytes used=68584, alloc=65524, time=.150`
):
`help/fjeforms/text/defform` := TEXT(
`FUNCTION: defform - define a constant or form`,
`      `,
`CALLING SEQUENCE:`,
`   defform( <n1> = <e1>, <n2> = <e2>, . . . )`,
`      `,
`PARAMETERS:`,
`   <n1>, <n2>, ... - names or calls to d`,
`   <e1>, <e2>, ... - non-negative integers or keyword 'const'`,
`      `,
`SYNOPSIS:   `,
`- defform is used to define the basic variables used in a computation, or to`,
`  define the exterior derivative of an expression.`,
`      `,
`- defform clears the remember tables of all functions in the fjeforms package, `,
`  as changing the definition of a form can make the remembered results invalid.`,
`  However, definitions made through defform are not cleared; they are remem-`,
`  bered permanently.`,
`      `,
`- defform takes an arbitrary number of equations, where each equation is <name>`,
`  = <non-nagative integer>, <name> = const, or d(<expr1>) = <expr2>.  The first `,
`  means that type(<name>,form(<positive integer>)) is true and wdegree(<name>) `,
`  = <positive integer>, or type(<name>,scalar) is true and wdegree(<name>) = 0.`,
`  The second means type(<name>,const) is true and wdegree(<name>) = 0.  The last `,
`  defines the exterior derivative of <expr1> to be <expr2>.  (Note that if <expr2>`,
`  involves forms declared in the present invocation of defform, <expr2> should`,
`  be unevaluated.)  These derivatives are remembered permanently. `,
`   `,
`- All names not explicitly declared using defform are automatically assumed to`,
`  represent scalars, i.e., type(<name>,scalar) is true and wdegree(<name>) = 0.`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms): `,
`> defform(a=const,u=1,v=1,d(x)=u,d(u)='u &^ v');`,
`> type(a,const);            `,
`                                      true`,
`      `,
`> type(b,scalar);           `,
`                                      true`,
`      `,
`> type(u,form),wdegree(u);  `,
`                                    true, 1`,
`      `,
`> type(d(x),form),wdegree(d(x));`,
`				    true, 1`,
`   `,
`> type(d(u),form),wdegree(d(u));  `,
`                                    true, 2`,
`      `,
`> d(u);                     `,
`                                     u &^ v `,
`      `
):
`help/fjeforms/text/examples` := TEXT(
`APPLICATION PROGRAMS USING FJEFORMS PACKAGE:`,
`      `,
`Each of the following is an adaptation of an older program written`,
`for the Grad Student Rational Calculator program of F. J. Ernst.`,
`   `,
` (1) kerr.in - derivation the null tetrad components of the Weyl`,
`	       conform tensor, the tracefree part of the Ricci tensor`,
`	       and the curvature scalar, together with the connection`,
`	       one forms, using the Hauser-Ernst notation and`,
`	       conventions.`,
`   `,
` (2) ts.in - derivation and comparison of the left and right hand `,
`	     sides of the Ernst equation for the simplest solution of `,
`	     Tomimatsu and Sato.`,
`   `,
` (3) np.in - derivation of the Newman-Penrose commutation relations `,
`	     and curvature quantities using the Hauser-Ernst notation`,
`             and conventions.`,
`   `,
` (4) bianchi.in - derivation of the Newman-Penrose Bianchi identities`,
`		  using the Hauser-Ernst notation and conventions.`,
`   `,
` (5) basis.in - derivation of the Ricci rotation matrix corresponding`,
`		to a generalized basis (neither the natural coordinate`,
`		basis nor an orthonormal or null tetrad basis).`,
`   `,
`EXAMPLE:  To run the program kerr.in do:`,
`   `,
`> read ````.libname.``/fjeforms/in/kerr.in``;`,
`   `,
`Output will appear in a file kerr.out in the working directory.`,
`   `,
`   `
):
`help/text/fjeforms` := TEXT(
`HELP FOR: The FJE ENTERPRISES differential forms package`,
`      `,
`CALLING SEQUENCE:`,
`   fjeforms[ <function> ] ( args ); or <function> ( args );`,
`      `,
`SYNOPSIS:   `,
`- To use a fjeforms function, either define that function alone by typing`,
`  with( fjeforms, <function> ), or define all fjeforms functions by typing`,
`  with( fjeforms ).`,
`      `,
`- The functions available are:`,
`      `,
`                   &^            d       defform     formpart`,
`                   mixpar        parity  scalarpart  simpform`,
`                   wdegree	 perm    coef        star`,
`		   step          cc      re          im`,
`		   complex`,
`                   `,
`- The functions &^, formpart, mixpar, parity, scalarpart, and simpform are`,
`  exactly the same as the corresponding functions in the difforms package.`,
`     `,
`- The difform functions d, defform, and wdegree have been revised by`,
`  FJE ENTERPRISES, as have been the functions type/const, type/form and`,
`  type/scalar.`,
`   `,
`- The functions perm, coef, star and step are unique to the fjeforms `,
`  package, as are the functions complex, cc, re and im.`,
`   `,
`- For help with a particular function do: help(fjeforms, <function>);`,
`      `,
`- For help with the basic types used by the package (const, scalar, form), do:`,
`  help(fjeforms, const); or help(fjeforms, scalar); or help(fjeforms, form);`,
`      `,
`- For a brief description of some application programs using the fjeforms`,
`  package do:  help(fjeforms, examples);`,
`   `,
`- Address:  FJE ENTERPRISES`,
`	    Rt. 1, Box 246A`,
`	    Potsdam, NY 13676`,
`   `,
`ACKNOWLEDGMENT:  The preparation of the fjeforms package by FJE ENTERPRISES `,
`  was supported in part by grant No. PHY 91-16681 from the U.S. National `,
`  Science Foundation.`,
`   `,
`SEE ALSO:  with, difforms`
):
`help/fjeforms/text/form` := TEXT(
`      `,
`FUNCTION: type/form - check for forms`,
`      `,
`CALLING SEQUENCE:`,
`   type( expr, form );`,
`   type( expr, form, <int> );`,
`      `,
`PARAMETERS:`,
`   expr  - maple expression`,
`   <int> - (optional) positive integer`,
`      `,
`SYNOPSIS:   `,
`- type(expr,form,<int>) is true if type(expr,form) is true and`,
`  wdegree(expr)=<int>, i.e. expr is an <int>-form`,
`      `,
`- type/form includes all expressions declared to be forms through defform, as`,
`  well any exterior derivative, any wedge product of forms, any ordinary `,
`  product involving one factor of type/form and any sum of terms of the same `,
`  nonvanishing wdegree.`,
`      `,
`- type/const, type/scalar, and type/form are mutually exclusive.  Any expres-`,
`  sion can belong to at most one of these types.`,
`      `,
`EXAMPLES:   `,
`> with(fjeforms): defform(a=const,f=1,g=2,h=1);`,
`   `,
`> type(a*b*f, form);`,
`                                      true `,
`      `,
`> type(a * f &^ h + x * g,form);`,
`				      true`,
`   `,
`> type(x * f &^ g,form(3));`,
`				      true`,
`     `
):
`help/fjeforms/text/im` := TEXT(
`FUNCTION: im - returns imaginary part of Maple expression`,
`      `,
`CALLING SEQUENCE:`,
`   im(expr)`,
`      `,
`PARAMETERS:`,
`   expr - Maple expression`,
`      `,
`SYNOPSIS:   `,
`- im returns imaginary part of expr`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms);`,
`> complex(x,y);`,
`   `,
`> re(2*(x+I*y)-3*(y+I*z));`,
`    -1/2 (2 x + 2 I y - 3 y - 6 I z - 2 cc(x) + 2 I cc(y) + 3 cc(y)) I`,
`   `,
`SEE ALSO:  complex, cc, re`
):
`help/fjeforms/text/perm` := TEXT(
`FUNCTION: perm - components of differential forms`,
`      `,
`CALLING SEQUENCE:`,
`   perm(fm1,fm2)`,
`      `,
`PARAMETERS:`,
`   fm1, fm2 - Maple expressions`,
`   `,
`SYNOPSIS:   `,
`- When wdegree(fm1) <> wdegree(fm2) perm returns 0.`,
`   `,
`- When wdegree(fm1) = wdegree(fm2) and simpform(fm1+fm2)=0, perm returns -1.`,
`   `,
`- When wdegree(fm1) = wdegree(fm2) and simpform(fm1-fm2)=0, perm returns 1.`,
`   `,
`- Otherwise, perm returns 0.`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms): defform(u=1,v=1,B=2);`,
`   `,
`> perm(u &^ v,v &^ u);`,
`				-1   `,
`   `,
`> perm(u &^ B,B &^ u);`,
`				 1   `,
`   `,
`> perm(u &^ v,w &^ v);`,
`				 0   `,
`   `
):
`help/fjeforms/text/re` := TEXT(
`FUNCTION: re - returns real part of Maple expression`,
`      `,
`CALLING SEQUENCE:`,
`   re(expr)`,
`      `,
`PARAMETERS:`,
`   expr - Maple expression`,
`      `,
`SYNOPSIS:   `,
`- re returns real part of expr`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms);`,
`> complex(x,y);`,
`   `,
`> re(2*(x+I*y)-3*(y+I*z));`,
`           x + I y - 3/2 y + cc(x) - I cc(y) - 3/2 cc(y)`,
`   `,
`SEE ALSO:  complex, cc, im `
):
`help/fjeforms/text/scalar` := TEXT(
`      `,
`FUNCTION: type/scalar - check for scalars`,
`      `,
`CALLING SEQUENCE:`,
`   type( expr, scalar );`,
`      `,
`PARAMETERS:`,
`   expr - maple expression`,
`      `,
`SYNOPSIS:   `,
`- type/scalar includes all names not defined to be type/scalar or type/form `,
`  through defform.`,
`      `,
`- Any sum or product which contains one term/factor that is type/scalar, and`,
`  the remaining terms/factors are all either type/scalar or type/const, is con-`,
`  sidered to be type/scalar.`,
`      `,
`- Any power, where the base or exponent is type/scalar, is considered to be `,
`  type/scalar.`,
`      `,
`- type/const, type/scalar, and type/form are mutually exclusive.  Any expres-`,
`  sion can belong to at most one of these types.`,
`      `,
`EXAMPLES:   `,
`> with(fjeforms): defform(a=const,b=const);`,
`> type(c+d^3,scalar);   `,
`                                      true`,
`      `,
`> type(a+d,scalar);     `,
`                                      true`,
`      `,
`> type(a+d+f,scalar);   `,
`                                      true `,
`      `,
`> type(a+b,scalar);     `,
`                                     false`,
`      `
):
`help/fjeforms/text/star` := TEXT(
`FUNCTION: star - The duality operator on forms`,
`      `,
`CALLING SEQUENCE:`,
`   star(expr)`,
`      `,
`PARAMETERS:`,
`   expr - maple expression`,
`      `,
`SYNOPSIS:   `,
`- When wdegree(expr) <= DIMENSION, star returns the dual of the form expr.  `,
`  Note that wdegree(star(expr)) = DIMENSION - wdegree(expr).`,
`   `,
`- When wdegree(expr) > DIMENSION an error condition is reported.`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms): defform(u=1,v=1,B=2);`,
`   `,
`> DIMENSION := 3;`,
`   `,
`> star(u &^ v + B);`,
` 		       star(u &^ v) + star(B)`,
`   `,
`> wdegree(");`,
`				 1   `,
`   `,
`   `
):
`help/fjeforms/text/step` := TEXT(
`FUNCTION: step - asymmetrical Grassman inner product of two forms`,
`      `,
`CALLING SEQUENCE:`,
`   step(fm1,fm2)`,
`      `,
`PARAMETERS:`,
`   expr - maple expression`,
`      `,
`SYNOPSIS:   `,
`- step calculates the asymmetrical Grassman inner product of two`,
`  forms, returning 0 if wdegree(fm1) > wdegree(fm2).`,
`      `,
`- When wdegree(fm1) <= wdegree(fm2), wdegree(step(fm1,fm2)) = `,
`  wdegree(fm2) - wdegree(fm1).`,
`   `,
`EXAMPLES:   `,
`> with(fjeforms): defform(u=1,v=1,w=1,B=2);`,
`   `,
`> step(u,v &^ w);`,
` 		     v step(u, w) - step(u, v) w`,
`   `,
`> step(v &^ w,u);`,
`		        	0`,
`> step(u &^ v,u &^ w);`,
`	 step(v, w) step(u, u) - step(v, u) step(u, w)`,
`   `,
`> step(u &^ v,B);`,
`		         step(u,step(v,B))`,
`   `,
`   `
):
`help/fjeforms/text/wdegree` := TEXT(
`FUNCTION: wdegree - degree of a form`,
`      `,
`CALLING SEQUENCE:`,
`   wdegree( expr );`,
`      `,
`PARAMETERS:`,
`   expr - maple expression`,
`      `,
`SYNOPSIS:   `,
`- wdegree computes the degree of an expression, considered as a form.`,
`      `,
`- wdegree issues an error message when expr is a sum of forms of `,
`  different degrees, involves a form as the base or exponent of a`,
`  power or involves two or more forms in an ordinary (non-wedge)`,
`  product.   `,
`      `,
`- Expressions of type scalar or const have wdegree = 0.`,
`      `,
`EXAMPLES:   `,
`> with(fjeforms): defform(x=1, c=const); `,
`> wdegree( c );           `,
`                                       0`,
`      `,
`> wdegree( x );           `,
`                                       1`,
`     `,
`> wdegree( y );`,
`				       0`,
`   `,
`> wdegree(d(y));`,
`				       1`,
`   `
):

save `fjeforms.m`;
quit
