{VERSION 3 0 "IBM INTEL NT" "3.0" } {USTYLETAB {CSTYLE "Maple Input" -1 0 "Courier" 0 1 255 0 0 1 0 1 0 0 1 0 0 0 0 }{PSTYLE "Normal" -1 0 1 {CSTYLE "" -1 -1 "" 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 }0 0 0 -1 -1 -1 0 0 0 0 0 0 -1 0 }} {SECT 0 {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 15 "# Sept 22, 2000" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 "# restart;" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 22 "liealg[init] := proc()" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " \+ description `initializing function, called when the package liealg is \+ loaded`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 127 " global GENERATORS, \+ ALGEBRA, WITHRULES, DIRECTSUMS, FACTORALGS, TRIANGALGS, INITFLAG, MODF LAG, MODVALUE, SIMPLE, MATRIX_TYPE;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " if( INITFLAG <> evaln(INI TFLAG) and INITFLAG ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ RETURN(evaln(init()));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1409 " unprotect(evaln(INITFLAG), evaln(GENERATORS), evaln(DIRECTSUMS), evaln(FACTORALGS), evaln(TRIANGALGS), evaln(DONTPR INT), evaln(free_plus), evaln(free_minus), evaln(_plus), evaln(_minus) , evaln(_zero),evaln(SIMPLE), evaln(dump), evaln(delta), evaln(generat ors), evaln(ideal), evaln(directsum), evaln(use), evaln(`&>`), evaln(` &<`), evaln(`&=`), evaln(`&>=`), evaln(`&<=`), evaln(`&<>`), evaln(eva luate), evaln(`&!<`), evaln(`&!>`), evaln(`&!>=`), evaln(`&!<=`), eval n(`&!=`), evaln(`&!<>`), evaln(extract), evaln(isgenerator), evaln(fun ctionize), evaln(reduce), evaln(simplify), evaln(store), evaln(delete) , evaln(wt), evaln(independent), evaln(symbasis), evaln(expand), evaln (lieconvert), evaln(listtolie), evaln(comp), evaln(genbasis), evaln(tr iangular), evaln(scpd), evaln(triangularsimplify), evaln(factoralg), e valn(factorsimplify), evaln(stableset), evaln(overlap), evaln(subwd), \+ evaln(comparewts), evaln(genhallmon), evaln(genhallmonom), evaln(grab) , evaln(`&*`), evaln(MODFLAG), evaln(MODVALUE), evaln(char), evaln(mai nsimplify), evaln(simple), evaln(matbase), evaln(Anmat), evaln(Dnmat), evaln(Enmat), evaln(Bnmat), evaln(Cnmat), evaln(Fnmat), evaln(Gnmat), evaln(simplefunction_ADE_matrix), evaln(simplefunction_B_matrix), eva ln(simplefunction_C_matrix), evaln(F4Lookup), evaln(G2Lookup), evaln(A LGEBRA), evaln(MATRIX_TYPE), evaln(epsilon_type_A), evaln(epsilon_type _D), evaln(epsilon_type_E));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### load other half of the pa ckage (functions unseen by the user)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " with(hidden);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### init our global variables " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 220 " GENERATORS := []; WITHRU LES := \{\}; DIRECTSUMS := \{\}; FACTORALGS := \{\}; TRIANGALGS := \{ \}; INITFLAG := true; MODFLAG := false; MODVALUE := 'MODVALUE'; SIMPLE := \{\}; ALGEBRA := 'ALGEBRA'; MATRIX_TYPE := 'MATRIX_TYPE';" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 881 " protect(evaln(INITFLAG), evaln(GENERATORS), evaln(DIRECTSUMS ), evaln(FACTORALGS), evaln(TRIANGALGS), evaln(SIMPLE), DONTPRINT,free _plus, free_minus, _plus, _minus, _zero, dump, delta, generators, idea l, directsum, use, `&>`, `&<`, `&=`, `&>=`, `&<=`, `&<>`, evaluate, `& !<`, `&!>`, `&!>=`, `&!<=`, `&!=`, `&!<>`, extract, isgenerator, funct ionize, reduce, simplify, store, delete, wt, independent, symbasis, ex pand, lieconvert, listtolie, comp, genbasis, triangular, triangularsim plify, factoralg, factorsimplify, stableset, overlap, subwd, comparewt s, genhallmon, genhallmonom, grab, `&*`, MODVALUE, evaln(MODFLAG), mai nsimplify, char, simple, simplefunction_ADE_matrix, scpd, matbase, Anm at, Dnmat, Enmat, Bnmat, Cnmat, Fnmat, Gnmat, simplefunction_B_matrix, simplefunction_C_matrix, F4Lookup, ALGEBRA, MATRIX_TYPE, epsilon_type _A, epsilon_type_D, epsilon_type_E, G2Lookup);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " RETURN(NULL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 "hidden[dump] := proc() " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " description `debugging tool, dumps a procedures ha sh table (remember table)`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### print the current algebra in use " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs = 0 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " RETURN(ALGEBRA = );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### check to see if procedure exist" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 40 " elif( type(args[1], procedure) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### there could be no table associated with the procedure" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " if( op(4, eval( args[1])) <> NULL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " \+ RETURN(op(4, eval(args[1])));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### there is no table assoc. with the proc." }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " \+ RETURN(NULL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " ### proc. doesn't exist" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(FAIL);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 "hidden[grab] := proc (Alg::name)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " description `retu rns the generators for the requested algebra`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " local Table;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Table := dump(generators);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " if( Table <> NULL and member([ Alg],[indices(Table)]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ RETURN([Table[Alg]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(FAIL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 " end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 80 "### simulates the delta function, e xpects two arguments, both integers, or names" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "liealg[delta] := table(identity):" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 "hidden[field] := proc()" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " description `through field() it is possible to set the MODVALUE`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarati ons" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " global MODFLAG, MODVALUE; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs > 1 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " \+ ERROR(`field() expects zero or one (integer) argument, received`, ar gs);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " ### with no arguments, set the flag reversed (if w e have a MODVALUE defined)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " el if( nargs = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if( M ODVALUE = 'MODVALUE' ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " \+ ERROR(`there is no MODVALUE defined, can't set flag.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### OK to set f lag" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " unprotect(evaln(MODFLA G));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " MODFLAG := not(MODFLA G);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " protect(evaln(MODFLAG) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " if( MODFLAG ) then RETU RN(evaln(characteristic) = MODVALUE);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " else RETURN(`characteristic off`); fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### we hav e an argument, set stuff" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( not(type(args[1],inte ger)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ERROR(`fie ld() expects an integer argument, received`, args[1]);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### OK to go on" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " unprotect(evaln(MODVALUE),evaln(MOD FLAG));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " MODVALUE := args[1 ];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " MODFLAG := true;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " protect(evaln(MODVALUE),evaln (MODFLAG));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " RETURN(evaln(c haracteristic) = MODVALUE);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 "liealg[generators] := proc(Label::name,Gens::list(name)) " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " description `generators(algname, \{generators\}<,[weights]>) uses its remember-table to store" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " the different sets o f generators in a table form; everytime a new set of " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " generators is added, the list GEN ERATORS is set to that list by default`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " global GENERATORS, ALGEBRA; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " local Defwt, i, Len; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ ### let it remember stuff" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " r emember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### to o many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " if (nargs > \+ 3) then ERROR(`too many arguments`, args); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### a specia l weight is defined by the user" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if (nargs = 3) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### received something other \+ than a list of weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " if( not(type(args[3],list(list))) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ERROR(`expected list, received`, args[3]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " \+ ### we have a list of weights, lets validate them further" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### looping through the weights" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 34 " for i to nops(args[3]) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " \+ ### checking for different lengths for weights (which is inva lid)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( i >= 2 ) th en" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " if( nops(args[ 3][i-1]) <> nops(args[3][i]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " ERROR(`weights are of different length`,args[3][ i-1],args[3][i]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### app roved" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " Defwt := args[3]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### otherwis e need to create default weights for generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " D efwt := [seq([seq(0,i = 1..nops(Gens))], i = 1..nops(Gens))];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " for i to nops(Gens) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " Defwt[i][i] := 1;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### entries going into the table :" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " ### defining algebra name a nd corresponding generators, form: algname = generator-list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " generators(Label) := op(Gens): " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### inserting weight into table, form: (algname,'weight')=[weigh-list]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " generators(Label,weight) := Defwt:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### also hav e to add entries to the ideal table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### idealname and its generators, form: algname = gen-list" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ideal(Label) := op(Gens):" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ### ideal's generators' alg, for m: (algname,'algebra') = algname" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ideal(Label,algebra) := Label:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " ### no GENERATORS were de fined yet, setting default list (happens only at very first time) " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " if( GENERATORS = [] or Label = A LGEBRA ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " use(Label); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### output t o user" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " RETURN(Label = , Defwt);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 56 "liealg[directsum] := proc(Label::name,Algs::list(na me)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " description `directsum(d irsumname, \{alg1, alg2\}) This function produces a directsum of two \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " algebras; calling sequence: directsum([name of dir.sum. alg],\{set of (two) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " algebras\})`; " }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 18 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " global DIRECTSUMS;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " local Table, Weight1, Weight2, DefWeight, i;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### let it remember stuff" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 11 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### called with too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " if( nargs > 2 ) then ERROR(`too many arguments`, ar gs); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### getting generators table" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 36 " Table := op(4,eval(generators));" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### \+ if there are algebras..." }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if \+ (Table <> NULL) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### checking for first alg. is found " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " if (member([op(1,Algs)], \{indices(Table)\})) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### checking for second al g. is found" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " if (member( [op(2,Algs)],\{indices(Table)\})) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " ### entry going into table of the form: dirsum.alg . = alg1,alg2" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " direct sum(Label) := op(1,Algs),op(2,Algs):" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### al so creating an entry in the generators table of form: " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 51 " ### dirsum.alg. = gensofalg1,genso falg2" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " generators(Lab el) := Table[op(1,Algs)],Table[op(2,Algs)]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### getting the weights for the algebras" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " Weight1 := [op(Table[(op(1,Algs),weight)])];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " Weight2 := [op(Table[(o p(2,Algs),weight)])];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### if weights are of the sam e length concatenate them" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ if( nops(Weight1[1]) = nops(Weight2[1]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " DefWeight := [op(Weight1),op(Weig ht2)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### otherwise make them the same length" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### weights in Weight1 are longer " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " if( nops(Weight1 [1]) > nops(Weight2[1]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " \+ DefWeight := [seq([seq(0,i=1..nops(Weight1[1]))]" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " \+ ,i=1..nops(Weight1)+nops(Weight2))];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### weights in Weight2 are longer " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " D efWeight := [seq([seq(0,i=1..nops(Weight2[1]))]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ,i=1..nops(Weight1 )+nops(Weight2))];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### adding in the first algebra's weig hts" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " for i to nops (Weight1) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " D efWeight[i] := zip((x,y)->x+y,DefWeight[i],Weight1[i],0);" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 18 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### adding in the second algebra's wei ghts" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " for i to nop s(Weight2) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ DefWeight[i+nops(Weight1)] := " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " \+ zip((x,y)->x+y,DefWeight[i+nops(Weight1)],Weight2 [i],0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " od;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " # ## entry going in the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " \+ generators(Label, weight) := DefWeight:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### need to keep track of directsums in list form" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " ### this is done so I could check for an \+ algebra to be a direct sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " \+ unprotect(evaln(DIRECTSUMS));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " DIRECTSUMS := DIRECTSUMS union \{Label\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " protect(evaln(DIRECTSUMS));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### output for user" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " RETURN(Label = );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ ### second alg. is not defined" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " E RROR(op(2,Algs),`not defined.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### first alg. is not defined" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ERROR(op(1,Algs),`not defined.`); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### generators table is em pty" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 43 " ERROR(`no generators are defined.`);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 "liealg[ideal] := pro c(Label::name,Gens::list(algebraic)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " description `ideal(idealname, idealgens) let's the user defi ne an ideal`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### declarati ons" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " local Alg, i; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### let it remember stuff" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " remember; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### called \+ with too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( \+ nargs > 3 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ERROR(` too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ ### there is nothing defined" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ elif( GENERATORS = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " \+ ERROR(`no algebras defined in generators().`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### give n an algebra to be used" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " elif ( nargs = 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " if( no t(type(args[3], name)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " \+ ERROR(`expecting an algebra's name, recieved`, args[3]);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := AL GEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### chec king whether all the generators " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### of the ideal are in the specified alg." }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i to nops(Gens) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " extract(Gens[i], Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### entries going into the tabl e:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ideal(Label) := op(Gens): ### generators for the given ideal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ideal(Label, algebra) := Alg: ### algebra of the generator s for the ideal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### some output to user" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 31 " RETURN(Label = );" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 35 "liealg[use] := pro c(Algebra::name) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " description `use(algname) changes the algebra currently in use to the specified ( sets " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " GENERATORS \+ to that algebra)`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### decla rations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " global GENERATORS, AL GEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " local Table, i; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### some standard error c heck, for too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " \+ if( nargs > 1 ) then ERROR(`too many arguments`, args); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ ### getting generator table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " T able := op(4, eval(generators)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### maybe there aren't any \+ algebras defined" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( Table <> NULL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### checking \+ whether the algebra is defined" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " \+ if( member([Algebra],[indices(Table)]) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### \+ change algebra and the generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " unprotect(evaln(GENERATORS), evaln(ALGEBRA));" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 39 " GENERATORS := [Table[Algebra]];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ALGEBRA := Algebra; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " protect(evaln(GENERATORS), \+ evaln(ALGEBRA));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 33 " ### return algebra in use" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 42 " RETURN(ALGEBRA = ); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### specified algebra wasn't found" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " \+ ERROR(`specified algebra`, Algebra, `is not defined.`); " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ER ROR(`no algebras defined`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi ; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 "liealg[isgenerator] := proc(Var::anything) " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 95 " description `isgenerator(Var[,algname]) checks \+ to see whether the passed on variable or in " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " case of a list all elements in the li st are generators or not; searches through " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " the list GENERATORS and returns true \+ if found, false if not found`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " \+ ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " global G ENERATORS; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " local indmember, checkgen, i, Gens, Flag, Temp;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### give it memory to improve efficiency" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 91 " #------------------------> definition of s ubprocedures <-------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " ### checkge n() does the actual checking of a var in the generator list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " checkgen := proc(Var::anything,GenLis t::list) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " ### declaration s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " local Flag, Temp;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### give it memory to improv e efficiency" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " option syste m, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 32 " ### initializing the flag" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Flag := false;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### var \+ has a constant multiplier " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ if( type(Var, `*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " \+ Temp := op(2, Var);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Temp := Var;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### gene rator isn't indexed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " if( m ember(Temp,GenList) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " \+ Flag := true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### generator can be indexed" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " if( type(Temp, indexed) ) then" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 52 " Flag := indmember(Temp, GenList ); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### return ing the result " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " RETURN(Fl ag);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " end:" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " #-------- ---------------------------------------------------------------------- ---------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### indmember() subproc. checks the existence of \+ indexed var's in GENERATORS" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " \+ indmember := proc(Var::anything,GenList::list) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " local i, Flag;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### give it memory to improve efficiency" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 31 " option system, remember;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " # ## initializing the flag " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ Flag := false;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### have to loop through generator list t o check var" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " for i to nops (GenList) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 60 " ### current generator is indexed like the variable" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " if( type(Gen List[i], indexed) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### the name matches" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( op(0, GenList[i] ) = op(0, Var) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### when the generator is parametric, we can have a constant" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### in the variable instead of the parameters" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " if( type([op(GenLis t[i])], list(name)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " \+ if( type([op(Var)], list(constant)) and " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 76 " nops( GenList[i]) = nops(Var) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " \+ Flag := true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### the generator i s indexed, but with integer values" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### (non-parametric), we have to have an exact mat ch" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " elif( type([o p(GenList[i])], list(constant)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " if( GenList[i] = Var ) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 35 " Flag := true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " break;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 22 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " \+ fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " od;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " # ## returning result" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " RETUR N(Flag);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " end: " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 90 " #------------------------------------ end \+ of subs ------------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " #---------- --------------------> main proc()'s body <---------------------------- --------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs > 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ERROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif( GENERATORS = [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ERROR(`no algebras defined in generators ().`); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### generator(s) are to be checked in other than th e default list (GENERATORS)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ## # therefore default algebra is temporarly set to specified alg." }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " elif( nargs = 2 ) then " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := ALGEBRA; " }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> args[2] ) then " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " use(args[2]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### there are no generators defined" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 40 " if( not(type(GENERATORS, list)) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ERROR(`no generators defined.` );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " ### we have a list to process (all elements are checked to be generators)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( type(Var,`list`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ ### initializing the loop's bounds" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " i := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " Flag := \+ true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " while( i <= nops(Var) and Flag ) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ ### checkgen does the actual checking" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " Flag := checkgen(Var[i],GENERATORS);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " i := i + 1; ### increment counter" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### there is only one \+ generator to check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### checkgen does the actual checking" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " Flag := checkgen(Var,GENERATORS);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### we have to change the default algera back to the original" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " if( nargs = 2 and Gens <> ALGEBR A ) then use(Gens); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### true or false" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 15 " RETURN(Flag);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "hidden[extract] := proc(E::a nything) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " description `extra ct(expression) picks out all the generators from a given non-commutati ve " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 110 " expression \+ and returns them in a list; side effects: ignores constants inside the expression`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### declaratio ns" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " local List, Alg, Cons; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### give it memory to improve efficiency" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " # option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### called with too many arguments " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( nargs > 2 ) then " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 41 " ERROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " ### have to use other than default al g. (setting default to be specified temporarely)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " elif( nargs = 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := A LGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### pa rameter is indexed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " if( type( E, indexed) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " List \+ := E;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " ### multiplication" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " elif( type(E, `*`) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " List := op(op(2,E));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### breaking the expression int o parts " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 22 " List := op(E);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### only one element in the lis t " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( nops([List]) = 1 ) \+ then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### element is a g enerator or a constant" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " i f( isgenerator(List, Alg) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " RETURN(List);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ ### element is unknown" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ERROR(List, `is not a valid generator in`, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 35 " ### need to break up both sides" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " RETURN(map(proc(x,y) extract(x,y); end, [List], Alg)[]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 "lie alg[`&<`] := proc(A::algebraic, B::algebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " description `monomial &< monomial defines the op erator \"&<\", which is interface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " function evaluate; works only with t he default set of generators`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " local LA, LB;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " ### if we have sum, look at leading term s, if constant multiplier, send only expression part" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(A, `+`) ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 34 " LA := leading(A, ALGEBRA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ LA := A;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(LA, `*`) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " LA := op(2,LA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(B, `+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " LB := leading(B, ALGEBR A);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 16 " LB := B;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(LB,`*` ) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " LB := op(2,LB); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " RETURN(eva lb(ranking(LA) < ranking(LB)));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "e nd:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 "liealg[`&>`] := proc(A::algebraic, \+ B::algebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " description \+ `monomial &> monomial defines the operator \"&>\", which is interface \+ to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " functio n evaluate; works only with the default set of generators`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " local LA, LB;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " ### if we \+ have sum, look at leading terms, if constant multiplier, send only exp ression part" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(A, `+ `) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " LA := leading( A, ALGEBRA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " LA := A;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if ( type(LA, `*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " L A := op(2,LA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ if( type(B, `+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ LB := leading(B, ALGEBRA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " LB := B;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(LB,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " LB := op(2,LB);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " RETURN(evalb(ranking(LA) > ranking(LB)));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " liealg[`&=`] := proc(A::algebraic, B::algebraic) " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 92 " description `monomial &= monomial defines the \+ operator \"&=\", which is interface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " function evaluate; works only with t he default set of generators`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " local LA, LB;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " ### if we have sum, look at leading term s, if constant multiplier, send only expression part" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(A, `+`) ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 34 " LA := leading(A, ALGEBRA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ LA := A;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(LA, `*`) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " LA := op(2,LA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(B, `+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " LB := leading(B, ALGEBR A);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 16 " LB := B;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( type(LB,`*` ) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " LB := op(2,LB); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " RETURN(eva lb([extract(LA, ALGEBRA)] = [extract(LB, ALGEBRA)]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 50 "liealg[`&<=`] := proc(A::algebraic, B::algebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " description `monomial &< monomial defines the operator \"&<= \", which is interface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " \+ function evaluate; works only with the default set of \+ generators`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " RETURN(not(A &> B));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 50 "liealg[`&>=`] := pro c(A::algebraic, B::algebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " \+ description `monomial &> monomial defines the operator \"&>=\", wh ich is interface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " \+ function evaluate; works only with the default set of genera tors`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " RETURN(not(A &< B)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 50 "liealg[`&<>`] := pro c(A::algebraic, B::algebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " \+ description `monomial &= monomial defines the operator \"&<>\", wh ich is interface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " \+ function evaluate; works only with the default set of genera tors`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " RETURN(not(A &= B));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 44 "hidden[ranking] := proc(Monomial::a lgebraic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " description `gives a \+ numerical rank to a monomial; to be used" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " for comparison of monomials;`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " local i, j, L, value, N, f, position;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " option remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " L:=[extract(Monomial, ALGEBRA)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " value:=0; N:=nops(GENERATORS)+1; f:=1/N;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " for i to nops(L) do" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 42 " member(L[i], GENERATORS, 'position');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " value:=value + position*f;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " f:=f/N;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 5 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN (value);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 87 "hidden[evaluate] := proc(MonomialA::algebra ic, Operator::symbol, MonomialB::algebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " description `evaluate(monomial, operator, monomia l) evaluates the relation between two " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " non-commutative expressions are the same or no t. Returns a boolean. Side effect: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " doesn't work with negative values (since op(-x) = \+ -1,x); works only with the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " \+ default set of generators`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " \+ local i, Limit, CompA, CompB, VarA, VarB; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### give it memory to improve efficiency" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " # option system, remember;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### we have expressions to process on both sides" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### extracting all terms from both lhs an d rhs sides..." }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " CompA := [ext ract(MonomialA, ALGEBRA)]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " \+ CompB := [extract(MonomialB, ALGEBRA)]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " ### finding terminating condition for loop (picking expression with less terms)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " ### lhs has more terms" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " if( nops(CompA) < nops(CompB) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Limit := nops(Comp A); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### rhs has just as m any or more than lhs" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else " } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " Limit := nops(CompB);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### looping through the variables in both lists (CompA and CompB)" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 21 " for i to Limit do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### VarA and VarB flag the position of the cur rent var" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### in the gener ator list " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " ### (ie. for g ens [x,y,z] and input x < z : VarA = 1, VarB = 3, 1 < 3 => true)" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " VarA := 0; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " VarB := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " ### getting the a ctual positions in the generators list of current var's" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 44 " member(CompA[i], GENERATORS, 'VarA');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " if( VarA = 0 and type(Comp A[i],indexed) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " # ## creating a set for the comparison of indexed var's" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " member(op(0,CompA[i]), map(proc(x) if( type(x, indexed)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ op(0,x); else x; " }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 75 " \+ fi; end, GENERATORS), 'VarA');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " member(CompB[i], GENERATORS, 'VarB');" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " if( VarB = 0 and type(CompB[ i],indexed) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " ### creating a set for the comparison of indexed var's" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " member(op(0,CompB[i]), map(proc(x) if(ty pe(x, indexed)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ op(0,x); else x; " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 75 " f i; end, GENERATORS), 'VarB');" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### the terms differ" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( VarA <> VarB ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " ### term on lhs comes after term on rhs, op . is lhs greater than rhs, so true" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " if( Operator = `>` and VarA > VarB ) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 27 " RETURN(true); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " ## # term on lhs comes before term on rhs, op. is lhs less than rhs, so t rue" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " elif( Operator = ` <` and VarA < VarB ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ RETURN(true); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### everything else is fa lse" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " RETURN(false);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " \+ ### we found no differences in the terms so far, but the" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 51 " ### lengths of the expressions can still differ" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( (Operator = `>` \+ and nops(CompA) > nops(CompB)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " or (Operator = `<` and nops(CompA) < nops(CompB)) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " RETURN(true);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### \+ all other cases evaluate to false" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " RETURN(false); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 56 "hidden[functionize] := proc(expr::a lgebraic, Alg::name) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " descrip tion `functionize(expression), if possible, finds the rule in the look up table that " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " su its the given expression, and returns that rule converted into a maple function;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " when n o corresponding rule is found or the lookup table is empty FAIL is " } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " returned`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 44 " local table, i, lhs, rhs, temp, entries; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### give it memory for efficie ncy" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### getting rules from lookup table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " table := op(4, eval(store)); " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### breaki ng the expression into two parts" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " if( type(expr, function) and nops(expr) > 1 ) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 25 " lhs := op(1,expr); " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 25 " rhs := op(2,expr); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ER ROR(`not a valid expression to find a rule for`, expr);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### if table is empty" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( table = NULL ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(FAIL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " en tries := table[Alg]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### else we loop through the indices of the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " for i to nops(entries) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### temp holds the i-th rule in the table " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " temp := op(1,entries[i]) ; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### if both sides of expr are indexed" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " if( type(lhs, indexed) and t ype(rhs, indexed) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " \+ if( lhs = op(1,temp) and rhs = op(2,temp)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " and type([op(lhs)],list(constant)) and \+ [op(lhs)] = [op(op(1,temp))]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " \+ and type([op(rhs)],list(constant)) and [op(rhs)] = [op(op(2 ,temp))] )" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " then RETURN (op(2,entries[i]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 46 " elif( op(0,lhs) = op(0,op(temp)[1] ) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " and op(0,rhs) = op(0,op(temp)[2]) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " \+ and nops([op(lhs)]) = nops(remove(type, [op(op(temp)[1])], integer)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " and nops([op(rhs) ]) = nops(remove(type, [op(op(temp)[2])], integer)) )" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " ### can't have two parameters of the same name, it \+ would crash unapply" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " \+ ### so instead of ie, (k,k)->0 we will have k->0, which is the same" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( op(op(1,temp)) = op(op(2,temp)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " \+ RETURN(unapply(op(2,entries[i]), op(op(1,temp))));" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 17 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " RETURN(unapply(op(2,entries[i]), op(o p(1,temp)), op(op(2,temp))));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### if only the left-hand-side is indexed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " elif( type(lhs, indexed) ) then " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " if( lhs = op(1,temp) and \+ rhs = op(2,temp)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " a nd type([op(lhs)],list(constant)) and [op(lhs)] = [op(op(1,temp))] ) \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " then RETURN(op(2,entr ies[i]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " elif( op(0,lhs) = op(0,op(temp)[1]) " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " and rhs = op(temp)[2] " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " and nops([op(lhs )]) = nops(remove(type, [op(op(temp)[1])], integer)) )" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 15 " then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( op(op(1,temp)) = rhs ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " RETURN(unapply(op(2,entries[i]), rhs));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " RETURN(unapply(op(2 ,entries[i]), op(op(1,temp)), rhs));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### if only the right-hand-side is indexed" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " elif( type(rhs, indexed) ) t hen" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " if( lhs = op(1,tem p) and rhs = op(2,temp)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " \+ and type([op(rhs)],list(constant)) and [op(rhs)] = [op(op(2,temp ))] )" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " then RETURN(op(2 ,entries[i]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " elif( lhs = op(temp)[1] " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " and op(0,rhs) = op(0,op(temp)[2 ]) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " and nops([op(r hs)]) = nops(remove(type, [op(op(temp)[2])], integer)) )" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( lhs = op(op(2,temp)) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " RETURN(unapply(op(2 ,entries[i]), lhs));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " RETURN(u napply(op(2,entries[i]), lhs, op(op(2,temp))));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 34 " ### neither side is indexed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( lhs = op(temp)[1] and rhs = op(temp)[2] )" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " then RETURN(op(2,entries[ i]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 36 " ### no matches found in the table" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 16 " RETURN(FAIL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} }{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 "hidden[reduce] := proc(expr ::algebraic, Alg::name) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 98 " desc ription `reduce(expression) simplifies an expression according to the \+ rules defined in the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " \+ lookup table; reduce() can only simplify an expression involving \+ two terms, not " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " m ore`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " global MATRIX_TYPE;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 57 " local lhs, rhs, func, consl, consr, cons, Table, Gens;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### give it mem ory to improve efficiency" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " opt ion system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### we have a simple algebra, it has i ts own simplification procedures" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( member(Alg, SIMPLE) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### we get the type of the algebra (ie A, B, C, etc)" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " Table := op(4,eval(simple)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " func := Table[Alg,type]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " unprotect(evaln(MATRIX_TY PE));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " MATRIX_TYPE := func[ 2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " protect(evaln(MATRIX_T YPE));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### we might have to change the default algebra " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " if( Alg <> ALGEBRA ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Gens := ALGEBRA; use(A lg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### call the corre sponding simplification function" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " func := simplefunction._.func[1](expr,Table[Alg]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### don't have to change the default algebra" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### call the corresponding simplification fu nction" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " func := simplefu nction._.func[1](expr,Table[Alg]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( func <> F AIL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " RETURN(func) ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### retrievi ng the corresponding rule" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " func := functionize(evaln (expr), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ### either no matching rule was found or no rules are defined in the tabl e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( func = FAIL ) then RETU RN(expr);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 26 " ### some rule was found" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " # ## breaking the expression into two parts" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " lhs := op(1,expr); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " rhs := op(2,expr); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### both \+ sides are indexed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " if( type (lhs, indexed) and type(rhs, indexed) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### we received a function, we have to plug \+ in values" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " if( type(func , procedure) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " \+ consl := op(lhs); consr := op(rhs);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### the two parameters are the constants from the lhs \+ and rhs" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " RETURN(eval( func)(consl,consr)); ### => returns the evaluated function" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### we received a simple results, \+ we can return it as is" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " RETURN(func);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### onl y lhs is indexed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " elif( typ e(lhs, indexed) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " \+ ### we received a function, we have to plug in values" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 41 " if( type(func, procedure) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " cons := op(lhs); " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " ### first parameter in \+ function is the constant from lhs, the second is rhs" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " RETURN(eval(func)(cons,rhs)); ### => returns the evaluated function" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### we received a simple results, we can return it as is" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " RETURN(func);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### only rhs is indexed " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " elif( type(rhs, indexed) ) \+ then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### we received a function, we have to plug in values" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " if( type(func, procedure) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " cons := op(rhs);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " ### first parameter in function is lhs, t he second is the constant from rhs" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " RETURN(eval(func)(lhs,cons)); ### => returns the evalu ated function" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### we re ceived a simple results, we can return it as is" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ RETURN(func);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " ### neither side is indexed, we didn't receive \+ a procedure, return what we got " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " RETURN(f unc);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end: " }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 "### redefine our operator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 "unprotect(`&*`);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 45 "hi dden[`&*`] := proc(A::anything,B::anything)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### if a co nstant on either side, treat &* as *" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " if( type(A,constant) or type(B,constant) ) then" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 21 " RETURN(A * B);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " ### no sums , no constants, but we can already simplify to zero if both sides are \+ the same" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " elif( (type(A,name) or type(A,function)) and (type(B,function) or type(B,name)) ) then" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " RETURN(evaln(A &* B));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### if a multiplication, pull constant out" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 28 " elif( type(A,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " RETURN(op(1,A) * (op(2,A) &* B));" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 28 " elif( type(B,`*`) ) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 40 " RETURN(op(1,B) * (A &* op(2,B)));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### if sum on either side, expand it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " elif( type(A,`+`) or type(B,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " RETURN(expand(evaln(A &* B)));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### garbage in, error message out" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " \+ ERROR(A, B, `are not defined in this context.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 "### we have to redefine the expand \+ function" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "unprotect(expand);" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 35 "hidden[expand] := proc(E::anything)" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 73 " description `Expands a Lie expression, pull s constants to the front.`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " # ## declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " local TermsX, TermsY;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### return if input is simple enough" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( nops(E) = 1 or type(E,indexed) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(E);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### l ook at both sides" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " elif( type( op(1,E),`+`) and type(op(2,E),`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " RETURN(map(proc(x,y) map(proc(x,y) y &* x; end, y, x); end, op(1,E), op(2,E)));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### only lhs is a sum" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " elif( type(op(1,E),`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " RETURN(map(proc(x,y) x &* y ; end, op(1,E), op(2,E)));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### only rhs is a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " elif( type(op(2,E),`+`) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " RETURN(map(proc(x,y) y &* x; \+ end, op(2,E), op(1,E)));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### nothing could be changed" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " RETURN(E);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 "### need to redefine simplify()" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 "unprotect(simplify);" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "liealg[ simplify] := proc()" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 99 " descripti on `this is an interface to the function mainsimplify() which is the m ain simpl. proc`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " local Temp, G, Alg;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 21 " ### lets simplify!" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Temp := traperror(mainsimplify(args));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " ## # we had an error" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( Temp = \+ lasterror ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " ERROR(last error); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if ((nargs > 2) o r (nargs = 0))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 102 " t hen ERROR(`too many arguments`, args); fi; \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " G:=args[1]; \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " if (nargs = 2) then Alg:=arg s[2] else Alg:=ALGEBRA; fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( type(G,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " RETURN(map(x-> if(type(x,`*`)) then op (1,x) * mainsimplify(op(2,x),Alg) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " else mainsimplify(x,Alg) fi, G));" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### \+ expression is multiplication" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " e lif( type(G,`*`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ## # we need to further simplify the non-constant part" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### and return the simplified expression" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " RETURN(op(1, G) * mainsimplify (op(2, G), Alg)); fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### if we have a field defined, use its characteristic" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " if( MODFLAG ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### if result is a sum, apply mod to all terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " if( type(Temp,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " RETURN(map((x,y)->if(type(x,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " \+ (Normal(op(1,x)) mod y) * op(2,x);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " (Normal(1) mod y) * x; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " fi, Temp , MODVALUE));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### if has a constant term, pull it out" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " elif( type(Temp,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " RETURN((Normal(op(1,Temp )) mod MODVALUE) * op(2,Temp));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " ### no constant term" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " RETURN((Normal(1) mod MODVALUE) * Temp);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### no field is defined, return what the simplification amounts to" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " \+ RETURN(Temp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " hidden[mainsimplify] := proc(G::algebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 101 " description `mainsimplify(expression<,algname>) si mplifies an expression containing Hall Monomials " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 94 " and returns the simplified expression ; precondition: in the expression brackets " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " have to be placed around constant * gen erator (ie instead of 2*x&*y use " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " (2*x)&*y)`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " local ismixe d, Gens, Alg, NewAlg, List, R, S, Temp, TMP, weight, Algabove, Table; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### give it memory to improve efficiency" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " # option remember ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " #------------------- -----> definition of subprocedures <-------------------------------" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### subprocedure to check for mixed expressions" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 43 " ### occuring with directsum expressions" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### returns an algebra, it the same as called with, it's mixed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " ### otherwise an algebra is returned with which we can continue t he simplification" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ismixed := proc(G::anything, Alg::name) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " \+ ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " loca l Table, List;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### let's get the algebras (we know table \+ is not empty," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### since th e set DIRECTSUMS isn't empty)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ Table := op(4, eval(directsum)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### let's get \+ the terms from the expression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ List := [extract(G, Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### terms from both algebra s, return original Alg" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " if( isgenerator(List, Table[Alg][1]) and isgenerator(List, Table[Alg][2]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " RETURN(Alg);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### if all terms are in Alg1 return Alg1" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 51 " elif( isgenerator(List, Table[Alg][1]) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " RETURN(Table[Alg][1]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### all terms are in Alg2 return Alg2" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " \+ RETURN(Table[Alg][2]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " #----- ------------------------------ end of subs --------------------------- ---------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " #------------ --------------------> main proc()'s body <---------------------------- ----" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### called with too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " if( nargs > 2 ) then ERROR(`too many arguments `, args); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### need to use specified algebra" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 23 " if( nargs = 2 ) then " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 20 " Alg := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### we can use default alg." }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 21 " Alg := ALGEBRA; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 "wei ght:=wt(G,Alg); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 61 " ### we have to check for the algebra to be a factor algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( member(Alg , FACTORALGS) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### getting factor algebra " }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 35 " Table := op(4, eval(factoralg));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### we know entry exists, since \+ it's in the set FACTORALGS" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Al gabove := [Table[Alg]][1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " # \+ Ideal := [Table[(Alg)]][2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " Temp := mainsimplify(G, Algabo ve);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if (Temp = 0) the n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN(0);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " if ( type(Temp, `*` )) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 67 " RETURN( op(1,Temp)*factorsimplify ( op(2,Temp), Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( type(Temp,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " RETURN( map (proc(x) if(type(x,`*`)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " \+ op(1,x) * factorsimplify(op(2,x), Alg);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " \+ factorsimplify(x, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " \+ fi; end, Temp) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " RETURN( factorsimplify( Temp , Alg) );" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### we have one term in the expression" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 47 " elif( nops(G) = 1 or type(G, indexed) ) th en " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ### it could be a constant or a generator, if s o, that's fine" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " if( type(G, constant) or isgenerator(G,Alg) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(G);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " \+ ### otherwise we have an error" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ERROR(G, `n ot a generator in`, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " \+ fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 30 " ### we have multiple terms " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 59 " ### expression is a sum, then apply simplify to e ach term" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " elif( type(G,`+`) ) t hen " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " RETURN(map(x-> if(type (x,`*`)) then op(1,x) * mainsimplify(op(2,x),Alg) " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 53 " else mainsimplify(x,Alg) fi, G) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### expression is multiplication" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " elif( type(G,`*`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### we need to further simplify the non-constant part" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### and return the si mplified expression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " RETURN( op(1, G) * mainsimplify(op(2, G), Alg));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### we have a n expression that has two sides (ie. x&*y)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " ### algebra is registered as a triangular algebra, needs special simplifi cation" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( member(Alg, TRIA NGALGS) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### simpl ify by triangular algebra rules" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " RETURN(triangularsimplify(G, Alg));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### we hav e a normal algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### simplify the two sides " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " Temp := mainsimplify(op (1, G), Alg) &* mainsimplify(op(2, G), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ### aut omatic expansion could have resulted in a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( type(Temp,`+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ### if so, apply simplification to all \+ terms in R" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " RETURN(map (x-> if(type(x,`*`)) then op(1,x) * mainsimplify(op(2,x),Alg) " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " else main simplify(x,Alg) fi, Temp));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### expansion could have re sulted in a multiplication" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " \+ elif( type(Temp, `*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ### if so, apply simplification to all terms in R" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " RETURN(op(1, Temp) * mainsimpl ify(op(2, Temp),Alg));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### expansion could have resulted in zero" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " elif( Temp = 0 \+ ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " mainsimplify(G,Alg):=0; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### find R and S , the two sides to our expression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " R := op(1, Temp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " S := op (2, Temp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### checking algebra \+ to be a directsum of two algebras" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( member(Alg, DIRECTSUMS) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " NewAlg := ismixed(G, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " if( NewAlg = Alg ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ Alg := NewAlg;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### alge bra may have rules defined" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " \+ if( member(Alg, WITHRULES) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " ### reduce R&*S" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " \+ RETURN(reduce(evaln(R&*S), Alg));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### not indexed algeb ra, no rules are defined for simplification" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " \+ ### we need to change the algebra (since evaluate can't deal" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " ### with any other than the default algebra), but save the default alg. into Gens" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 24 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### lexicographical \+ comparisons, R and S are the same" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if( R &= S ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " \+ mainsimplify(G,Alg):=0; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### R comes before S" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 28 " elif( R &> S ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " use(Gens); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 32 "TMP:=-mainsimplify(S &* R, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "mainsimplify(G,Alg):=TMP; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN(TMP);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### R c omes after S" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 98 " elif( ((R & < S) and isgenerator(S, Alg)) or (type(S,function) and (R &>= op(1,S)) ) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " use(Gens); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### nothing to simpl ify" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 "TMP:=R &* S;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "mainsimplify(G,Alg):=TMP; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN(TMP);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " \+ ### S = [U,V] and R &< U, apply the Jacobian identity" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 "TMP:=mainsimplify((R&*op(1,S))&*op(2,S),Alg)+mainsimplify(op(1,S)& *(R&*op(2,S)),Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "mainsimplify (G,Alg):=TMP; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN (TMP);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 24 "liealg[store] := proc() " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " description `store() saves a given rule and its re verse in the lookup table`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " # ## declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " global WITHRU LES;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " local rhs, lhs, res, i, \+ j, Table, Start, End, Alg;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " ## # memory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### some input checks" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " if( \+ nargs = 0 ) then RETURN();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " el if( args[1] = DONTPRINT ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Start := 2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " Start := 1; " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " \+ ### delete the remember table of functionize, since will " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### use that to look up a rule whether i t exists or not" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " subsop(4=NULL , eval(functionize)):" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### process all rules" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " for i from Start to nargs do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " ### trap an error" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " if( not(type(args[i], list)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ERROR(`expected a list of rules, r eceived`, args[i]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " elif( \+ type(args[i,nops(args[i])],name) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " End := nops(args[i])-1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " Alg := args[i,nops(args[i])];" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 34 " elif( GENERATORS = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " ERROR(`can't set rules for default algera, since there is no default algebra defined.`);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " End := nops(args[i]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### keeping track of algebras with simplificati on rules" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( not(member(Al g, WITHRULES)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " u nprotect(evaln(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " \+ WITHRULES := WITHRULES union \{Alg\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " protect(evaln(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### process the rules" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " for j to End do" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 43 " ### we got an expression coming in " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( not(type(args[i,j] ,`=`)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ERROR( `expected an expression, received`, args[i,j]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### wh at we have is not an algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " \+ else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ### some error handling, enforcing correct form " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 111 " if( nops(args[i][j]) <> 2 or nops(op(1,a rgs[i][j])) <> 2 or type(op(1,args[i][j]), indexed) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " ERROR(`incorrect rule, cor rect form: [name]&*[name]=[expr]`, args[i]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### it's safe to br eak up the rule" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " lhs \+ := op(1,op(1,args[i][j])); ### left-hand-side of expression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " rhs := op(2,op(1,args[i][j])) ; ### right-hand-side of expression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " res := op(2,args[i][j]); ### result of expression" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### rule can't have constants on the LHS" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " if( type(lhs, constant) or type (rhs, constant) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " \+ ERROR(`incorrect rule, no constants are allowed in the LHS of \+ expr`, args[i][j]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " if( functionize(evaln(lhs&*rhs),Alg) = FA IL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### ent ry going in the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ if( op(4,eval(store)) <> NULL " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " and member([Alg],[indices( op(4,eval(store)))]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ if( lhs <> rhs ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " store(Alg) := [op(4,eval(store))[Alg][], lhs& *rhs=res, rhs&*lhs=-res]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " \+ store(Alg) := [op(4,eval(store))[Alg][], lhs&*rhs=res]:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( lhs <> rhs ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " store(Alg) := [evaln(lhs &*rhs)=res, evaln(rhs&*lhs)=-res]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " \+ store(Alg) := [evaln(lhs&*rhs)=res]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " ### deleting the remember table of functionize, sin ce we made some changes" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " \+ subsop(4=NULL, eval(functionize)):" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### formated output for user" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " \+ if( args[1] <> DONTPRINT ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " print(evaln(lhs &* rhs) = res);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( lhs <> rhs ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " print(evaln(rhs &* lhs) = -res);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(NULL):" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 24 "liealg[delete] := proc()" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " description `gets rid of rules d efined for an algebra in the remember table`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " local i;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " \+ global WITHRULES;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 39 " ### delete rules for default algebra" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( GENERATORS = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " ERROR(`cannot delete rules for d efault algebra, there is no default algebra defined.`);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( member(ALGEBRA, WITHRULES) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " op(4, eval(store))[ALGEBRA] := evaln(op(4, e val(store))[ALGEBRA]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " \+ unprotect(evaln(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ WITHRULES := WITHRULES minus \{ALGEBRA\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " protect(evaln(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " print(subs(\{evaln(ALGEBRA)=ALGEBRA\},e valn(store(ALGEBRA))) = [NULL]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " print(subs( \{evaln(ALGEBRA)=ALGEBRA\},evaln(store(ALGEBRA))) = FAIL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### delete rules for defa ult algebra but don't print" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " e lif( nargs = 1 and args[1] = DONTPRINT ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( GENERATORS = [] ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 96 " ERROR(`cannot delete rules for default alg ebra, there is no default algebra defined.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " \+ if( member(ALGEBRA, WITHRULES) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " op(4, eval(store))[ALGEBRA] := evaln(op(4, eval(store)) [ALGEBRA]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " unprotect(e valn(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " WITHR ULES := WITHRULES minus \{ALGEBRA\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " protect(evaln(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ RETURN();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### delete all the rules for the specified algebras" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( args[1] = DONTPRINT ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " i := 2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " i := 1; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### loop through the arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " while( i <= nargs and op(4,eval(store)) <> NULL ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " if( member(a rgs[i],WITHRULES) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " \+ op(4,eval(store))[args[i]] := evaln(op(4,eval(store))[args[i]]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( args[1] <> DONT PRINT ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " prin t(subs(\{evaln(args[i])=args[i]\},evaln(store(args[i]))) = [NULL]);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " unprotect(evaln(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " WITHRULES := WITHRULES minus \+ \{args[i]\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " protect (evaln(WITHRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " els e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( args[1] <> DON TPRINT ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " pri nt(subs(\{evaln(args[i])=args[i]\},evaln(store(args[i]))) = FAIL);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " i := i + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### we quit because the tabl e was empty, show that others can't be deleted" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " if( i <= nargs and args[1] <> DONTPRINT ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i to nargs do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " print(subs(\{evaln(args [i])=args[i]\},evaln(store(args[i]))) = FAIL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " RETURN();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "liealg[wt] := proc(Expr::alg ebraic) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " description `wt(exp ression) calculates the weight of a given expression using values defi ned " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " for the gene rators in generators(); ----> doesn't work for directsums yet <----`; \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " global GENERATORS; " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 51 " local FindWeight, Table, Result, Gens, Weights; \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### give it memory to improv e efficiency" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " # option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " #----------- --------------------> definition of subprocedures <------------------- ------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### FindWeight() finds the actual weight of the ex pression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " FindWeight := proc(E xpr::algebraic,Weights::list,GenList::list)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " local i, j, List, Result, Temp;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### give it memory to improve efficiency" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " # option system, remember;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### we have a sum for expression (Expr)" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 36 " ### get weights for both sides" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 31 " if( type(Expr,`+`) ) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 71 " ### getting weights of both sides (no te that sums of multiple " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " \+ ### terms are dealt with in a recursive fashion)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " Tem p := map(proc(x,y,z) if(type(x,`*`)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " FindWeight(op(2,x ),y,z);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " \+ FindWeight(x,y,z);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " fi; end, [op(Expr)], Weights, G enList);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### \+ we assume all have the same weight, we assign the first to result" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " Result := Temp[1];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### and then try to find a different one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " for i fr om 2 to nops(Temp) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " \+ if( Temp[i] <> Result ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ Result := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " \+ ### we have regular expressions, no sums" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " \+ ### initializing the result list to zero" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " Result := [seq(0, i = 1..nops(Weights[1]))]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### getting generators that make up the expression" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( type(Expr,`*`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " List := [extract(op (2,Expr), ALGEBRA)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " el se" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " List := [extract( Expr, ALGEBRA)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### looping through the generators for given algebra" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " for i to nops(GenList) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### looping through the generators (in the express ion)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " for j to nops(L ist) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " ### we have a match, add its weight to the result" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " if( L ist[j] = GenList[i] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " \+ ### we have parametric weights (unapply makes a function of the weight list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " \+ ### then we plug in the parameters to get the actual weight)" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( hastype(Weigh ts[i], name) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " \+ Result := Result + unapply(Weights[i],op(GenList[i]))(op(Lis t[j]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " ### we have non-parametric weights, we just add it " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " else" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 51 " Result := Result + Weig hts[i];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " ### we have indexed generators, we have to do check ing different" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " eli f( type(List[j], indexed) and type(GenList[i], indexed) ) then " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### checking for \+ equals" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " if( (op (0,List[j]) = op(0,GenList[i]))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 102 " and not(hastype([op(List[j])],name) or hastype([o p(GenList[i])],constant)) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " ### we ha ve parametric weights (unapply makes a function of the weight list" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " ### then we pl ug in the parameters to get the actual weight)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " if( hastype(Weights[i], name) ) \+ then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " Re sult := Result + unapply(Weights[i],op(GenList[i]))(op(List[j]));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " ### we have non-parametric weights, we just a dd it " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " \+ Result := Result + Weights[i];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " \+ od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " od; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### returning the weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " RETURN(Result);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " #------------- ------------------------ end of subs --------------------------------- -------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " #----------- ----------------------> main proc()'s body <-------------------------- ---------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### procedure is called with too many arguments" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " if( nargs > 2) then ERROR(`too \+ many arguments`, args ); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " ### if we received an additi onal argument, it has to be the name of the" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " ### algebra to use, but we still save the default \+ algebra into Gens" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> a rgs[2] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " Gens := A LGEBRA; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " use(args[2]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 25 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### getting weights from the table of generators() " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Table := op(4,eval(generators)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " Weights := Table[(ALGEBRA,we ight)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### calling suproc to do the calculations" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " Result := FindWeight(Expr, Weigh ts, GENERATORS);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 58 " ### switch back to the default algebra if w e changed it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " if( nargs = 2 an d ALGEBRA <> Gens ) then use(Gens); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### returning our ans wer" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(Result); " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " hidden[independent] := proc(List::list) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 98 " description `independent([list of expressions]) pi cks out the linearly independent expressions " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " from the list`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " local i, j, k, SimplList, Vars, Gens, Alg, Vectors, LinIndVec tors, Result, addelement;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " # o ption system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " #------------------------> definition of subprocedures <----- --------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### adds an element to a set i f it's not a constant" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " ### a lso, it throws out the constant multiplier of the element to be added, if there is one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 53 " addelement := proc(Element::algebraic, Se t::set)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### giving it me mory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " # option system, re member;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### we have a constant, we throw the constant part away, add element" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " \+ if( type(Element, `*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " \+ RETURN(Set union \{op(2, Element)\});" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " ### no \+ constant multiplier, and element isn't a constant, we just add it as i s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " elif( not(type(Element , constant)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " R ETURN(Set union \{Element\}); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### Element is a constant , don't add it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN(Set);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " #--------- ------------------------ end of subs --------------------------------- -------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " #----------- -------------------> main proc()'s body <----------------------------- -------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### called with too many arguments" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 61 " if (nargs > 2) then ERROR(`too many argumen ts`, args); fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " ### if called with two arguments, the second \+ must be the algebra to use" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " ## # setting default algebra to be requested, saving current algebra" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( nargs = 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> args[2] ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " A lg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### we need these two functions from the linear -algebra package" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " with(linalg, vector);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " with(linalg,basis); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### Vars holds the terms of an expression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### ie. for x + x&*y Vars = \{x, x&*y\}" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " Vars := \{\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " ### Simpl List holds the simplified terms of the original list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### (given the simplification didn't result i n a constant)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " SimplList := ar ray(1..nops(List));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 63 " ### looping through the list starting wit h the first element" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " for i to \+ nops(List) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### simplifying each term in the list" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " SimplList[i] := simplify(List [i],Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### simplified expression is a sum" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 41 " if( type(SimplList[i], `+`) ) then " } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ### loop through the terms of the sum to add terms to Var s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " for j to nops(SimplLi st[i]) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### add element returns the set with the \+ added term, it also" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ ### takes care of leading constant multipliers" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " Vars := addelement(op(j, SimplList[i]), V ars);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### simplified exp ression is not a sum of terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### add element returns the set with the add ed term, it also" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### ta kes care of leading constant multipliers" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " Vars := addelement(SimplList[i], Vars);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ## # we define a list of vectors that will hold the independent terms" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " ### (needs to be a vector for th e linear algebra procedures to work with them)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " Vectors := [seq(vector(nops(Vars),0),i=1..nops([in dices(SimplList)]))];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### looping through the simplified exp ression" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### to fill the vecto r" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " for i to nops([indices(Simp lList)]) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 54 " ### looping through the different terms we fo und" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " for j to nops(Vars) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### expression can be a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " if( type(SimplList[i],`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " \+ ### looping through the terms in the sum" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 43 " for k to nops(SimplList[i]) do " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### we have to get the constant multiplier from the term" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " ### and set the corresponding vector element to that number" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " \+ if( type(op(k, SimplList[i]), `*`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " if( op(2, op(k, SimplList[i])) = V ars[j] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " \+ Vectors[i][j] := Vectors[i][j] + op(1, op(k, SimplList[i]));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " \+ ### the default constant is 1" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " elif( op(k, SimplList[i]) = Vars[j] ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " Vectors[i][j] := \+ Vectors[i][j] + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ ### we have to get the constant multiplier from the term" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### and set the correspond ing vector element to that number" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " elif( type(SimplList[i], `*`) and op(2, SimplList[i]) = V ars[j] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " Vecto rs[i][j] := Vectors[i][j] + op(1, SimplList[i]); " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### \+ the default constant is one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ elif( SimplList[i] = Vars[j] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " Vectors[i][j] := Vectors[i][j] + 1; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od; \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### this command picks out the independent vectors" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " LinIndVectors := basis(Vectors); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### initializing the result list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Result := []; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### picking out the terms from the original list that are independent" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " ### (the vectors that didn't change when the indep endent vectors were found)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " fo r i to nops(LinIndVectors) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### we're looking for the v ectors that are in both list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " \+ ### List and Vectors are parallel lists (at the place of constants " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### Vectors contains a ze ro vector), so the k-th term matches the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " ### corresponding term in List, which needs to \+ be returned" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " if( member(Lin IndVectors[i], Vectors, 'k') ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Result := [op(Result), List[k]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### changing back the default algebra if we changed it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " if( nargs = 2 and Gens <> ALGEBRA ) then use(Gens) ; fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### returning the result" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " RETURN(Result);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 "hidden[symbasis] := proc(Wei ght::list(constant)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " descri ption `symbasis([weight]) generates the basis of an algebra for a spec ified weight`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### declarati ons" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " local ispos, GenerateBas is, Ideal, Table, IdealGens, AlgGens, Alg;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### give it memory to improve efficiency" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " option system, remember;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " #------------------ ------> definition of subprocedures <-------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ### this subproc. is the part of the procedure that genera tes the basis" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### Weight: \+ specified weight to find the basis for" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### IdealGens: generators of the ideal for the " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### AlgGens: generators of th e ideal's algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### Alg: name of ideal's algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " GenerateBasis := proc(Weight: :list,IdealGens::list,AlgGens::list,Alg::name,Neg::boolean) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " local i, W, Temp, Result;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 48 " ### give it memory to improve efficien cy" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " option system, rememb er;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### result is empty at this point" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Result := \{\}; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### \+ looping through the generators of the ideal's algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " for i to nops(AlgGens) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " \+ ### subtract the weight of the current generator from the weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " W := zip((x,y)->x-y, W eight, wt(AlgGens[i], Alg), 0); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " ### checking for the weight to be positive after the subtraction" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( Neg and not(hastype(W, negative)) ) th en" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### call recursively the function" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " Temp := GenerateBasis (W, IdealGens, AlgGens, Alg, Neg); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ### we add all elements of Temp multiplied by " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### the current generator of the ideal's algebra" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " Result := Result unio n \{op(map(proc(x,y) evaln(y&*x) end, Temp, AlgGens[i]))\}; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " \+ ### checking for the weight to be negative after the addition " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " elif( not(Neg) and n ot(hastype(W, positive)) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### call recursiv ely the function" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " T emp := GenerateBasis(W, IdealGens, AlgGens, Alg, Neg); " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " \+ ### we add all elements of Temp multiplied by " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### the current generator of the i deal's algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " Res ult := Result union \{op(map(proc(x,y) evaln(y&*x) end, Temp, AlgGens[ i]))\}; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### loo p through the ideal's generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " for i to nops(IdealGens) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ### add all tho se terms that have the same as the specified weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " if( Weight = wt(IdealGens[i], Alg) ) th en" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " Result := Result union \{IdealGens[i]\}; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### return only the indepe ndent elements" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " RETURN(in dependent([op(Result)],Alg));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " \+ end: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " #--------------- ------------------ end of subs -------------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " #----------------- --------------> main proc()'s body <--------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### procedure was called with too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " if (nargs > 2) then ERROR(`too many arg uments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### if no algebra specified, then use the de fault" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " elif( nargs = 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Ideal := args[2];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " RETURN(symbasis(Weight, ALGEBRA));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### getting the algebra of the ideal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " Table := op(4,eva l(ideal)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 38 " ### maybe there aren't any defined" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 29 " if( Table <> NULL ) then " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " # ## Ideal is in the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " \+ if( member([Ideal],[indices(Table)]) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### getting the generators for the ideal" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " IdealGens := [Table[Idea l]]; " }{TEXT -1 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### getting the name of the algeb ra of the ideal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " Alg := Table[(Ideal,algebra)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " ### getting the actual ge nerators for the algebra from the generators table" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 43 " Table := op(4, eval(generators));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( Table <> NULL ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " AlgGens := [Table[ Alg]]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ERROR(`there are no generato rs defined.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " ### generating the basis (depending on the passed in wei ght, we pass on flags;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " \+ ### when passing `true`, it means we have to have to check for negati ve values in the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " ### \+ weight for quitting the loop in GenerateBasis, `false` means a check f or pos)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " if( Weight &!> = [seq(0,i=Weight)] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ ### checking for negative weights for the generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " ### (this check is done to a void an infinite loop in GenerateBasis where" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### the weight of generators is subtract ed from Weight)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " if( map(proc(x,y) if(wt(x,y) &!<= [seq(0,i=wt(x,y))]) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 84 " RETURN(false ); fi; end, AlgGens, Alg) = [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " RETURN(GenerateBasis(Weight, IdealGens, AlgGen s, Alg, true));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " els e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " RETURN([]);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ ### generating basis" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " e lif( Weight &!<= [seq(0,i=Weight)] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### checking for positive weights for th e generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " ### (t his check is done to avoid an infinite loop in GenerateBasis where" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### the weight of gene rators is subtracted from Weight)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " if( map(proc(x,y) if(wt(x,y) &!>= [seq(0,i=wt(x,y))]) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " \+ RETURN(false); fi; end, AlgGens, Alg) = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " RETURN(GenerateBasis(Weigh t, IdealGens, AlgGens, Alg, false));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ RETURN([]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### mixed values in Weight, not OK" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 97 " ERROR(`received a mixed weight`, Weight ,`which should either be pos, neg, or zero.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### Ideal is not in the ta ble" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ERROR(`not an ideal`, Ideal);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### no ideals defined, table is empty" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ERROR(`there are no ideals defined.`);" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" } }}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 "hidden[sortscale] := proc(Sum::alge braic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " description `Sorts the Sum (the leading term goes first) and" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " rescales to make the leading coefficient 1`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " local Alg, Gens, Temp, cons, k ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " global ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### \+ standard error check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( narg s > 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too m any arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### we have to use sg. other than the default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> args[2] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := \+ ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := ALGEBRA ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Ge ns := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := ALGE BRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(Sum , `+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Temp := sor t([op(Sum)],`&<`); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " cons:= 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " if (type(Temp[1], `*`) \+ ) then cons:=op(1,Temp[1]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " RETURN(add(k, k=Temp)/cons); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif \+ (type(Sum, `*`)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ RETURN(Sum/op(1,Sum));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " els e RETURN(Sum);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### resetting default algebra" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( nargs = 2 and Gens <> ALGEBR A ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " use(Gens);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 46 "hidden[sorted_leading] := proc(Sum::algebraic)" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " description `Returns the leading term of the sorted sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ with the leading coefficient 1`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type( Sum, `+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " RETURN( op(1,Sum));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " RETURN(Sum);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " end: \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 "hidde n[leading] := proc(Sum::algebraic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " description `Picks out the leading term from the sum (the term \+ with the maximum value)," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ and also checks for the terms to be homogenous.`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " local MinTerm, Alg, Gens;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " global ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " ### memory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " # option sy stem, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### standard error check" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 24 " if( nargs > 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, args);" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 56 " ### we have to use sg. other than the def ault algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 2 \+ ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> args [2] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := ALGE BRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := args[2];" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " \+ Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### we have a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(Sum, `+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " MinTerm := sort([op(Sum)],`&<`)[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### sum has \+ only one term" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " MinTerm := Sum;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### resetting default algebra" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( nargs = 2 and Gens <> ALGEBR A ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " use(Gens);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### and retu rning the maximum term found" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ RETURN(MinTerm);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 "hidden[ double_list] := proc(Sum::algebraic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 128 " description `Converts a sum into a pair of lists - first lis t is a list of monomials, the second is the list of coefficients." }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " Returns: [[list of mon omials], [list of coefficients]]`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " local L,T,S,i, Alg, Gens;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " global A LGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### standard error check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( nargs > 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, args);" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 56 " ### we have to use sg. other than the def ault algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 2 \+ ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> args [2] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := ALGE BRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := args[2];" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " \+ Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " L:=[]; T:=[];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 "if (Sum <> 0) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ## # we have a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(Sum, `+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " S := [op(Sum )];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### sum has only one term" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " S \+ := [Sum];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " for \+ i to nops(S) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if (type(S [i], `*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " T := [ op(T), op(1,S[i])];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " L : = [op(L), op(2,S[i])];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " el se" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " T := [T[], 1 ];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " L := [op(L), S[i]];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 "fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### resetting default alg ebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( nargs = 2 and Gens < > ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " use(Gens) ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " RETURN([L ,T]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} }{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 44 "hidden[leading_pair] := pro c(Sum::algebraic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 101 " descriptio n `Picks out the leading term from the sum (the smallest term with res pect to &< order)," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 113 " \+ and also checks for the terms to be homogenous. Return s a list: [coefficient, term]`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " local Min Term, Alg, Gens;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " global ALGEB RA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " ### memory" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 28 " #option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### sta ndard error check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( nargs > 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### we ha ve to use sg. other than the default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> args[2] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := \+ ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := ALGEBRA ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Ge ns := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := ALGE BRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### we have \+ a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(Sum, `+`) ) th en " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " MinTerm := sort([op(Su m)],`&<`)[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### sum has only one term" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Mi nTerm := Sum;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### resetting default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if ( nargs = 2 and Gens <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### and returning the smallest term found" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 31 " if (type(MinTerm, `*`)) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 45 " RETURN([op(1,MinTerm), op(2,MinTerm)]);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " RETURN([1, MinTerm]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 1 " " }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 "hidden[listtolie] := proc(List)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " description `Converts a list to a lieexpression (with &*-s).`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 30 " local i, Result, KeepTerms;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 20 " ### memory option" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " ### stnd. ch eck" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs > 2 ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, a rgs);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " KeepTerms := true;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " KeepTerms := false;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### for extra caution" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( not(type(List, list)) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " if( KeepTerms = true ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " RETURN(listtolie([List], 0));" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " RETURN(listtolie([List]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ elif( nops(List) = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ RETURN(NULL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " ### needed for the comparisons in lieconvert, if we get a an ex pression in the list," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### ie \+ sum, then we make our deicion depending on its leading term" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " ### if there are two arguments to the \+ function, it flags that we mean to keep the `+` terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " if( (KeepTerms = false) and (nops(List) = 1) \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " and (type(List[], `+`) or type(List[], function)) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " Result := leading(List[], ALGEBRA);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### expand the sublist as wel l" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( type(List[1], list) \+ ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( KeepTerms = \+ true ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " Result : = listtolie(List[1], 0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Result := lis ttolie(List[1]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " Result := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### applying &* to elements" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " for i from 2 to nops(List) \+ do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( type(List[i], l ist) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " if( Keep Terms = true ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " Result := Result &* listtolie(List[i], 0);" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " Result := Result &* listtolie(List[i]) ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " Result := Result &* List[i];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 18 " RETURN(Result);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 38 "hidden[lieconvert] := proc(L ist::list)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " description `Brack ets a list of names properly according to Lie rules.`;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " local Least, i, Previ, Mon, Alg, Gens;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### memory option" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### standard error check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs > 2 ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many argum ents`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### using the needed algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " Gen s := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( ALGEBRA <> args[ 2] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := args[2 ];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 21 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " ### base case" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( nops(List) = 1 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### we have to distinguish between names (expre ssions of single vars.)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ## # and complex ones; this is done because if listtolie() sees a complex " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### expression (one with \+ sums) in a list all by itself, it knows that it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### has to consider only the leading term from \+ it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( type(List[], name) \+ ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( Gens <> ALGE BRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " use(Gens) ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " RETURN(List[]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " \+ if( Gens <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " RETURN(List);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### we have \+ arranging to do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### finding smallest value in the l ist" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Least := List[1]; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " for i to nops(List) do " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " if( listtolie(List[i]) &< \+ listtolie(Least) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " \+ Least := List[i];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### cat ching a case that would cause an infinite loop" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " if( listtolie(List[nops(List)]) &= listtolie(Le ast) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( Gens <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " use( Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 20 " RETURN([]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### init. i to one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " i := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### init. Mon (this holds the bracketed monomia ls" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " Mon := [];" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " \+ ### loop 'til Christmas, not really, but instead once through the list " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " while( i <= nops(List) ) \+ do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### this will show u s whether there is a sequence of smallest terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " Previ := i;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " ### bracketing th e smallest value with the one to it on the right" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " while( listtolie(List[i]) &= listtolie(Least ) ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " i := i + 1; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### no smallest terms, just copy element over" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( Previ = i ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Mon := [Mon[], List[i]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " # ## we had a sequence of smallest terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " \+ Mon := [Mon[], List[Previ..i-2][], List[i-1..i]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### increment i" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " \+ i := i + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### resetting default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( Gens <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### we do the same for until everything is groupped into one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " RETURN( lieconvert(Mon, Alg));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " hidden[comp] := proc(a::list(name),unsimplV::algebraic,b::list(name)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " description `Computes the co mposition of the expression.`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " local U, A lg, i, Previ, BracketList, Least, LowMark, HighMark, Gens, V, leadofV, Vinlist;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### standard check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs > 4 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### use othe r than default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( \+ nargs = 4 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := A LGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := args[4];" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " \+ Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := A LGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### prepa ring the V part of the entry going in list U" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### producing V from the unsimplified input" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " V := simplify(unsimplV, Alg);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### getting the leading term of V" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " leadofV := leading(V, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### checking for homogenouity" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( type(V, `+`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( wt(V, Al g) = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ERROR(`t erms in sum are not homogenous in`,z) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 27 " ### some checks on input" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " elif( V = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " elif( type(V, constant) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " ERROR(`middle term simplifies to a constant, which is not \+ allowed.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### r escaling the sum if we have to" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " \+ if( type(leadofV, `*`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " V := (V) * (1/op(1,leadofV));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " leadofV := leadofV/op(1,leadofV);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### the part of V that goes in U" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " Vinlist := map(proc(x) if(type(x ,`*`)) then op(2,x); else x; fi; end, [extract(leadofV,Alg)]);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### throwing everything in a list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " U := [op(a), op(Vinlist), op(b)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### whe re V starts and ends" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " LowMark \+ := nops(a)+1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " HighMark := nop s(a)+nops(Vinlist);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 43 " ### finding smallest element in the list " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " Least := sort(U,`&<`)[1];" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### this is the list we're copying into" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " BracketList := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### loop counter" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " i := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### looping through the list, examining each eleme nt in it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " while( i <= nops(U) \+ ) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### shows the first \+ in a series of smallest elements" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Previ := i;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### we loop 'til current element is sma llest" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " while( U[i] &= Least and i < nops(U) ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " i := i + 1; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " \+ ### we have more than one smallest elements in row " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### and they stretch over V" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 51 " if( Previ <= LowMark and HighMark < i ) \+ then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " BracketList := [B racketList[], [U[Previ..LowMark-1][], [[V], " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " \+ lieconvert(U[HighMark+1..i], Alg)]]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### if th e bracketing would fall inside V skip to the end of V" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " elif( Previ <= LowMark and LowMark <= i ) \+ then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### Previ is righ t on the dot" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( Previ \+ = LowMark ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " Bra cketList := [BracketList[], [V]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " Br acketList := [BracketList[], [U[Previ..LowMark-1][], [V]]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### since we grabbed the whole of V, increme nt i" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " i := HighMark;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### not a smallest element, just copy it over" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " elif( Previ = i ) then " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " BracketList := [BracketLis t[], U[i]]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 39 " ### sequence of smallest elements" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " if( Previ = LowMark and i = HighMark ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " BracketList := [Bra cketList[], [V]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " BracketList := [Bra cketList[], U[Previ..i]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " i := i + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### generating the lie-expressions from the lis ts" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " for i to nops(BracketList) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### single values are not in list form" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " if( type (BracketList[i], `list`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " BracketList[i] := lieconvert(BracketList[i], Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " BracketList[i] := lieconvert([BracketList[i] ], Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### now that the subparts ar e broken up, we can combine them" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " BracketList := lieconvert(BracketList, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### resettin g default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( nargs = 4 and ALGEBRA <> Gens ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ## # not all input is accepted" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " i f( BracketList = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ ERROR(`bad words, cannot be converted to a Hall Monomial`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### returning our results" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " RETURN(listtolie(BracketList, 0));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 "liealg[ genhallmon] := proc(Weight::list(integer))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " description `Generates Hall Monomials of the speci fied degree.`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declaratio ns" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " local Gens, Alg, Set, i, j , k, U, B, x, w, Add, right_weight;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " global GENERATORS, ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### give it memory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " o ption remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " #-------------------------------------" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " # definition of subprocedure" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " right_weight := proc(gen::algebr aic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " description `Checks whet her a weight of a generator equals to Weight, used in select`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " if (wt(gen) = Weight) then RETURN(true); else RETURN(false); \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " #---- ---------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### standard error check " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( nargs > 2 ) then " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, a rgs);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### we have to use sg. \+ other than the default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ elif( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " G ens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := arg s[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( args[2] <> ALGEB RA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### we can use the default algebra" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " \+ RETURN(genhallmon(Weight, ALGEBRA));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### will hold generated weights" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " B := [seq(0,i=Weight)];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### checking whether we have to add or subtract from B to get W eight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( Weight &!>= B ) the n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " Add := true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " elif( Weight &!<= B ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " Add := false;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " us e(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ERROR(`weight`, W eight, `has to be either positive, negative or zero.`);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### holds the results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " Set := \{\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " for i to nop s(GENERATORS) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 108 " if ( (Add \+ and (wt(GENERATORS[i]) &!<= Weight )) or (not(Add) and (wt(GENERATORS[ i]) &!>= Weight ))) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " w := Weight - wt(GENERATORS[i]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ U:=genhallmon(w, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " # compute the brakets [gen, A lg(w)]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " for j to nops(U) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " x := simplify( GENERAT ORS[i] &* U[j] , Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " \+ Set := Set union \{op(double_list(x)[1])\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 58 " ### we might have to return a generator (th e base case)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " Set \+ := Set union \{select(right_weight,GENERATORS)[]\} ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### resetting default algebra if we changed it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( nargs = 2 \+ and ALGEBRA <> Gens ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### r eturn the results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " RETURN([op( Set)]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 "# Fast, but has a bug if grading is [[1],[1],[1]] !!" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 "hidden[genhallmonom] := proc(Weight ::list(integer))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " description \+ `Generates Hall Monomials of the specified degree.`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " local Gens, Alg, Set, i, j, k, U, V, A, B, Add;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " global GENERATORS, ALGEBRA;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### give it memory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### sta ndard error check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( nargs > 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### we ha ve to use sg. other than the default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " \+ if( args[2] <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### we can use the default a lgebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " RETURN(genhallmonom(Weight, ALGEBRA));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### will hol d generated weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " B := [seq (0,i=Weight)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### checking whether we have to add or subtra ct from B to get Weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( W eight &!>= B ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " Add := true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " elif( Weight &!<= B ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " Add := false;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ERROR(`weight`, Weight, `has to be either positive, negative or zero.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### \+ holds the results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " Set := []; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " ### we loop" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " while( B <> Weight ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### creating B" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " for i to nops(B) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### current element of B is to be zeroed" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( B[i] = Weight[i] ) the n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " B[i] := 0;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### increment curr. elemen t of B" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if( Add ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " B[i] := B[i] + 1;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " B[i] := B[i] - 1;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### in \+ this case we generate subexpressions of lower weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( B <> Weight ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### subtract the weight of the current generator from the weight" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " U := genhallmonom(Weight-B , Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " V := genhallmon om(B, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 43 " ### loop through the returned sets" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " for j to nops(U) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " for k to nops(V) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### and apply the ru les" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if( U[j] &< V [k] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " if( (isgenerator(V[k], Alg)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " \+ or (not(isgenerator(V[k], Alg)) and not(U[j] &< op(1, V [k]))) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ Set := [Set[], evaln(U[j] &* V[k])]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### we might have to return a ge nerator (the base case)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " # ERROR!! only one generator is \+ returned here!" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " if( member(Weight, [seq(wt(i, Alg), i=GENERAT ORS)], 'k') ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Set := \+ [Set[], GENERATORS[k]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### resetting default algebra if we changed it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( nargs = 2 and ALGEBRA <> Gens ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### return the results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " RETURN(Set);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 50 "hidden[subwd] := pro c(E1::algebraic,E2::algebraic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " \+ description `subwd() picks out the subword E1 in E2 and returns a an d b in a list," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " w here E2 = aE1b`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### deca larations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " local i, Gens, Alg, Result, A, B;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### standard error check" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 25 " if( nargs > 3 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ERROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 3) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( ALGEBRA <> Alg ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### prepare A and B and init. r esult" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " A := [extract(leading( E1, Alg), Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " B := [extra ct(leading(E2, Alg), Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### simple enough case, A is th e same as B" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " if( A = B ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " Result := [[], E1, []]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### we have thinking and looping to do" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " \+ Result := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### go th rough B looking for A hidden somewhere" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " for i to nops(B)-nops(A)+1 do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### when found, return corresponding pieces " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( A = B[i..i+nops(A )-1] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " Result := [B[1..i-1], E1, B[i+nops(A)..nops(B)]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### switch \+ to default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( Gens \+ <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " use(Gen s);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### return \+ the goods" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(Result);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " hidden[overlap] := proc(E1::algebraic,E2::algebraic)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " description `overlap() picks out the overlaps of the end of A (1st arguments) and the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " beginning of B (second argument)`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 49 " local i, A, B, Result, Rem, Gens, Alg, L1, \+ L2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### if list L1 is longer then drop the first few \+ elements" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### standard error \+ check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( nargs > 3 ) then \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ERROR(`too many argument s`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " elif( nargs = 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Gens := ALGEBRA;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( ALGEBRA <> Alg ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " e lse" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Gens := ALGEBRA;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := ALGEBRA;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### creating lists from the expressions" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " L1 := [extract( leading(E1, Alg), Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " L2 \+ := [extract(leading(E2, Alg), Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ### remove part of L1 \+ that isn't effected by the overlap" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( nops(L1) > nops(L2) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " A := L1[nops(L1)-nops(L2)+1..nops(L1)];" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 39 " Rem := L1[1..nops(L1)-nops(L2)];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " A := L1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Rem := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### B is always this" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " B := L2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### compare an always shrinking part of the end of A to a shrinking" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### part of beginning of B" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 18 " Result := []; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " for i to nops(A) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " if( A[i..nops(A)] = B[1..nops(A)+1-i] ) then \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " Result := [Result[], \+ [[Rem[], A[1..i-1][]], A[i..nops(A)], B[nops(A)+2-i..nops(B)]]];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### switch back to default alg \+ if we changed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( Gens <> AL GEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### return \+ stuff" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(Result);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " hidden[comparewts] := proc(W1::list(integer), OP::symbol, W2::list(int eger))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " description `checks fo r W1 to be less than or equal to W2 (this relationship" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 73 " has to hold for all correspondi ng elements in the lists)`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " # ## decalarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " local i, Fla g;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### give it memory" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " # option system, remember; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### when wrong set of lists passed in" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( nops(W1) <> nops(W2) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ERROR(`the weights`,W1,`and`,W2,`are of non- equal length, can't compare`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### we could be asked to do fi nd a relation we're not ready for" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " elif( not(member(OP,\{`=`,`<`,`>`,`<=`,`>=`\})) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ERROR(`operation`,OP,`is not \+ supported`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### \+ init. our flag" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " Flag := true; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### let's compare piece by piece" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " for i to nops(W1) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### checking the relations" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 44 " if( (OP = `<` and not(W1[i] < W2[i])) " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " or (OP = `>` and not(W1[i] > W2[i]))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " or (OP = `<=` an d W1[i] > W2[i])" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " or (OP = `>=` and W1[i] < W2[i]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Flag := false;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ RETURN(Flag);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 "end: " }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 "hidden[`&!<`] := proc(A::list(integ er), B::list(integer)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " des cription `list &!< list defines the operator \"&!<\", which is interfa ce to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " func tion comparewts`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " RETURN(comparewts(A,`<`,B));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 "hidden[ `&!>`] := proc(A::list(integer), B::list(integer)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " description `list &!> list defines the operat or \"&!>\", which is interface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " function comparewts`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " RETURN(com parewts(A,`>`,B));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "hidden[`&!<=`] := proc(A::list(inte ger), B::list(integer)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " de scription `list &!<= list defines the operator \"&!<=\", which is inte rface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " f unction comparewts`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " RETURN(comparewts(A,`<=`,B));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " hidden[`&!>=`] := proc(A::list(integer), B::list(integer)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " description `list &!>= list defines \+ the operator \"&!>=\", which is interface to the " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 39 " function comparewts`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ RETURN(comparewts(A,`>=`,B));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end :" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 "hidden[`&!=`] := proc(A::list(integ er), B::list(integer)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " des cription `list &!= list defines the operator \"&!=\", which is interfa ce to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " func tion comparewts`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " RETURN(evalb(A = B));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "hidden[`&!<>`] : = proc(A::list(integer), B::list(integer)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " description `list &!<> list defines the operator \"&!<>\", which is interface to the " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " function comparewts`; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " RETURN(eva lb(A <> B));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " ### checktabs() empties s ome remember tables if they are too large (>62380 entries)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 "hidde n[checktabs] := proc() " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " desc ription``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " local ii, L, i nd; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 "L:= [indices(op(4,eval(main simplify)))]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " for ii t o nops(L) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ind:=L[i i];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " print(op(1,ind));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if ( type(op(1,ind),`+`)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 119 " op(4,eval(mainsim plify))[ind] := evaln(op(4,eval(mainsimpl ify))[op(ind)]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " elif(not(wt(op(1,ind))&!<=[1,1,1] ) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " op(4,eval(mai nsimplify))[ind] := " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " e valn(op(4,eval(mainsimplify))[ind]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 "fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 "print(nops([indices(op(4,eval(mainsimplify)))]));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 8 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 66 "hidden[stableset] := pr oc(R::list(algebraic),Alpha::list(integer))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " description``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### decalarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 330 " l ocal Gens, Alg, i, j, k, S, Q, P, Temp, time0, time1, time2, time3, ti me4, time5, time6, time7, timetot, timehall, timeloc, timered, timesub , timecomp, printcount, leadofTemp, Beta, Words, Next, Add, Term, Lead , TempLead, PLead, Pwt, Swt, ii, jj, icanc, nQ, nP, shift, Qdbl, newel , H, mon, coef1, coef2, i1, i2, flag, countQ," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " rescale, insert, remidlead, SWC; ### ==> o ur subprocedures" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " ### give it memory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " option system, remem ber; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " #---------- ---------> definition of subprocedures <--------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " \+ ### this procedures rescales the given expression and its leading ter m" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " rescale := proc(leadofExpr::algebraic, Expr::algebraic)" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " local Temp, NewLead;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " \+ ### when there is a field defined, we have to take the mod of the expr ession before" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### rescali ng anything" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( MODFLAG ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( type(Expr,`+ `) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " Temp := m ap((x,y)->if(type(x,`*`)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " (Normal(op(1,x)) mod y) * op(2,x); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " \+ (Normal(1) mod y) * x;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " fi, Expr, MODVALUE);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 37 " elif( type(Expr,`*`) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " Temp := (Normal(op(1, Expr)) mod MODVALUE) * op(2,Expr);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " \+ Temp := (Normal(1) mod MODVALUE) * Expr;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " ### the whole mod thing could have cancelled our leading term, we have to get a new one" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### but if temp is zero, \+ just return it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( Tem p = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN (0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 47 " NewLead := leading(Temp, ALGEBR A);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " # ## no characteristic is defined, just use our arguments" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 11 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Temp := Expr;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ NewLead := leadofExpr;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### doing the rescaling" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( type(NewLead,`*`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " RETURN(Temp/op(1,NewLead));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN(Temp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " e nd:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " #------------------------------------------------- ----------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### insert() inserts an element into \+ a list " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### (depending on th e lexicograph. position)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " insert := proc(E::algebraic,L:: list(algebraic))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " ### decl arations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " local Half, R;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### finding half point" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " Half := trunc(nops(L)/2);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### if list is empt y, expr is the only element" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " \+ if( L = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " R := [E];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " ### if there is only one term in L, it's easy \+ to determine the right spot for E" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif( nops(L) = 1 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( E &< L[1] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " R := [E, L[]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " R := [L[], E];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### else insert into the half that should contain E" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif( E &< L[Half] ) then" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " R := [insert(E, L[1..Hal f-1])[], L[Half..nops(L)][]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ elif( E &= L[Half] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " \+ R := [L[1..Half-1][], E, L[Half..nops(L)][]];" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 11 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " R := [L[1..Half][], insert(E, L[Half+1..nops(L)])[]];" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### retu rn the results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " RETURN(R); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " #---------- -------------------------------------------------------------" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### remidlead() eliminates the identical leading terms in L" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " remidlead := proc(L::list(algebraic))" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 23 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " local i, Q, Temp, Next;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### init . the loop-counter and our list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " Q := L;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " i := 1;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### loop through the sorted list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " while( i < nops(Q) ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### t akes care of the displacement after an element is removed" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 20 " Next := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### w hen two elements in sequence have " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### the same leading term subtract them..." }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( Q[i] &= Q[i+1] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### don't skip next element " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Next := 0;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### we do the subtraction " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Temp := Q[i+1] - Q[i]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### when there isn't a cancellation, we rescale our s tuff " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( Temp <> \+ 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " Temp := rescale(leading(Temp, ALGEBRA), Temp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " ### thro w the result back in the list in the correct place" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 66 " Q := [Q[1..i][], insert(Temp, Q[i+2 ..nops(Q)])[]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### remove the element, since Q[i] \+ = Q[i+1]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " else " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Q := subsop(i = NUL L, Q);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### i ncrement count" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " i := i \+ + Next;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " ### return the list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " RETURN(Q);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 75 " #----------------------------------------------- ------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " #---------------------------- en d of subs ------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " #----------- -------------> main proc()'s body <-------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ if( nargs > 3 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ER ROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " elif( nargs = 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " \+ Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg : = args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( ALGEBRA <> Alg ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " use(Alg); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " \+ Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Alg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### \+ will hold generated weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " \+ Beta := [seq(0,i=Alpha)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ### see what we'll have to do ( add to Beta or subtract from it)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( Alpha &!>= Beta ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " Add := true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif( Al pha &!<= Beta ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " Add \+ := false;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 17 " use(Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ERROR(`weight`, Alpha, `has to be either posit ive, negative or zero.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " S := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " Swt := \+ [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " for i to nops(R) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Temp := simplify(R[i], Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### getting the leading term" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 40 " leadofTemp := leading(Temp, Alg);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### checking for homogenouity" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " if( type(Temp, `+`) ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 39 " if( wt(Temp, Alg) = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " ERROR(`terms in sum`, Temp, `a re not homogenous.`) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### doing the rescaling" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " Temp := rescale(leadofTemp, Temp); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### add element to S if \+ it's weight is not greater than alpha" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( Temp <> 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " leadofTemp := leading(Temp, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( Add ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " if( wt(leadofTemp, Alg) &!<= Alpha ) the n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " S := [S[], Tem p];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " Swt := [Swt[ ], wt(leadofTemp, Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " if( wt(leadofTemp, Alg ) &!>= Alpha ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " \+ S := [S[], Temp];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " \+ Swt := [Swt[], wt(leadofTemp, Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### init. t he list P, that holds our results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " P := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " PLead := [] ; Pwt := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### we lo op and generate Betas" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " while( Beta <> Alpha ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 24 " ### creating Beta" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 29 " for i to nops(Beta) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### current element of Beta is to be zeroed if reached its max value" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ if( Beta[i] = Alpha[i] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " Beta[i] := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### increment curr. ele ment of B" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### adding or subtract ing, depending on what we need to do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( Add ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " Beta[i] := Beta[i] + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " Beta[i] := Beta[i] - 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " od;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 "#######" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 "# print(`==>`,Beta,`<==`,`time:`, time());" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 "# if ( (op(4,eval(ranking)) <> NULL) and ( nops([indi ces(op(4,eval(ranking)))]) > 30 ) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 "# print(`Ranking:`, nops([indices(op(4,eval(rankin g)))]) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 "# fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 "# checkta bs();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 "# if ( (op(4,eval(mainsimp lify)) <> NULL) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 "# pri nt(`Mainsimplify:`, nops([indices(op(4,eval(mainsimplify)))]) );" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "# print( op(4,eval(mainsimplify)) ) ; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 "# fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 "# if(o p(4,eval(ranking)) <> NULL) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 "# subsop(4=NULL,eval(ranking)):" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 "# fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 "SWC := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### init. Q and our counter" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " Q := [];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " i := 1;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 19 " countQ := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " while( i <= nops( S) ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### dump elem ents of weight Beta from S into Q" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### and delete element from S, don't increment counter " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( Swt[i] = Beta ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Q := [Q[], S[ i]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " S := subsop(i =NULL,S);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " Swt := s ubsop(i=NULL,Swt);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " el se" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " i := i + 1;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 10 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### rearrange Q in increasing order " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### (in `<` decision is made dep. on the leadi ng terms)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### and remove \+ identical leading terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " # Q := remidlead(sort(Q, `&<`));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### delete tables that m ight have become too large" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ # checktabs();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " # sort and rescale elements of Q" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " #create double list with el ements in the format:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " # [[ list of monomials],[list of coefficients]]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Qdbl := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " for i to nops(Q) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " Qdbl := [op(Qdbl), double_ list(Q[i])];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 17 "timehall:=time();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " # generate and sort Hall monomials" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " H:=sort(genhallmon(Beta), `&< `);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 "timehall:=time() - timehall; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "# print(`Hall monomials:`, time hall);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### delete tables that might have become too l arge" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " # checktabs();" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " nP:= nops(P);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " pr intcount:=0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 57 "timetot:=0; timeloc:=0;timered:=0;timesub:=0;timeco mp:=0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " while ((nops(Q)>0) and (nops(H)>0)) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " time0:=time();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 "time1:=time();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " mon := H[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " H := subsop(1=NULL,H);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " S WC := SWC + 1; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " # find elements of Q with mon as a lead ing term" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " # Temp is a li st with elements in format: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " \+ # [position in Q, coeff at mon]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " Temp:=[];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " for i to nops(Q) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " if ( member( mon, Qdbl[i ,1], 'jj') ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " T emp := [op(Temp), [i,Qdbl[i,2,jj]] ];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 "time1:=time() - time1; time2:=0; time3:=0; time4:=0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " # if Temp is empty, skip t o the next monomial" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " # i f Temp has more than one element, reduce using the first" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " # if Temp has one element, try to fi nd a composition" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 33 " if (nops(Temp) > 0) then" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 "time2: =time();" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " i1 := Temp[1,1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " coef1 := Temp[1,2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if ( nops(Temp) > 1) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ for i from nops(Temp) by -1 to 2 do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " i2 := Temp[i,1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " coef2 := Temp[i,2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " \+ # new reduced element of Q" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " newel := Q[i2] - (co ef2/coef1)*Q[i1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 34 " if (newel = 0) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " #delete if it vanished" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " Q := subsop( i 2=NULL, Q);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " Q dbl := subsop( i2=NULL, Qdbl);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ #replace" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ Q := subsop( i2=newel, Q);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " \+ Qdbl := subsop( i2=double_list(newel), Qdbl);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 37 "time2:=time() - time2; time3:=time( );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " flag := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " # if we find the composition, we switch flag to 0. " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### init. the \+ other loop count" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " j := \+ 1; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " while( (j <= nP) a nd (flag = 1) ) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ ### attempting to find P[j] hidden within mon" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### (only if it's possible for P[j] to b e in mon)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " if( (Add and (Pwt[j] &!<= Beta))" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " or (not(Add) and (Pwt [j] &!>= Beta )) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " Temp := subwd(P[j], mon, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 52 " ### when found, take its compositio n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if( Temp <> [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 "time3:= time() - time3; time4:=time(); \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " flag := 0 ; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " Q[i1] := Q[i 1] - coef1*simplify(comp(Temp[], Alg), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 8 "########" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### the terms cancelled" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " if( Q[i1] = 0 ) then " }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 48 " Q := subsop(i1 = NULL, Q);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " Qdbl: =subsop(i1 = NULL, Qdbl);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " \+ Qdbl:=subsop(i1 = double_list(Q[i1]), Qdbl);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " time4:= time() - time4; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " j := j+1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " # if flag is still 1, m ove the element of Q to P" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if (flag = 1) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 "time3:=time() - time3;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " P := [op(P), Q[i1]/coef1 ];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " PLead := [op(PLead), mon];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Pwt := [op(Pwt), Beta];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " Q := subsop( i1 = NULL , Q);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " Qdbl := subso p( i1 = NULL, Qdbl);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ countQ := countQ + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 "time0:=t ime() - time0; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 121 "timeloc:=timeloc+time1; timered:=timered+time2; timesub:=timesub+time3; timecomp:=timecomp+time4; timetot:=timetot+ti me0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 "if (printcount = 200) then \+ printcount:=0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 139 " print(`it eration:`, SWC, `time:`, timetot, `locate:`,timeloc, `redu ce:`,timered, `subword:`,timesub, `comp:`, timecomp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 "timetot:=0; timeloc:=0;timered:=0;timesub:=0;tim ecomp:=0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 29 " printcount:=printcount+1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 "fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 10 "##########" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 "# print(`Comp&simpl for subwords:`, SWC);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 "time5:=time(); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### going through P and \+ new part of P (from Q)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " fo r i to nops(P) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " for \+ j from nops(P) - countQ + 1 to nops(P) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " \+ ### checking for overlaps" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " if( PLead[i] &< PLead[j] ) then " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " \+ ### the functions returns overlaps if found any" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 66 " ### (returned in form [[[a],[overla p],[b]],[...]])" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ Words := overlap(PLead[i], PLead[j], Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " \+ ### if there are overlaps and the weight of the word" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### a(overlap)b is less than alp ha, our incoming weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " \+ if( Words <> [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### now we go \+ through the overlaps" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " \+ for k to nops(Words) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " if( (Add and add(wt(l,Alg),l=[Words[k][1][]," }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " \+ Words[k][2][],Words[k][3][]]) &!<= Alpha) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " or (not(Add) and add( wt(l,Alg),l=[Words[k][1][]," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 99 " \+ Words[k][2][],Words[k][ 3][]]) &!>= Alpha) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " Temp := si mplify(comp([],P[i],Words[k][3], Alg), Alg) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " - simplify(comp(Words[ k][1],P[j],[], Alg), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " if( Temp < > 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " \+ Temp := rescale(leading(Temp, Alg), Temp);" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 45 " S := [S[], Temp];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " Swt := \+ [Swt[], wt(leading(Temp, Alg))];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " f i;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### the symmetric case to the previous" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( PLead[i] &> PL ead[j] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### the functions returns overla ps if found any" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " \+ ### (returned in form [[[a],[overlap],[b]],[...]])" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 58 " Words := overlap(PLead[j], PLead[i] , Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### if there are overlaps and the wei ght of the word" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " \+ ### a(overlap)b is less than alpha, our incoming weight" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 38 " if( Words <> [] ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### now we go th rough the overlaps" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " \+ for k to nops(Words) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ if( (Add and add(wt(l,Alg),l=[Words[k][1][]," }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " \+ Words[k][2][],Words[k][3][]]) &!<= Alpha) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " or (not(Add) and add( wt(l,Alg),l=[Words[k][1][]," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 99 " \+ Words[k][2][],Words[k][ 3][]]) &!>= Alpha) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " Temp := si mplify(comp([],P[j],Words[k][3], Alg), Alg) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " - simplify(comp(Words[ k][1],P[i],[], Alg), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ if( Temp <> 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " Temp := rescale(leading(T emp, Alg), Temp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ S := [S[], Temp];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " Swt := [Swt[], wt(leading(Temp, Alg))];" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " time5: =time()-time5; # print(`time for new:`,time5); " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### reset d efault algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( Gens <> A LGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " use(Gens); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### returni ng our results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " RETURN(P);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 47 "liealg[genbasis] := proc(Wei ght::list(integer))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " descripti on ``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " local i, j, Table, Entries, Idea l, Alg, StableSet, Basis, DeleteIt, maximize, Temp, FactAlg;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### give it memory" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 76 " #----------------------> definition of subp rocedures <-------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### creates a maximized versio n of two sets of weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ### \+ ie for input ([1,3,5],[2,5,3]) the output is: [2,5,5]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " maximiz e := proc(A::list(integer),B::list(integer))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " local i, Result;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( nops(A) = nops(B) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Result := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " for i to nops(A) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " if( A[i] > B[i] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Result := [Resul t[],A[i]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " Result := [Result[], B[i]]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " \+ ERROR(`weights`, A, `and`, B, `are of different length.`);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " RETURN(Result);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " #------------- ------------------end of subs---------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " #--- ----------------------> main proc()'s body <---------------------" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " ### standard check" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " i f( nargs > 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR( `too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ elif( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Fac tAlg := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " FactAlg := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### retrieving the factor algebra from the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Table := op(4, eval(factoralg)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ if( Table <> NULL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " E ntries := [indices(Table)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " \+ if( member(FactAlg, FACTORALGS) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " Alg := Table[FactAlg][1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Ideal := Table[FactAlg][2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " ERROR(`factor algebra`, FactAlg, `isn't defined.`);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ER ROR(`no factor algebras defined`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### find the stable set (generate it if we have to )" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " if( member([(Ideal,stabset) ], Entries, 'k') ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### if our stable set is comp uted for weight high enough, we're OK" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " if( (Weight &!<= [Table[Entries[k][]]][1] and Weight &!>= \+ [seq(0,i=Weight)]) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " or ( Weight &!>= [Table[Entries[k][]]][1] and Weight &!<= [seq(0,i=Weight)] ) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " StableSet := [ Table[Entries[k][]]][2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### we have to recompute the \+ stable set for a larger weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### Weight is not necesserily larger, only some elements" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " ### therefore we find a maximized weight and recalc. the stableset (for pos. wt-s)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " if( not(Weight &!> [Table[Entries[k][]]][1]) and Weig ht &!>= [seq(0,i=Weight)] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " Temp := maximize([Table[Entries[k][]]][1], Weight);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " StableSet := stableset( [op(4,eval(ideal))[Ideal]], Temp, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### once we computed it for a higher weight, we mi ght as well" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### add \+ it to the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " fact oralg(Ideal, stabset) := Temp, StableSet:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### We ight is not necesserily larger, only some elements" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 91 " ### therefore we find a maximized weight a nd recalc. the stableset (for neg. wt-s)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " elif( not(Weight &!< [Table[Entries[k][]]][1 ]) and Weight &!<= [seq(0,i=Weight)] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " Temp := -maximize(-[Table[Entries[k][]]][ 1], -Weight);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " Stable Set := stableset([op(4,eval(ideal))[Ideal]], Temp, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### once we computed it for a hig her weight, we might as well" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " \+ ### add it to the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " factoralg(Ideal, stabset) := Temp, StableSet:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " \+ ### the weight is simply larger than the one we had, recalc. s-set " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " StableSet := stableset([op(4,eval(id eal))[Ideal]], Weight, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " \+ ### once we computed it for a higher weight, we might as well " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### add it to the t able" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " factoralg(Ideal , stabset) := Weight, StableSet:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### stable set has to be computed" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " StableSet := stableset([op(4,eval(ideal))[Ideal ]], Weight, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ### once we computed it, we might as well add it to the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " factoralg(Ideal, stabset) := Weight, Stabl eSet:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### genera te hall monomials of the given weight" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Basis := genhallmon(Weight, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### pick out only the elements we will need" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( Weight &!>= [seq(0,i=Weight)] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 98 " StableSet := map(proc(x) if(wt(leading(x,Alg),A lg) &!<= Weight) then x; fi; end, StableSet);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 98 " St ableSet := map(proc(x) if(wt(leading(x,Alg),Alg) &!>= Weight) then x; \+ fi; end, StableSet);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### almost ready to loop, init. some stuff" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 10 " i := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### throw out the hall monomial s that have the leading term of an element" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### from the stable set as a subword" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " while( nops(Basis) > 0 and i <= nops(Basis ) ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " DeleteIt := false; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " j := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " while( j <= nops(StableSet) ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " if( subwd(StableSet[j], Basis[i] , Alg) <> [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " \+ DeleteIt := true;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " b reak; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 20 " j := j + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### go ahead and delete c urrent element, don't increment count" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( DeleteIt ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " Basis := subsop(i=NULL,Basis);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### increment count" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " i := i + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### return the results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " RETURN(Basis);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 "liealg[factoralg] := proc(Label::name, List::list(name)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " description `factoralg(factoralgname, idealname, algname(opti onal)) This" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " funct ion defines a factor algebra of an ideal and its algebra`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " global FACTORALGS;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " local Table, Entries, Gens, CutOffWt, Algebra, Ideal, Wts; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### let it remember stuff" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### called w ith too many arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " if( na rgs > 3 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ERROR(`too many arguments`, args);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### \+ there is nothing defined" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif ( GENERATORS = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " E RROR(`no algebras defined in generators().`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### the four th arg. can only be the cut off weights for the ideal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " if( not(type(args[3],list(integer))) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ERROR(`a list of integers \+ is expected for the cut off weight`,args[3]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " \+ CutOffWt := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " CutOffWt := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### get the algebra and the id eal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( nops(List) > 2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ERROR(`expected [algebra , ideal], received`, List);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " # ## use default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " elif( \+ nops(List) = 1 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Alge bra := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Ideal := L ist[];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### we have an algebra and an ideal, we're just not sure of the order" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " Ta ble := op(4, eval(generators));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " if( member([List[1]],[indices(Table)]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " Algebra := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " Ideal := List[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " \+ Ideal := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ Algebra := List[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### opening \+ the generator table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Table := \+ op(4, eval(generators));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### if there are entries in it, \+ look for the requested one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if ( Table <> NULL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " Ent ries := [indices(Table)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### we found the algebra, get the generators for it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " if( member([Algebra],Entries) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " Gens := Table[Algebra];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### get weights f or the algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( memb er([(Algebra, weight)],Entries) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " Wts := Table[(Algebra, weight)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ERROR(`no weights defined for algebra`, Algebra);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### we co uldn't find the algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " el se" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ERROR(`algebra`, Alg ebra, `is not defined`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### the table was empty as is " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ER ROR(`no algebras defined`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### opening the ideal table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Table := op(4, eval(ideal));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### if there are e ntries in it, look for the requested one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( Table <> NULL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " Entries := [indices(Table)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### we found the ideal, get the generators for it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " if( member([Ideal],Entries) ) then" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 14 " NULL;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### we co uldn't find the ideal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ERROR(`ideal`, Ideal, \+ `is not defined`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### the table was empty as is " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ERROR(`no i deals defined`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " \+ ### place entries in the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " \+ ### names of the ideal and algebra for factor algebra" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 38 " factoralg(Label) := Algebra, Ideal:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### also registering them in the generators table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " generators( Label) := Gens: ### generators of the algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " generators(Label, weight):= Wts: ### weights for t he generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 " " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 56 " ### if we have to generate a stable-set for the ideal" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( CutOffWt <> [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " factoralg(Ideal, s tabset) := CutOffWt, stableset([Gens][2], CutOffWt, Algebra):" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### keeping \+ track of the factor algebras (for simplify)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " unprotect(evaln(FACTORALGS));" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 42 " FACTORALGS := FACTORALGS union \{Label\};" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " protect(evaln(FACTORALGS));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### return some output" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " \+ RETURN(Label=);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "e nd:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 62 "hidden[factorsimplif y] := proc(Expr::algebraic, FactAlg::name)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " local Basis, i, j, Table, StableSet, Temp, Alg, Ideal, TMP, \+ Gens, weight;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### memory thin g" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " option remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " \+ # we expect a monomial, already simplified in algebra above" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### getting factor algebra " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Table := op(4, eval(factoralg)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### we know entry exists, si nce it's in the set FACTORALGS" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ Alg := [Table[FactAlg]][1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ Ideal := [Table[(FactAlg)]][2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " # I delete the change of algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### we need to change the default algebra, so we c ould use the overloaded" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### & <, etc. operators in the built in sort algorithm" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " # if( Alg <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " # Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " # use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " # else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " # Gens := ALGEBR A;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " # fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " weight := wt (Expr, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 23 " ### getting basis" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Basis := genbasis(weight, FactAlg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " \+ if (nops(Basis) = 0) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### getting the stable set for the ideal" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 46 " StableSet := Table[(Ideal, stabset)][2];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### pick out only the elements we will need" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " if( weight &!>= [seq(0,i=weight)] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 109 " StableSet := map(proc(x ,y,z) if(wt(leading(x,z),z) &!<= y) then x; fi; end, StableSet, weight , Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 109 " StableSet := map(proc(x,y,z) if(wt( leading(x,z),z) &!>= y) then x; fi; end, StableSet, weight, Alg);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 80 " ### our term is not part of the ideal , so it has to be in the stableset" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if (member(Expr, Basis)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " RETURN(Expr);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### loop through stableset, looking for an expression \+ with a " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### leading \+ term that is a subword in Expr" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " for j to nops(StableS et) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " Temp := s ubwd(StableSet[j], Expr, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### the leading te rm was found" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " if( \+ Temp <> [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### take its composition " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### (current te rm as V, U=leading term from stableset element)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " TMP := Expr - mainsimplify(comp(Tem p[],Alg), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if (TMP = 0) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 23 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " \+ if ( type(TMP, `*` )) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " RETURN( op(1,TMP)*factorsimplify( op(2,TMP), FactAlg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 34 " if( type(TMP,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " RETURN( map(proc(x) if(type(x, `*`)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " \+ op(1,x) * factorsimplify(op(2,x), FactAlg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " factorsimplify(x, FactAlg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " \+ fi; end, TMP) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " RETURN( \+ factorsimplify( TMP, FactAlg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " od;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 "# ### change back the defa ult algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 "# if( Gens <> ALGE BRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 "# use(Gens);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 "# fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 "# " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "# ### retu rn our results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 "# RETURN(SLF); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 65 "hidden[factorsimplifyold] := proc(E xpr::algebraic, FactAlg::name)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " local S, S LF, Basis, i, j, k, Table, StableSet, Temp, Alg, Ideal, Cons, Next, Ge ns;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### memory thing" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### getting factor algebra " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Table := op(4, eval(factoralg));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### we know entry exists, since it's in the set FACTORALGS " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " Alg := [Table[FactAlg]][1]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " Ideal := [Table[(FactAlg)]][ 2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### we need to change the default algebra, so we c ould use the overloaded" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### & <, etc. operators in the built in sort algorithm" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( Alg <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " use(Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := ALGEBRA;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### simplify our expressi on" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " S := mainsimplify(Expr, Al g);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### and sort terms in increasing order" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( S = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " elif( type(S, `+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " SLF := sort([op(S)], `&<`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " SLF := [S];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### checking for the homogenouity of the simplified expression" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 62 " ### (wt returns [] for an expression with non-ho mog. terms)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " if( wt(S, Alg) <> [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 23 " ### getting basis" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " Basis := genbasis(wt(SLF[1], Alg), FactAlg);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### getting the stable set for the ideal" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 46 " StableSet := Table[(Ideal, stabset)][2];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### pick out only the elements we will need" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " if( wt(SLF[1], Alg) &!>= [seq(0,i=wt(SLF[1 ], Alg))] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 118 " Stabl eSet := map(proc(x,y,z) if(wt(leading(x,z),z) &!<= y) then x; fi; end, StableSet, wt(SLF[1], Alg), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 118 " StableS et := map(proc(x,y,z) if(wt(leading(x,z),z) &!>= y) then x; fi; end, S tableSet, wt(SLF[1], Alg), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### init. the loop counter" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 13 " i := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### loop until there are \+ terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " while( i <= nops(SLF ) and SLF <> [0] ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " ### Next is added to i when incr ementing it (if we reduce the size" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### of SLF, then we will change it to zero in order not \+ to skip terms)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " Next := \+ 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### removing constants" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " if( type(SLF[i], `*`) ) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 34 " Cons := op(1, SLF[i]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " SLF[i] := op(2, SLF[i]);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Cons := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### our term is not part of the id eal, so it has to be in the stableset" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " if( not(member(SLF[i], Basis)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### init. our other loop-counter" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " j := 1;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " \+ ### loop through stableset, looking for an expression with a " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### leading term that h as the current term from SLF as a subword" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " while( j <= nops(StableSet) ) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " Temp := subwd(Stable Set[j], SLF[i], Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### the leading term was f ound" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " if( Temp <> \+ [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### take its composition " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### (current term as V, U=leading term from stableset element)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " SLF[i] := SLF[i] - mainsimplify(comp(Temp[], Alg), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 65 " ### throwing the term back, combi ning constants" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ ### and recreating the list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " \+ SLF[i] := Cons * SLF[i];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ### if we had a zero, don't skip ahead" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( SLF[i] = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Next := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### we have to look at all the elem ents again" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " els e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " i := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " \+ ### reform sum (this automatically takes care of reductio n)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " SLF := add( k,k=SLF);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " ### when we have a sum, reform list " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " if( type(SLF, `+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " \+ SLF := sort([op(SLF)], `&<`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### what we h ave is not a sum, just form a list of it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " SLF := [SLF];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " break;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ ### increment count" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " \+ j := j + 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " od ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### add the constant back to the term" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " SLF[i] := Cons * SLF[i]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ ### increment count" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " \+ i := i + Next;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " od;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### we have \+ to form the sum again from the terms " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( nops(SLF) > 1 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " SLF := add(k, k=SLF);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### we have nothing in the list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " elif( SLF = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ SLF := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " ### only one ele ment, remove the list-brackets" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " SLF := SLF[];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### change b ack the default algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( G ens <> ALGEBRA ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " use( Gens);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### retu rn our results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " RETURN(SLF);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " liealg[triangular] := proc(Label::name, List::list(name))" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 83 " description `allows the construction of a lgebras with triangular decomposition`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " global TRIANGALGS;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " \+ local i, j, Table, Wp, Wh, Wn, Gp, Gn, Gh, Temp, Lp, Ln, H, Len, Entr ies;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " ### memory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### getting the generat ors for the algebras" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Table := op(4, eval(generators));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### if there are entries...." }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " if( Table <> NULL ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ### selecting algebras withou t knowing the order they came in" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " if( member([List[1]],[indices(Table)]) and member([List[2]],[in dices(Table)])" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " and membe r([List[3]],[indices(Table)]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### first one is \+ H" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " if( Table[(List[1], w eight)][1] = [seq(0,i=Table[(List[1], weight)][1])] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " H := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### second is Lminus" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 96 " if( (Table[(List[2], weight)][1]) \+ &!<= [seq(0,i=Table[(List[2], weight)][1])] ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 29 " Ln := List[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Lp := List[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### second is Lplus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Lp := List[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Ln := List[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 28 " ### second one is H" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 92 " elif( (Table[(List[2], weight)][1]) = [seq(0,i=Table[(List[2], weight)][1])] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " H := List[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### first is Lminus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " if( (Table[(List[1], weight)][1]) &!<= [s eq(0,i=Table[(List[1], weight)][1])] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Ln := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Lp := List[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### first is Lplus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Lp := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Ln := List[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 42 " ### we're assuming the third is H" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 25 " H := List[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### first is Lminus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 96 " if( (Table[(List[1], weight)][1]) &!<= [s eq(0,i=Table[(List[1], weight)][1])] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Ln := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Lp := List[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### first is Lplus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Lp := List[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Ln := List[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### an algebra wasn't found" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " \+ ERROR(`one of the algebras from`, List[], `is not defined in gene rators().`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " \+ ### checking restrictions on positive algebra's weights (they have \+ to be non-negative)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " Wp := \+ Table[(Lp, weight)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Len : = nops(Wp[1]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i to no ps(Wp) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( hastype(W p[i], negative) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " \+ ERROR(`negative weight is not allowed for algebra`, Lp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " elif( nops(Wp[i]) <> Len ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ERROR(`weights`, Wp [1], `and`, Wp[i], `have different lengths.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " ### checking restrictions on alg. with supposed all zero weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Wh := Ta ble[(H, weight)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i to nops(Wh) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " if( hastyp e(Wh[i],negative) or hastype(Wh[i],positive) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ERROR(`only zero weights are allowed f or algebra`, H);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " elif( \+ nops(Wh[i]) <> Len ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " \+ ERROR(`weights`, Wp[1], `and`, Wh[i], `have different lengths.`) ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " ### checking restrictions o n negative algebra's weights (they have to be non-positive)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " Wn := Table[(Ln, weight)];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i to nops(Wn) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( hastype(Wn[i], positiv e) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ERROR(`pos itive weight is not allowed for algebra`, Ln);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " elif( nops(Wn[i]) <> Len ) then" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 77 " ERROR(`weights`, Wp[1], `and`, W n[i], `have different lengths.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### we might have been sent some rules already set up" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if( nargs = 3 ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( type(args[3], list) ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " store(DONTPRINT , [args[3][], Label]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ERROR(`rules ar e expected in a list, received`, args[3]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### retriveing the generators for each algebra " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Gp := [Table[Lp]];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Gn := [Table[Ln]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Gh := [Table[H]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 100 " \+ ### and getting the lookup table to check whether we set up all the rules if they were sent in" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ Table := op(4, eval(store));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " \+ if( Table <> NULL and member([Label],[indices(Table)]) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " Entries := Table[Label];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " Entries := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ### delete the remember table , since we'll be looking up values from it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " subsop(4=NULL, eval(functionize)):" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " \+ ### looking at the weights of the generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i to nops(Gp) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " for j to nops(Gn) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### we didn't find the rule, add it" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " if( functionize(evaln(G p[i]&*Gn[j]),Label) = FAIL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " if( wt(Gp[i], Lp) <> -(wt(Gn[j], Ln)) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " store(DONTPRINT, \+ [evaln(Gp[i]&*Gn[j])=0, Label]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " elif( wt(Gp[i], Lp) = -(wt(Gn[j], Ln)) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 98 " Temp := readstat( cat(convert(Gp[i], string),`&*`,convert(Gn[j], string),` = `));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " store([evaln(Gp[i ]&*Gn[j])=Temp, Label]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " ### prompting user for rules \+ for intersection of H and Lp (pos. lie algebra)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### and for rules for intersection of H and Ln \+ (neg. lie algebra)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i t o nops(Gh) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### loopi ng through pos. algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " \+ for j to nops(Gp) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " \+ ### we didn't find the rule, add it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " if( functionize(evaln(Gh[i]&*Gp[j]),Label) = FAIL ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " Temp := read stat(cat(convert(Gh[i], string),`&*`,convert(Gp[j], string),` = `));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " store([evaln(Gh[i] &*Gp[j])=Temp, Label]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " \+ ### looping through neg. algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " for j to nops(Gn) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### we didn't find the rule, add it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " if( functionize(evaln(Gh[i]&*Gn[j]),La bel) = FAIL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " \+ Temp := readstat(cat(convert(Gh[i], string),`&*`,convert(Gn[j], stri ng),` = `));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " stor e([evaln(Gh[i]&*Gn[j])=Temp, Label]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " o d;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " ### producing the rules for the intersection of H with generators from itself" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### (H[i]&*H[j]=0 for all i,j)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " for j from i to nops(Gh) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### we didn't find the rule, add it " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " if(functionize(eval n(Gh[i]&*Gh[j]),Label) = FAIL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " store(DONTPRINT, [evaln(Gh[i]&*Gh[j])=0, Label]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 12 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### making this algebra appear in its set " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " unprotect(evaln(TRIANGALG S));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " TRIANGALGS := TRIANGA LGS union \{Label\};" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " prote ct(evaln(TRIANGALGS));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " ### adding the gen-s of the three a lg-s as the gen-s of our produced triang. alg." }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " generators(Label):=Gp[],Gh[],Gn[]:" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 52 " generators((Label, weight)):=[Wp[],Wh[ ],Wn[]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " ### storing our algebras in the procedure's rem ember table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " triangular(Lab el) := Lp, H, Ln:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 31 " ### returning some output" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 19 " printf(\"\\n\");" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " RETURN(Label=);" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }} }{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 59 "hidde n[triangularsimplify] := proc(E::algebraic, Alg::name)" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 18 " description ``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " local Table, TMP, Temp, P, S, N, sim;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### memory option" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " # ----------- subprocedure \+ to be mapped into ---------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " sim := proc(x::algebraic, Algnam e1::name,Algname2::name,Algname3::name)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " local L, Algname;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " \+ # x is Const times a monomial, we simplify using" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " # appropriate Algname rule" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if (t ype(x,`*`)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " L := [ex tract(op(2,x),Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " L := [extract(x,Alg)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if (isgene rator(L,Algname1)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " \+ Algname := Algname1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if (isgenerator(L,Algname2)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " Algname := Algname2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if (isgenerator(L,Algname3)) t hen" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " Algname := Algname3; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if (type(x ,`*`)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " RETURN( op(1 ,x)*mainsimplify(op(2,x),Algname) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " RETURN( mainsimplify(x,Algname) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " end: " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 47 " #------------- end of subprocedure -----------" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### getting the algebras \+ from the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Table := op(4, eval(triangular));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Temp := [ Table[Alg]]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### Lplus # ## H ### Lminus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " P := \+ Temp[1]; S := Temp[2]; N := Temp[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " # we expect that E is a monomial" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " TMP := mixedtrisimplify(E,Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " if ( TMP = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " RETURN(0); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if ( type(TM P,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " RETURN( sim( \+ TMP, P, S, N) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if ( type(TMP,`+`) ) then" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " RETURN( map ( sim, TMP, P, S, N) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " RETURN( sim( TMP, P, S, N) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "en d:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 57 "hidden[ mixedtrisimplify] := proc(E::algebraic, Alg::name)" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 18 " description ``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " loc al i, Result, Table, Temp, P, S, N, Lhs, Rhs, Lgen, Alg1, Alg2;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### memory option" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 29 " # option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### getting the algebras from the tabl e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " Table := op(4, eval(triangu lar));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Temp := [Table[Alg]]; \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### Lplus ### H \+ ### Lminus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " P := Temp[1]; S := Temp[2]; N := Temp[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( nops(E) = 1 or type(E,indexe d) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(E);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### breaking expression into its two sides" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " Lhs := op(1,E); Rhs := op(2,E );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " # if either Lhs or Rhs is not pure (contains terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " # from different algebras, then mixedtrisimplify it" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Lgen := [extract(Lhs,Alg)]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if ( isgenerator(Lgen, \+ P) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " Alg1 := P;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " elif ( isgenerator(Lgen, S) ) t hen " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " Alg1 := S;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " elif ( isgenerator(Lgen, N) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Alg1 := N;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " Temp := mixedtrisimplify(Lhs, Alg);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if (Temp = 0) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " if ( type(Temp, `*` )) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 74 " RETURN( op(1,Temp)*mixedtrisimpli fy( op(2,Temp)&*Rhs, Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( type(Te mp,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " RETU RN( map(proc(x) if(type(x,`*`)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " op(1,x) * mixedtrisimplify(op(2,x)&*Rhs, \+ Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " \+ mixedtrisimplify(x&*Rhs, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " fi; end, Temp) );" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " RETURN( mixedtrisimplify( Temp &* Rhs , Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " Lgen := [ex tract(Rhs,Alg)]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " i f ( isgenerator(Lgen, P) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " Alg2 := P;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " elif ( isg enerator(Lgen, S) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ Alg2 := S;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " elif ( isgen erator(Lgen, N) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " \+ Alg2 := N;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " Temp := mixedtrisimplify( Rhs, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if (Temp = \+ 0) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN(0); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if ( type(Temp, `*` ) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " RETURN( op(1,Temp)*mixedtris implify( Lhs&*op(2,Temp), Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( \+ type(Temp,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " \+ RETURN( map(proc(x) if(type(x,`*`)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " op(1,x) * mixedtrisimplify(Lhs &*op(2,x), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " \+ mixedtrisimplify(Lhs&*x, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " fi; end, Temp) );" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " RETURN( mixedtrisimplify( Lhs &* Te mp, Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " # both side s are monomials in one subalgebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " # if it is the same algebra, then we are done" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " # else we need to rearrange and apply reduce " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " if ( eval(Alg1) = eval(Alg2) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " RETURN(E);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " ### this nice little statement is for checking \+ for mixed weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " if( ((is generator([extract(Lhs,Alg)],P) and isgenerator([extract(Rhs,Alg)],N)) or" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " (isgenerator([ext ract(Lhs,Alg)],N) and isgenerator([extract(Rhs,Alg)],P)))" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 77 " and not(((wt(Lhs, Alg) + wt(Rhs, Alg) ) &!>= [seq(0,i=wt(Lhs,Alg))]) or" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " ((wt(Lhs, Alg) + wt(Rhs, Alg)) &!<= [seq(0,i=wt(Lhs ,Alg))])) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 34 " ### we have mixed weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " i f ( isgenerator(Lhs, Alg1) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " if ( isgenerator(Rhs, Alg2) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " RETURN( reduce(E, Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " RETURN( mixedtrisimplify( (Lhs&*op(1,Rhs))&*op(2,Rhs) , Alg) + " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " mixedtrisimpli fy( op(1,Rhs)&*(Lhs&*op(2,Rhs)) , Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " el se" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " RETURN( mixedtrisimpli fy( op(1,Lhs)&*(op(2,Lhs)&*Rhs) , Alg) + " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " mixedtrisimplify( (op(1,Lhs)&*Rhs)&*op (2,Lhs) , Alg) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 62 "hidden[triangularsimplifyold ] := proc(E::algebraic, Alg::name)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " description ``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### de clarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " local i, Result, T able, Temp, P, S, N, formsum, Lhs, Rhs;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " ### memory option" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 90 " #---------------------------> definition of subprocedures <----- ------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### formsum() expects 4 argum ents, the last being the name of the algebra;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " ### all the procedure does it applies the sum f ormula to the received arguments" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " ### eg. h is an el. from H; x1, x2 are el's from L+; expression : (h&*(x1&*x2))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### formsu m expects arguments: \{h, x1, x2, Alg\} (without the set symbol)" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### applies sum: (h&*x1)&*x2 \+ + x1&*(h&*x2)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " formsum := proc(Lhs::algebraic, Rhs1::algebr aic, Rhs2::algebraic, Alg::name)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " lo cal Temp, Result;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### make it quicker" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### creating first term in the sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " Temp := mainsimplify(Lhs &* Rhs1 , Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### we have a constant up front, pull it out side" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( type(Temp, `*` ) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " Result := o p(1,Temp) * mainsimplify(op(2,Temp) &* Rhs2, Alg);" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " Result := mainsimplify(Temp &* Rhs2, Alg);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### second term i n the sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " Temp := mains implify(Lhs &* Rhs2, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### pull the constant out \+ if necessary" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " if( type(T emp, `*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " Res ult := Result + (op(1,Temp) * mainsimplify(Rhs1 &* op(2,Temp), Alg)); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif( Temp <> 0 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " Result := Result + \+ mainsimplify(Rhs1 &* Temp, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### return the result" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 24 " RETURN(Result);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " #-- -------------------------------- end of subs ------------------------- ----------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 92 "#---------------------------------> main proc( )'s body <------------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ### getting \+ the algebras from the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " T able := op(4, eval(triangular));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Temp := [Table[Alg]]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ## # Lplus ### H ### Lminus" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " P := Temp[1]; S := Temp[2]; N := Temp[3];" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " if( nops(E ) = 1 or type(E,indexed) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(E);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### breaking expression into \+ its two sides" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " Lhs := op(1, E); Rhs := op(2,E);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### both sides are generators from Lplus, simplify normally" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " if( isgenerator([extract(Lhs,Alg )],P) and isgenerator([extract(Rhs,Alg)],P) ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 35 " Result := mainsimplify(E, P);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### b oth sides are generators from Lminus, simplify normally" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 87 " elif( isgenerator([extract(Lhs,Alg)],N) and isgenerator([extract(Rhs,Alg)],N) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Result := mainsimplify(E, N);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 97 " ### Lhs and Rhs belong to different algebras, there is a rule defined for the ir simplification" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " elif( isgen erator(Lhs, Alg) and isgenerator(Rhs, Alg) ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 31 " Result := reduce(E, Alg);" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " ### genera tor from S on the Lhs and monomial of P or N on the other side" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " elif( (isgenerator([extract(Lhs, Alg)], S) and " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " (isge nerator([extract(Rhs, Alg)], P) or isgenerator([extract(Rhs, Alg)], N) ))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " or (isgenerator([extract (Rhs, Alg)], S) and " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " (isgenerator([extract(Lhs, Alg)], P) or is generator([extract(Lhs, Alg)], N)))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " or (isgenerator([extract(Lhs,Alg)],P) and isgenerator([extrac t(Rhs,Alg)],N))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " or (isgener ator([extract(Lhs,Alg)],N) and isgenerator([extract(Rhs,Alg)],P)) ) th en" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " ### this nice little statement is for checking \+ for mixed weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " if( ((is generator([extract(Lhs,Alg)],P) and isgenerator([extract(Rhs,Alg)],N)) or" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " (isgenerator([ext ract(Lhs,Alg)],N) and isgenerator([extract(Rhs,Alg)],P)))" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 77 " and not(((wt(Lhs, Alg) + wt(Rhs, Alg) ) &!>= [seq(0,i=wt(Lhs,Alg))]) or" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " ((wt(Lhs, Alg) + wt(Rhs, Alg)) &!<= [seq(0,i=wt(Lhs ,Alg))])) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 34 " ### we have mixed weights" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### we ha ve a generator on the right hand side" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " elif( isgenerator(Rhs, Alg) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " Result := - formsum(Rhs, op(1, Lhs), op(2, L hs), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### send in the terms to form proper sum" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " Result := formsum(Lhs, op(1,Rhs), op(2,Rhs), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " ### non e of the other cases (at least one of Lhs and Rhs contain generators f rom " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " ### more the one algebra )" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 8 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### simpl ify the two sides" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " Temp := \+ mainsimplify(Lhs, Alg) &* mainsimplify(Rhs, Alg);" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " ### and simplify further if we have no zeros and the sides got simplified any " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( Temp = 0 ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Result := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " elif( Temp = evaln(Lhs &* Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Result := Temp;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " elif( type(Temp, `*`) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " Result := op(1,Temp) * mainsimplify(op(2,Temp), Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " Result := ma insimplify(Temp, Alg);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " ### there co uld be some more to simplify" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ if( type(Result,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " \+ Result := map(proc(x,y) if(type(x,`*`)) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " op(1,x) * triangular simplify(op(2,x), y);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ triangularsimplify(x, y);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " fi; end, Result, Alg );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### return t he results" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " RETURN(Result);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " liealg[KacMoody] := proc(Label::name, Cartan::anything)" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 18 " description ``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " local i, j, M, Wts, Gens, n, Rules, DefGens, Lp, Lm, Lz, Serr eP, SerreM, TempP, TempM, Temp," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " k;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " ### memory" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " ### inputche ck" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs > 4 ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ERROR(`too many arguments`, a rgs[]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 4 ) the n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " Gens := args[3];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " Wts := args[4];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Gens := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " Wts := [ ];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " ### we hopef uly got a matrix, if not, we can try to convert it" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 34 " if( type(Cartan, matrix) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " M := Cartan;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " elif( type(Cartan, list) or type(Cartan, array) or type(Cartan, vector) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " \+ M := convert(Cartan, matrix);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " ERROR(`expected an input of type matrix (or list, or array), received`, Cartan);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### checking the dimensions of the matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 94 " \+ if( nops(convert((linalg[row](M,1),list))) <> nops(convert((linalg[co l](M,1),list))) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ERR OR(Cartan, `is not a square matrix.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " n := nops(c onvert((linalg[row](M,1),list)));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### checking the matrix restrictions" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### 1) diagonal entries have to be 2" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### 2) all other entries less th en or equal to 0" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### 3) M[i,j ] = 0 <=> M[j,i] = 0" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " for i to n do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " for j to i do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if( i <> j ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " if( M[i,j] > 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 95 " ERROR(M[i,j], `is \+ a positive value outside the diagonal in the cartan matrix.`);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " elif( M[i,j] = 0 and no t(M[j,i] = 0) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " \+ ERROR(`zeros are not in a symmetrical fashion in the cartan matrix .`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( i = j and not(M[i,j] = 2) ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ERROR(`diagonal entry`, M[i,j] <> 2, `in cartan matrix.`); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### creati ng subscripted default generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( Gens = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ DefGens := [f,h,e];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 91 " Gens := map(proc(x,y) map(proc(x,y) y[x]; end, y, x); end, DefGens, [seq(i ,i=1..n)]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### p icking out the L+, L- and H algebras from the list" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 17 " Lm := Gens[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Lz := Gens[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " Lp := Gens[3]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### making the algebras visible" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " if( Wts = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " generators(Label._free_plus, Lp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " Wts := [seq([seq(0,i=Lz)],i=Lz)];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " generators(Label._zero, Lz, W ts);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " for i to nops(Wts) do Wts[i,i] := -1; od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " gener ators(Label._free_minus, Lm, Wts);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " generators(Labe l._free_plus, Lp, Wts);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ge nerators(Label._free_minus, Lm, -Wts);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " generators(Label._zero, Lz, [seq([seq(0,i=i)],i=Wts)]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### so the l oop wouldn't crash" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " if( nops(L p) <> n or nops(Lm) <> n or nops(Lz) <> n ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " ERROR(`incorrect number of generators for the c artan matrix of size`, n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### setting up the rules (e[i]: Lp, f[i]: Lm, h[i]:Lz)" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### h[i]&*e[j] = M[i,j]*e[j]" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### h[i]&*f[j] = -M[i,j]*e[j]" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### e[i]&*f[j] = if(i=j) h[i] e lse 0" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### and Serre's relatio ns for the plus and minus algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " Rules := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " SerreP := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " SerreM := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " for i to n do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " for j to n do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( i = j ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 92 " Rules := [Rules[], evaln(Lp[i]&*Lm[i])=Lz[i], evaln(Lz[i]& *Lp[j])=M[i,j]*Lp[j]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " \+ Rules := [Rules[], evaln(Lz[i]&*Lm[j])=-M[i,j]*Lm[j], evaln(Lz[i]&* Lz[j])=0];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " Rules := [Rules[], eval n(Lp[i]&*Lm[j])=0, evaln(Lz[i]&*Lz[j])=0];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " Rules := [Rules[], evaln(Lz[i]&*Lp[j])=M[ i,j]*Lp[j], Lz[i]&*Lm[j]=-M[i,j]*Lm[j]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 81 " ### creating the Serre's relations for both Lplus and Lminus algebras" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " TempP := Lp[j]; TempM : = Lm[j];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " for k to 1- M[i,j] do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " TempP \+ := evaln(Lp[i] &* TempP); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " \+ TempM := evaln(Lm[i] &* TempM); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " SerreP := [SerreP[], TempP];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " SerreM := [SerreM[], TempM];" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ ### storing the ideals" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " ideal( Label._plus._.ideal, SerreP, Label._free_plus);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ideal(Label._minus._.ideal, SerreM, Label._free_mi nus);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### creating factoralgebras" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " factoralg(Label._plus, [Label._free_plus, Label._p lus._.ideal]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 70 " factoralg(Labe l._minus, [Label._free_minus, Label._minus._.ideal]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### sto ring our matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " KacMoody(Labe l) := eval(M):" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " ### if we already have \+ a default triangular algebra defined, delete its rules" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 37 " if( member(Label,WITHRULES) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " delete(DONTPRINT, Label);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### form the triangular decomposition of the algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 "# RETURN(triangular(Label, [Label._plus, Label._zer o, Label._minus], Rules));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 73 "Temp:=triangular(Label, [Label._plu s, Label._zero, Label._minus], Rules);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " # Change the default a lgebra " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " use(Label);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 "RETURN(Temp);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 "#### Attempt to mer ge #####" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 49 "liealg[simple] := proc(Label ::name, Cartan::name)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " descrip tion `supports the declaration of simple algebras`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " global SIMPLE, WITHRULES, e, h;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " local j, k, M, Gens, n, Wts, _matrix, Temp, type_A , type_D, type_E, none;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " ### m emory" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " ### \+ inputcheck" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs > 4 ) th en" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " ERROR(`too many argumen ts`, args[]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " elif( nargs = 4 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " if( type(args[3],l ist(name)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens \+ := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Wts := args [4];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " elif( type(args[3],li st(list)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Wts := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := args[ 4];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 99 " ERROR(`invalid parameter (expected a li st of generators and a list of weights)`, args[3]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ elif( nargs = 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " if( type(args[3],list(name)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " Gens := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ Wts := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " elif( type( args[3],list(list)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " \+ Wts := args[3];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " Gen s := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 98 " ERROR(`invalid parameter (expected \+ a list of generators or a list of weights)`, args[3]);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " Gens := [];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " Wts := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### we hopefuly got a supported \+ type for the Cartan matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 93 " if ( not(type(Cartan,indexed)) or nops(Cartan) <> 1 or not(type(op(Cartan ),integer)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " ERROR(` incorrect name for type of Cartan matrix`, Cartan);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " \+ n := op(Cartan);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### creating subscripted default generators and weights" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( Gens = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " e := 'e'; h := 'h';" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " Gens := [e[seq(k.j,j=1..n)],h[i.1]];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " Gens := [Gens[1][seq(k.j,j=1..n)], Gens[2][i.1] ];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " if( Wts = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " Wts := [[seq(k.j,j=1..n)],[seq(0,j=1..n)]];" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Temp := [seq(0,j=1..nops(Wts[1]))];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " Wts := [Wts[], Temp];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### create A[n] Cartan matrix" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( op(0,Cartan) = A ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " M := Anmat(n);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 48 " simple(Label,type) := ADE._matrix, type_ A:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### create D[n] Cartan matrix" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 32 " elif( op(0,Cartan) = D ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " M := Dnmat(n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " simple(Label,type) := ADE._matrix, type_D:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### create E[n] Cartan matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif( op(0,Cartan) = E ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " M := Enmat(n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ simple(Label,type) := ADE._matrix, type_E:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### create B [n] Cartan matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif( op(0, Cartan) = B ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " M := Bn mat(n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " simple(Label,type) := B._matrix, type_D:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### create C[n] Cartan matrix" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif( op(0,Cartan) = C ) then" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " M := Cnmat(n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " simple(Label,type) := C._matrix, type_A :" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### create F[n] Cartan matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif( op(0,Cartan) = F ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 23 " if( n <> 4 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ERROR(F[n], `is not a supported type of simp le algebra.`);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### set up the rules for F4" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " F4Lookup();" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 20 " M := Fnmat(n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " simple(Label,type) := F._matrix, type_E:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### create G[n] Cartan matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " elif( op(0,Cartan) = G ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( n <> 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " ERROR(G[n], `is not a supported type of simple algebra.`);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### set up the rules for G2" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 44 " G2Lookup(op(0,Gens[1]),op(0,Gens[2]));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " M := Gnmat(n);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 46 " simple(Label,type) := G._matrix, type_G: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 112 " simple(G2,indices) := [[ 1,0],[0,1],[1,1],[2,1],[3,1],[3,2],[-1,0],[0,-1],[-1,-1],[-2,-1],[-3,- 1],[-3,-2]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### \+ storing our matrix" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " simple(Lab el) := eval(M):" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### other registration stuff " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 80 " ### (so the simplification and reduce funct ions would know about the algebra)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " unprotect(evaln(SIMPLE),evaln(WITHRULES)); " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 35 " SIMPLE := SIMPLE union \{Label\}; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " WITHRULES := WITHRULES union \{Label\}; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " protect(evaln(SIMPLE),evaln(WI THRULES));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " ### registering the algebras, and making the matri x available globally" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " A._.Labe l := eval(M);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " RETURN(generato rs(Label, Gens, Wts));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 65 "hidden[scpd] := proc(A::list(intege r),B::list(integer),M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " \+ description `produces the scalar product of two lists, given the mat rix for them`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " local i, j, Re s;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " Res := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " \+ for i to nops(A) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " for \+ j to nops(B) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " Res := \+ Res + (A[i] * B[j] * M[i,j]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " RETURN(Res);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 75 "hidden[epsilon_type_A] := pr oc(A::list(integer),B::list(integer),M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " description `epsilon function for An algebra`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " local i, j, Result, n;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ Result := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " n := nops(conver t(linalg[row](M,1),list));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " fo r i to nops(A) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for j to nops(B) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " if( (i=j+1 \+ and 2*j<=n) or (i=j-1 and 2*i>n) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " Result := Result + ((A[i]*B[j]*M[i,j]) mod 2);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " RETURN(Result mod 2) ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 75 "hidden[epsilon_type_D] := proc(A::list(integer),B::list(integer) ,M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " description ``;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " local i, j, Result;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ Result := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " for i to nops(A) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for j to nops(B) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( i > j ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " Result := Result + ((A[ i]*B[j]*M[i,j]) mod 2);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " \+ fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " RETURN(Result mod 2);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }} }{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 75 "hidden[epsilon_type_E] := proc(A::l ist(integer),B::list(integer),M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " description `epsilon function for En algebra`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " local i, j, Result, n;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ Result := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " n := nops(conver t(linalg[row](M,1),list));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " fo r i to nops(A) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for j to nops(B) do " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " if( (i=j+1 and i<=n-3) or (i=n-3 and j=n-2)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " or (i=n-2 and j=n-1) or (i=n-3 and j=n) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " Result := Result + ((A[i]*B[j ]*M[i,j]) mod 2);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi; \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " RET URN(Result mod 2);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 5 " end:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 64 "hidden[simplefunction_ADE_matrix] : = proc(E::function,M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 116 " \+ description `this is the function for a simple lie algebra, that doe s the simplification of algebras An, Dn, En`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " local LI, RI, Lhs, Rhs;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### setting \+ up our variables" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " Lhs := op(1, E); Rhs := op(2,E);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " LI := [op (Lhs)]; RI := [op(Rhs)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### we got mixed indices in" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( (hastype(LI,negative) and ha stype(LI, positive))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " or (h astype(RI,negative) and hastype(RI, positive))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " or (Lhs = Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### h[i]'s on both sides" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " elif( op(0,GENERATORS[2]) = op( 0,Lhs) and op(0,GENERATORS[2]) = op(0,Rhs)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " ### on LHS we have h[i], RH S: e[k1,k2,..,kn]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op(0, GENERATORS[2]) = op(0,Lhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### rhs has to be a true generator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " if( scpd(RI,RI,M) = 2 and (LI[] > 0 and not(LI[ ] > nops(RI))) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " R ETURN(add(RI[j] * M[LI[],j],j=1..nops(RI)) * op(0,GENERATORS[1])[RI[]] );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 36 " ### opposite of the previous case" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op(0,GENERATORS[2]) = op(0,Rhs) \+ ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### lhs has to be a true generator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " if( scpd(L I,LI,M) = 2 and (RI[] > 0 and not(RI[] > nops(LI))) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " RETURN(-1 * add(LI[j] * M[RI[],j], j=1..nops(LI)) * op(0,GENERATORS[1])[LI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ### we have e[k1,..,kn] on both sides, but they have to be true generators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " elif( scpd(LI,LI, M) = 2 and scpd(RI,RI,M) = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### when scalar product of lhs and rhs is -2" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 36 " if( scpd(LI,RI,M) = -2 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " RETURN(((-1)^epsilon_.MATRIX_TYP E(LI,RI,M)) *" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " add(LI[j ] * op(0,GENERATORS[2])[j],j=1..nops(LI))); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " \+ ### if scalar product is -1" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " \+ elif( scpd(LI,RI,M) = -1 ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " RETURN(((-1)^epsilon_.MATRIX_TYPE(LI,RI,M)) * " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " map((x,y)->y[x[]],[LI+RI] , op(0,GENERATORS[1]))[]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " ### else we have 0 or larger " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " else " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 20 " RETURN(0); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 42 " ### not true generators, result is zero" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 62 "hidden[simplefunction_B_matrix] := proc(E::function,M ::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 116 " description `this \+ is the function for a simple lie algebra, that does the simplification of algebras of type Bn`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 60 " loc al LI, RI, i, j, LB, a, DI, Lhs, Rhs, DM, Len, unfold;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 85 " #---- ---------------------> subproc() definitions <------------------------ -------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " unfold := proc(L::list(integer))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " local j, Temp, State, zeros, ones, twos, z te;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### init. our list we're going to unfold into" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " Temp := [seq(0, j = 1..nops (L))]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### init. our stat e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " State := zeros;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### loop through e's indices, checking states, copying indic es" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " for j to nops(L) do" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### copy all the stuff unt il we have zeros" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " if( L[ j] = 0 and (State = zeros or State = zte) ) then;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 26 " Temp[j] := 0; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ### we just saw a sequence of ones, we can only have zeros following" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### (change state, zte is \+ for zeros till the end)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ elif( L[j] = 0 and State = ones ) then;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " State := zte;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " Temp[j] := 0; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " ### we saw a one and we only had zeros, copy element, change state" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " elif( abs(L[j]) = 1 and State = \+ zeros ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " State \+ := ones;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Temp[j] := \+ L[j]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### we're seeing a sequence of ones" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " elif( abs(L[j]) = 1 and St ate = ones ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Te mp[j] := L[j]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 1 " " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 63 " ### we've come accross a two change f lag, copy element" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " elif( abs(L[j]) = 2 and State = ones ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " State := twos;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Temp[j] := L[j]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### sequence of tw os" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " elif( abs(L[j]) = 2 \+ and State = twos ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " \+ Temp[j] := L[j]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### we didn't recognize the patt ern, return 0" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN([]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 59 " ### analyzing our state, determine the u nfolded parts" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 28 " if( State = \+ zte ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " Temp := [[Te mp[], 0],[]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif( State \+ = ones ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " Temp := [ [Temp[], 0],[Temp[1..nops(Temp)-1][], 0, Temp[nops(Temp)]]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif( State = twos ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 88 " Temp := [[Temp[1..nops(Temp)-1][ ], Temp[nops(Temp)]/2, Temp[nops(Temp)]/2],[]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### we only had zeros, not a valid generator" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " Temp := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(Temp );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " #------------------------------- end of subs ----- ------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " #---------------------------> \+ main proc()'s body <------------------------------" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### init. \+ our list variables" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Lhs := op( 1,E); Rhs := op(2,E); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " LI := \+ [op(Lhs)]; RI := [op(Rhs)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### we got mixed indices in" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( (hastype(LI,negative) and ha stype(LI, positive))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " or (h astype(RI,negative) and hastype(RI, positive))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " or (Lhs = Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### the product consists of two h[i]'s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " elif( op(0,GENERA TORS[2]) = op(0,Lhs) and op(0,GENERATORS[2]) = op(0,Rhs)) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### on lh s we have h[i], on rhs we have e[k1,..,kn]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op(0,GENERATORS[2]) = op(0,Lhs) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### rhs has to be a true gene rator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " if( (unfold(RI) = [] ) or (LI[] < 1) or (LI[] > nops(RI)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " RETURN (add(RI[j] * M[LI[],j],j=1..nops(RI)) * op(0,GENERATORS[1])[RI[]]);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### opposite of the previous case" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( o p(0,GENERATORS[2]) = op(0,Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### lhs has to be a true generator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " if( (unfold(LI) = []) or (RI[] < 1) or (RI[] > \+ nops(LI)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN (0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " RETURN(-1 * add(LI[j] * M[RI[],j],j=1.. nops(LI)) * op(0,GENERATORS[1])[LI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 80 " ### e[k1,..,kn] on both sides, unfold the i ndices in case they are real roots" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " ### checking fo r indices to be the right sequence (0's, 1's, 2's, 1)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### and unfolding betas into alphas at the same time" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( LI = -RI ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " LB := [LI,RI];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " LB := [LI,RI,LI+RI];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ DI := [];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " for i to nops(LB ) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### unfolding the \+ current index" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " LB[i] := \+ unfold(LB[i]); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " ### if any unfolding was unsuccessful, \+ return zero" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( LB[i] = [] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " RETURN(0) ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " ### don't add the unfolded LI+RI term" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 27 " elif( i < n ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### preparing the D terms" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 36 " if( LB[i][2] = [] ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " DI := [DI[], op(0,GE NERATORS[1])[LB[i][1][]]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 150 " DI : = [DI[], op(0,GENERATORS[1])[LB[i][1][]] \+ + op(0,GENERATORS[1])[LB[i][2][]]];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### save the size of unfolded terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " Len := nops(LI)+1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### ex pand the sum if we have to" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ DI := DI[1] &* DI[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### get matrix for An algebra" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " DM := Dnmat(Len);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " \+ ### simplify the expression according to An rules" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 41 " ### we have a sum, simpl. all terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(DI,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " DI := map((x,y)->if(type(x,`*`)) t hen" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " \+ op(1,x) * simplefunction_ADE_matrix(op(2,x),y);" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 33 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " simplefunction_AD E_matrix(x,y);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " \+ fi, DI, DM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### we have a product, get co nstant, simpl. the rest" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " el if( type(DI,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ DI:= op(1,DI) * simplefunction_ADE_matrix(op(2,DI), DM);" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ ### just an expression, simpl. it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " DI := si mplefunction_ADE_matrix(DI, DM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### simpl. resulted in zero" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 23 " if( DI = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### fold back stuff " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 72 " ### we still have a sum, pick out constant s and look at indices" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " i f( type(DI,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " \+ if( type(op(1,DI),`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " if( op(0,op(2,op(1,DI))) = op(0,GENERATORS[2]) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " ### remove h[ i] elements that are larger than the max " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### index of Bn element (we subs i n zero for them)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ RETURN(subs(\{op(0,GENERATORS[2])[Len]=0\}, DI));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " a := op(1,op(1,DI));" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 45 " LI := [op(op(2,op(1,DI)))]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " RI := [op(op( 2,op(2,DI)))];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " \+ RI := LI[nops(LI)-1..nops(LI)] + RI[nops(RI)-1..nops(RI)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " DM := [LI[1..nops(LI)-2 ][], RI[]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " if( op(0,op(1,DI)) = op(0,GENERAT ORS[2]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 72 " \+ ### remove h[i] elements that are larger than the max " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 69 " ### index of Bn element (we subs in zero for them)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " \+ RETURN(subs(\{op(0,GENERATORS[2])[Len]=0\}, DI));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " a := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " LI := [op(op(1,DI))];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " RI := [op(op(2,DI))];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " RI := LI[nops(LI) -1..nops(LI)] + RI[nops(RI)-1..nops(RI)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " DM := [LI[1..nops(LI)-2][], RI[]]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " fi;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### when we have two terms, it folds back into one term, for which" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " \+ ### we have to drop the last index" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " RETURN(a * op(0,GENERATORS[1])[DM[1..nops (DM)-1][]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 58 " ### not a sum, pick out constant part and \+ indices" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " elif( type(DI,` *`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " if( op(0, op(2,DI)) = op(0,GENERATORS[2]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### remove h[i] elements that are larger than t he max " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### index of Bn element (we subs in zero for them)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " RETURN(subs(\{op(0,GENERATORS[2])[Len] =0\}, DI));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " a := op(1,DI);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " DM := [op(op(2,DI))] ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " \+ ### we have a single generator in Dn+1 coming back, pick out indices " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " if( op(0,DI) = op(0,GENERATORS[2]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " ### remove \+ h[i] elements that are larger than the max " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### index of Bn element (we subs in z ero for them)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " RET URN(subs(\{op(0,GENERATORS[2])[Len]=0\}, DI));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " a := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ DM := [op(DI)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " \+ ### the case when we have a sequence of ones inside, drop last t erm" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " if( DM[nops(DM)] = \+ 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " RETURN(a * \+ op(0,GENERATORS[1])[DM[1..nops(DM)-1][]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 79 " ### we have a sequence of zeros, ones and twos, replace last two terms" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " ### with a two" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 155 " RETURN(a * op(0,GENERATORS[1])[[DM[1..nop s(DM)-2][], \+ DM[nops(DM)-1]+DM[nops(DM)]][]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 62 "hidden[simplefunctio n_C_matrix] := proc(E::function,M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 116 " description `this is the function for a simple li e algebra, that does the simplification of algebras of type Cn`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " local LI, RI, i, j, a, LB, AI, L hs, Rhs, AM, unfold;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " #-----------------------------> subs def initions <---------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " ### checking for indice s to be the right sequence (0's, 1's, 2's, 1)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### and unfolding betas into alphas at the same ti me" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " unfold := proc(L::list(integer))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " local i, j, State, zeros, ones, twos, zte, Temp;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### init. our list we're going to unfold into" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " Temp := [[seq(0, i = 1..(2 \+ * nops(L) - 1))],[seq(0, i = 1..(2 * nops(L) - 1))]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### \+ init. our state" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " State := z eros;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### loop through e's indices, checking states, \+ copying indices" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " for j to n ops(L) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " ### copy all \+ the stuff until we have zeros" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " \+ if( L[j] = 0 and (State = zeros or State = zte) ) then;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Temp[1][j] := 0; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " Temp[2][nops(Temp[2]) + 1 - j] := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " ### we just saw a sequence of ones, we ca n only have zeros following" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ ### (change state, zte is for zeros till the end)" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 48 " elif( L[j] = 0 and State = ones ) the n;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " State := zte;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " Temp[1][j] := 0; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " Temp[2][nops(Temp[2]) + 1 - j] := 0;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 75 " ### we saw a one and we only had zero s, copy element, change state" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " \+ elif( abs(L[j]) = 1 and State = zeros ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " State := ones;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " Temp[1][j] := L[j]; " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 51 " Temp[2][nops(Temp[2]) + 1 - j] := L[j]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 2 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " ### we're seeing a sequence of ones" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " elif( abs(L[j]) = 1 and St ate = ones ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " Te mp[1][j] := L[j]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " T emp[2][nops(Temp[2]) + 1 - j] := L[j];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " ### when we \+ had a sequence of twos, we have to have the last as one" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 68 " elif( abs(L[j]) = 1 and j = nops(L) a nd State = twos ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ Temp[1][j] := L[j]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " \+ Temp[2][nops(Temp[2]) + 1 - j] := L[j];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### we've come accross a two change flag, copy element" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 89 " elif( j <> nops(L) and abs(L[j]) = 2 and \+ (State = ones or State = zeros) ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " State := twos;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " Temp[1][j] := L[j]/2; Temp[2][j] := L[j]/2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " Temp[1][nops(Temp[1]) + 1 - j ] := L[j]/2; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " Temp[2 ][nops(Temp[2]) + 1 - j] := L[j]/2; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### sequence o f twos" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " elif( j <> nops( L) and abs(L[j]) = 2 and State = twos ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " Temp[1][j] := L[j]/2; Temp[2][j] := L[j]/ 2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " Temp[1][nops(Temp [1]) + 1 - j] := L[j]/2; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " \+ Temp[2][nops(Temp[2]) + 1 - j] := L[j]/2; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### we didn't recognize the pattern, return empty list" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " RETURN([]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " od; " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### return unfolded lists" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(Temp);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 7 " end:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 83 " \+ #------------------------------- end of subs ----------------------- ------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 83 " #---------------------------> main proc()'s body <------------------------------" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### init. our list variables " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " Lhs := op(1,E); Rhs := op(2, E); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " LI := [op(Lhs)]; RI := [ op(Rhs)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### we got mixed indices in" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " if( (hastype(LI,negative) and hastype(LI, positive ))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " or (hastype(RI,negative ) and hastype(RI, positive)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ or (Lhs = Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### the product consists of two h[i]'s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " elif( op(0,GENERATORS[2]) = op(0,Lhs) an d op(0,GENERATORS[2]) = op(0,Rhs)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### on lhs we have h[i], on rhs \+ we have e[k1,..,kn]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op( 0,GENERATORS[2]) = op(0,Lhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### rhs has to be a true generator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### lhs has to be a true generator" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 69 " if( (unfold(RI) = []) or (LI[] < 1) or (LI[] > nops(RI)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " RETURN(add(RI[j] * M[LI[], j],j=1..nops(RI)) * op(0,GENERATORS[1])[RI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### opposite of the previous cas e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op(0,GENERATORS[2]) = op(0,Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### lhs \+ has to be a true generator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " \+ ### lhs has to be a true generator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 69 " if( (unfold(LI) = []) or (RI[] < 1) or (RI[] > nops(LI)) ) t hen" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " RETURN(-1 * add(LI[j] * M[RI[],j],j=1..nops( LI)) * op(0,GENERATORS[1])[LI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 66 " ### e[k1,..,kn] on both sides, unfold the indice s if real roots" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 84 " ### the two indices and their sum ( if it's not [0,...,0]) must unfold properly" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " if( LI = -RI ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " LB := [LI,RI]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " \+ LB := [LI,RI,LI+RI]; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " AI := [];" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 74 " \+ ### checking for indices to be the right sequence (0's, 1's, 2's, 1)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### and unfolding betas int o alphas at the same time" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " \+ for i to nops(LB) do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ## # unfold index" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " LB[i] := unfold(LB[i]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### check whether unfold was successful " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " if( LB[i] = [] ) then " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " RETURN(0);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### we don't want to add the unfolded sum" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 27 " elif( i < 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " ### preparing the A terms, the current index unfolded into the same indices" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " if( LB[i][1] = LB[i][2] ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " AI := [AI[], op(0,GENERATORS[1])[LB[i] [1][]]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " ### unfolded into different patterns" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 206 " AI := [AI[], op(0,GENERATORS[1])[L B[i][1][]] + \+ op(0,GENERATORS[ 1])[LB[i][2][]]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " fi ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### expand the sum if we ha ve to" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " AI := AI[1] &* AI[2] ;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### get matrix for An algebra" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " AM := Anmat(nops(LB[1][1]));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### si mplify the expression according to An rules" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### we have a sum, simpl. all terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(AI,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " AI := map((x,y)->if(type(x,`*`)) the n" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " \+ op(1,x) * simplefunction_ADE_matrix(op(2,x),y);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " else " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 62 " simplefunction_ADE_m atrix(x,y);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " \+ fi, AI, AM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### we have a product, get constant, \+ simpl. the rest" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif( type (AI,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " AI:= op (1,AI) * simplefunction_ADE_matrix(op(2,AI),AM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### just \+ an expression, simpl. it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " e lse" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " AI := simplefunctio n_ADE_matrix(AI,AM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### simpl. resulted in zero" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( AI = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 24 " ### fold back loop" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " \+ ### we still have a sum, pick first element into temp var" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( type(AI,`+`) ) then" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " AM := op(1,AI);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ### assign all of it, it's not a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " AM := AI;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### we have a con stant front, pick it out" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ if( type(AM,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " \+ a := op(1,AM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ AM := op(2,AM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### no cons, our cons is one" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " \+ else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " a := 1;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " fi; " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### \+ we had an h[i] sum coming back from the simplification, return it" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " if( op(0,AM) = op(0,GENERA TORS[2]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### \+ remove h[i] elements that are larger than the max index of Bn " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " ### element (we subs in zero for them)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " RETU RN(subs(\{seq(op(0,GENERATORS[2])[i]=0," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " i=nops(LI)+1..no ps(LB[1][1]))\},AI));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " ### the actual fold-back loop" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 27 " LI := [op(AM)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " RI := [seq(0, i = RI)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 34 " for j to nops(RI)-1 do" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " RI[j] := LI[j] + LI[nops(LI) + 1 - j];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " od;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " RI[j] := LI[j];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " ### return result" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " RETURN(a * op(0,AM)[RI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 65 "hidden[simplefunct ion_F_matrix] := proc(Expr::function,M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 116 " description `this is the function for a simple li e algebra, that does the simplification of algebras of type F4`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " local LI, RI, i, a, b, EI, Lhs, \+ Rhs, EM;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### init. our list variables" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Lhs := op(1,Expr); Rhs := op(2,Expr); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " LI := [op(Lhs)]; RI := [op(Rhs)];" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### the product consists of two h[i]'s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " if( op(0,GENERATORS[2]) = op(0,Lhs) and op(0,GENER ATORS[2]) = op(0,Rhs)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 54 " ### on lhs we have h[i], on rhs we have e[k1,.., kn]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op(0,GENERATORS[2]) = op(0,Lhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### we have all the true generators in the lookup table" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 73 " if( (F4Lookup(RI) = FAIL) or (LI[] < 1) or (L I[] > nops(RI)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " \+ RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " RETURN(add(RI[j] * M[LI[],j],j=1 ..nops(RI)) * op(0,GENERATORS[1])[RI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### opposite of the previous cas e" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op(0,GENERATORS[2]) = op(0,Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " ### we h ave all the true generators in the lookup table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 73 " if( (F4Lookup(LI) = FAIL) or (RI[] < 1) or (RI[ ] > nops(LI)) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RE TURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 87 " RETURN(-1 * add(LI[j] * M[RI[],j],j =1..nops(LI)) * op(0,GENERATORS[1])[LI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### e[k1,..,kn] on both sides, u nfold the indices" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " ### we have to check for the \+ sum of indices to be in the table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if( LI <> -RI ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 42 " \+ if( F4Lookup(LI+RI) = FAIL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 22 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 35 " ### creating expression in E6" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 63 " ### lookup left side, if not found (FAIL), quit with zer o" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " EM := F4Lookup(LI);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if( EM = FAIL ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 68 " EI := add(i,i=map((x,y)->y[x[]], EM, op(0,GENERATORS[1])) );" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 86 " ### loo kup right side, if not found (FAIL), quit with zero, else produce prod uct" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " ### (automatically ext ended to a product if needed)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " \+ EM := F4Lookup(RI);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " if ( EM = FAIL ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETU RN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 74 " EI := EI &* add(i,i=map((x,y)->y[x[]] , EM, op(0,GENERATORS[1])));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " ### creating the E6 matrix needed for the simpl ification" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " EM := Enmat(6); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " ### simplify the expression according to An rules" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### we have a sum, simpl. all terms" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " if( type(EI,`+`) ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " EI := map((x,y)->i f(type(x,`*`)) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " \+ op(1,x) * simplefunction_ADE_matrix(op(2,x),y);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " else " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " si mplefunction_ADE_matrix(x,y);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " \+ fi, EI, EM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " ### we have a prod uct, get constant, simpl. the rest" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " elif( type(EI,`*`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " EI:= op(1,EI) * simplefunction_ADE_matrix(op(2,EI),EM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ### just an expression, simpl. it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ EI := simplefunction_ADE_matrix(EI,EM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 " ### simpl. resulted in zero" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( EI = 0 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " ### fold \+ back loop" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 66 " ### we still have a sum, pick firs t element into temp var" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " \+ if( type(EI,`+`) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " \+ EM := op(1,EI);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " ## # assign all of it, it's not a sum" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " EM := EI;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " \+ ### we have a constant up front, pick it out" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " if( type(EM,`*`) ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 26 " a := op(1,EM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " EM := op(2,EM);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 37 " ### no cons, our cons is one" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " a := 1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 14 " \+ fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### we had an h[i] sum coming back from the \+ simplification, return it" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " \+ if( op(0,EM) = op(0,GENERATORS[2]) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 78 " ### remove h[i] elements that are larger \+ than the max index of Bn " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " \+ ### element (we subs in zero for them)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 75 " RETURN(subs(\{op(0,GENERATORS[2])[4]=0,op (0,GENERATORS[2])[5]=0," }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 80 " \+ op(0,GENERATORS[2])[6]=op(0,GENERATORS[2])[4]\},EI ));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " " }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 38 " ### the actual fold-back loop" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 13 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " LI := [op(EM)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " RI := [LI[1]+LI[5],LI[2]+LI[4],LI[3],LI[6]];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### return our stuff" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " RETURN(a * op(0,EM)[RI[ ]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " fi;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 65 "hidden[simplefunction_G_matrix] := proc(Expr::functio n,M::matrix)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 116 " description `th is is the function for a simple lie algebra, that does the simplificat ion of algebras of type G2`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " \+ local LI, RI, Lhs, Rhs, TrueGens;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 31 " ### init. our list variable s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " Lhs := op(1,Expr); Rhs := o p(2,Expr); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " LI := [op(Lhs)]; \+ RI := [op(Rhs)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " TrueGens := \+ op(4,eval(simple))[G2,indices];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 30 " ### we got mixed indices in " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " if( (hastype(LI,negative) an d hastype(LI, positive)) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " \+ or (hastype(RI,negative) and hastype(RI, positive))" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " or (Lhs = Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 41 " ### the product consists of two h[i]'s" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 82 " elif( op(0,GENERA TORS[2]) = op(0,Lhs) and op(0,GENERATORS[2]) = op(0,Rhs)) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " ### on lh s we have h[i], on rhs we have e[k1,..,kn]" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( op(0,GENERATORS[2]) = op(0,Lhs) ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### rhs has to be a true gene rator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " if( member(RI,TrueGe ns) and (LI[] > 0 and not(LI[] > nops(RI))) ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 82 " RETURN(add(RI[j] * M[LI[],j],j=1..nops(RI) ) * op(0,GENERATORS[1])[RI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### opposite of the previous case" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " elif( o p(0,GENERATORS[2]) = op(0,Rhs) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " ### lhs has to be a true generator" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 76 " if( member(LI,TrueGens) and (RI[] > 0 and not(R I[] > nops(LI))) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 87 " \+ RETURN(-1 * add(LI[j] * M[RI[],j],j=1..nops(LI)) * op(0,GENERATORS[1] )[LI[]]);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " ### e[k1,..,kn] on both sides, u nfold the indices" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " elif( membe r(LI,TrueGens) and member(RI,TrueGens) ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " LI := G2Lookup(evaln(Lhs&*Rhs));" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 26 " if( LI = FAIL ) then" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 43 " LI := - G2Lookup(evaln(Rhs&*Lhs));" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 9 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " RETURN(LI);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 36 " ### we don't have true ge nerators" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 16 " RETURN(0);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 50 "hidden[matbase] := proc(n::integer,uplim::integer) " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 71 " description `the base matrix off all matrices (for algs An,.., Gn)`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 17 " local j, k, M;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 38 " M := [seq([seq(0,j=1..n)] ,j=1..n)];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " for j to uplim do \+ " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " for k to uplim do " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " if( j = k ) then M[j,k] := 2; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " elif( abs(j - k) = 1 ) then M[j,k] := -1; fi; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 10 " \+ od; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " od;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 29 " RETURN(convert(M,matrix));" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "hidden[Anmat] := p roc(n::integer)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " description ` generates an An matrix`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " opti on system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 3 " " }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( n < 2 ) then" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 39 " ERROR(`subscript is too low`, n);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 24 " RETURN(matbase(n,n));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "hidden[Dnmat] := pro c(n::integer)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " description `ge nerates an Dn matrix`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " local \+ M;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( n < 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ ERROR(`subscript is too low`, n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " M := matbase(n,n-1); " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " M[n-2,n] := -1; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " M[n,n-2] := -1; " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " M[n,n] := 2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(eval(M));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "hidden[Enmat] := proc(n::integer)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " description `generates an En m atrix`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " local M;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( n < 4 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ERROR(`subscript is too low`, n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " M := matbase(n,n-1);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " M[n-3,n] := -1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " M[n,n-3] := -1;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 15 " M[n,n] := 2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(ev al(M));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 " > " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "hidden[Bnmat] := proc(n::integer)" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 40 " description `generates an Bn matrix`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " local M;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( n < 2 ) \+ then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ERROR(`subscript is t oo low`, n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " M := matbase(n,n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " M[n,n-1] := -2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(eval(M));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "hidden[Cnmat] := proc(n::integer)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " description `generates an Cn m atrix`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " local M;" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( n < 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ERROR(`subscript is too low`, n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " M := matbase(n,n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " M[n-1,n] := -2;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(eval(M));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "hidden[Fnmat] := proc(n::int eger)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " description `generates \+ an Fn matrix`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " local M;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( n < 3 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " ER ROR(`subscript is too low`, n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " \+ fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " M := matbase(n,n);" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 20 " M[n-2,n-1] := -2;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 19 " RETURN(eval(M));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 33 "hidden[Gnmat] := pro c(n::integer)" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 40 " description `ge nerates an Gn matrix`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 11 " local \+ M;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " option system, remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " if( n < 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 39 " \+ ERROR(`subscript is too low`, n);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 21 " M := matbase(n,n);" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 18 " M[n-1,n] := -3;" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 19 " RETURN(eval(M));" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "hidden[F4Lookup] := \+ proc()" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 77 " description `this is f or looking up what indices in F4 unfold into in E6`;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### let it use its table" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 12 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs = 0 ) then" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 32 " ### initializing our table" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([1,0,0,0]) := [[1,0 ,0,0,0,0],[0,0,0,0,1,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " \+ F4Lookup([0,1,0,0]) := [[0,1,0,0,0,0],[0,0,0,1,0,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([0,0,1,0]) := [[0,0,1,0,0,0]]:" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([0,0,0,1]) := [[0,0 ,0,0,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([1,1, 0,0]) := [[1,1,0,0,0,0],[0,0,0,1,1,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([0,1,1,0]) := [[0,1,1,0,0,0],[0,0,1,1,0,0]]:" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([0,0,1,1]) := [[0,0 ,1,0,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([1,1, 1,0]) := [[1,1,1,0,0,0],[0,0,1,1,1,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([0,1,1,1]) := [[0,1,1,0,0,1],[0,0,1,1,0,1]]:" } }{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([1,1,1,1]) := [[1,1 ,1,0,0,1],[0,0,1,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ F4Lookup([0,2,1,0]) := [[0,1,1,1,0,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([0,2,1,1]) := [[0,1,1,1,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 62 " F4Lookup([1,2,1,0]) := [[1,1,1,1,0,0],[0,1 ,1,1,1,0]]: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([0 ,2,2,1]) := [[0,1,2,1,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " \+ F4Lookup([1,2,1,1]) := [[1,1,1,1,0,1],[0,1,1,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([2,2,1,0]) := [[1,1,1,1,1,0]]: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([1,2,2,1]) := [[ 1,1,2,1,0,1],[0,1,2,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " \+ F4Lookup([2,2,1,1]) := [[1,1,1,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Lookup([1,3,2,1]) := [[1,2,2,1,0,1],[0,1,2,2, 1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([2,2,2,1]) := [[1,1,2,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 59 " F4Loo kup([2,3,2,1]) := [[1,2,2,1,1,1],[1,1,2,2,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([2,4,2,1]) := [[1,2,2,2,1,1]]:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([2,4,3,1]) := [[1,2, 3,2,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " F4Lookup([2,4,3 ,2]) := [[1,2,3,2,1,2]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " F 4Lookup(-[1,0,0,0]) := -[[1,0,0,0,0,0],[0,0,0,0,1,0]]:" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 61 " F4Lookup(-[0,1,0,0]) := -[[0,1,0,0,0,0], [0,0,0,1,0,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(- [0,0,1,0]) := -[[0,0,1,0,0,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[0,0,0,1]) := -[[0,0,0,0,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " F4Lookup(-[1,1,0,0]) := -[[1,1,0,0,0,0],[0,0,0, 1,1,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " F4Lookup(-[0,1,1, 0]) := -[[0,1,1,0,0,0],[0,0,1,1,0,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[0,0,1,1]) := -[[0,0,1,0,0,1]]:" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 61 " F4Lookup(-[1,1,1,0]) := -[[1,1,1,0,0,0], [0,0,1,1,1,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " F4Lookup(- [0,1,1,1]) := -[[0,1,1,0,0,1],[0,0,1,1,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " F4Lookup(-[1,1,1,1]) := -[[1,1,1,0,0,1],[0,0,1, 1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[0,2,1, 0]) := -[[0,1,1,1,0,0]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F 4Lookup(-[0,2,1,1]) := -[[0,1,1,1,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " F4Lookup(-[1,2,1,0]) := -[[1,1,1,1,0,0],[0,1,1, 1,1,0]]: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[0,2 ,2,1]) := -[[0,1,2,1,0,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " \+ F4Lookup(-[1,2,1,1]) := -[[1,1,1,1,0,1],[0,1,1,1,1,1]]:" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[2,2,1,0]) := -[[1,1,1,1,1,0 ]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " F4Lookup(-[1,2,2,1]) : = -[[1,1,2,1,0,1],[0,1,2,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[2,2,1,1]) := -[[1,1,1,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " F4Lookup(-[1,3,2,1]) := -[[1,2,2,1,0,1],[0,1 ,2,2,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[2,2 ,2,1]) := -[[1,1,2,1,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " \+ F4Lookup(-[2,3,2,1]) := -[[1,2,2,1,1,1],[1,1,2,2,1,1]]:" }}{PARA 0 " > " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[2,4,2,1]) := -[[1,2,2,2,1,1 ]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Lookup(-[2,4,3,1]) : = -[[1,2,3,2,1,1]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " F4Look up(-[2,4,3,2]) := -[[1,2,3,2,1,2]]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " ### no match was found " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(FAIL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 " " {MPLTEXT 1 0 26 "hidden[G2Lookup] := proc()" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " description `this is for looking up G2 rules`;" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " ### declarations" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 14 " local a, b;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 27 " ### let it use its table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 12 " remember;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 29 " ### initializing our table" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 23 " if( nargs = 2 ) then" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " a := args[1];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " b := args[2];" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 " ### create the rules" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " G2Lookup(evaln(a[1,0]&*a[0,1] )) := a[1,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " G2Lookup(eva ln(a[1,0]&*a[1,1])) := a[2,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " \+ G2Lookup(evaln(a[1,0]&*a[2,1])) := a[3,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Lookup(evaln(a[1,0]&*a[3,1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Lookup(evaln(a[1,0]&*a[3,2])) := \+ 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " G2Lookup(evaln(a[1,0]&* a[-1,0])) := b[1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " G2Looku p(evaln(a[1,0]&*a[0,-1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " G2Lookup(evaln(a[1,0]&*a[-1,-1])) := 3 * a[0,-1]:" }}{PARA 0 "> \+ " 0 "" {MPLTEXT 1 0 56 " G2Lookup(evaln(a[1,0]&*a[-2,-1])) := 4 * a[-1,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " G2Lookup(evaln( a[1,0]&*a[-3,-1])) := 3 * a[-2,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " G2Lookup(evaln(a[1,0]&*a[-3,-2])) := 0:" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 43 " G2Lookup(evaln(a[0,1]&*a[1,1])) := 0:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Lookup(evaln(a[0,1]&*a[2,1] )) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 48 " G2Lookup(evaln(a[ 0,1]&*a[3,1])) := a[3,2]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " \+ G2Lookup(evaln(a[0,1]&*a[3,2])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " G2Lookup(evaln(a[0,1]&*a[-1,0])) := 0:" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 47 " G2Lookup(evaln(a[0,1]&*a[0,-1])) := b[2]:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " G2Lookup(evaln(a[0,1]&*a[-1,- 1])) := - a[-1,0]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " G2Looku p(evaln(a[0,1]&*a[-2,-1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " G2Lookup(evaln(a[0,1]&*a[-3,-1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " G2Lookup(evaln(a[0,1]&*a[-3,-2])) := a[-3,-1]: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 50 " G2Lookup(evaln(a[1,1]&*a[ 2,1])) := - a[3,2]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Look up(evaln(a[1,1]&*a[3,1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Lookup(evaln(a[1,1]&*a[3,2])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " G2Lookup(evaln(a[1,1]&*a[-1,0])) := - 3 * a[0,1 ]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 49 " G2Lookup(evaln(a[1,1]&* a[0,-1])) := a[1,0]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 61 " G2Loo kup(evaln(a[1,1]&*a[-1,-1])) := - 3 * b[2] - b[1]:" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 55 " G2Lookup(evaln(a[1,1]&*a[-2,-1])) := 4 * a[-1 ,0]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " G2Lookup(evaln(a[1,1] &*a[-3,-1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " G2Looku p(evaln(a[1,1]&*a[-3,-2])) := 3 * a[-2,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Lookup(evaln(a[2,1]&*a[3,1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Lookup(evaln(a[2,1]&*a[3,2])) := \+ 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " G2Lookup(evaln(a[2,1]&* a[-1,0])) := - 4 * a[1,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " \+ G2Lookup(evaln(a[2,1]&*a[0,-1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " G2Lookup(evaln(a[2,1]&*a[-1,-1])) := - 4 * a[1,0]:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 64 " G2Lookup(evaln(a[2,1]&*a[-2,- 1])) := 12 * b[2] + 8 * b[1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 58 " \+ G2Lookup(evaln(a[2,1]&*a[-3,-1])) := - 12 * a[-1,0]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " G2Lookup(evaln(a[2,1]&*a[-3,-2])) := 12 * a[-1,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 43 " G2Lookup(eval n(a[3,1]&*a[3,2])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 54 " G 2Lookup(evaln(a[3,1]&*a[-1,0])) := -3 * a[2,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " G2Lookup(evaln(a[3,1]&*a[0,-1])) := 0:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 45 " G2Lookup(evaln(a[3,1]&*a[-1,- 1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 55 " G2Lookup(evaln( a[3,1]&*a[-2,-1])) := 12 * a[1,0]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 67 " G2Lookup(evaln(a[3,1]&*a[-3,-1])) := - 36 * b[2] - 36 * b[1] :" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " G2Lookup(evaln(a[3,1]&*a [-3,-2])) := 36 * a[0,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 44 " \+ G2Lookup(evaln(a[3,2]&*a[-1,0])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 51 " G2Lookup(evaln(a[3,2]&*a[0,-1])) := - a[3,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " G2Lookup(evaln(a[3,2]&*a[-1,-1])) : = - 3 * a[2,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " G2Lookup(e valn(a[3,2]&*a[-2,-1])) := - 12 * a[1,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 57 " G2Lookup(evaln(a[3,2]&*a[-3,-1])) := - 36 * a[0 ,1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 65 " G2Lookup(evaln(a[3,2] &*a[-3,-2])) := 72 * b[2] + 36 * b[1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 52 " G2Lookup(evaln(a[-1,0]&*a[0,-1])) := a[-1,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " G2Lookup(evaln(a[-1,0]&*a[-1,-1])) \+ := a[-2,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " G2Lookup(eval n(a[-1,0]&*a[-2,-1])) := a[-3,-1]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " G2Lookup(evaln(a[-1,0]&*a[-3,-1])) := 0:" }}{PARA 0 "> " 0 " " {MPLTEXT 1 0 46 " G2Lookup(evaln(a[-1,0]&*a[-3,-2])) := 0:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " G2Lookup(evaln(a[0,-1]&*a[-1, -1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " G2Lookup(evaln (a[0,-1]&*a[-2,-1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 53 " \+ G2Lookup(evaln(a[0,-1]&*a[-3,-1])) := a[-3,-2]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 46 " G2Lookup(evaln(a[0,-1]&*a[-3,-2])) := 0:" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 56 " G2Lookup(evaln(a[-1,-1]&*a[-2 ,-1])) := - a[-3,-2]:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " G2Lo okup(evaln(a[-1,-1]&*a[-3,-1])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " G2Lookup(evaln(a[-1,-1]&*a[-3,-2])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " G2Lookup(evaln(a[-2,-1]&*a[-3,-1])) := 0: " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " G2Lookup(evaln(a[-2,-1]&* a[-3,-2])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 47 " G2Lookup( evaln(a[-3,-1]&*a[-3,-2])) := 0:" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 0 " " }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 25 " ### no match was found" }} {PARA 0 "> " 0 "" {MPLTEXT 1 0 7 " else" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 19 " RETURN(FAIL);" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 6 " fi;" }}{PARA 0 "> " 0 "" {MPLTEXT 1 0 4 "end:" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}} {EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 68 "save(liealg, \"C:\\\\Program Files\\\\Maple V Release 5\\\\LIB\\\\liealg.m\");" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "#save(liealg, \"liealg.m\");" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 68 "save(hidden, \"C:\\\\Program Files \\\\Maple V Release 5\\\\LIB\\\\hidden.m\");" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 26 "#save(hidden, \"hidden.m\");" }}}{EXCHG {PARA 0 "> " 0 "" {MPLTEXT 1 0 0 "" }}}}{MARK "0 0 0" 0 }{VIEWOPTS 1 1 0 1 1 1803 }