From 15b2d796e5f5fb1fcbdd63aebf8f4e2acb4704f3 Mon Sep 17 00:00:00 2001
From: stepan <stepan.sindelar@oracle.com>
Date: Wed, 5 Apr 2017 15:11:22 +0200
Subject: [PATCH] FastR Grid: implement L_pretty
---
.../fastrGrid/FastRGridExternalLookup.java | 2 +
.../truffle/r/library/fastrGrid/LPretty.java | 98 +++++++++++
.../truffle/r/nodes/builtin/base/Pretty.java | 145 +--------------
.../truffle/r/runtime/PrettyIntevals.java | 166 ++++++++++++++++++
mx.fastr/copyrights/overrides | 2 +
5 files changed, 272 insertions(+), 141 deletions(-)
create mode 100644 com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LPretty.java
create mode 100644 com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/PrettyIntevals.java
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/FastRGridExternalLookup.java b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/FastRGridExternalLookup.java
index 1292153015..daea6bc681 100644
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/FastRGridExternalLookup.java
+++ b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/FastRGridExternalLookup.java
@@ -89,6 +89,8 @@ public final class FastRGridExternalLookup {
return LConvert.create();
case "L_validUnits":
return LValidUnit.create();
+ case "L_pretty":
+ return LPretty.create();
// Viewport management
case "L_upviewport":
diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LPretty.java b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LPretty.java
new file mode 100644
index 0000000000..1ff6bb3f11
--- /dev/null
+++ b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LPretty.java
@@ -0,0 +1,98 @@
+/*
+ * This material is distributed under the GNU General Public License
+ * Version 2. You may review the terms of this license at
+ * http://www.gnu.org/licenses/gpl-2.0.html
+ *
+ * Copyright (C) 2001-3 Paul Murrell
+ * Copyright (c) 1998-2013, The R Core Team
+ * Copyright (c) 2017, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+package com.oracle.truffle.r.library.fastrGrid;
+
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.numericValue;
+import static com.oracle.truffle.r.runtime.nmath.TOMS708.fabs;
+
+import com.oracle.truffle.api.dsl.Specialization;
+import com.oracle.truffle.r.nodes.builtin.RExternalBuiltinNode;
+import com.oracle.truffle.r.runtime.PrettyIntevals;
+import com.oracle.truffle.r.runtime.RError.Message;
+import com.oracle.truffle.r.runtime.data.RDataFactory;
+import com.oracle.truffle.r.runtime.data.model.RAbstractDoubleVector;
+
+public abstract class LPretty extends RExternalBuiltinNode.Arg1 {
+ static {
+ Casts casts = new Casts(LPretty.class);
+ casts.arg(0).mustBe(numericValue()).asDoubleVector();
+ }
+
+ public static LPretty create() {
+ return LPrettyNodeGen.create();
+ }
+
+ @Specialization
+ protected Object doPretty(RAbstractDoubleVector scale) {
+ double min = scale.getLength() > 0 ? scale.getDataAt(0) : 0;
+ double max = scale.getLength() > 1 ? scale.getDataAt(1) : 0;
+ boolean swap = max < min;
+ if (swap) {
+ min = max;
+ max = scale.getDataAt(0);
+ }
+
+ if (Double.isInfinite(min) || Double.isInfinite(max)) {
+ throw error(Message.GENERIC, String.format("infinite axis extents [GEPretty(%g,%g,5)]", min, max));
+ }
+
+ double[] ns = new double[]{min};
+ double[] nu = new double[]{max};
+ int[] ndiv = new int[]{5};
+ double unit = PrettyIntevals.pretty(getErrorContext(), ns, nu, new int[]{5}, 1, 0.25, new double[]{.8, 1.7}, 2, false);
+
+ if (nu[0] >= ns[0] + 1) {
+ if (ns[0] * unit < min - 1e-7 * unit) {
+ ns[0]++;
+ }
+ if (nu[0] > ns[0] + 1 && nu[0] * unit > max + 1e-7 * unit) {
+ nu[0]--;
+ }
+ ndiv[0] = (int) (nu[0] - ns[0]);
+ }
+ min = ns[0] * unit;
+ max = nu[0] * unit;
+
+ if (swap) {
+ double temp = min;
+ min = max;
+ max = temp;
+ }
+ return createAtVector(min, max, ndiv[0]);
+ }
+
+ private static RAbstractDoubleVector createAtVector(double axp0, double axp1, double axp2) {
+ /*
+ * Create an 'at = ...' vector for axis(.) i.e., the vector of tick mark locations, when
+ * none has been specified (= default).
+ *
+ * axp[0:2] = (x1, x2, nInt), where x1..x2 are the extreme tick marks {unless in log case,
+ * where nInt \in {1,2,3 ; -1,-2,....} and the `nint' argument is used *instead*.} The
+ * resulting REAL vector must have length >= 1, ideally >= 2
+ *
+ * FastR Notes: we only implement case where logflag == false.
+ */
+ /* --- linear axis --- Only use axp[] arg. */
+ int n = (int) (fabs(axp2) + 0.25); /* >= 0 */
+ int dn = Math.max(1, n);
+ double rng = axp1 - axp0;
+ double small = fabs(rng) / (100. * dn);
+ double[] at = new double[n + 1];
+ for (int i = 0; i <= n; i++) {
+ at[i] = axp0 + ((double) i / dn) * rng;
+ if (fabs(at[i]) < small) {
+ at[i] = 0;
+ }
+ }
+ return RDataFactory.createDoubleVector(at, RDataFactory.COMPLETE_VECTOR);
+ }
+}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Pretty.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Pretty.java
index 52f90c316f..01bdd569f5 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Pretty.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Pretty.java
@@ -22,6 +22,7 @@ import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL;
import com.oracle.truffle.api.dsl.Specialization;
import com.oracle.truffle.r.nodes.builtin.RBuiltinNode;
+import com.oracle.truffle.r.runtime.PrettyIntevals;
import com.oracle.truffle.r.runtime.RError;
import com.oracle.truffle.r.runtime.RRuntime;
import com.oracle.truffle.r.runtime.builtins.RBuiltin;
@@ -46,6 +47,8 @@ public abstract class Pretty extends RBuiltinNode {
casts.arg("eps.correct").defaultError(RError.Message.GENERIC, "'eps.correct' must be 0, 1, or 2").asIntegerVector().findFirst().mustNotBeNA().mustBe(and(gte0(), lte(2)));
}
+ public abstract RList execute(double l, double u, int n, int minN, double shrinkSml, RAbstractDoubleVector hi, int epsCorrect);
+
@Specialization
protected RList pretty(double l, double u, int n, int minN, double shrinkSml, RAbstractDoubleVector hi, int epsCorrect) {
double hi0 = hi.getDataAt(0);
@@ -60,151 +63,11 @@ public abstract class Pretty extends RBuiltinNode {
double[] lo = new double[]{l};
double[] up = new double[]{u};
int[] ndiv = new int[]{n};
- rPretty(lo, up, ndiv, minN, shrinkSml, hi.materialize().getDataWithoutCopying(), epsCorrect, true);
+ PrettyIntevals.pretty(getErrorContext(), lo, up, ndiv, minN, shrinkSml, hi.materialize().getDataWithoutCopying(), epsCorrect, true);
Object[] data = new Object[3];
data[0] = lo[0];
data[1] = up[0];
data[2] = ndiv[0];
return RDataFactory.createList(data, NAMES);
}
-
- double rPretty(double[] lo, double[] up, int[] ndiv, int minN,
- double shrinkSml, double[] highUFact,
- int epsCorrection, boolean returnBounds) {
- /*
- * From version 0.65 on, we had rounding_eps := 1e-5, before, r..eps = 0 1e-7 is consistent
- * with seq.default()
- */
- double roundingEps = 1e-7;
-
- double h = highUFact[0];
- double h5 = highUFact[1];
-
- double dx;
- double cell;
- double unit;
- double base;
- double uu;
- double ns;
- double nu;
- int k;
- boolean iSmall;
-
- dx = up[0] - lo[0];
- /* cell := "scale" here */
- if (dx == 0 && up[0] == 0) { /* up == lo == 0 */
- cell = 1;
- iSmall = true;
- } else {
- cell = Math.max(Math.abs(lo[0]), Math.abs(up[0]));
- /* uu = upper bound on cell/unit */
- // uu = (1 + (h5 >= 1.5 * h + .5)) ? 1 / (1 + h) : 1.5 / (1 + h5);
- // How can above expression ever be zero?
- uu = 1 / (1 + h);
- /* added times 3, as several calculations here */
- iSmall = dx < cell * uu * Math.max(1, ndiv[0]) * RRuntime.EPSILON * 3;
- }
-
- /* OLD: cell = FLT_EPSILON+ dx / ndiv[0]; FLT_EPSILON = 1.192e-07 */
- if (iSmall) {
- if (cell > 10) {
- cell = 9 + cell / 10;
- }
- cell *= shrinkSml;
- if (minN > 1) {
- cell /= minN;
- }
- } else {
- cell = dx;
- if (ndiv[0] > 1) {
- cell /= ndiv[0];
- }
- }
-
- if (cell < 20 * Double.MIN_VALUE) {
- warning(RError.Message.GENERIC, "Internal(pretty()): very small range.. corrected");
- cell = 20 * Double.MIN_VALUE;
- } else if (cell * 10 > Double.MAX_VALUE) {
- warning(RError.Message.GENERIC, "Internal(pretty()): very large range.. corrected");
- cell = .1 * Double.MAX_VALUE;
- }
- /*
- * NB: the power can be negative and this relies on exact calculation, which glibc's exp10
- * does not achieve
- */
- base = Math.pow(10.0, Math.floor(Math.log10(cell))); /* base <= cell < 10*base */
-
- /*
- * unit : from { 1,2,5,10 } * base such that |u - cell| is small, favoring larger (if h > 1,
- * else smaller) u values; favor '5' more than '2' if h5 > h (default h5 = .5 + 1.5 h)
- */
- unit = base;
- if ((uu = 2 * base) - cell < h * (cell - unit)) {
- unit = uu;
- if ((uu = 5 * base) - cell < h5 * (cell - unit)) {
- unit = uu;
- if ((uu = 10 * base) - cell < h * (cell - unit)) {
- unit = uu;
- }
- }
- }
- /*
- * Result: c := cell, u := unit, b := base c in [ 1, (2+ h) /(1+h) ] b ==> u= b c in ( (2+
- * h)/(1+h), (5+2h5)/(1+h5)] b ==> u= 2b c in ( (5+2h)/(1+h), (10+5h) /(1+h) ] b ==> u= 5b c
- * in ((10+5h)/(1+h), 10 ) b ==> u=10b
- *
- * ===> 2/5 *(2+h)/(1+h) <= c/u <= (2+h)/(1+h)
- */
-
- ns = Math.floor(lo[0] / unit + roundingEps);
- nu = Math.ceil(up[0] / unit - roundingEps);
- if (epsCorrection != 0 && (epsCorrection > 1 || !iSmall)) {
- if (lo[0] != 0.) {
- lo[0] *= (1 - RRuntime.EPSILON);
- } else {
- lo[0] = -Double.MIN_VALUE;
- }
- if (up[0] != 0.) {
- up[0] *= (1 + RRuntime.EPSILON);
- } else {
- up[0] = +Double.MIN_VALUE;
- }
- }
-
- while (ns * unit > lo[0] + roundingEps * unit) {
- ns--;
- }
-
- while (nu * unit < up[0] - roundingEps * unit) {
- nu++;
- }
-
- k = (int) (0.5 + nu - ns);
- if (k < minN) {
- /* ensure that nu - ns == min_n */
- k = minN - k;
- if (ns >= 0.) {
- nu += k / 2;
- ns -= k / 2 + k % 2; /* ==> nu-ns = old(nu-ns) + min_n -k = min_n */
- } else {
- ns -= k / 2;
- nu += k / 2 + k % 2;
- }
- ndiv[0] = minN;
- } else {
- ndiv[0] = k;
- }
- if (returnBounds) { /* if()'s to ensure that result covers original range */
- if (ns * unit < lo[0]) {
- lo[0] = ns * unit;
- }
- if (nu * unit > up[0]) {
- up[0] = nu * unit;
- }
- } else {
- lo[0] = ns;
- up[0] = nu;
- }
- return unit;
- }
}
diff --git a/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/PrettyIntevals.java b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/PrettyIntevals.java
new file mode 100644
index 0000000000..9ff10b704e
--- /dev/null
+++ b/com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/PrettyIntevals.java
@@ -0,0 +1,166 @@
+/*
+ * This material is distributed under the GNU General Public License
+ * Version 2. You may review the terms of this license at
+ * http://www.gnu.org/licenses/gpl-2.0.html
+ *
+ * Copyright (c) 1995, 1996 Robert Gentleman and Ross Ihaka
+ * Copyright (c) 1997-2014, The R Core Team
+ * Copyright (c) 2016, 2017, Oracle and/or its affiliates
+ *
+ * All rights reserved.
+ */
+package com.oracle.truffle.r.runtime;
+
+import com.oracle.truffle.r.runtime.nodes.RBaseNode;
+
+/**
+ * Constructs m "pretty" values which cover the given interval. This code is used in both built-in
+ * {@code pretty} and the grid package.
+ */
+public final class PrettyIntevals {
+ private PrettyIntevals() {
+ // only static members
+ }
+
+ // transcribed from pretty.c
+
+ public static double pretty(RBaseNode errorCtx, double[] lo, double[] up, int[] ndiv, int minN,
+ double shrinkSml, double[] highUFact,
+ int epsCorrection, boolean returnBounds) {
+ /*
+ * From version 0.65 on, we had rounding_eps := 1e-5, before, r..eps = 0 1e-7 is consistent
+ * with seq.default()
+ */
+ double roundingEps = 1e-7;
+
+ double h = highUFact[0];
+ double h5 = highUFact[1];
+
+ double dx;
+ double cell;
+ double unit;
+ double base;
+ double uu;
+ double ns;
+ double nu;
+ int k;
+ boolean iSmall;
+
+ dx = up[0] - lo[0];
+ /* cell := "scale" here */
+ if (dx == 0 && up[0] == 0) { /* up == lo == 0 */
+ cell = 1;
+ iSmall = true;
+ } else {
+ cell = Math.max(Math.abs(lo[0]), Math.abs(up[0]));
+ /* uu = upper bound on cell/unit */
+ // uu = (1 + (h5 >= 1.5 * h + .5)) ? 1 / (1 + h) : 1.5 / (1 + h5);
+ // How can above expression ever be zero?
+ uu = 1 / (1 + h);
+ /* added times 3, as several calculations here */
+ iSmall = dx < cell * uu * Math.max(1, ndiv[0]) * RRuntime.EPSILON * 3;
+ }
+
+ /* OLD: cell = FLT_EPSILON+ dx / ndiv[0]; FLT_EPSILON = 1.192e-07 */
+ if (iSmall) {
+ if (cell > 10) {
+ cell = 9 + cell / 10;
+ }
+ cell *= shrinkSml;
+ if (minN > 1) {
+ cell /= minN;
+ }
+ } else {
+ cell = dx;
+ if (ndiv[0] > 1) {
+ cell /= ndiv[0];
+ }
+ }
+
+ if (cell < 20 * Double.MIN_VALUE) {
+ RError.warning(errorCtx, RError.Message.GENERIC, "Internal(pretty()): very small range.. corrected");
+ cell = 20 * Double.MIN_VALUE;
+ } else if (cell * 10 > Double.MAX_VALUE) {
+ RError.warning(errorCtx, RError.Message.GENERIC, "Internal(pretty()): very large range.. corrected");
+ cell = .1 * Double.MAX_VALUE;
+ }
+ /*
+ * NB: the power can be negative and this relies on exact calculation, which glibc's exp10
+ * does not achieve
+ */
+ base = Math.pow(10.0, Math.floor(Math.log10(cell))); /* base <= cell < 10*base */
+
+ /*
+ * unit : from { 1,2,5,10 } * base such that |u - cell| is small, favoring larger (if h > 1,
+ * else smaller) u values; favor '5' more than '2' if h5 > h (default h5 = .5 + 1.5 h)
+ */
+ unit = base;
+ if ((uu = 2 * base) - cell < h * (cell - unit)) {
+ unit = uu;
+ if ((uu = 5 * base) - cell < h5 * (cell - unit)) {
+ unit = uu;
+ if ((uu = 10 * base) - cell < h * (cell - unit)) {
+ unit = uu;
+ }
+ }
+ }
+ /*
+ * Result: c := cell, u := unit, b := base c in [ 1, (2+ h) /(1+h) ] b ==> u= b c in ( (2+
+ * h)/(1+h), (5+2h5)/(1+h5)] b ==> u= 2b c in ( (5+2h)/(1+h), (10+5h) /(1+h) ] b ==> u= 5b c
+ * in ((10+5h)/(1+h), 10 ) b ==> u=10b
+ *
+ * ===> 2/5 *(2+h)/(1+h) <= c/u <= (2+h)/(1+h)
+ */
+
+ ns = Math.floor(lo[0] / unit + roundingEps);
+ nu = Math.ceil(up[0] / unit - roundingEps);
+ if (epsCorrection != 0 && (epsCorrection > 1 || !iSmall)) {
+ if (lo[0] != 0.) {
+ lo[0] *= (1 - RRuntime.EPSILON);
+ } else {
+ lo[0] = -Double.MIN_VALUE;
+ }
+ if (up[0] != 0.) {
+ up[0] *= (1 + RRuntime.EPSILON);
+ } else {
+ up[0] = +Double.MIN_VALUE;
+ }
+ }
+
+ while (ns * unit > lo[0] + roundingEps * unit) {
+ ns--;
+ }
+
+ while (nu * unit < up[0] - roundingEps * unit) {
+ nu++;
+ }
+
+ k = (int) (0.5 + nu - ns);
+ if (k < minN) {
+ /* ensure that nu - ns == min_n */
+ k = minN - k;
+ if (ns >= 0.) {
+ nu += k / 2;
+ ns -= k / 2 + k % 2; /* ==> nu-ns = old(nu-ns) + min_n -k = min_n */
+ } else {
+ ns -= k / 2;
+ nu += k / 2 + k % 2;
+ }
+ ndiv[0] = minN;
+ } else {
+ ndiv[0] = k;
+ }
+ if (returnBounds) { /* if()'s to ensure that result covers original range */
+ if (ns * unit < lo[0]) {
+ lo[0] = ns * unit;
+ }
+ if (nu * unit > up[0]) {
+ up[0] = nu * unit;
+ }
+ } else {
+ lo[0] = ns;
+ up[0] = nu;
+ }
+ return unit;
+ }
+}
diff --git a/mx.fastr/copyrights/overrides b/mx.fastr/copyrights/overrides
index a72c103a9a..d5600cf28a 100644
--- a/mx.fastr/copyrights/overrides
+++ b/mx.fastr/copyrights/overrides
@@ -185,6 +185,7 @@ com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/L
com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Merge.java,gnu_r_gentleman_ihaka2.copyright
com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Order.java,gnu_r_gentleman_ihaka.copyright
com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Pretty.java,gnu_r_gentleman_ihaka2.copyright
+com.oracle.truffle.r.runtime/src/com/oracle/truffle/r/runtime/PrettyIntevals.java,gnu_r_gentleman_ihaka2.copyright
com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Quit.java,gnu_r_gentleman_ihaka.copyright
com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Rank.java,gnu_r_gentleman_ihaka.copyright
com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/Prod.java,purdue.copyright
@@ -744,6 +745,7 @@ com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/p
com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/deriv/Deriv.java,gnu_r_gentleman_ihaka2.copyright
com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/deriv/DerivVisitor.java,gnu_r_gentleman_ihaka2.copyright
com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LRect.java,gnu_r_murrel_core.copyright
+com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LPretty.java,gnu_r_murrel_core.copyright
com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LRectBounds.java,gnu_r_murrel_core.copyright
com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LCircleBounds.java,gnu_r_murrel_core.copyright
com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/fastrGrid/LLocnBounds.java,gnu_r_murrel_core.copyright
--
GitLab