-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. -- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are -- met: -- -- - Redistributions of source code must retain the above copyright -- notice, this list of conditions and the following disclaimer. -- -- - Redistributions in binary form must reproduce the above copyright -- notice, this list of conditions and the following disclaimer in -- the documentation and/or other materials provided with the -- distribution. -- -- - Neither the name of The Numerical ALgorithms Group Ltd. nor the -- names of its contributors may be used to endorse or promote products -- derived from this software without specific prior written permission. -- -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS -- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A -- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER -- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, -- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. import i_-coerce namespace BOOT $coerceFailure := gensym() position1(x,y) == -- this is used where we want to assume a 1-based index 1 + position(x,y) --% Direct Product, New and Old DP2DP(u,source is [.,n,S],target is [.,m,T]) == n ~= m => nil u = '_$fromCoerceable_$ => canCoerce(S,T) null (u' := coerceInt(objNewWrap(u,['Vector,S]),['Vector,T])) => coercionFailure() objValUnwrap u' --% Distributed Multivariate Polynomials, New and Old Dmp2Dmp(u,source is [dmp,v1,S], target is [.,v2,T]) == -- the variable lists must share some variables, or u is a constant u = '_$fromCoerceable_$ => v:= intersection(v1,v2) v and w2:= SETDIFFERENCE(v2,v) t1:= if w1 then [dmp,w1,S] else S t2:= if w2 then [dmp,w2,T] else T canCoerce(t1,t2) null u => domainZero(target) u is [[e,:c]] and e=LIST2VEC [0 for v in v1] => z:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(z) coercionFailure() v:= intersection(v1,v2) => w1:= SETDIFFERENCE(v1,v) => coerceDmp1(u,source,target,v,w1) coerceDmp2(u,source,target) coercionFailure() coerceDmp1(u,source is [.,v1,S],target is [.,v2,T],v,w) == -- coerces one Dmp to another, where v1 is not a subset of v2 -- v is the intersection, w the complement of v1 and v2 t:= ['DistributedMultivariatePolynomial,w,S] x:= domainZero(target) one:= domainOne(T) plusfunc:= getFunctionFromDomain('_+,target,[target,target]) multfunc:= getFunctionFromDomain('_*,target,[target,target]) pat1:= [member(x,v) for x in v1] pat2:= [member(x,w) for x in v1] pat3:= [member(x,v) and POSN1(x,v) for x in v2] for [e,:c] in u until not z repeat exp:= LIST2VEC [y for x in pat2 for y in VEC2LIST e | x] z:= coerceInt(objNewWrap([[exp,:c]],t),target) => li:= [y for x in pat1 for y in VEC2LIST e | x] a:= [[LIST2VEC [if x then li.x else 0 for x in pat3],:one]] x:= SPADCALL(x,SPADCALL(objValUnwrap(z),a,multfunc),plusfunc) z => x coercionFailure() coerceDmp2(u,source is [.,v1,S],target is [.,v2,T]) == -- coerces one Dmp to another, where v1 is included in v2 x:= domainZero(target) one:= domainOne(T) plusfunc:= getFunctionFromDomain('_+,target,[target,target]) multfunc:= getFunctionFromDomain('_*,target,[target,target]) pat:= [member(x,v1) and POSN1(x,v1) for x in v2] for [e,:c] in u until not z repeat z:= coerceInt(objNewWrap(c,S),target) => li:= VEC2LIST e a:= [[LIST2VEC [if x then li.x else 0 for x in pat],:one]] x:= SPADCALL(x,SPADCALL(objValUnwrap(z),a,multfunc),plusfunc) NIL z => x coercionFailure() Dmp2Expr(u,source is [dmp,vars,S], target is [Expr,T]) == u = '_$fromCoerceable_$ => canCoerce(S, target) null vars => [[., :c]] := u not (c := coerceInt(objNewWrap(c, S), target)) => coercionFailure() objValUnwrap(c) syms := [objValUnwrap coerceInt(objNewWrap(var, $Symbol), target) for var in vars] sum := domainZero(target) plus := getFunctionFromDomain("+", target, [target, target]) mult := getFunctionFromDomain("*", target, [target, target]) expn := getFunctionFromDomain("**", target, [target, $Integer]) for [e, :c] in u repeat not (c := coerceInt(objNewWrap(c, S), target)) => coercionFailure() c := objValUnwrap(c) term := domainOne(target) for i in 0.. for sym in syms repeat exp := e.i e.i > 0 => term := SPADCALL(term, SPADCALL(sym, e.i, expn), mult) sum := SPADCALL(sum, SPADCALL(c, term, mult), plus) sum Dmp2Mp(u, source is [dmp, x, S], target is [mp, y, T]) == source' := [dmp,y,T] u = '_$fromCoerceable_$ => x = y => canCoerce(S,T) canCoerce(source',target) null u => domainZero(target) -- 0 dmp is = nil x ~= y => (u' := coerceInt(objNewWrap(u,source),source')) or coercionFailure() (u' := coerceInt(u',target)) or coercionFailure() objValUnwrap(u') -- slight optimization for case #u = 1, x=y , #x =1 and S=T -- I know it's pathological, but it may avoid an instantiation (x=y) and (1 = #u) and (1 = #x) and (S = T) => [1,1,[(CAAR u).0,0,:CDAR u]] (u' := coerceDmpCoeffs(u,S,T)) = 'failed => coercionFailure() plusfunc := getFunctionFromDomain("+",target,[target,target]) u'' := genMpFromDmpTerm(u'.0, 0) for i in 1..(#u' - 1) repeat u'' := SPADCALL(u'',genMpFromDmpTerm(u'.i, 0),plusfunc) u'' coerceDmpCoeffs(u,S,T) == -- u is a dmp, S is domain of coeffs, T is domain to coerce coeffs to S = T => u u' := nil bad := nil for [e,:c] in u repeat bad => nil null (c' := coerceInt(objNewWrap(c,S),T)) => return (bad := true) u' := [[e,:objValUnwrap(c')],:u'] bad => 'failed reverse! u' sortAndReorderDmpExponents(u,vl) == vl' := reverse MSORT vl n := (-1) + #vl pos := LIST2VEC LZeros (n+1) for i in 0..n repeat pos.i := position(vl.i,vl') u' := nil for [e,:c] in u repeat e' := LIST2VEC LZeros (n+1) for i in 0..n repeat e'.(pos.i) := e.i u' := [[e',:c],:u'] reverse u' domain2NDmp(u, source, target is [., y, T]) == target' := ['DistributedMultivariatePolynomial,y,T] u = '_$fromCoerceable_$ => canCoerce(source,target') (u' := coerceInt(objNewWrap(u,source),target')) => (u'' := coerceInt(u',target)) => objValUnwrap(u'') coercionFailure() coercionFailure() Dmp2NDmp(u,source is [dmp,x,S],target is [ndmp,y,T]) == -- a null DMP = 0 null u => domainZero(target) target' := [dmp,y,T] u = '_$fromCoerceable_$ => Dmp2Dmp(u,source,target') (u' := Dmp2Dmp(u,source,target')) => addDmpLikeTermsAsTarget(u',target) coercionFailure() addDmpLikeTermsAsTarget(u,target) == u' := domainZero(target) func := getFunctionFromDomain("+",target,[target,target]) for t in u repeat u' := SPADCALL(u',[t],func) u' -- rewrite ? Dmp2P(u, source is [dmp,vl, S], target is [.,T]) == -- a null DMP = 0 null u => domainZero(target) u = '_$fromCoerceable_$ => t := canCoerce(S,T) null t => canCoerce(S,target) t S is ['Polynomial,.] => mp := coerceInt(objNewWrap(u,source),['MultivariatePolynomial,vl,S]) or coercionFailure() p := coerceInt(mp,target) or coercionFailure() objValUnwrap p -- slight optimization for case #u = 1, #vl =1 and S=T -- I know it's pathological, but it may avoid an instantiation (1 = #u) and (1 = #vl) and (S = T) => -- The Rep of Polynomial T is a 2-branched Union with scalar -- (coefficient ring values) first (tag = 0), and non-trivial -- polynomials second (tag = 1). (lexp:= (CAAR u).0) = 0 => [0,:CDAR u] [1,vl.0,[lexp,0,:CDAR u]] vl' := reverse MSORT vl source' := [dmp,vl',S] target' := ['MultivariatePolynomial,vl',S] u' := sortAndReorderDmpExponents(u,vl) u' := coerceInt(objNewWrap(u',source'),target') if u' then u' := translateMpVars2PVars (objValUnwrap(u'),vl') u' := coerceInt(objNewWrap(u',['Polynomial,S]),target) u' => objValUnwrap(u') -- get drastic. create monomials source' := [dmp,vl,T] u' := domainZero(target) oneT := domainOne(T) plusfunc := getFunctionFromDomain("+",target,[target,target]) multfunc := getFunctionFromDomain("*",target,[target,target]) for [e,:c] in u repeat (c' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() (e' := coerceInt(objNewWrap([[e,:oneT]],source'),target)) or coercionFailure() t := SPADCALL(objValUnwrap(e'),objValUnwrap(c'),multfunc) u' := SPADCALL(u',t,plusfunc) coercionFailure() translateMpVars2PVars (u, vl) == u is [ =1, v, :termlist] => [ 1, vl.(v-1), :[[e,:translateMpVars2PVars(c,vl)] for [e,:c] in termlist]] u Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) == null u => -- this is true if u = 0 domainZero(target) u = '_$fromCoerceable_$ => member(var,vl) => vl' := remove(vl,var) null vl' => -- no remaining variables canCoerce(S,T) null rest vl' => -- one remaining variable canCoerce([up,first vl',S],T) canCoerce([dmp,vl',S], T) canCoerce(source,T) -- check constant case (null rest u) and (first(u) is [e,:c]) and ( and/[(0 = e.i) for i in 0..(-1 + #vl)] ) => (x := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(x) -- check non-member case null member(var,vl) => (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure() [[0,:objValUnwrap u']] vl' := remove(vl,var) -- only one variable in DMP case null vl' => u' := reverse! SORTBY('CAR,[[e.0,:c] for [e,:c] in u]) (u' := coerceInt(objNewWrap(u',[up,var,S]),target)) or coercionFailure() objValUnwrap u' S1 := [dmp,vl',S] plusfunc:= getFunctionFromDomain('_+,T,[T,T]) zero := getConstantFromDomain($Zero,T) x := NIL pos:= POSN1(var,vl) for [e,:c] in u until not y repeat exp:= e.pos e1:= removeVectorElt(e,pos) y:= coerceInt(objNewWrap([[e1,:c]],S1),T) => -- need to be careful about zeros p:= ASSQ(exp,x) => c' := SPADCALL(rest p,objValUnwrap(y),plusfunc) c' = zero => x := REMALIST(x,exp) p.rest := c' zero = objValUnwrap(y) => 'iterate x := [[exp,:objValUnwrap(y)],:x] y => reverse! SORTBY('CAR,x) coercionFailure() removeVectorElt(v,pos) == -- removes the pos'th element from vector v LIST2VEC [x for x in VEC2LIST v for y in 0.. | not (y=pos)] removeListElt(l,pos) == pos = 0 => rest l [first l, :removeListElt(rest l,pos-1)] NDmp2domain(u,source is [ndmp,x,S],target) == -- a null NDMP = 0 null u => domainZero(target) dmp := 'DistributedMultivariatePolynomial source' := [dmp,x,S] u = '_$fromCoerceable_$ => canCoerce(source',target) u' := addDmpLikeTermsAsTarget(u,source') (u'' := coerceInt(objNewWrap(u',source'),target)) => objValUnwrap(u'') coercionFailure() NDmp2NDmp(u,source is [ndmp,x,S],target is [.,y,T]) == -- a null NDMP = 0 null u => domainZero(target) dmp := 'DistributedMultivariatePolynomial source' := [dmp,x,S] target' := [dmp,y,T] u = '_$fromCoerceable_$ => canCoerce(source',target') u' := addDmpLikeTermsAsTarget(u,source') (u'' := coerceInt(objNewWrap(u',source'),target')) => addDmpLikeTermsAsTarget(objValUnwrap(u''),target) coercionFailure() --% Expression Expr2Complex(u,source is [.,S], target is [.,T]) == u = '_$fromCoerceable_$ => nil -- can't tell, in general not member(S, [$Integer, $Float, $DoubleFloat]) => coercionFailure() not member(T, [$Float, $DoubleFloat]) => coercionFailure() complexNumeric := getFunctionFromDomain("complexNumeric", ['Numeric, S], [source]) -- the following might fail cf := SPADCALL(u,complexNumeric) -- returns a Float T = $DoubleFloat => null (z := coerceInt(objNewWrap(cf, ['Complex, $Float]), ['Complex, $DoubleFloat])) => coercionFailure() objValUnwrap z cf Expr2Dmp(u,source is [Expr,S], target is [dmp,v2,T]) == u = '_$fromCoerceable_$ => canCoerce(source, T) null v2 => not (z := coerceInt(objNewWrap(u, source), T)) => coercionFailure() [[LIST2VEC NIL, :objValUnwrap z]] obj := objNewWrap(u, source) univ := coerceInt(obj, ['UnivariatePolynomial, first v2, T]) not univ => T = source => coercionFailure() not (z := coerceInt(obj, [dmp, v2, source])) => coercionFailure() z := objValUnwrap z for term in z repeat [., :c] := term not (c := coerceInt(objNewWrap(c, source), T)) => coercionFailure() term.rest := objValUnwrap c z univ := objValUnwrap univ -- only one variable null rest v2 => for term in univ repeat term.first := VECTOR first term univ -- more than one variable summands := nil for [e,:c] in univ repeat summands := Expr2Dmp1(summands, LIST2VEC [e, :[0 for v in rest v2]], c, T, 1, rest v2, T) plus := getFunctionFromDomain("+", target, [target, target]) sum := domainZero target for summand in summands repeat sum := SPADCALL([summand], sum, plus) sum Expr2Dmp1(summands, vec, c, source, index, varList, T) == if null varList then if not (source = T) then not (c := coerceInt(objNewWrap(c, source), T)) => coercionFailure() c := objValUnwrap c summands := [[vec, :c], :summands] else univ := coerceInt(objNewWrap(c, source), ['UnivariatePolynomial, first varList, T]) univ := objValUnwrap univ for [e,:c] in univ repeat vec := COPY_-SEQ vec vec.index := e summands := Expr2Dmp1(summands, vec, c, T, index+1, rest varList, T) summands Expr2Mp(u,source is [Expr,S], target is [.,v2,T]) == u = '_$fromCoerceable_$ => canCoerce(source, T) dmp := ['DistributedMultivariatePolynomial,v2,T] d := Expr2Dmp(u,source, dmp) not (m := coerceInt(objNewWrap(d, dmp), target)) => coercionFailure() objValUnwrap m Expr2Up(u,source is [Expr,S], target is [.,var,T]) == u = '_$fromCoerceable_$ => canCoerce(source, T) kernelFunc := getFunctionFromDomain("kernels", source, [source]) kernelDom := ['Kernel, source] operatorFunc := getFunctionFromDomain("operator",kernelDom,[kernelDom]) bopDom := ["BasicOperator"] nameFunc := getFunctionFromDomain("name", bopDom, [bopDom]) kernels := SPADCALL(u,kernelFunc) v1 := [SPADCALL(SPADCALL(kernel, operatorFunc),nameFunc) for kernel in kernels] not member(var, v1) => coercionFailure() -- variable is a kernel varKernel := kernels.(POSN1(var, v1)) univFunc := getFunctionFromDomain("univariate", source, [source, kernelDom]) sup := ['SparseUnivariatePolynomial, source] fracUniv := SPADCALL(u, varKernel, univFunc) denom := rest fracUniv not equalOne(denom, sup) => coercionFailure() numer := first fracUniv uniType := ['UnivariatePolynomial, var, source] (z := coerceInt(objNewWrap(numer, uniType), target)) => objValUnwrap z coercionFailure() --% Kernels over Expr Ker2Ker(u,source is [.,S], target is [.,T]) == u = '_$fromCoerceable_$ => canCoerce(S, T) not (m := coerceInt(objNewWrap(u, source), S)) => coercionFailure() u' := objValUnwrap m not (m' := coerceInt(objNewWrap(u', S), T)) => coercionFailure() u'' := objValUnwrap m' not (m'' := coerceInt(objNewWrap(u'', T), target)) => coercionFailure() objValUnwrap m'' Ker2Expr(u,source is [.,S], target) == u = '_$fromCoerceable_$ => canCoerce(S, target) not (m := coerceByFunction(objNewWrap(u, source), S)) => coercionFailure() u':= objValUnwrap m not (m' := coerceInt(objNewWrap(u', S), target)) => coercionFailure() objValUnwrap m' --% Factored objects Factored2Factored(u,oldmode,newmode) == [.,oldargmode,:.]:= oldmode [.,newargmode,:.]:= newmode u = '_$fromCoerceable_$ => canCoerce(oldargmode,newargmode) u' := unwrap u unit' := coerceInt(objNewWrap(first u',oldargmode),newargmode) null unit' => coercionFailure() factors := KDR u' factors' := [(coerceFFE(x,oldargmode,newargmode)) for x in factors] member('failed,factors') => coercionFailure() [objValUnwrap(unit'),:factors'] coerceFFE(ffe, oldmode, newmode) == fac' := coerceInt(objNewWrap(ffe.1,oldmode),newmode) null fac' => 'failed LIST2VEC [ffe.0,objValUnwrap(fac'),ffe.2] --% Complex Complex2underDomain(u,[.,S],target) == u = '_$fromCoerceable_$ => nil [r,:i] := u i=domainZero(S) => [r',.,.]:= coerceInt(objNewWrap(r,S),target) or coercionFailure() r' coercionFailure() Complex2FR(u,S is [.,R],target is [.,T]) == u = '_$fromCoerceable_$ => S ~= T => nil R = $Integer => true nil S ~= T => coercionFailure() package := R = $Integer => ['GaussianFactorizationPackage] coercionFailure() factor := getFunctionFromDomain('factor,package,[S]) SPADCALL(u,factor) Complex2Expr(u, source is [.,S], target is [., T]) == u = '_$fromCoerceable_$ => T is ['Complex, T1] and canCoerceFrom(S, T1) or coercionFailure() E := defaultTargetFE source negOne := coerceInt(objNewWrap(-1, $Integer), E) null negOne => coercionFailure() sqrtFun := getFunctionFromDomain('sqrt, E, [E]) i := SPADCALL(objValUnwrap negOne, sqrtFun) realFun := getFunctionFromDomain('real, source, [source]) imagFun := getFunctionFromDomain('imag, source, [source]) real := SPADCALL(u, realFun) imag := SPADCALL(u, imagFun) realExp := coerceInt(objNewWrap(real, S), E) null realExp => coercionFailure() imagExp := coerceInt(objNewWrap(imag, S), E) null imagExp => coercionFailure() timesFun := getFunctionFromDomain('_*, E, [E, E]) plusFun := getFunctionFromDomain('_+, E, [E, E]) newVal := SPADCALL(objValUnwrap(realExp), SPADCALL(i, objValUnwrap imagExp, timesFun), plusFun) newObj := objNewWrap(newVal, E) finalObj := coerceInt(newObj, target) finalObj => objValUnwrap finalObj coercionFailure() --% Integer I2EI(n,source,target) == n = '_$fromCoerceable_$ => nil if not ODDP(n) then n else coercionFailure() I2OI(n,source,target) == n = '_$fromCoerceable_$ => nil if ODDP(n) then n else coercionFailure() I2PI(n,source,target) == n = '_$fromCoerceable_$ => nil if n > 0 then n else coercionFailure() I2NNI(n,source,target) == n = '_$fromCoerceable_$ => nil if n >= 0 then n else coercionFailure() --% List L2Tuple(val, source is [.,S], target is [.,T]) == val = '_$fromCoerceable_$ => canCoerce(S,T) null (object := coerceInt1(objNewWrap(val,source), ['List, T])) => coercionFailure() asTupleNew0(getVMType T, objValUnwrap object) L2DP(l, source is [.,S], target is [.,n,T]) == -- need to know size of the list l = '_$fromCoerceable_$ => nil n ~= # l => coercionFailure() (v := coerceInt(objNewWrap(LIST2VEC l,['Vector,S]),['Vector,T])) or coercionFailure() V2DP(objValUnwrap v, ['Vector, T], target) V2DP(v, source is [.,S], target is [.,n,T]) == -- need to know size of the vector v = '_$fromCoerceable_$ => nil n ~= # v => coercionFailure() (v1 := coerceInt(objNewWrap(v,source),['Vector,T])) or coercionFailure() dpFun := getFunctionFromDomain('directProduct, target, [['Vector,T]]) SPADCALL(objValUnwrap v1, dpFun) L2V(l, source is [.,S], target is [.,T]) == l = '_$fromCoerceable_$ => canCoerce(S,T) (v := coerceInt(objNewWrap(LIST2VEC l,['Vector,S]),target)) or coercionFailure() objValUnwrap(v) V2L(v, source is [.,S], target is [.,T]) == v = '_$fromCoerceable_$ => canCoerce(S,T) (l := coerceInt(objNewWrap(VEC2LIST v,['List,S]),target)) or coercionFailure() objValUnwrap(l) L2M(u,[.,D],[.,R]) == u = '_$fromCoerceable_$ => nil D is ['List,E] and isRectangularList(u,#u,# first u) => u' := nil for x in u repeat x' := nil for y in x repeat (y' := coerceInt(objNewWrap(y,E),R)) or coercionFailure() x' := [objValUnwrap(y'),:x'] u' := [LIST2VEC reverse x',:u'] LIST2VEC reverse u' coercionFailure() L2Record(l,[.,D],[.,:al]) == l = '_$fromCoerceable_$ => nil #l = #al => v:= [u for x in l for [":",.,D'] in al] where u() == T:= coerceInt(objNewWrap(x,D),D') or return 'failed objValUnwrap(T) v = 'failed => coercionFailure() #v = 2 => [v.0,:v.1] LIST2VEC v coercionFailure() L2Rm(u,source is [.,D],target is [.,n,m,R]) == u = '_$fromCoerceable_$ => nil D is ['List,E] and isRectangularList(u,n,m) => L2M(u,source,['Matrix,R]) coercionFailure() L2Sm(u,source is [.,D],[.,n,R]) == u = '_$fromCoerceable_$ => nil D is ['List,E] and isRectangularList(u,n,n) => L2M(u,source,['Matrix,R]) coercionFailure() L2Set(x,source is [.,S],target is [.,T]) == x = '_$fromCoerceable_$ => canCoerce(S,T) -- call library function brace to get a set target' := ['Set,S] u := objNewWrap( SPADCALL(x,getFunctionFromDomain('brace,target',[source])), target') (u := coerceInt(u,target)) or coercionFailure() objValUnwrap u Set2L(x,source is [.,S],target is [.,T]) == x = '_$fromCoerceable_$ => canCoerce(S,T) -- call library function destruct to get a list u := objNewWrap( SPADCALL(x,getFunctionFromDomain('destruct,source,[source])), ['List,S]) (u := coerceInt(u,target)) or coercionFailure() objValUnwrap u Agg2Agg(x,source is [agg1,S],target is [.,T]) == x = '_$fromCoerceable_$ => canCoerce(S,T) S = T => coercionFailure() -- library function target' := [agg1,T] (u := coerceInt(objNewWrap(x,source),target')) or coercionFailure() (u := coerceInt(u,target)) or coercionFailure() objValUnwrap u Agg2L2Agg(x,source is [.,S],target) == -- tries to use list as an intermediate type mid := ['List,S] x = '_$fromCoerceable_$ => canCoerce(source,mid) and canCoerce(mid,target) (u := coerceInt(objNewWrap(x,source),mid)) or coercionFailure() (u := coerceInt(u,target)) or coercionFailure() objValUnwrap u isRectangularList(x,p,q) == p=0 or p=#x => n:= #first x and/[n=#y for y in rest x] => p=0 or q=n --% Matrix M2L(x,[.,S],target) == mid := ['Vector,['Vector,S]] x = '_$fromCoerceable_$ => canCoerce(mid,target) (u := coerceInt(objNewWrap(x,mid),target)) or coercionFailure() objValUnwrap u M2M(x,[.,R],[.,S]) == x = '_$fromCoerceable_$ => canCoerce(R,S) n := # x m := # x.0 v := nil for i in 0..(n-1) repeat u := nil for j in 0..(m-1) repeat y := x.i.j (y' := coerceInt(objNewWrap(y,R),S)) or coercionFailure() u := [objValUnwrap y',:u] v := [LIST2VEC reverse u,:v] LIST2VEC reverse v M2Rm(x,source is [.,R],[.,p,q,S]) == x = '_$fromCoerceable_$ => nil n:= #x m:= #x.0 n=p and m=q => M2M(x,source,[nil,S]) coercionFailure() M2Sm(x,source is [.,R],[.,p,S]) == x = '_$fromCoerceable_$ => nil n:= #x m:= #x.0 n=m and m=p => M2M(x,source,[nil,S]) coercionFailure() M2V(x,[.,S],target) == mid := ['Vector,['Vector,S]] x = '_$fromCoerceable_$ => canCoerce(mid,target) (u := coerceInt(objNewWrap(x,mid),target)) or coercionFailure() objValUnwrap u --% Multivariate Polynomial Mp2Dmp(u, source is [., x, S], target is [dmp, y, T]) == -- Change the representation to a DMP with the same variables and -- coerce. target' := [dmp,x,S] u = '_$fromCoerceable_$ => canCoerce(target',target) -- check if we have a constant u is [ =0,:c] => null (u' := coerceInt(objNewWrap(c,S),target)) => coercionFailure() objValUnwrap(u') plus := getFunctionFromDomain('_+,target',[target',target']) mult := getFunctionFromDomain('_*,target',[target',target']) one := domainOne(S) zero := domainZero(S) (u' := coerceInt(objNewWrap(Mp2SimilarDmp(u,S,#x,plus,mult,one,zero), target'),target)) or coercionFailure() objValUnwrap(u') Mp2SimilarDmp(u,S,n,plus,mult,one,zero) == u is [ =0,:c] => c = zero => NIL -- zero for dmp [[LIST2VEC LZeros n,:c]] u is [ =1,x,:terms] => u' := NIL -- zero for dmp for [e,:c] in terms repeat e' := LIST2VEC LZeros n e'.(x-1) := e t := [[e',:one]] t := SPADCALL(t,Mp2SimilarDmp(c,S,n,plus,mult,one,zero),mult) u' := SPADCALL(u',t,plus) u' Mp2Expr(u,source is [mp,vars,S], target is [Expr,T]) == u = '_$fromCoerceable_$ => canCoerce(S, target) dmp := ['DistributedMultivariatePolynomial, vars, S] not (d := coerceInt(objNewWrap(u, source), dmp)) => coercionFailure() Dmp2Expr(objValUnwrap d, dmp, target) Mp2FR(u,S is [.,vl,R],[.,T]) == u = '_$fromCoerceable_$ => S ~= T => nil member(R,'((Integer) (Fraction (Integer)))) => true nil S ~= T => coercionFailure() package := R = $Integer => ovl := ['OrderedVariableList, vl] ['MultivariateFactorize,ovl, ['IndexedExponents, ovl],R,S] R is ['Fraction, D] => ovl := ['OrderedVariableList, vl] package := ['MRationalFactorize,['IndexedExponents, ovl], ovl, D, S] coercionFailure() factor := getFunctionFromDomain('factor,package,[S]) SPADCALL(u,factor) Mp2Mp(u,source is [mp,x,S], target is [.,y,T]) == -- need not deal with case of x = y (coerceByMapping) common := intersection(y,x) x' := SETDIFFERENCE(x,common) y' := SETDIFFERENCE(y,common) u = '_$fromCoerceable_$ => x = y => canCoerce(S,T) null common => canCoerce(source,T) null x' => canCoerce(S,target) null y' => canCoerce([mp,x',S],T) canCoerce([mp,x',S],[mp,y',T]) -- first check for constant case u is [ =0,:c] => (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') plus := getFunctionFromDomain('_+,target,[target,target]) -- now no-common-variables case null common => times := getFunctionFromDomain('_*,target,[target,target]) expn := getFunctionFromDomain('_*_*,target, [target,$NonNegativeInteger]) Mp2MpAux0(u,S,target,x,plus,times,expn) -- if source vars are all in target null x' => monom := getFunctionFromDomain('monomial,target, [target,['OrderedVariableList,y],$NonNegativeInteger]) Mp2MpAux1(u,S,target,x,y,plus,monom) -- if target vars are all in source null y' => -- change source to MP[common] MP[x'] S univariate := getFunctionFromDomain('univariate, source,[source,['OrderedVariableList,x]]) u' := Mp2MpAux2(u,x,common,x',common,x',univariate,S,NIL) (u' := coerceInt(objNewWrap(u', [mp,common,[mp,x',S]]),target)) or coercionFailure() objValUnwrap(u') -- we have a mixture (u' := coerceInt(objNewWrap(u,source),[mp,common,[mp,x',S]])) or coercionFailure() (u' := coerceInt(u',target)) or coercionFailure() objValUnwrap(u') Mp2MpAux0(u,S,target,vars,plus,times,expn) == -- for case when no common variables u is [ =0,:c] => (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') [.,var,:terms] := u [mp,.,T] := target x := coerceInt(objNewWrap(vars.(var-1),['Variable,vars.(var-1)]), [mp,vars,$Integer]) or coercionFailure() (x := coerceInt(x,T)) or coercionFailure() x := [0,:objValUnwrap x] sum := domainZero(target) for [e,:c] in terms repeat prod := SPADCALL(SPADCALL(x,e,expn), Mp2MpAux0(c,S,target,vars,plus,times,expn),times) sum := SPADCALL(sum,prod,plus) sum Mp2MpAux1(u,S,target,varl1,varl2,plus,monom) == -- for case when source vars are all in target u is [ =0,:c] => (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') [.,var,:terms] := u sum := domainZero(target) for [e,:c] in terms repeat mon := SPADCALL( Mp2MpAux1(c,S,target,varl1,varl2,plus,monom), position1(varl1.(var-1), varl2),e,monom) sum := SPADCALL(sum,mon,plus) sum Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,isUnder) == -- target vars are all in source mp2 := ['MultivariatePolynomial,oldcomm,['MultivariatePolynomial, oldrest,S]] common => u is [ =0,:c] => (u' := coerceInt(objNewWrap(c,S),mp2)) or coercionFailure() objValUnwrap(u') [var,:common] := common u' := SPADCALL(u,position1(var,x),univariate) null(rest(u')) and (first(first(u')) = 0) => Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,isUnder) [1,position1(var,oldcomm),:[[e,:Mp2MpAux2(c,x,oldcomm,oldrest, common,restvars,univariate,S,isUnder)] for [e,:c] in u']] null isUnder => [0,:Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,true)] -- just treat like elt of [mp,x',S] u is [ =0,:c] => u [var,:restvars] := restvars u' := SPADCALL(u,position1(var,x),univariate) null(rest(u')) and (first(first(u')) = 0) => Mp2MpAux2(u,x,oldcomm,oldrest,common,restvars,univariate,S,isUnder) [1,position1(var,oldrest),:[[e,:Mp2MpAux2(c,x,oldcomm,oldrest, common,restvars,univariate,S,isUnder)] for [e,:c] in u']] genMpFromDmpTerm(u, oldlen) == -- given one term of a DMP representation of a polynomial, this creates -- the corresponding MP term. patlen := oldlen [e,:c] := u numexps := # e patlen >= numexps => [0, :c] for i in patlen..(numexps - 1) repeat e.i = 0 => patlen := patlen + 1 return nil patlen >= numexps => [0, :c] [1, 1+patlen, [e.patlen,:genMpFromDmpTerm(u,patlen+1)]] Mp2P(u, source is [mp,vl, S], target is [p,R]) == u = '_$fromCoerceable_$ => canCoerce(S,target) S is ['Polynomial,.] => MpP2P(u,vl,S,R) vl' := reverse MSORT vl -- if Mp2Mp fails, a THROW will occur u' := Mp2Mp(u,source,[mp,vl',S]) u' := translateMpVars2PVars (u',vl') (u' := coerceInt(objNewWrap(u',[p,S]),target)) or coercionFailure() objValUnwrap(u') MpP2P(u,vl,PS,R) == -- u has type MP(vl,PS). Want to coerce to P R. PR := ['Polynomial,R] u is [ =0,:c] => (u' :=coerceInt(objNewWrap(c,PS),PR)) or coercionFailure() objValUnwrap u' [ .,pos,:ec] := u multivariate := getFunctionFromDomain('multivariate, PR,[['SparseUnivariatePolynomial,PR],$Symbol]) sup := [[e,:MpP2P(c,vl,PS,R)] for [e,:c] in ec] p := SPADCALL(sup,vl.(pos-1),multivariate) --(p' :=coerceInt(objNewWrap(p,PS),['Polynomial,R])) or coercionFailure() --objValUnwrap(p') Mp2Up(u,source is [mp,vl,S],target is [up,x,T]) == u = '_$fromCoerceable_$ => member(x,vl) => vl = [x] => canCoerce(S,T) canCoerce([mp,remove(vl,x),S],T) canCoerce(source,T) u is [ =0,:c] => -- constant polynomial? (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap u' null member(x,vl) => (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure() [[0,:objValUnwrap(u')]] vl = [x] => u' := [[e,:c] for [e,.,:c] in CDDR u] (u' := coerceInt(objNewWrap(u',[up,x,S]),target)) or coercionFailure() objValUnwrap u' -- do a univariate to transform u to a UP(x,P S) and then coerce again var := position1(x,vl) UPP := ['UnivariatePolynomial,x,source] univariate := getFunctionFromDomain('univariate, source,[source,['OrderedVariableList,vl]]) upU := SPADCALL(u,var,univariate) -- we may assume this has type UPP (u' := coerceInt(objNewWrap(upU,UPP),target)) or coercionFailure() objValUnwrap u' --% OrderedVariableList OV2OV(u,source is [.,svl], target is [.,tvl]) == svl = intersection(svl,tvl) => u = '_$fromCoerceable_$ => true position1(svl.(u-1),tvl) u = '_$fromCoerceable_$ => nil coercionFailure() OV2P(u,source is [.,svl], target is [.,T]) == u = '_$fromCoerceable_$ => true v := svl.(unwrap(u)-1) [1,v,[1,0,:domainOne(T)]] OV2poly(u,source is [.,svl], target is [p,vl,T]) == u = '_$fromCoerceable_$ => p = 'UnivariatePolynomial => (# svl = 1) and (p = svl.0) and/[member(v,vl) for v in svl] v := svl.(unwrap(u)-1) val' := [1,:domainOne(T)] p = 'UnivariatePolynomial => v ~= vl => coercionFailure() [[1,:domainOne(T)]] null member(v,vl) => coercionFailure() val' := [[1,:domainOne(T)]] source' := ['UnivariatePolynomial,v,T] (u' := coerceInt(objNewWrap(val',source'),target)) or coercionFailure() objValUnwrap(u') OV2SE(u,source is [.,svl], target) == u = '_$fromCoerceable_$ => true svl.(unwrap(u)-1) OV2Sy(u,source is [.,svl], target) == u = '_$fromCoerceable_$ => true svl.(unwrap(u)-1) --% Polynomial varsInPoly(u) == u is [ =1, v, :termlist] => [v,:varsInPoly(c) for [e,:c] in termlist] nil P2FR(u,S is [.,R],[.,T]) == u = '_$fromCoerceable_$ => S ~= T => nil member(R,'((Integer) (Fraction (Integer)))) => true nil S ~= T => coercionFailure() package := R = $Integer => ['MultivariateFactorize,$Symbol,['IndexedExponents, $Symbol],R,S] R is ['Fraction, D] => package := ['MRationalFactorize,['IndexedExponents, $Symbol],$Symbol, D, S] coercionFailure() factor := getFunctionFromDomain('factor,package,[S]) SPADCALL(u,factor) P2Dmp(u, source is [., S], target is [., y, T]) == u = '_$fromCoerceable_$ => -- might be able to say yes canCoerce(source,T) u is [ =0,:c] => -- polynomial is a constant (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') univariate := getFunctionFromDomain('univariate, source,[source,$Symbol]) plus := getFunctionFromDomain("+",target,[target,target]) monom := getFunctionFromDomain('monomial,target, [target,['OrderedVariableList,y],$NonNegativeInteger]) P2DmpAux(u,source,S,target,copy y,y,T,univariate,plus,monom) P2Expr(u, source is [.,S], target is [., T]) == u = '_$fromCoerceable_$ => canCoerce(S, T) S = T => coercionFailure() newS := ['Polynomial, T] val := coerceInt(objNewWrap(u, source), newS) null val => coercionFailure() val := coerceInt(val, target) null val => coercionFailure() objValUnwrap val P2DmpAux(u,source,S,target,varlist,vars,T,univariate,plus,monom) == u is [ =0,:c] => -- polynomial is a constant (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') -- if no variables left, try to go to underdomain of target (T) null vars => (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure() -- if successful, embed (u' := coerceByFunction(u',target)) or coercionFailure() objValUnwrap(u') -- there are variables, so get them out of u [x,:vars] := vars sup := SPADCALL(u,x,univariate) -- this is a SUP P S null sup => -- zero? unlikely. domainZero(target) -- degree 0 polynomial? (variable did not occur) null(rest(sup)) and first(sup) is [ =0,:c] => -- call again, but with one less var P2DmpAux(c,source,S,target,varlist,vars,T,univariate,plus,monom) var := position1(x,varlist) u' := domainZero(target) for [e,:c] in sup repeat u'' := SPADCALL( P2DmpAux(c,source,S,target,varlist,vars,T,univariate,plus,monom), var,e,monom) u' := SPADCALL(u',u'',plus) u' P2Mp(u, source is [., S], target is [., y, T]) == u = '_$fromCoerceable_$ => -- might be able to say yes canCoerce(source,T) univariate := getFunctionFromDomain('univariate, source,[source,$Symbol]) P2MpAux(u,source,S,target,copy y,y,T,univariate) P2MpAux(u,source,S,target,varlist,vars,T,univariate) == u is [ =0,:c] => -- polynomial is a constant (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') -- if no variables left, try to go to underdomain of target (T) null vars => (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure() -- if successful, embed [ 0,:objValUnwrap(u')] -- there are variables, so get them out of u [x,:vars] := vars sup := SPADCALL(u,x,univariate) -- this is a SUP P S null sup => -- zero? unlikely. domainZero(target) -- degree 0 polynomial? (variable did not occur) null(rest(sup)) and first(sup) is [ =0,:c] => -- call again, but with one less var P2MpAux(c,source,S,target,varlist,vars,T,univariate) terms := [[e,:P2MpAux(c,source,S,target,varlist,vars,T,univariate)] for [e,:c] in sup] [1, position1(x,varlist), :terms] varIsOnlyVarInPoly(u, var) == u is [ =1, v, :termlist] => v ~= var => nil and/[varIsOnlyVarInPoly(c,var) for [e,:c] in termlist] true P2Up(u,source is [.,S],target is [.,x,T]) == u = '_$fromCoerceable_$ => canCoerce(source,T) u is [ =0,:c] => (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') -- see if the target var is the polynomial vars varsFun := getFunctionFromDomain('variables,source,[source]) vars := SPADCALL(u,varsFun) not member(x,vars) => (u' := coerceInt(objNewWrap(u,source),T)) or coercionFailure() [[0,:objValUnwrap(u')]] -- do a univariate to transform u to a UP(x,P S) and then coerce again UPP := ['UnivariatePolynomial,x,source] univariate := getFunctionFromDomain('univariate, source,[source,$Symbol]) upU := SPADCALL(u,x,univariate) -- we may assume this has type UPP (u' := coerceInt(objNewWrap(upU,UPP),target)) or coercionFailure() objValUnwrap(u') --% Fraction Qf2PF(u,source is [.,D],target) == u = '_$fromCoerceable_$ => canCoerce(D,target) [num,:den] := u num':= coerceInt(objNewWrap(num,D),target) or coercionFailure() num' := objValUnwrap num' den':= coerceInt(objNewWrap(den,D),target) or coercionFailure() den' := objValUnwrap den' equalZero(den', target) => throwKeyedMsg("S2IA0001",NIL) SPADCALL(num',den', getFunctionFromDomain("/",target,[target,target])) Qf2F(u,source is [.,D,:.],target) == D = $Integer => u = '_$fromCoerceable_$ => true Rn2F(u,source,target) u = '_$fromCoerceable_$ => canCoerce(D,target) [num,:den] := u [.,:num']:= coerceInt(objNewWrap(num,D),target) or coercionFailure() [.,:den']:= coerceInt(objNewWrap(den,D),target) or coercionFailure() (unwrap num') * QUOTIENT(1.0, unwrap den') Rn2F(rnum, source, target) == float QUOTIENT(first rnum, rest rnum) -- next function is needed in RN algebra code --Rn2F([a,:b],source,target) == -- al:=if LINTP a then QLENGTHCODE a else 4 -- bl:=if LINTP b then QLENGTHCODE b else 4 -- MAX(al,bl) < 36 => FLOAT a / FLOAT b -- sl:=0 -- if al>32 then -- sl:=35*(al-32)/4 -- a:=a/2**sl -- if bl>32 then -- sbl:=35*(bl-32)/4 -- b:=b/2**sbl -- sl:=sl-sbl -- ans:=FLOAT a /FLOAT b -- sl=0 => ans -- ans*2**sl Qf2domain(u,source is [.,D],target) == -- tests whether it is an element of the underlying domain useUnder := (ut := underDomainOf target) and canCoerce(source,ut) u = '_$fromCoerceable_$ => useUnder not (containsPolynomial(D) and containsPolynomial(target)) and useUnder => coercionFailure() -- let other mechanism handle it [num, :den] := u (num' := coerceInt(objNewWrap(num,D),target)) or coercionFailure() num' := objValUnwrap(num') equalOne(den,D) => num' (target is [.,[=$QuotientField,T]]) or (target is [.,.,[=$QuotientField,T]]) => (den' := coerceInt(objNewWrap(den,D),T)) or coercionFailure() den' := [domainOne(T),:objValUnwrap(den')] timesfunc:= getFunctionFromDomain('_*,target, [[$QuotientField,T],target]) SPADCALL(den',num',timesfunc) coercionFailure() Qf2EF(u,[.,S],target) == u = '_$fromCoerceable_$ => canCoerce(S,target) [num,:den] := u (num' := coerceInt(objNewWrap(num,S),target)) or coercionFailure() (den' := coerceInt(objNewWrap(den,S),target)) or coercionFailure() divfun := getFunctionFromDomain("/",target,[target,target]) SPADCALL(objValUnwrap(num'),objValUnwrap(den'),divfun) Qf2Qf(u0,[.,S],target is [.,T]) == u0 = '_$fromCoerceable_$ => S = ['Polynomial, [$QuotientField, $Integer]] and T = '(Polynomial (Integer)) => true canCoerce(S,T) [a,:b] := u0 S = ['Polynomial, [$QuotientField, $Integer]] and T = '(Polynomial (Integer)) => (a' := coerceInt(objNewWrap(a,S),target)) => (b' := coerceInt(objNewWrap(b,S),target)) => divfunc:= getFunctionFromDomain('_/,target,[target,target]) SPADCALL(objValUnwrap(a'),objValUnwrap(b'),divfunc) coercionFailure() coercionFailure() (a' := coerceInt(objNewWrap(a,S),T)) => (b' := coerceInt(objNewWrap(b,S),T)) => [objValUnwrap(a'),:objValUnwrap(b')] coercionFailure() coercionFailure() -- partOf(x,i) == -- vector? x => x.i -- i=0 => first x -- i=1 => rest x -- systemError '"partOf" --% RectangularMatrix Rm2L(x,[.,.,.,R],target) == M2L(x,['Matrix,R],target) Rm2M(x,[.,.,.,R],target is [.,S]) == M2M(x,[nil,R],target) Rm2Sm(x,[.,n,m,S],[.,p,R]) == x = '_$fromCoerceable_$ => n=m and m=p and canCoerce(S,R) n=m and m=p => M2M(x,[nil,S],[nil,R]) coercionFailure() Rm2V(x,[.,.,.,R],target) == M2V(x,['Matrix,R],target) --% Script Scr2Scr(u, source is [.,S], target is [.,T]) == u = '_$fromCoerceable_$ => canCoerce(S,T) null (v := coerceInt(objNewWrap(rest u,S),T)) => coercionFailure() [first u, :objValUnwrap(v)] --% SparseUnivariatePolynomialnimial SUP2Up(u,source is [.,S],target is [.,x,T]) == u = '_$fromCoerceable_$ => canCoerce(source,T) or canCoerce(S,T) null u => u S = T => u -- try to go underneath first null (u' := coerceInt(objNewWrap(u,source),T)) => -- must be careful in case any of the coeffs come back 0 u' := NIL zero := getConstantFromDomain($Zero,T) for [e,:c] in u repeat c' := objValUnwrap (coerceInt(objNewWrap(c,S),T) or coercionFailure()) c' = zero => 'iterate u' := [[e,:c'],:u'] reverse! u' [[0,:objValUnwrap u']] --% SquareMatrix Sm2L(x,[.,.,R],target) == M2L(x,['Matrix,R],target) Sm2M(x,[.,n,R],target is [.,S]) == M2M(x,[nil,R],target) Sm2PolyType(u,source is [sm,n,S], target is [pol,vl,T]) == -- only really handles cases like: -- SM[2] P I -> P[x,y] SM[2] P I -- works for UP, MP, DMP and NDMP u = '_$fromCoerceable_$ => canCoerce(source,T) -- first want to check case S is Polynomial S is ['Polynomial,S'] => -- check to see if variable occurs in any of the terms if atom vl then vl' := [vl] else vl' := vl novars := true for i in 0..(n-1) while novars repeat for j in 0..(n-1) while novars repeat varsUsed := varsInPoly u.i.j or/[member(x,varsUsed) for x in vl'] => novars := nil novars => coercionFailure() source' := [sm,n,[pol,vl,S]] null (u' := coerceInt(objNewWrap(u,source),source')) => coercionFailure() null (u' := coerceInt(u',target)) => coercionFailure() objValUnwrap(u') -- let other cases be handled by standard machinery coercionFailure() Sm2Rm(x,[.,n,R],[.,p,q,S]) == x = '_$fromCoerceable_$ => p=q and p=n and canCoerce(R,S) p=q and p=n => M2M(x,[nil,R],[nil,S]) coercionFailure() Sm2V(x,[.,.,R],target) == M2V(x,['Matrix,R],target) --% Symbol Sy2OV(u,source,target is [.,vl]) == u = '_$fromCoerceable_$ => nil position1(u,vl) Sy2Dmp(u,source,target is [dmp,vl,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) len:= #vl -1 ~= (n:= position(u,vl)) => u:= wrap LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],:1] objValUnwrap(coerceInt(objNew(u,[dmp,vl,$Integer]),target)) (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[Zeros len,:objValUnwrap u]] Sy2Mp(u,source,target is [mp,vl,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) (n:= position1(u,vl)) ~= 0 => [1,n,[1,0,:domainOne(S)]] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [0,:objValUnwrap(u)] Sy2NDmp(u,source,target is [ndmp,vl,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) len:= #vl -1 ~= (n:= position(u,vl)) => u:= wrap LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1],:1] objValUnwrap(coerceInt(objNew(u,[ndmp,vl,$Integer]),target)) (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[Zeros len,:objValUnwrap(u)]] Sy2P(u,source,target is [poly,S]) == u = '_$fromCoerceable_$ => true -- first try to get it into an underdomain if (S ~= $Integer) then u' := coerceInt(objNewWrap(u,source),S) if u' then return [0,:objValUnwrap(u')] -- if that failed, return it as a polynomial variable [1,u,[1,0,:domainOne(S)]] Sy2Up(u,source,target is [up,x,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) u=x => [[1,:domainOne(S)]] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[0,:objValUnwrap u]] Sy2Var(u,source,target is [.,x]) == u = '_$fromCoerceable_$ => NIL u=x => u coercionFailure() --% Univariate Polynomial Up2Dmp(u,source is ['UnivariatePolynomial,var,S], target is ['DistributedMultivariatePolynomial,vl,T]) == -- var must be a member of vl, or u is a constant u = '_$fromCoerceable_$ => member(var,vl) and canCoerce(S,target) null u => domainZero(target) u is [[e,:c]] and e=0 => z:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(z) coercionFailure() member(var,vl) => x:= domainZero(target) one:= domainOne(T) plusfunc:= getFunctionFromDomain('_+,target,[target,target]) multfunc:= getFunctionFromDomain('_*,target,[target,target]) n:= #vl ; p:= POSN1(var,vl) l1:= not (p=0) and [0 for m in 1..p] l2:= not (p=n-1) and [0 for m in p..n-2] for [e,:c] in u until not z repeat z:= coerceInt(objNewWrap(c,S),target) => y:= SPADCALL(objValUnwrap(z), [[LIST2VEC [:l1,e,:l2],:one]],multfunc) x:= SPADCALL(x,y,plusfunc) z => x coercionFailure() coercionFailure() Up2Expr(u,source is [up,var,S], target is [Expr,T]) == u = '_$fromCoerceable_$ => canCoerce(S, target) null u => domainZero(target) u is [[e,:c]] and e=0 => (z := coerceInt(objNewWrap(c, S), target)) => objValUnwrap(z) coercionFailure() sym := objValUnwrap coerceInt(objNewWrap(var, $Symbol), target) plus := getFunctionFromDomain("+", target, [target, target]) mult := getFunctionFromDomain("*", target, [target, target]) expn := getFunctionFromDomain("**", target, [target, $Integer]) -- coerce via Horner's rule [e1, :c1] := first u if not (S = target) then not (c1 := coerceInt(objNewWrap(c1, S), target)) => coercionFailure() c1 := objValUnwrap(c1) for [e2, :c2] in rest u repeat coef := e1 - e2 = 1 => sym SPADCALL(sym, e1-e2, expn) if not (S = target) then not (c2 := coerceInt(objNewWrap(c2, S), target)) => coercionFailure() c2 := objValUnwrap(c2) coef := SPADCALL(SPADCALL(c1, coef, mult), c2, plus) e1 := e2 c1 := coef e1 = 0 => c1 e1 = 1 => SPADCALL(sym, c1, mult) SPADCALL(SPADCALL(sym, e1, expn), c1, mult) Up2FR(u,S is [.,x,R],target is [.,T]) == u = '_$fromCoerceable_$ => S ~= T => nil member(R,'((Integer) (Fraction (Integer)))) => true nil S ~= T => coercionFailure() package := R = $Integer => ['UnivariateFactorize,S] R = $RationalNumber => package := ['RationalFactorize,S] coercionFailure() factor := getFunctionFromDomain('factor,package,[S]) SPADCALL(u,factor) Up2Mp(u,source is [.,x,S], target is [.,vl,T]) == u = '_$fromCoerceable_$ => member(x,vl) => canCoerce(S,T) canCoerce(source,T) null u => domainZero(target) null(rest(u)) and (first(u) is [e,:c]) and e=0 => x:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(x) coercionFailure() null member(x,vl) => (x := coerceInt(objNewWrap(u,source),T)) or coercionFailure() [0,:objValUnwrap(x)] plus := getFunctionFromDomain('_+,target,[target,target]) monom := getFunctionFromDomain('monomial,target, [target,['OrderedVariableList,vl],$NonNegativeInteger]) sum := domainZero(target) pos := position1(x,vl) for [e,:c] in u repeat (p := coerceInt(objNewWrap(c,S),target)) or coercionFailure() mon := SPADCALL(objValUnwrap(p),pos,e,monom) sum := SPADCALL(sum,mon,plus) sum Up2P(u,source is [.,var,S],target is [.,T]) == u = '_$fromCoerceable_$ => canCoerce(S,target) null u => domainZero(target) u is [[e,:c]] and e=0 => x:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(x) coercionFailure() pol:= domainZero(target) one:= domainOne(T) plusfunc := getFunctionFromDomain("+",target,[target,target]) multfunc := getFunctionFromDomain("*",target,[target,target]) for [e,:c] in u until not x repeat x:= coerceInt(objNewWrap(c,S),target) => term:= SPADCALL([1,var,[e,0,:one]],objValUnwrap(x),multfunc) pol:= SPADCALL(pol,term,plusfunc) coercionFailure() x => pol coercionFailure() Up2SUP(u,source is [.,x,S],target is [.,T]) == u = '_$fromCoerceable_$ => canCoerce(source,T) or canCoerce(S,T) null u => u S = T => u -- try to go underneath first null (u' := coerceInt(objNewWrap(u,source),T)) => u' := NIL zero := getConstantFromDomain($Zero,T) for [e,:c] in u repeat c' := objValUnwrap (coerceInt(objNewWrap(c,S),T) or coercionFailure()) c' = zero => 'iterate u' := [[e,:c'],:u'] reverse! u' [[0,:objValUnwrap u']] Up2Up(u,source is [.,v1,S], target is [.,v2,T]) == -- if v1 = v2 then this is handled by coerceIntByMap -- this only handles case where poly is a constant u = '_$fromCoerceable_$ => v1=v2 => canCoerce(S,T) canCoerce(source,T) null u => u u is [[e,:c]] and e=0 => x:= coerceInt(objNewWrap(c,S),target) => objValUnwrap(x) coercionFailure() coercionFailure() insertAlist(a,b,l) == null l => [[a,:b]] a = l.0.0 => (first(l).rest := b;l) _?ORDER(l.0.0,a) => [[a,:b],:l] (fn(a,b,l);l) where fn(a,b,l) == null rest l => l.rest := [[a,:b]] a = l.1.0 => l.1.rest := b _?ORDER(l.1.0,a) => l.rest := [[a,:b],:rest l] fn(a,b,rest l) --% Union Un2E(x,source,target) == ['Union,:branches] := source x = '_$fromCoerceable_$ => and/[canCoerce(t, target) for t in branches | not string? t] coerceUn2E(x,source) --% Variable Var2OV(u,source,target is [.,vl]) == sym := second source u = '_$fromCoerceable_$ => member(sym,vl) member(sym,vl) => position1(sym,vl) coercionFailure() Var2Dmp(u,source,target is [dmp,vl,S]) == sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len := #vl -1 ~= (n:= position(sym,vl)) => LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1], :getConstantFromDomain($One,S)] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[Zeros len,:objValUnwrap u]] Var2Gdmp(u,source,target is [dmp,vl,S]) == sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len := #vl -1 ~= (n:= position(sym,vl)) => LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1], :getConstantFromDomain($One,S)] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[Zeros len,:objValUnwrap u]] Var2Mp(u,source,target is [mp,vl,S]) == sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) (n:= position1(u,vl)) ~= 0 => [1,n,[1,0,:getConstantFromDomain($One,S)]] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [0,:objValUnwrap u] Var2NDmp(u,source,target is [ndmp,vl,S]) == sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len:= #vl -1 ~= (n:= position(u,vl)) => LIST [LIST2VEC [(n=i => 1; 0) for i in 0..len-1], :getConstantFromDomain($One,S)] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[Zeros len,:objValUnwrap(u)]] Var2P(u,source,target is [poly,S]) == sym := second source u = '_$fromCoerceable_$ => true -- first try to get it into an underdomain if (S ~= $Integer) then u' := coerceInt(objNewWrap(u,source),S) if u' then return [0,:objValUnwrap(u')] -- if that failed, return it as a polynomial variable [1,sym,[1,0,:getConstantFromDomain($One,S)]] Var2QF(u,source,target is [qf,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) S = $Integer => coercionFailure() sym := second source (u' := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [objValUnwrap u',:getConstantFromDomain($One,S)] Var2FS(u,source,target is [fs,S]) == u = '_$fromCoerceable_$ => true (v := coerceInt(objNewWrap(u,source),['Polynomial,S])) or coercionFailure() (v := coerceInt(v,target)) or coercionFailure() objValUnwrap v Var2Up(u,source,target is [up,x,S]) == sym := second source u = '_$fromCoerceable_$ => (sym = x) or canCoerce(source,S) x=sym => [[1,:getConstantFromDomain($One,S)]] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[0,:objValUnwrap u]] Var2SUP(u,source,target is [sup,S]) == sym := second source u = '_$fromCoerceable_$ => (sym = "?") or canCoerce(source,S) sym = "?" => [[1,:getConstantFromDomain($One,S)]] (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [[0,:objValUnwrap u]] Var2UpS(u,source,target is [ups,x,S]) == sym := second source u = '_$fromCoerceable_$ => (sym = x) or canCoerce(source,S) mid := ['UnivariatePolynomial,x,S] x = sym => u := Var2Up(u,source,mid) (u := coerceInt(objNewWrap(u,mid),target)) or coercionFailure() objValUnwrap u (u := coerceInt(objNewWrap(u,source),S)) or coercionFailure() (u := coerceInt(u,target)) or coercionFailure() objValUnwrap u Var2OtherPS(u,source,target is [.,x,S]) == sym := second source mid := ['UnivariatePowerSeries,x,S] u = '_$fromCoerceable_$ => (sym = x) or (canCoerce(source,mid) and canCoerce(mid,target)) u := Var2UpS(u,source,mid) (u := coerceInt(objNewWrap(u,mid),target)) or coercionFailure() objValUnwrap u --% Vector V2M(u,[.,D],[.,R]) == u = '_$fromCoerceable_$ => D is ['Vector,:.] => nil -- don't have data canCoerce(D,R) -- first see if we are coercing a vector of vectors D is ['Vector,E] and isRectangularVector(u,maxIndex u,maxIndex u.0) => LIST2VEC [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(x.j,E),R)) for j in 0..maxIndex(x:=u.i)] for i in 0..maxIndex u] -- if not, try making it into a 1 by n matrix coercionFailure() --LIST2VEC [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(u.i,D),R)) -- for i in 0..maxIndex(u)]] V2Rm(u,[.,D],[.,n,m,R]) == u = '_$fromCoerceable_$ => nil D is [.,E,:.] and isRectangularVector(u,n-1,m-1) => LIST2VEC [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(x.j,E),R)) for j in 0..maxIndex(x:=u.i)] for i in 0..maxIndex u] coercionFailure() V2Sm(u,[.,D],[.,n,R]) == u = '_$fromCoerceable_$ => nil D is [.,E,:.] and isRectangularVector(u,n-1,n-1) => LIST2VEC [LIST2VEC [objValUnwrap(coerceInt(objNewWrap(x.j,E),R)) for j in 0..maxIndex(x:=u.i)] for i in 0..maxIndex u] coercionFailure() isRectangularVector(x,p,q) == maxIndex x = p => and/[q=maxIndex x.i for i in 0..p] -- Polynomial and Expression to Univariate series types P2Uts(u, source, target) == P2Us(u,source, target, 'taylor) P2Uls(u, source, target) == P2Us(u,source, target, 'laurent) P2Upxs(u, source, target) == P2Us(u,source, target, 'puiseux) P2Us(u, source is [.,S], target is [.,T,var,cen], type) == u = '_$fromCoerceable_$ => -- might be able to say yes canCoerce(S,T) T isnt ['Expression, :.] => coercionFailure() if S ~= $Float then S := $Integer obj := objNewWrap(u, source) E := ['Expression, S] newU := coerceInt(obj, E) null newU => coercionFailure() EQtype := ['Equation, E] eqfun := getFunctionFromDomain('_=, EQtype, [E,E]) varE := coerceInt(objNewWrap(var, $Symbol), E) null varE => coercionFailure() cenE := coerceInt(objNewWrap(cen, T), E) null cenE => coercionFailure() eq := SPADCALL(objValUnwrap(varE), objValUnwrap(cenE), eqfun) package := ['ExpressionToUnivariatePowerSeries, S, E] func := getFunctionFromDomain(type, package, [E, EQtype]) newObj := SPADCALL(objValUnwrap(newU), eq, func) newType := first newObj newVal := rest newObj newType = target => newVal finalObj := coerceInt(objNewWrap(newVal, newType), target) null finalObj => coercionFailure() objValUnwrap finalObj --% General Coercion Commutation Functions -- general commutation functions are called with 5 values -- u object of type source -- source type of u -- S underdomain of source -- target coercion target type -- T underdomain of T -- Because of checking, can always assume S and T have underdomains. --% Complex commuteComplex(u,source,S,target,T) == u = '_$fromCoerceable_$ => canCoerce(S,target) and canCoerce(T,target) [real,:imag] := u (real := coerceInt(objNewWrap(real,S),target)) or coercionFailure() (imag := coerceInt(objNewWrap(imag,S),target)) or coercionFailure() T' := underDomainOf T i := [domainZero(T'), :domainOne(T')] (i := coerceInt(objNewWrap(i,T),target)) or coercionFailure() f := getFunctionFromDomain("*",target,[target,target]) i := SPADCALL(objValUnwrap i, objValUnwrap imag, f) f := getFunctionFromDomain("+",target,[target,target]) SPADCALL(objValUnwrap real,i,f) --% Quaternion commuteQuaternion(u,source,S,target,T) == u = '_$fromCoerceable_$ => canCoerce(S,target) and canCoerce(T,target) c := [objValUnwrap(coerceInt(objNewWrap(x,S),target) or coercionFailure()) for x in VEC2LIST u] q := '(Quaternion (Integer)) e := [[1,0,0,0],[0,1,0,0],[0,0,1,0],[0,0,0,1]] e := [(coerceInt(objNewWrap(LIST2VEC x,q),T) or coercionFailure()) for x in e] e :=[objValUnwrap(coerceInt(x,target) or coercionFailure()) for x in e] u' := domainZero(target) mult := getFunctionFromDomain("*",target,[target,target]) plus := getFunctionFromDomain("+",target,[target,target]) for x in c for y in e repeat u' := SPADCALL(u',SPADCALL(x,y,mult),plus) u' --% Fraction commuteFraction(u,source,S,target,T) == u = '_$fromCoerceable_$ => ofCategory(target,$Field) => canCoerce(S,target) canCoerce(S,T) and canCoerce(T,target) [n,:d] := u ofCategory(target,$Field) => -- see if denominator can go over to target (d' := coerceInt(objNewWrap(d,S),target)) or coercionFailure() -- if so, try to invert it inv := getFunctionFromDomain('inv,target,[target]) d' := SPADCALL(objValUnwrap d',inv) -- now coerce to target (n' := coerceInt(objNewWrap(n,S),target)) or coercionFailure() multfunc := getFunctionFromDomain("*",target,[target,target]) SPADCALL(d',objValUnwrap n',multfunc) -- see if denominator can go over to QF part of target (d' := coerceInt(objNewWrap(d,S),T)) or coercionFailure() -- if so, try to invert it inv := getFunctionFromDomain('inv,T,[T]) d' := SPADCALL(objValUnwrap d',inv) -- now coerce to target (d' := coerceInt(objNewWrap(d',T),target)) or coercionFailure() (n' := coerceInt(objNewWrap(n,S),target)) or coercionFailure() multfunc := getFunctionFromDomain("*",target,[target,target]) SPADCALL(objValUnwrap d',objValUnwrap n',multfunc) --% SquareMatrix commuteSquareMatrix(u,source,S,target,T) == u = '_$fromCoerceable_$ => canCoerce(S,target) and canCoerce(T,target) -- commuting matrices of matrices should be a no-op S is ['SquareMatrix,:.] => source=target => u coercionFailure() u' := domainZero(target) plusfunc := getFunctionFromDomain("+",target,[target,target]) multfunc := getFunctionFromDomain("*",target,[target,target]) zero := domainZero(S) [sm,n,:.] := source S' := [sm,n,$Integer] for i in 0..(n-1) repeat for j in 0..(n-1) repeat (e := u.i.j) = zero => 'iterate (e' := coerceInt(objNewWrap(e,S),target)) or coercionFailure() (Eij := coerceInt(objNewWrap(makeEijSquareMatrix(i,j,n),S'),T)) or coercionFailure() (Eij := coerceInt(Eij,target)) or coercionFailure() e' := SPADCALL(objValUnwrap(e'),objValUnwrap(Eij),multfunc) u' := SPADCALL(e',u',plusfunc) u' makeEijSquareMatrix(i, j, dim) == -- assume using 0 based scale, makes a dim by dim matrix with a -- 1 in the i,j position, zeros elsewhere LIST2VEC [LIST2VEC [((i=r) and (j=c) => 1; 0) for c in 0..(dim-1)] for r in 0..(dim-1)] --% Univariate Polynomial and Sparse Univariate Polynomial commuteUnivariatePolynomial(u,source,S,target,T) == commuteSparseUnivariatePolynomial(u,source,S,target,T) commuteSparseUnivariatePolynomial(u,source,S,target,T) == u = '_$fromCoerceable_$ => canCoerce(S,target) and canCoerce(T,target) u' := domainZero(target) null u => u' T' := underDomainOf T one := domainOne(T') monom := getFunctionFromDomain('monomial,T,[T',$NonNegativeInteger]) plus := getFunctionFromDomain("+",target,[target,target]) times := getFunctionFromDomain("*",target,[target,target]) for [e,:c] in u repeat (c := coerceInt(objNewWrap(c,S),target)) or coercionFailure() m := SPADCALL(one,e,monom) (m := coerceInt(objNewWrap(m,T),target)) or coercionFailure() c := objValUnwrap c m := objValUnwrap m u' := SPADCALL(u',SPADCALL(c,m,times),plus) u' --% Multivariate Polynomials commutePolynomial(u,source,S,target,T) == commuteMPolyCat(u,source,S,target,T) commuteMultivariatePolynomial(u,source,S,target,T) == commuteMPolyCat(u,source,S,target,T) commuteDistributedMultivariatePolynomial(u,source,S,target,T) == commuteMPolyCat(u,source,S,target,T) commuteNewDistributedMultivariatePolynomial(u,source,S,target,T) == commuteMPolyCat(u,source,S,target,T) commuteMPolyCat(u,source,S,target,T) == u = '_$fromCoerceable_$ => canCoerce(S,target) -- check constant case isconstfun := getFunctionFromDomain("ground?",source,[source]) SPADCALL(u,isconstfun) => constfun := getFunctionFromDomain("ground",source,[source]) c := SPADCALL(u,constfun) (u' := coerceInt(objNewWrap(c,S),target)) or coercionFailure() objValUnwrap(u') lmfun := getFunctionFromDomain('leadingMonomial,source,[source]) lm := SPADCALL(u,lmfun) -- has type source, is leading monom lcfun := getFunctionFromDomain('leadingCoefficient,source,[source]) lc := SPADCALL(lm,lcfun) -- has type S, is leading coef (lc' := coerceInt(objNewWrap(lc,S),target)) or coercionFailure() pmfun := getFunctionFromDomain('primitiveMonomials,source,[source]) lm := first SPADCALL(lm,pmfun) -- now we have removed the leading coef (lm' := coerceInt(objNewWrap(lm,source),T)) or coercionFailure() (lm' := coerceInt(lm',target)) or coercionFailure() rdfun := getFunctionFromDomain('reductum,source,[source]) rd := SPADCALL(u,rdfun) -- has type source, is reductum (rd' := coerceInt(objNewWrap(rd,source),target)) or coercionFailure() lc' := objValUnwrap lc' lm' := objValUnwrap lm' rd' := objValUnwrap rd' plusfun := getFunctionFromDomain("+",target,[target,target]) multfun := getFunctionFromDomain("*",target,[target,target]) SPADCALL(SPADCALL(lc',lm',multfun),rd',plusfun) ------------------------------------------------------------------------ -- Format for alist member is: domain coercionType function -- here coercionType can be one of 'total, 'partial or 'indeterm -- (indeterminant - cannot tell in a simple way). -- -- In terms of canCoerceFrom, 'total implies true, 'partial implies -- false (just cannot tell without actual data) and 'indeterm means -- to call the function with the data = "$fromCoerceable$" for a -- response of true or false. ------------------------------------------------------------------------ -- There are no entries here for RationalNumber or RationalFunction. -- These should have been changed to QF I and QF P, respectively, by -- a function like deconstructTower. RSS 8-1-85 ------------------------------------------------------------------------ SETANDFILEQ($CoerceTable, '( _ (Complex . ( _ (Expression indeterm Complex2Expr) _ (Factored indeterm Complex2FR) _ (Integer partial Complex2underDomain) _ (PrimeField partial Complex2underDomain) _ ))_ (DirectProduct . ( _ (DirectProduct partial DP2DP) _ )) _ (DistributedMultivariatePolynomial . ( _ (DistributedMultivariatePolynomial indeterm Dmp2Dmp) _ (Expression indeterm Dmp2Expr) _ (Factored indeterm Mp2FR) _ (HomogeneousDistributedMultivariatePolynomial indeterm Dmp2NDmp) _ (MultivariatePolynomial indeterm Dmp2Mp) _ (Polynomial indeterm Dmp2P) _ (UnivariatePolynomial indeterm Dmp2Up) _ ))_ (Expression . ( (Complex partial Expr2Complex) _ (DistributedMultivariatePolynomial indeterm Expr2Dmp) _ (HomogeneousDistributedMultivariatePolynomial indeterm Expr2Dmp) _ (MultivariatePolynomial indeterm Expr2Mp) _ (UnivariateLaurentSeries indeterm P2Uls) _ (UnivariatePolynomial indeterm Expr2Up) _ (UnivariatePuiseuxSeries indeterm P2Upxs) _ (UnivariateTaylorSeries indeterm P2Uts) _ )) _ (Kernel . ( _ (Kernel indeterm Ker2Ker) _ (Expression indeterm Ker2Expr) _ )) _ (Factored . ( _ (Factored indeterm Factored2Factored) _ ))_ (Fraction . ( _ (DistributedMultivariatePolynomial partial Qf2domain) _ (ElementaryFunction indeterm Qf2EF) _ (Expression indeterm Qf2EF) _ (Fraction indeterm Qf2Qf) _ (HomogeneousDistributedMultivariatePolynomial partial Qf2domain) _ (Integer partial Qf2domain) _ (MultivariatePolynomial partial Qf2domain) _ (Polynomial partial Qf2domain) _ (PrimeField indeterm Qf2PF) _ (UnivariateLaurentSeries indeterm P2Uls) _ (UnivariatePolynomial partial Qf2domain) _ (UnivariatePuiseuxSeries indeterm P2Upxs) _ (UnivariateTaylorSeries indeterm P2Uts) _ ))_ (Int . ( _ (Expression total ncI2E) _ (Integer total ncI2I) _ ))_ (Baby . ( _ (Expression total ncI2E) _ (Integer total ncI2I) _ ))_ (Integer . ( _ (Baby total I2ncI) _ (EvenInteger partial I2EI) _ (Int total I2ncI) _ (NonNegativeInteger partial I2NNI) _ (OddInteger partial I2OI) _ (PositiveInteger partial I2PI) _ ))_ (List . ( _ (DirectProduct indeterm L2DP) _ (Matrix partial L2M) _ (Record partial L2Record) _ (RectangularMatrix partial L2Rm) _ (Set indeterm L2Set) _ (SquareMatrix partial L2Sm) _ (Stream indeterm Agg2Agg) _ (Tuple indeterm L2Tuple) _ (Vector indeterm L2V) _ ))_ )) SETANDFILEQ($CoerceTable,append!($CoerceTable,'( _ (Matrix . ( _ (List indeterm M2L) _ (RectangularMatrix partial M2Rm) _ (SquareMatrix partial M2Sm) _ (Vector indeterm M2L) _ ))_ (MultivariatePolynomial . ( _ (DistributedMultivariatePolynomial indeterm Mp2Dmp) _ (Expression indeterm Mp2Expr) _ (Factored indeterm Mp2FR) _ (HomogeneousDistributedMultivariatePolynomial indeterm domain2NDmp) _ (MultivariatePolynomial indeterm Mp2Mp) _ (Polynomial indeterm Mp2P) _ (UnivariatePolynomial indeterm Mp2Up) _ ))_ (HomogeneousDirectProduct . ( _ (HomogeneousDirectProduct indeterm DP2DP) _ ))_ (HomogeneousDistributedMultivariatePolynomial . ( _ (Complex indeterm NDmp2domain) _ (DistributedMultivariatePolynomial indeterm NDmp2domain) _ (Expression indeterm Dmp2Expr) _ (Factored indeterm Mp2FR) _ (Fraction indeterm NDmp2domain) _ (HomogeneousDistributedMultivariatePolynomial indeterm NDmp2NDmp) _ (MultivariatePolynomial indeterm NDmp2domain) _ (Polynomial indeterm NDmp2domain) _ (Quaternion indeterm NDmp2domain) _ (UnivariatePolynomial indeterm NDmp2domain) _ ))_ (OrderedVariableList . ( _ (DistributedMultivariatePolynomial indeterm OV2poly) _ (HomogeneousDistributedMultivariatePolynomial indeterm OV2poly) _ (MultivariatePolynomial indeterm OV2poly) _ (OrderedVariableList indeterm OV2OV) _ (Polynomial total OV2P) _ (Symbol total OV2Sy) _ (UnivariatePolynomial indeterm OV2poly) _ ))_ (Polynomial . ( _ (DistributedMultivariatePolynomial indeterm P2Dmp) _ (Expression indeterm P2Expr) _ (Factored indeterm P2FR) _ (HomogeneousDistributedMultivariatePolynomial partial domain2NDmp) _ (MultivariatePolynomial indeterm P2Mp) _ (UnivariateLaurentSeries indeterm P2Uls) _ (UnivariatePolynomial indeterm P2Up) _ (UnivariatePuiseuxSeries indeterm P2Upxs) _ (UnivariateTaylorSeries indeterm P2Uts) _ ))_ (Set . ( _ (List indeterm Set2L) _ (Vector indeterm Agg2L2Agg) _ ))_ (RectangularMatrix . ( _ (List indeterm Rm2L) _ (Matrix indeterm Rm2M) _ (SquareMatrix indeterm Rm2Sm) _ (Vector indeterm Rm2V) _ ))_ (SparseUnivariatePolynomial . ( _ (UnivariatePolynomial indeterm SUP2Up) _ ))_ (SquareMatrix . ( -- ones for polys needed for M[2] P I -> P[x,y] M[2] P I, say (DistributedMultivariatePolynomial partial Sm2PolyType) _ (HomogeneousDistributedMultivariatePolynomial partial Sm2PolyType) _ (List indeterm Sm2L) _ (Matrix indeterm Sm2M) _ (MultivariatePolynomial partial Sm2PolyType) _ (RectangularMatrix indeterm Sm2Rm) _ (UnivariatePolynomial indeterm Sm2PolyType) _ (Vector indeterm Sm2V) _ ) ) _ (Symbol . ( _ (DistributedMultivariatePolynomial indeterm Sy2Dmp) _ (HomogeneousDistributedMultivariatePolynomial indeterm Sy2NDmp) _ (MultivariatePolynomial indeterm Sy2Mp) _ (OrderedVariableList partial Sy2OV) _ (Polynomial total Sy2P) _ (UnivariatePolynomial indeterm Sy2Up) _ (Variable partial Sy2Var) _ ) ) _ (UnivariatePolynomial . ( _ (DistributedMultivariatePolynomial indeterm Up2Dmp) _ (Expression indeterm Up2Expr) _ (Factored indeterm Up2FR) _ (HomogeneousDistributedMultivariatePolynomial indeterm domain2NDmp) _ (MultivariatePolynomial indeterm Up2Mp) _ (Polynomial indeterm Up2P) _ (SparseUnivariatePolynomial indeterm Up2SUP) _ (UnivariatePolynomial indeterm Up2Up) _ ) ) _ (Variable . ( _ (AlgebraicFunction total Var2FS) _ (ContinuedFractionPowerSeries indeterm Var2OtherPS) _ (DistributedMultivariatePolynomial indeterm Var2Dmp) _ (ElementaryFunction total Var2FS) _ (Fraction indeterm Var2QF) _ (FunctionalExpression total Var2FS) _ (GeneralDistributedMultivariatePolynomial indeterm Var2Gdmp) _ (HomogeneousDistributedMultivariatePolynomial indeterm Var2NDmp) _ (LiouvillianFunction total Var2FS) _ (MultivariatePolynomial indeterm Var2Mp) _ (OrderedVariableList indeterm Var2OV) _ (Polynomial total Var2P) _ (SparseUnivariatePolynomial indeterm Var2SUP) _ (Symbol total Identity) _ (UnivariatePolynomial indeterm Var2Up) _ (UnivariatePowerSeries indeterm Var2UpS) _ ) ) _ (Vector . ( _ (DirectProduct indeterm V2DP) _ (List indeterm V2L) _ (Matrix indeterm V2M) _ (RectangularMatrix indeterm V2Rm) _ (Set indeterm Agg2L2Agg) _ (SquareMatrix indeterm V2Sm) _ (Stream indeterm Agg2Agg) _ ) ) _ ) ) ) -- this list is too long for the parser, so it has to be split into parts -- specifies the commute functions -- commute stands for partial commute function --SETANDFILEQ($CommuteTable, '( _ -- (DistributedMultivariatePolynomial . ( _ -- (DistributedMultivariatePolynomial commute commuteMultPol) _ -- (Complex commute commuteMultPol) _ -- (MultivariatePolynomial commute commuteMultPol) _ -- (NewDistributedMultivariatePolynomial commute commuteMultPol) _ -- (Polynomial commute commuteMultPol) _ -- (Quaternion commute commuteMultPol) _ -- (Fraction commute commuteMultPol) _ -- (SquareMatrix commute commuteMultPol) _ -- (UnivariatePolynomial commute commuteMultPol) _ -- )) _ -- (Complex . ( _ -- (DistributedMultivariatePolynomial commute commuteG2) _ -- (MultivariatePolynomial commute commuteG2) _ -- (NewDistributedMultivariatePolynomial commute commuteG2) _ -- (Polynomial commute commuteG1) _ -- (Fraction commute commuteG1) _ -- (SquareMatrix commute commuteG2) _ -- (UnivariatePolynomial commute commuteG2) _ -- )) _ -- (MultivariatePolynomial . ( _ -- (DistributedMultivariatePolynomial commute commuteMultPol) _ -- (Complex commute commuteMultPol) _ -- (MultivariatePolynomial commute commuteMultPol) _ -- (NewDistributedMultivariatePolynomial commute commuteMultPol) _ -- (Polynomial commute commuteMultPol) _ -- (Quaternion commute commuteMultPol) _ -- (Fraction commute commuteMultPol) _ -- (SquareMatrix commute commuteMultPol) _ -- (UnivariatePolynomial commute commuteMultPol) _ -- )) _ -- (Polynomial . ( _ -- (DistributedMultivariatePolynomial commute commuteMultPol) _ -- (Complex commute commuteMultPol) _ -- (MultivariatePolynomial commute commuteMultPol) _ -- (NewDistributedMultivariatePolynomial commute commuteMultPol) _ -- (Polynomial commute commuteMultPol) _ -- (Quaternion commute commuteMultPol) _ -- (Fraction commute commuteMultPol) _ -- (SquareMatrix commute commuteMultPol) _ -- (UnivariatePolynomial commute commuteMultPol) _ -- )) _ -- (Quaternion . ( _ -- (DistributedMultivariatePolynomial commute commuteQuat2) _ -- (MultivariatePolynomial commute commuteQuat2) _ -- (NewDistributedMultivariatePolynomial commute commuteQuat2) _ -- (Polynomial commute commuteQuat1) _ -- (SquareMatrix commute commuteQuat2) _ -- (UnivariatePolynomial commute commuteQuat2) _ -- )) _ -- (SquareMatrix . ( _ -- (DistributedMultivariatePolynomial commute commuteSm2) _ -- (Complex commute commuteSm1) _ -- (MultivariatePolynomial commute commuteSm2) _ -- (NewDistributedMultivariatePolynomial commute commuteSm2) _ -- (Polynomial commute commuteSm1) _ -- (Quaternion commute commuteSm1) _ -- (SparseUnivariatePolynomial commute commuteSm1) _ -- (UnivariatePolynomial commute commuteSm2) _ -- )) _ -- (UnivariatePolynomial . ( _ -- (DistributedMultivariatePolynomial commute commuteUp2) _ -- (Complex commute commuteUp1) _ -- (MultivariatePolynomial commute commuteUp2) _ -- (NewDistributedMultivariatePolynomial commute commuteUp2) _ -- (Polynomial commute commuteUp1) _ -- (Quaternion commute commuteUp1) _ -- (Fraction commute commuteUp1) _ -- (SparseUnivariatePolynomial commute commuteUp1) _ -- (SquareMatrix commute commuteUp2) _ -- (UnivariatePolynomial commute commuteUp2) _ -- )) _ -- )) SETANDFILEQ($CommuteTable, '( _ (Complex . ( _ (DistributedMultivariatePolynomial commute commuteG2) _ (MultivariatePolynomial commute commuteG2) _ (HomogeneousDistributedMultivariatePolynomial commute commuteG2) _ (Polynomial commute commuteG1) _ (Fraction commute commuteG1) _ (SquareMatrix commute commuteG2) _ (UnivariatePolynomial commute commuteG2) _ )) _ (Polynomial . ( _ (Complex commute commuteMultPol) _ (MultivariatePolynomial commute commuteMultPol) _ (HomogeneousDistributedMultivariatePolynomial commute commuteMultPol)_ (Polynomial commute commuteMultPol) _ (Quaternion commute commuteMultPol) _ (Fraction commute commuteMultPol) _ (SquareMatrix commute commuteMultPol) _ (UnivariatePolynomial commute commuteMultPol) _ )) _ (SquareMatrix . ( _ (DistributedMultivariatePolynomial commute commuteSm2) _ (Complex commute commuteSm1) _ (MultivariatePolynomial commute commuteSm2) _ (HomogeneousDistributedMultivariatePolynomial commute commuteSm2)_ (Polynomial commute commuteSm1) _ (Quaternion commute commuteSm1) _ (SparseUnivariatePolynomial commute commuteSm1) _ (UnivariatePolynomial commute commuteSm2) _ )) _ ))