/* Implementation of MultiNomials based on sparse representation in the sparsetree.ys code. This is the real driver, using the sparse trees just for representation. */ Use("multivar.rep/sparsetree.ys"); LocalSymbols(NormalMultiNomial) [ CreateTerm(_vars,{_coefs,_fact}) <-- MultiNomial(vars,CreateSparseTree(coefs,fact)); /************************************************************ Adding and multiplying multivariate polynomials ************************************************************/ MultiNomialAdd(MultiNomial(_vars,_x), MultiNomial(_vars,_y)) <-- MultiNomial(vars,AddSparseTrees(Length(vars),x,y)); MultiNomialMultiplyAdd(MultiNomial(_vars,_x), MultiNomial(_vars,_y),_coefs,_fact) <-- MultiNomial(vars,MultiplyAddSparseTrees(Length(vars),x,y,coefs,fact)); MultiNomialNegate(MultiNomial(_vars,_terms)) <-- [ SparseTreeMap(Hold({{coefs,list},-list}),Length(vars),terms); MultiNomial(vars,terms); ]; MultiNomialMultiply(MultiNomial(_vars,_x),_multi2) <-- [ Local(result); Set(result,MakeMultiNomial(0,vars)); SparseTreeScan("muadm",Length(vars),x); result; ]; muadm(_coefs,_fact) <-- [ Set(result,MultiNomialMultiplyAdd(result, multi2,coefs,fact)); //GarbageCollect(); //TODO do we really want this? ]; UnFence("muadm",2); /* NormalForm: done as an explicit loop in stead of using SparseTreeScan for speed. This routine is a lot faster! */ 10 # NormalForm(x_IsMulti/y_IsMulti) <-- NormalForm(x)/NormalForm(y); 20 # NormalForm(MultiNomial(_vars,_list) ) <-- NormalMultiNomial(vars,list,1); 10 # NormalMultiNomial({},_term,_prefact) <-- prefact*term; 20 # NormalMultiNomial(_vars,_list,_prefact) <-- [ Local(first,rest,result); Set(first,Head(vars)); Set(rest,Tail(vars)); Set(result,0); ForEach(item,list) [ Set(result,result+NormalMultiNomial(rest,item[2],prefact*first^(item[1]))); ]; result; ]; ]; MultiMonomial(_vars,_exponents) <-- [ term:=MultiMonomialTerm(exponents); MultiNomial(vars,term); ]; 20 # MultiMonomialTerm(_exponents) <-- [ {{exponents[1],MultiMonomialTerm(Tail(exponents))}}; ]; 10 # MultiMonomialTerm({}) <-- [ 1; ]; MultiSM(MultiNomial(_vars,_terms),_fact) <-- [ Local(i); For(i:=1,i<=Length(terms),i++) [ terms[i]:=MultiScalarMultiplyTerm(terms[i],fact,Length(vars)); ]; MultiNomial(vars,terms); ]; 20 # MultiScalarMultiplyTerm(_term,_fact,_depth) <-- [ Local(string,i); string:={}; For(i:=1,i<=Length(term[2]),i++) [ string:=Concat(string,{MultiScalarMultiplyTerm(term[2][i],fact,depth-1)}); ]; {term[1],string}; ]; 10 # MultiScalarMultiplyTerm(_term,_fact,1) <-- {term[1],term[2]*fact}; LocalSymbols(drop,t,x,y)//'drop' means 'there //was a leading term with coefficient zero that was dropped' [ DropZeroLC(MultiNomial(_vars,_terms)) <-- [ Local(depth); depth:=Length(vars); drop:=True; While(drop=True) [ terms:=CheckLeadingTerm(depth,terms);//'drop' is recalculated ]; MultiNomial(vars,terms); ]; /* This function assumes 'terms' is from a MultiNomial expression, and it checks the leading (i.e. first) term for a coefficient of zero. In this case it is deleted. Otherwise the complete expression 'terms' is unchanged. This is sufficient for use by MultiDivide where one term at a time is processed, and it should be a lot faster than checking all the terms */ 10 # CheckLeadingTerm(1,_terms) <-- [ if(Head(terms)[2]=0) [ drop:=True;Tail(terms); ] else [ drop:=False;terms;]; ]; 5 # CheckLeadingTerm(_depth,{}) <-- [ drop:=False;{};]; 20 # CheckLeadingTerm(_depth,_terms) <-- [ // Echo("terms = ",terms,"depth = ",depth); Local(x,y,t); x:={}; t:=Length(Head(terms)[2])>1; t:=(t Or depth>1); y:=CheckLeadingTerm(depth-1,Head(terms)[2]); if(t) [x:={{Head(terms)[1],y}};]; if(y={}) [x:={};]; Union(x,Tail(terms)); ]; ]; /* This is obviously incomplete! -- commented out Use MultiLeadingTerm to get {exponents,coef} this looks fast. but it is not in the form of a multinomial. MLT(MultiNomial(_vars,_terms)) <-- MultiNomial(vars,Head(terms)); 10 # MultiLeadingTerm(MultiNomial(_vars,_terms)_terms={}) <-- False; 20 # MultiLeadingTerm(MultiNomial(_vars,_terms)) <-- [ depth:=Length(vars); ]; MultiDropLeadingZeroes(f) <-- [ While(Length(MultiTerms(f))!=0 And MultiLC(f)=0) [ f:=MultiDeleteLeadingTerm(f);//the leading term has zero coefficient ]; f; ]; */ MultiTerms(MultiNomial(_vars,_terms)) <-- terms; MultiLeadingTerm(MultiNomial(_vars,_terms)) <-- [ Local(coefs,fact); Set(coefs,MultiDegreeScanHead(terms,Length(vars))); {coefs,fact}; ]; 10 # MultiDegreeScanHead(_tree,0) <-- [ Set(fact,tree); {}; ]; 10 # MultiDegreeScanHead(_tree,1) <-- [ Set(fact,tree[1][2]); {tree[1][1]}; ]; 20 # MultiDegreeScanHead(_tree,_depth) <-- [ (tree[1][1]):MultiDegreeScanHead(tree[1][2],depth-1); ]; UnFence("MultiDegreeScanHead",2); ScanMultiNomial(_op,MultiNomial(vars_IsList,_terms)) <-- SparseTreeScan(op,Length(vars),terms); UnFence("ScanMultiNomial",2); RuleBase("MyMultiDropScan",{terms,Length,del}); /* MultiDropLeadingZeroes(MultiNomial(_vars,_terms)) <-- [ Local(del); Echo("MultiDropLeadingZeroes:testing"); MyMultiDropScan(terms,Length(vars),del); MultiNomial(vars,terms); ]; */ //MultiDropScan(terms,Length(vars)) /* If patterns for substrings of an expression could be matched and substituted the effect of this function could be expressed by the rules 10 # {_anything,0} <-- ""; 20 # {_anything,{}} <-- ""; 30 # ,} <-- "}" 40 # {} <-- "" applied repeatedly to the tree until no further reduction is possible. e.g. {0,{{0,{{1,0},{0,0}}}}} {0,{{0,{,}}}} by rule 10 twice {0,{{0,{}}}} by rule 30 {0,{{}}} by rule 20 {0,{}} by rule 40 "" by rule 20 //does not quite work LocalSymbols(del) [ 30 # MyMultiDropScan(_tree,_depth,_del) <-- [ Echo("MyMultiDropScan:depth =",depth,"tree = ",tree); Local(i,newtree); del:=False; For(i:=1,i<=Length(tree),i++) [ newtree:=tree[i][2]; Echo("tree=",tree,"i=",i,"newtree = ",newtree); if(depth > 1) [ Echo("depth = ",depth); MyMultiDropScan(newtree,depth-1,del); ] else [ Echo("depth = ",depth); if(newtree=0) [del:=True;Echo("del=",del);] else [del:=False;Echo("del=",del);]; ]; Echo("del= ",del); If(del, i:=i-1); ];Union({{Head(g)[1],Tail(Head(g)[2])}},Tail(g)); If(IsZero(Length(tree)), [ Echo("Length(tree) = ",Length(tree)); Echo("tree to be deleted = ",tree); DestructiveDelete(tree);del:=True; ]); ]; ]; */ 10 # MyMultiDropScan(0,0,_del) <-- [ d= True;True;]; 20 # MyMultiDropScan(_x,0,_del) <-- [ d=False;False;]; //10 # MultiDropScan(0,0) <-- True; //10 # MultiDropScan({_n,0},0) <-- True; //20 # MultiDropScan(_n,0) 5 # MultiDropScan(_x) <-- False; 30 # MultiDropScan(_tree,_depth) <-- [ Local(i); For(i:=1,i<=Length(tree),i++)//for each branch [ if (MultiDropScan(tree[i][2],depth-1)) [ DestructiveDelete(tree,i); i--;//the branches of the tree above i are now shifted down by 1 ] else [ i:=Length(tree);//if a branch is not reducible,jump to last branch! ]; ]; (tree = {}); ]; UnFence("MultiDropScan",2); MultiTermLess({_deg1,_fact1},{_deg2,_fact2}) <-- [ Local(deg); Set(deg, deg1-deg2); While(deg != {} And Head(deg) = 0) [ Set(deg, Tail(deg));]; ((deg = {}) And (fact1-fact2 < 0)) Or ((deg != {}) And (deg[1] < 0)); ]; 20 # MultiZero(multi_IsMulti) <-- [ CheckMultiZero(DropZeroLC(multi)); ]; 10 # CheckMultiZero(MultiNomial(_vars,{})) <-- True; 20 # CheckMultiZero(MultiNomial(_vars,_terms)) <-- False; //checks for polynomial being constant by checking whether MultiDegree //returns a string of zeros or not. It does not remove leading zero terms. LocalSymbols(LM,i,t,nv) [ MultiConstant(_multi) <-- [ LM:=MultiDegree(multi); nv:=Length(MultiVars(multi)); t:=True; For(i:=1,i<=nv,i++) [t:=(t And LM[i]=0);]; t; ]; ];