Skip to content

Commit 83fbbb8

Browse files
committed
[GR-2798] When using GNU-R graphics (-UseInternalGridGraphics) FastR would still override the graphics package R functions.
PullRequest: fastr/1899
2 parents 460b111 + c2d64d5 commit 83fbbb8

File tree

3 files changed

+167
-157
lines changed

3 files changed

+167
-157
lines changed

CHANGELOG.md

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,13 @@
11
# 1.0 RC 13
22

3-
New features:
3+
New features:
4+
5+
* new JUL-like logging infrastructure backed by Truffle
6+
* FastR options backed by Truffle now. New command-line format - i.e. bin/r --R.PerformanceWarning="true". Also configurable via org.graal.polyglot.Context.Builder.
7+
8+
Bug fixes:
49

5-
* new JUL-like logging infrastructure backed by Truffle
6-
* FastR options backed by Truffle now. New command-line format - i.e. bin/r --R.PerformanceWarning="true". Also configurable via org.graal.polyglot.Context.Builder.
10+
* when using GNU-R graphics (-UseInternalGridGraphics) FastR would still override the graphics package R functions
711

812
# 1.0 RC 12
913

Lines changed: 154 additions & 152 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
# Copyright (c) 2017, 2018, Oracle and/or its affiliates. All rights reserved.
1+
# Copyright (c) 2017, 2019, Oracle and/or its affiliates. All rights reserved.
22
# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
33
#
44
# This code is free software; you can redistribute it and/or modify it
@@ -24,172 +24,174 @@
2424
# e.g. plot.xy, title, ... So far we only provide higher level "plot" that also
2525
# prints a warning message instructing the user to use grid/lattice/ggplot2 instead
2626

27-
eval(expression({
28-
graphicsWarning <- function(name, ignore = NULL) {
29-
# lookup original function and fetch signature
30-
fun <- tryCatch(get(name, environment()), error=function(x) NULL)
31-
if(!is.null(fun)) {
32-
sig <- formals(fun)
33-
} else {
34-
sig <- NULL
35-
}
27+
if (.fastr.option('UseInternalGridGraphics')) {
28+
eval(expression({
29+
graphicsWarning <- function(name, ignore = NULL) {
30+
# lookup original function and fetch signature
31+
fun <- tryCatch(get(name, environment()), error=function(x) NULL)
32+
if(!is.null(fun)) {
33+
sig <- formals(fun)
34+
} else {
35+
sig <- NULL
36+
}
3637

37-
if (.fastr.option('IgnoreGraphicsCalls')) {
38-
# We evaluate the non-missing arguments to simulate the function effects.
39-
# Some arguments must be ignored, because they are a promise to a value
40-
# that will be calculated inside the function before the argument is accessed
41-
sigNames <- setdiff(base::names(sig), ignore)
42-
replacementFun <- function(...) {
43-
if (is.null(sigNames)) {
44-
return(invisible(list(...)));
45-
}
46-
missingExpr <- quote(missing(x))
47-
for (n in sigNames) {
48-
missingExpr[[2]] <- as.symbol(n)
49-
if (!eval(missingExpr)) {
50-
get(n)
38+
if (.fastr.option('IgnoreGraphicsCalls')) {
39+
# We evaluate the non-missing arguments to simulate the function effects.
40+
# Some arguments must be ignored, because they are a promise to a value
41+
# that will be calculated inside the function before the argument is accessed
42+
sigNames <- setdiff(base::names(sig), ignore)
43+
replacementFun <- function(...) {
44+
if (is.null(sigNames)) {
45+
return(invisible(list(...)));
5146
}
47+
missingExpr <- quote(missing(x))
48+
for (n in sigNames) {
49+
missingExpr[[2]] <- as.symbol(n)
50+
if (!eval(missingExpr)) {
51+
get(n)
52+
}
53+
}
54+
invisible(NULL);
55+
}
56+
} else {
57+
replacementFun <- function(...) {
58+
warning(paste0(name, " not supported.", " Note: FastR does not support graphics package and most of its functions. Please use grid package or grid based packages like lattice instead."))
59+
NULL
5260
}
53-
invisible(NULL);
5461
}
55-
} else {
56-
replacementFun <- function(...) {
57-
warning(paste0(name, " not supported.", " Note: FastR does not support graphics package and most of its functions. Please use grid package or grid based packages like lattice instead."))
58-
NULL
62+
63+
if(!is.null(sig)) {
64+
formals(replacementFun) <- sig
5965
}
66+
return(replacementFun)
6067
}
6168

62-
if(!is.null(sig)) {
63-
formals(replacementFun) <- sig
64-
}
65-
return(replacementFun)
66-
}
69+
plot.default <- function (x, y = NULL, type = "p", xlim = NULL, ylim = NULL,
70+
log = "", main = NULL, sub = NULL, xlab = NULL, ylab = NULL,
71+
ann = par("ann"), axes = TRUE, frame.plot = axes, panel.first = NULL,
72+
panel.last = NULL, asp = NA, ...)
73+
{
74+
library(grid)
75+
xlabel <- if (!missing(x)) deparse(substitute(x))
76+
ylabel <- if (!missing(y)) deparse(substitute(y))
77+
xy <- xy.coords(x, y, xlabel, ylabel, log)
78+
xlab <- if (is.null(xlab)) xy$xlab else xlab
79+
ylab <- if (is.null(ylab)) xy$ylab else ylab
80+
xlim <- if (is.null(xlim)) range(xy$x[is.finite(xy$x)]) else xlim
81+
ylim <- if (is.null(ylim)) range(xy$y[is.finite(xy$y)]) else ylim
82+
grid.newpage()
83+
dev.hold()
84+
on.exit(dev.flush())
6785

68-
plot.default <- function (x, y = NULL, type = "p", xlim = NULL, ylim = NULL,
69-
log = "", main = NULL, sub = NULL, xlab = NULL, ylab = NULL,
70-
ann = par("ann"), axes = TRUE, frame.plot = axes, panel.first = NULL,
71-
panel.last = NULL, asp = NA, ...)
72-
{
73-
library(grid)
74-
xlabel <- if (!missing(x)) deparse(substitute(x))
75-
ylabel <- if (!missing(y)) deparse(substitute(y))
76-
xy <- xy.coords(x, y, xlabel, ylabel, log)
77-
xlab <- if (is.null(xlab)) xy$xlab else xlab
78-
ylab <- if (is.null(ylab)) xy$ylab else ylab
79-
xlim <- if (is.null(xlim)) range(xy$x[is.finite(xy$x)]) else xlim
80-
ylim <- if (is.null(ylim)) range(xy$y[is.finite(xy$y)]) else ylim
81-
grid.newpage()
82-
dev.hold()
83-
on.exit(dev.flush())
86+
xlim <- range(xy$x[is.finite(xy$x)])
87+
ylim <- range(xy$y[is.finite(xy$y)])
88+
xfactor <- 1 / (xlim[[2]] - xlim[[1]])
89+
yfactor <- 1 / (ylim[[2]] - ylim[[1]])
8490

85-
xlim <- range(xy$x[is.finite(xy$x)])
86-
ylim <- range(xy$y[is.finite(xy$y)])
87-
xfactor <- 1 / (xlim[[2]] - xlim[[1]])
88-
yfactor <- 1 / (ylim[[2]] - ylim[[1]])
91+
pushViewport(viewport(width=.7, height=.7))
92+
grid.points((xy$x - xlim[[1]]) * xfactor, (xy$y - ylim[[1]]) * yfactor)
8993

90-
pushViewport(viewport(width=.7, height=.7))
91-
grid.points((xy$x - xlim[[1]]) * xfactor, (xy$y - ylim[[1]]) * yfactor)
94+
pushViewport(viewport(width=1.1, height=1.1))
95+
grid.rect()
96+
popViewport()
9297

93-
pushViewport(viewport(width=1.1, height=1.1))
94-
grid.rect()
95-
popViewport()
98+
pushViewport(viewport(width=1, height=1.1))
99+
grid.xaxis(seq(0, 1, by=.2), label = round(xlim[[1]] + seq(0, 1, by=.2) / xfactor, 2))
100+
popViewport()
96101

97-
pushViewport(viewport(width=1, height=1.1))
98-
grid.xaxis(seq(0, 1, by=.2), label = round(xlim[[1]] + seq(0, 1, by=.2) / xfactor, 2))
99-
popViewport()
102+
pushViewport(viewport(width=1.1, height=1))
103+
grid.yaxis(seq(0, 1, by=.2), label = round(ylim[[1]] + seq(0, 1, by=.2) / yfactor, 2))
104+
popViewport()
100105

101-
pushViewport(viewport(width=1.1, height=1))
102-
grid.yaxis(seq(0, 1, by=.2), label = round(ylim[[1]] + seq(0, 1, by=.2) / yfactor, 2))
103-
popViewport()
106+
popViewport()
107+
if (!is.null(main)) {
108+
grid.text(main, 0.5, 0.91, gp=gpar(font=2))
109+
}
104110

105-
popViewport()
106-
if (!is.null(main)) {
107-
grid.text(main, 0.5, 0.91, gp=gpar(font=2))
111+
grid.text("FastR does not support graphics package and most of its functions. \nThe 'plot' function is emulated to a small extent. \nPlease use grid package or grid based packages like lattice or ggplot2 instead.", gp=gpar(fontsize=10))
112+
graphicsWarning()
113+
invisible()
108114
}
109115

110-
grid.text("FastR does not support graphics package and most of its functions. \nThe 'plot' function is emulated to a small extent. \nPlease use grid package or grid based packages like lattice or ggplot2 instead.", gp=gpar(fontsize=10))
111-
graphicsWarning()
112-
invisible()
113-
}
114-
115-
# Note: explicitly supported functions: din
116-
# Note: harmless functions that we do not override: co.intervals, hist.default, axTicks
117-
# Note: S3 dispatch functions that may dispatch to lattice/ggplot2/etc. implementation: hist, contour, lines, pairs, points, text
118-
# Note: we ignore plot.new because Shiny probably uses it for getting coordinates, but not for plotting itself
116+
# Note: explicitly supported functions: din
117+
# Note: harmless functions that we do not override: co.intervals, hist.default, axTicks
118+
# Note: S3 dispatch functions that may dispatch to lattice/ggplot2/etc. implementation: hist, contour, lines, pairs, points, text
119+
# Note: we ignore plot.new because Shiny probably uses it for getting coordinates, but not for plotting itself
119120

120-
# Special case of grconvertX/Y used in Shiny
121-
grconvertX <- function(x, from, to) if (from == "user" && to == "nfc") round(x) else graphicsWarning("gcconvertX")(x, from, to)
122-
grconvertY <- function(x, from, to) if (from == "user" && to == "nfc") round(x) else graphicsWarning("gcconvertX")(x, from, to)
123-
plot.new <- function(...) { } # just ignore
121+
# Special case of grconvertX/Y used in Shiny
122+
grconvertX <- function(x, from, to) if (from == "user" && to == "nfc") round(x) else graphicsWarning("gcconvertX")(x, from, to)
123+
grconvertY <- function(x, from, to) if (from == "user" && to == "nfc") round(x) else graphicsWarning("gcconvertX")(x, from, to)
124+
plot.new <- function(...) { } # just ignore
124125

125-
abline <- graphicsWarning("abline");
126-
arrows <- graphicsWarning("arrows");
127-
assocplot <- graphicsWarning("assocplot");
128-
axis <- graphicsWarning("axis");
129-
Axis <- graphicsWarning("Axis");
130-
axis.Date <- graphicsWarning("axis.Date");
131-
axis.POSIXct <- graphicsWarning("axis.POSIXct");
132-
barplot.default <- graphicsWarning("barplot.default");
133-
box <- graphicsWarning("box");
134-
boxplot.default <- graphicsWarning("boxplot.default");
135-
boxplot.matrix <- graphicsWarning("boxplot.matrix");
136-
bxp <- graphicsWarning("bxp");
137-
cdplot <- graphicsWarning("cdplot");
138-
clip <- graphicsWarning("clip");
139-
close.screen <- graphicsWarning("close.screen");
140-
contour.default <- graphicsWarning("contour.default");
141-
coplot <- graphicsWarning("coplot");
142-
curve <- graphicsWarning("curve");
143-
dotchart <- graphicsWarning("dotchart");
144-
erase.screen <- graphicsWarning("erase.screen");
145-
filled.contour <- graphicsWarning("filled.contour");
146-
fourfoldplot <- graphicsWarning("fourfoldplot");
147-
frame <- graphicsWarning("frame");
148-
grid <- graphicsWarning("grid");
149-
identify <- graphicsWarning("identify");
150-
image <- graphicsWarning("image");
151-
image.default <- graphicsWarning("image.default");
152-
layout <- graphicsWarning("layout");
153-
layout.show <- graphicsWarning("layout.show");
154-
lcm <- graphicsWarning("lcm");
155-
legend <- graphicsWarning("legend", c('merge'));
156-
lines.default <- graphicsWarning("lines.default");
157-
locator <- graphicsWarning("locator");
158-
matlines <- graphicsWarning("matlines");
159-
matplot <- graphicsWarning("matplot");
160-
matpoints <- graphicsWarning("matpoints");
161-
mosaicplot <- graphicsWarning("mosaicplot");
162-
mtext <- graphicsWarning("mtext");
163-
pairs.default <- graphicsWarning("pairs.default");
164-
panel.smooth <- graphicsWarning("panel.smooth");
165-
persp <- graphicsWarning("persp");
166-
pie <- graphicsWarning("pie");
167-
plot.design <- graphicsWarning("plot.design");
168-
plot.function <- graphicsWarning("plot.function");
169-
plot.window <- graphicsWarning("plot.window");
170-
plot.xy <- graphicsWarning("plot.xy");
171-
points.default <- graphicsWarning("points.default");
172-
polygon <- graphicsWarning("polygon");
173-
polypath <- graphicsWarning("polypath");
174-
rasterImage <- graphicsWarning("rasterImage");
175-
rect <- graphicsWarning("rect");
176-
rug <- graphicsWarning("rug");
177-
screen <- graphicsWarning("screen");
178-
segments <- graphicsWarning("segments");
179-
smoothScatter <- graphicsWarning("smoothScatter");
180-
spineplot <- graphicsWarning("spineplot");
181-
split.screen <- graphicsWarning("split.screen");
182-
stars <- graphicsWarning("stars");
183-
stem <- graphicsWarning("stem");
184-
strheight <- graphicsWarning("strheight");
185-
stripchart <- graphicsWarning("stripchart");
186-
strwidth <- graphicsWarning("strwidth");
187-
sunflowerplot <- graphicsWarning("sunflowerplot");
188-
symbols <- graphicsWarning("symbols");
189-
text.default <- graphicsWarning("text.default");
190-
title <- graphicsWarning("title");
191-
xinch <- graphicsWarning("xinch");
192-
xspline <- graphicsWarning("xspline");
193-
xyinch <- graphicsWarning("xyinch");
194-
yinch <- graphicsWarning("yinch");
195-
}), asNamespace("graphics"))
126+
abline <- graphicsWarning("abline");
127+
arrows <- graphicsWarning("arrows");
128+
assocplot <- graphicsWarning("assocplot");
129+
axis <- graphicsWarning("axis");
130+
Axis <- graphicsWarning("Axis");
131+
axis.Date <- graphicsWarning("axis.Date");
132+
axis.POSIXct <- graphicsWarning("axis.POSIXct");
133+
barplot.default <- graphicsWarning("barplot.default");
134+
box <- graphicsWarning("box");
135+
boxplot.default <- graphicsWarning("boxplot.default");
136+
boxplot.matrix <- graphicsWarning("boxplot.matrix");
137+
bxp <- graphicsWarning("bxp");
138+
cdplot <- graphicsWarning("cdplot");
139+
clip <- graphicsWarning("clip");
140+
close.screen <- graphicsWarning("close.screen");
141+
contour.default <- graphicsWarning("contour.default");
142+
coplot <- graphicsWarning("coplot");
143+
curve <- graphicsWarning("curve");
144+
dotchart <- graphicsWarning("dotchart");
145+
erase.screen <- graphicsWarning("erase.screen");
146+
filled.contour <- graphicsWarning("filled.contour");
147+
fourfoldplot <- graphicsWarning("fourfoldplot");
148+
frame <- graphicsWarning("frame");
149+
grid <- graphicsWarning("grid");
150+
identify <- graphicsWarning("identify");
151+
image <- graphicsWarning("image");
152+
image.default <- graphicsWarning("image.default");
153+
layout <- graphicsWarning("layout");
154+
layout.show <- graphicsWarning("layout.show");
155+
lcm <- graphicsWarning("lcm");
156+
legend <- graphicsWarning("legend", c('merge'));
157+
lines.default <- graphicsWarning("lines.default");
158+
locator <- graphicsWarning("locator");
159+
matlines <- graphicsWarning("matlines");
160+
matplot <- graphicsWarning("matplot");
161+
matpoints <- graphicsWarning("matpoints");
162+
mosaicplot <- graphicsWarning("mosaicplot");
163+
mtext <- graphicsWarning("mtext");
164+
pairs.default <- graphicsWarning("pairs.default");
165+
panel.smooth <- graphicsWarning("panel.smooth");
166+
persp <- graphicsWarning("persp");
167+
pie <- graphicsWarning("pie");
168+
plot.design <- graphicsWarning("plot.design");
169+
plot.function <- graphicsWarning("plot.function");
170+
plot.window <- graphicsWarning("plot.window");
171+
plot.xy <- graphicsWarning("plot.xy");
172+
points.default <- graphicsWarning("points.default");
173+
polygon <- graphicsWarning("polygon");
174+
polypath <- graphicsWarning("polypath");
175+
rasterImage <- graphicsWarning("rasterImage");
176+
rect <- graphicsWarning("rect");
177+
rug <- graphicsWarning("rug");
178+
screen <- graphicsWarning("screen");
179+
segments <- graphicsWarning("segments");
180+
smoothScatter <- graphicsWarning("smoothScatter");
181+
spineplot <- graphicsWarning("spineplot");
182+
split.screen <- graphicsWarning("split.screen");
183+
stars <- graphicsWarning("stars");
184+
stem <- graphicsWarning("stem");
185+
strheight <- graphicsWarning("strheight");
186+
stripchart <- graphicsWarning("stripchart");
187+
strwidth <- graphicsWarning("strwidth");
188+
sunflowerplot <- graphicsWarning("sunflowerplot");
189+
symbols <- graphicsWarning("symbols");
190+
text.default <- graphicsWarning("text.default");
191+
title <- graphicsWarning("title");
192+
xinch <- graphicsWarning("xinch");
193+
xspline <- graphicsWarning("xspline");
194+
xyinch <- graphicsWarning("xyinch");
195+
yinch <- graphicsWarning("yinch");
196+
}), asNamespace("graphics"))
197+
}

com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/CallAndExternalFunctions.java

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@
2222
import static com.oracle.truffle.r.runtime.RVisibility.CUSTOM;
2323
import static com.oracle.truffle.r.runtime.builtins.RBehavior.COMPLEX;
2424
import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.PRIMITIVE;
25+
import static com.oracle.truffle.r.runtime.context.FastROptions.UseInternalGridGraphics;
2526

2627
import com.oracle.truffle.api.CompilerDirectives;
2728
import com.oracle.truffle.api.CompilerDirectives.CompilationFinal;
@@ -94,7 +95,6 @@
9495
import com.oracle.truffle.r.nodes.helpers.MaterializeNode;
9596
import com.oracle.truffle.r.nodes.objects.GetPrimNameNodeGen;
9697
import com.oracle.truffle.r.nodes.objects.NewObjectNodeGen;
97-
import static com.oracle.truffle.r.runtime.context.FastROptions.UseInternalGridGraphics;
9898
import com.oracle.truffle.r.runtime.RError;
9999
import com.oracle.truffle.r.runtime.RInternalCode;
100100
import com.oracle.truffle.r.runtime.RInternalError;
@@ -1076,7 +1076,11 @@ public Object[] getDefaultParameterValues() {
10761076
@Override
10771077
@TruffleBoundary
10781078
public RExternalBuiltinNode lookupBuiltin(RList f) {
1079-
return FastRGridExternalLookup.lookupDotCallGraphics(lookupName(f));
1079+
if (RContext.getInstance().getOption(UseInternalGridGraphics)) {
1080+
return FastRGridExternalLookup.lookupDotCallGraphics(lookupName(f));
1081+
} else {
1082+
return null;
1083+
}
10801084
}
10811085

10821086
@SuppressWarnings("unused")

0 commit comments

Comments
 (0)