promote cleanup

M2/Macaulay2/m2/classes.m2

@@ -9,7 +9,7 @@ ancestors  = T -> unique join({T}, while (T = parent T) =!= Thing list T, {Thing
 ancestors' = T -> unique join({T}, while (T = class  T) =!= Type  list T, {Type})
 
 -- TODO: make this TT toString X later?
-synonym = X -> if X.?synonym then X.synonym else "object of class " | toString X
+synonym = X -> X.synonym ?? "object of class " | toString X
 -- TODO: find a more permanent solution
 plurals = new MutableHashTable from {
     "body"       => "bodies",
@@ -22,7 +22,7 @@ pluralize = s -> demark_" " append(
     drop(ws := separate_" " s, -1),
     if  plurals#?(last ws)
     then plurals#(last ws) else last ws | "s")
-pluralsynonym = T -> if T.?synonym then pluralize T.synonym else "objects of class " | toString T
+pluralsynonym = T -> pluralize T.synonym ?? "objects of class " | toString T
 
 Time.synonym = "timing result"
 Boolean.synonym = "Boolean value"

M2/Macaulay2/m2/engine.m2

@@ -255,6 +255,7 @@ raw Number := x -> x_((class x).RawRing)
 raw InexactNumber := x -> x_((ring x).RawRing)
 Number _ RawRing := (n,R) -> rawFromNumber(R,n)
 RawRingElement _ RawRing := (x,R) -> rawPromote(R,x)
+raw Constant := raw @@ numeric
 
 RawRingElement == RawRingElement := (x,y) -> x === y
 

M2/Macaulay2/m2/enginering.m2

@@ -315,6 +315,20 @@ coefficientRing FractionField := F -> coefficientRing last F.baseRings
 
 -- freduce := (f) -> (numerator f)/(denominator f)
 
+isPromotable(FractionField,FractionField) := (F,G) -> lookup(promote,F,G) =!= null or (
+    R:=baseRing F; S:=baseRing G;
+    l:=lookup(promote,R,S);
+    l=!=null and (setupPromote(a->fraction(promote(numerator a,S),promote(denominator a,S)),F,G); true)
+    )
+
+lift(RingElement, RingElement) := opts -> (f, R) -> (
+    if (instance(class f,FractionField) and instance(R,FractionField) and (R1:=baseRing R; lookup(lift,baseRing class f,R1) =!= null)) then (
+	setupLift(a->fraction(lift(numerator a,R1),lift(denominator a,R1)),class f,R);
+	return lift(f,R,opts);
+	);
+    if opts.Verify then error ("cannot lift from "|toString class f|" to "|toString R)
+    )
+
 factoryAlmostGood = R -> (
     if instance(R,QuotientRing) then factoryAlmostGood ambient R
     else if instance(R,PolynomialRing) then factoryAlmostGood coefficientRing R
@@ -360,10 +374,6 @@ frac EngineRing := R -> if isField R then R else if R.?frac then R.frac else (
      if R.?indexSymbols then F.indexSymbols = applyValues(R.indexSymbols, r -> promote(r,F));
      if R.?indexStrings then F.indexStrings = applyValues(R.indexStrings, r -> promote(r,F));
      if R.?numallvars then F.numallvars=R.numallvars;
-     scan(R.baseRings, S -> if S.?frac and not isPromotable(S.frac,F) then (
-	     setupPromote(a->fraction(promote(numerator a,R),promote(denominator a,R)),S.frac,F);
-	     setupLift(a->fraction(lift(numerator a,S),lift(denominator a,S)),F,S.frac);
-	     ));
      F)
 
 -- methods for all ring elements
@@ -460,10 +470,10 @@ ZZ ? RingElement := (m,y) -> m_(class y) ? y
 
 RingElement ^ ZZ := RingElement => (x,i) -> new ring x from (raw x)^i
 
-toString RingElement := x -> toString expression x
-toExternalString RingElement := x -> toExternalFormat expression x
-net RingElement := x -> net expression x
-texMath RingElement := x -> texMath expression x
+toString         RingElement :=         toString @@ expression
+toExternalString RingElement := toExternalFormat @@ expression
+net              RingElement :=              net @@ expression
+texMath          RingElement :=          texMath @@ expression
 
 someTerms(RingElement,ZZ,ZZ) := RingElement => (f,i,n) -> new ring f from rawGetTerms(numgens ring f,raw f,i,n+i-1)
 

M2/Macaulay2/m2/matrix.m2

@@ -3,6 +3,24 @@
 
 needs "modules.m2"
 
+notsamering := (X,Y) -> (
+     if X === Y then error("expected ",pluralsynonym X, " for the same ring")
+     else error("expected ",synonym X," and ",synonym Y," for the same ring"))
+samering = (M,N) -> if ring M === ring N then (M,N) else notsamering(class M,class N)
+nottosamering := (X,Y) -> (
+     if X === Y then error("expected ",pluralsynonym X, " for compatible rings")
+     else error("expected ",synonym X," and ",synonym Y," for compatible rings"))
+tosamering = (M,N) -> (
+     R := ring M; S := ring N;
+     if R =!= S then (
+	 R' := if instance(R,InexactField) then ring R else R;
+	 S' := if instance(S,InexactField) then ring S else S;
+	 if isPromotable(R',S) then (promote(M,S),N)
+	 else if isPromotable(S',R) then (M,promote(N,R))
+	 else nottosamering(class M,class N)
+	 )
+     else (M,N))
+
 oops := R -> error (
      if degreeLength R === 1
      then "expected degree to be an integer or list of integers of length 1"
@@ -79,23 +97,15 @@ InfiniteNumber * Matrix := (r,m) -> (map(target m, source m, matrix(r*(entries m
 Matrix * InfiniteNumber := (m,r) -> r*m
 Number * Matrix :=
 RingElement * Matrix := (r,m) -> (
-    if ring r =!= ring m then try r = promote(r,ring m) else m = promote(m,ring r);
+    (r,m) = tosamering(r,m);
      map(target m, source m, reduce(target m, raw r * raw m)))
 Matrix * Number :=
 Matrix * RingElement := (m,r) -> (
-    if ring r =!= ring m then try r = promote(r,ring m) else m = promote(m,ring r);
+    (r,m) = tosamering(r,m);
      map(target m, source m, reduce(target m, raw m * raw r)))
 Matrix / Number      :=
 Matrix / RingElement := (m,r) -> m * (1/r)
 
-toSameRing = (m,n) -> (
-     if ring m =!= ring n then (
-	  try (promote(m,ring n) , n) else
-	  try (m , promote(n,ring m))
-	  else error "expected compatible rings"
-	  )
-     else (m,n))
-
 Matrix _ Sequence := RingElement => (m,ind) -> (
      if # ind === 2
      then promote(rawMatrixEntry(m.RawMatrix, ind#0, ind#1), ring m)
@@ -128,7 +138,7 @@ Matrix == ZZ := (m,i) -> if i === 0 then rawIsZero m.RawMatrix else m - i == 0
 
 Matrix + Matrix := Matrix => (
      (f,g) -> map(target f, source f, reduce(target f, raw f + raw g))
-     ) @@ toSameRing
+     ) @@ tosamering
 Matrix + RingElement :=
 Matrix + Number      := (f,r) -> if r == 0 then f else f + r*id_(target f)
 RingElement + Matrix :=
@@ -138,7 +148,7 @@ Number + Vector := RingElement + Vector := (r,v) -> vector(r + matrix v)
 
 Matrix - Matrix := Matrix => (
      (f,g) -> map(target f, source f, reduce(target f, raw f - raw g))
-     ) @@ toSameRing
+     ) @@ tosamering
 Matrix - RingElement :=
 Matrix - Number      := (f,r) -> if r == 0 then f else f - r*id_(target f)
 RingElement - Matrix :=
@@ -176,13 +186,7 @@ Matrix * Matrix := Matrix => (m,n) -> (
 	       q,
 	       Degree => degree m + if m.?RingMap then m.RingMap.cache.DegreeMap degree n else degree n))
      else (
-     	  R := ring m;
-	  S := ring target n;
-	  if R =!= S then ( -- use toSameRing?
-	       try m = promote(m,S) else
-	       try n = promote(n,R) else
-	       error "maps over incompatible rings";
-	       );
+	  (m,n) = tosamering(m,n);
 	  M = target m;
 	  P := source m;
 	  N = source n;
@@ -515,7 +519,7 @@ bothFree := (f,g) -> (
      or not isFreeModule source g or not isFreeModule target g then error "expected a homomorphism between free modules"
      else (f,g))
 
-diff(Matrix, Matrix) := Matrix => ( (f,g) -> map(ring f, rawMatrixDiff(f.RawMatrix, g.RawMatrix)) ) @@ bothFree @@ toSameRing 
+diff(Matrix, Matrix) := Matrix => ( (f,g) -> map(ring f, rawMatrixDiff(f.RawMatrix, g.RawMatrix)) ) @@ bothFree @@ tosamering
 diff(RingElement, RingElement) := RingElement => (f,g) -> (diff(matrix{{f}},matrix{{g}}))_(0,0)
 diff(Matrix, RingElement) := (m,f) -> diff(m,matrix{{f}})
 diff(RingElement, Matrix) := (f,m) -> diff(matrix{{f}},m)
@@ -525,7 +529,7 @@ diff(Vector, Vector) := (v,w) -> diff(matrix{v}, transpose matrix{w})
 diff(Matrix, Vector) := (m,w) -> diff(m,transpose matrix {w})
 diff(Vector, Matrix) := (v,m) -> diff(matrix {v}, m)
 
-contract(Matrix, Matrix) := Matrix => ( (f,g) -> map(ring f, rawMatrixContract(f.RawMatrix, g.RawMatrix)) ) @@ bothFree @@ toSameRing
+contract(Matrix, Matrix) := Matrix => ( (f,g) -> map(ring f, rawMatrixContract(f.RawMatrix, g.RawMatrix)) ) @@ bothFree @@ tosamering
 contract(RingElement, RingElement) := RingElement => (f,g) -> (contract(matrix{{f}},matrix{{g}}))_(0,0)
 contract(Matrix, RingElement) := (m,f) -> contract(m,matrix{{f}})
 contract(RingElement, Matrix) := (f,m) -> contract(matrix{{f}},m)
@@ -543,8 +547,8 @@ contract(Number, Matrix) := (f,m) -> contract(matrix{{f}},m)
 contract(Vector, Number) := (v,f) -> (contract(matrix{v},matrix{{f}}))_0
 contract(Number, Vector) := (f,v) -> contract(matrix{{f}},transpose matrix{v})
 
-diff'(Matrix, Matrix) := Matrix => ((m,n) -> ( flip(dual target n, target m) * diff(n,m) * flip(source m, dual source n) )) @@ bothFree @@ toSameRing
-contract'(Matrix, Matrix) := Matrix => ((m,n) -> ( flip(dual target n, target m) * contract(n,m) * flip(source m, dual source n) )) @@ bothFree @@ toSameRing
+diff'(Matrix, Matrix) := Matrix => ((m,n) -> ( flip(dual target n, target m) * diff(n,m) * flip(source m, dual source n) )) @@ bothFree @@ tosamering
+contract'(Matrix, Matrix) := Matrix => ((m,n) -> ( flip(dual target n, target m) * contract(n,m) * flip(source m, dual source n) )) @@ bothFree @@ tosamering
 
 jacobian = method()
 jacobian Matrix := Matrix => (m) -> diff(transpose vars ring m, m)

M2/Macaulay2/m2/matrix1.m2

@@ -6,17 +6,6 @@ needs "quotient.m2"
 
 -----------------------------------------------------------------------------
 
-notsamering := (X,Y) -> (
-     if X === Y then error("expected ",pluralsynonym X, " for the same ring")
-     else error("expected ",X.synonym," and ",Y.synonym," for the same ring"))
-nottosamering := (X,Y) -> (
-     if X === Y then error("expected ",pluralsynonym X, " for compatible rings")
-     else error("expected ",X.synonym," and ",Y.synonym," for compatible rings"))
-samering = (M,N) -> if ring M === ring N then (M,N) else notsamering(class M,class N)
-tosamering := (M,N) -> if ring M === ring N then (M,N) else (
-     z := try 0_(ring M) + 0_(ring N) else nottosamering(class M,class N);
-     (promote(M,ring z),promote(N,ring z)))
-
 module Ring := Module => (cacheValue symbol module)(R -> R^1)
 
 matrix(RingFamily,List) := Matrix => opts -> (R,m) -> matrix(default R, m, opts)
@@ -382,7 +371,7 @@ tensor(Matrix, Matrix) := Matrix => {} >> opts -> ((f, g) -> (
      map(target f ** target g, 
 	  source f ** source g, 
 	  map(R, f.RawMatrix ** g.RawMatrix),
-	  Degree => degree f + degree g))) @@ toSameRing
+	  Degree => degree f + degree g))) @@ tosamering
 
 Matrix ** Module := Matrix => (f, M) -> tensor(f, id_M)
 Module ** Matrix := Matrix => (M, f) -> tensor(id_M, f)

M2/Macaulay2/m2/reals.m2

@@ -103,7 +103,9 @@ promote(RawRingElement,RRi') := (x,R) -> new RRi from x
 promote(RawRingElement,CC') := (x,R) -> new CC from x
 promote(RawRingElement,Number) := (x,R) -> new R from x
 promote(RawRingElement,RingElement) := (x,R) -> new R from x
-promote(Number,InexactNumber) := (x,RR) -> promote(x,default RR)
+promote(QQ,RR) :=
+promote(ZZ,RR) := (x,RR) -> promote(x,default RR)
+promote(Number,CC) := (x,CC) -> promote(x,default CC)
 promote(ZZ,RR') := 
 promote(QQ,RR') := 
 promote(RR,RR') := (i,K) -> toRR(K.precision,i)
@@ -157,6 +159,10 @@ QQ _ ComplexField :=
 RR _ ComplexField :=
 CC _ ComplexField := (x,R) -> toCC(R.precision,x)
 
+lift1 := z -> if z === 0. then 0/1 else if isFinite z then (
+     (prec,sgn,expt,m,numbits) := partsRR z;
+     sgn * m / 2^(numbits - expt)
+     )
 lift(RR,QQ) := opts -> (r,QQ) -> (
      if r == 0 then return 0/1;
      r' := r;
@@ -172,7 +178,7 @@ lift(RR,QQ) := opts -> (r,QQ) -> (
 	  d := m_(1,0);
 	  q := n / d;
 	  if r === numeric(p,q) then return q;
-	  if r' == 0 or abs(n*d) > p2 then return promote(r,QQ);
+	  if r' == 0 or abs(n*d) > p2 then return lift1 r;
 	  r' = 1/r' ;
 	  ))
 lift(RR,ZZ) := opts -> (r,ZZ) -> (
@@ -183,10 +189,6 @@ lift(CC,QQ) := lift(CC,ZZ) := opts -> (z,R) -> (
      if imaginaryPart z == 0 then lift(realPart z, R) 
      else if opts.Verify then error "lift: complex number not real"
      )
-promote(RR,QQ) := (z,QQ) -> if z === 0. then 0/1 else if isFinite z then (
-     (prec,sgn,expt,m,numbits) := partsRR z;
-     sgn * m / 2^(numbits - expt)
-     ) else error "promote(RR,QQ): non-finite number encountered"
 liftable(RRi,QQ) := (z,RR) -> diameter(z) == 0
 liftable(RRi,ZZ) := (z,RR) -> diameter(z) == 0
 lift(RRi,QQ) := opts -> (r,QQ) -> (
@@ -475,6 +477,10 @@ BesselY = method()
 BesselY(ZZ, Number) := (n, x) -> BesselY'(n, numeric x)
 BesselY(Number, Number) := (n, x) -> BesselY'(numeric n, numeric x)
 
+ring ComplexField := R -> CC
+ring RealField := R -> RR
+ring RealIntervalField := R -> RRi
+
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "
 -- End:

M2/Macaulay2/m2/rings.m2

@@ -107,7 +107,8 @@ Number ^ Ring := lift
 promote = method(Dispatch => {Thing, Type, Type})
 Number _ Ring := promote
 
-isPromotable = (R,S) -> lookup(promote,R,S) =!= null
+isPromotable = method(TypicalValue => Boolean)
+isPromotable(Ring,Ring) := (R,S) -> lookup(promote,R,S) =!= null
 
 -- Local Variables:
 -- compile-command: "make -C $M2BUILDDIR/Macaulay2/m2 "

M2/Macaulay2/packages/DeterminantalRepresentations.m2

@@ -121,7 +121,7 @@ cubicBivariateDetRep RingElement := List => opts -> f -> (
     L := flatten apply(select(clean(eps, L0), isDoublyStochastic), M -> orthogonalFromOrthostochastic(M, opts));
     if k === QQ then (
         numDigits := ceiling(-log_10(eps));
-        (D1, D2) = (D1/round_numDigits, D2/round_numDigits);
+        (D1, D2) = (D1/round_numDigits/(x->x^QQ), D2/round_numDigits/(x->x^QQ));
         L = L/roundMatrix_numDigits;
     );
     (D1, D2) = (D1, D2)/diagonalMatrix_k;

M2/Macaulay2/packages/LatticePolytopes.m2

@@ -652,7 +652,7 @@ epsilonBounds(Polyhedron,ZZ):=(P,n)->(
 		intInP:=unique(intsect_pos);
 		if (#intInP==2) then(
 		    fVec:=intInP_0-intInP_1;
-		    fv:=gcd(apply(flatten entries(fVec),x->promote(x,QQ)));
+		    fv:=gcd(apply(flatten entries(fVec),x->lift(x,QQ)));
 		    Fvs=append(Fvs,fv);
 		    );
       	    	);

M2/Macaulay2/packages/Macaulay2Doc/changes.m2

@@ -2858,11 +2858,6 @@ document {
 			 "The quotient and remainder for two ring elements can now be obtained simultaneously,
 			 saving time.  See ", TO (quotientRemainder,RingElement,RingElement), "."
 			 },
-		    LI {
-			 "The binary representation of a real number is now available using ", TO (promote,RR,QQ), ".
-			 The code for ", TO (lift,RR,QQ), " has been tightened up so a rational number is provided
-			 that provides exactly the same real number when promoted."
-			 },
 		    LI {
 			 "The Emacs commands ", KBD "M-x M2", ", bound to ", KBD "F12", ", and ", TT "M2-send-to-program",
 			 ", bound to ", KBD "F11", ", have some new capability.

M2/Macaulay2/packages/Macaulay2Doc/functions/lift-doc.m2

@@ -118,19 +118,16 @@ document {
      lift(3.0,QQ)
      ///,
      PARA{
-	  "A continued fraction method is used to lift a real number to a rational number, whereas
-	  ", TO "promote", " uses the internal binary representation.",
+	  "A continued fraction method is used to lift a real number to a rational number."
 	  },
      EXAMPLE lines ///
      lift(123/2341.,QQ)
-     promote(123/2341.,QQ)
      factor oo
      ///,
      PARA { "For numbers and ring elements, an alternate syntax with ", TO "^", " is available,
 	  analogous to the use of ", TO "_", " for ", TO "promote", "." },
      EXAMPLE lines ///
      .0001^QQ
-     .0001_QQ
      ///,
      SeeAlso => { baseRings, promote },
      Subnodes => {

M2/Macaulay2/packages/Macaulay2Doc/functions/promote-doc.m2

@@ -19,7 +19,10 @@ promote(Vector,type of RingElement)
 *-
 
 undocumented {(promote,CC,CC_*),
-     (promote, Matrix, InexactNumber),(promote, Number, InexactNumber),
+     (promote, Matrix, InexactNumber),
+     (promote, QQ, RR),
+     (promote, ZZ, RR),
+     (promote, Number, CC),
      (promote, Ideal, Number),
      (promote, Ideal, RingElement),
      (promote, List, QQ, CC_*),
@@ -94,8 +97,7 @@ undocumented {(promote,CC,CC_*),
 
 document { 
      Key => {promote,
-	  (symbol _, RingElement, Ring),(symbol _,Number,Ring),
-	  (promote,RR,QQ)},
+	  (symbol _, RingElement, Ring),(symbol _,Number,Ring)},
      Headline => "promote to another ring",
      Usage => "promote(f,R)",
      Inputs => {
@@ -117,17 +119,6 @@ document {
      promote(f,S)
      G = map(S,R); G(f)
      ///,
-     PARA {
-	  "Promotion of real numbers to rational numbers is accomplished by using all of the bits of
-	  the internal representation."
-	  },
-     EXAMPLE lines ///
-     promote(101.,QQ)
-     promote(.101,QQ)
-     factor denominator oo
-     ooo + 0.
-     oo === .101
-     ///,
      PARA {
 	  "For promotion of ring elements, there is the following shorter notation."
 	  },

M2/Macaulay2/packages/Nauty.m2

@@ -247,7 +247,8 @@ generateRandomGraphs (ZZ, ZZ, ZZ) := List => opts -> (n, num, p) -> (
     rndSeed := if instance(opts.RandomSeed, ZZ) then " -S" | toString(opts.RandomSeed % 2^30) else "";
     callNauty("genrang -qg -P" | toString p | " "  | toString n | " " | toString num | rndSeed, {})
 )
-generateRandomGraphs (ZZ, ZZ, QQ) := List => opts -> (n, num, p) -> (
+generateRandomGraphs (ZZ, ZZ, QQ) :=
+generateRandomGraphs (ZZ, ZZ, RR) := List => opts -> (n, num, p) -> (
     if n < 1 then error("generateRandomGraphs: nauty does not like graphs with non-positive numbers of vertices.");
     if num < 1 then return {};
     if p <= 0 or p > 1 then error("generateRandomGraphs: Probability must be between 0 and 1.");
@@ -257,7 +258,6 @@ generateRandomGraphs (ZZ, ZZ, QQ) := List => opts -> (n, num, p) -> (
     q := round(100000000 * p) / 100000000;
     callNauty("genrang -qg -P" | toString q | " "  | toString n | " " | toString num | rndSeed, {})
 )
-generateRandomGraphs (ZZ, ZZ, RR) := List => opts -> (n, num, p) -> generateRandomGraphs(n, num, promote(p, QQ), opts)
 generateRandomGraphs (ZZ, ZZ) := List => opts -> (n, num) -> (
     if n < 1 then error("generateRandomGraphs: nauty does not like graphs with non-positive numbers of vertices.");
     if not instance(opts.RandomSeed, Nothing) and not instance(opts.RandomSeed, ZZ) then error("generateRandomGraphs: Option [RandomSeed] is not a valid type, i.e., ZZ or Nothing.");