diff --git a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R
index 3245db800939dc6f30c42f3e67bee168579ac8ae..37640f855ba9e0ec96d6831e6d6abb188f944f2c 100644
--- a/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R
+++ b/com.oracle.truffle.r.library/src/com/oracle/truffle/r/library/stats/model.R
@@ -5,7 +5,7 @@
#
# Copyright (c) 1995, 1996 Robert Gentleman and Ross Ihaka
# Copyright (c) 1997-2013, The R Core Team
-# Copyright (c) 2016, Oracle and/or its affiliates
+# Copyright (c) 2016, 2017 Oracle and/or its affiliates
#
# All rights reserved.
#
@@ -166,7 +166,7 @@ ExtractVars <- function (formula, checkonly=FALSE) {
if (identical(op, quote(`~`))) { # tilde
if (response) {
error("invalid model formula")
- } else if (is.null(formula[[3]])) {
+ } else if (length(formula) < 3 || is.null(formula[[3]])) {
response <<- FALSE
ExtractVars(formula[[2]], FALSE)
} else {
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/RecordGraphics.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/RecordGraphics.java
index b0be4bf5342b864edfc78816e3218bb41c1494fb..5182327ab41aeac25c16cefd9204729f11e4dc36 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/RecordGraphics.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/RecordGraphics.java
@@ -22,6 +22,7 @@
*/
package com.oracle.truffle.r.nodes.builtin.base;
+import static com.oracle.truffle.r.nodes.builtin.CastBuilder.Predef.instanceOf;
import static com.oracle.truffle.r.runtime.builtins.RBehavior.COMPLEX;
import static com.oracle.truffle.r.runtime.builtins.RBuiltinKind.INTERNAL;
@@ -53,6 +54,13 @@ public abstract class RecordGraphics extends RBuiltinNode {
@Child private SetVisibilityNode visibility = SetVisibilityNode.create();
@Child private RList2EnvNode list2EnvNode = new RList2EnvNode();
+ static {
+ Casts casts = new Casts(RecordGraphics.class);
+ casts.arg("expr").mustBe(instanceOf(RLanguage.class).or(instanceOf(RExpression.class)));
+ casts.arg("list").mustBe(instanceOf(RList.class));
+ casts.arg("env").mustBe(instanceOf(REnvironment.class));
+ }
+
public static RecordGraphics create() {
return RecordGraphicsNodeGen.create();
}
diff --git a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/CallAndExternalFunctions.java b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/CallAndExternalFunctions.java
index c8fc0b6df1d973f36b7631a6d93172e63cfd2c2c..40b188aed727ee7cd36735edc3f1510c02b97442 100644
--- a/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/CallAndExternalFunctions.java
+++ b/com.oracle.truffle.r.nodes.builtin/src/com/oracle/truffle/r/nodes/builtin/base/foreign/CallAndExternalFunctions.java
@@ -911,6 +911,10 @@ public class CallAndExternalFunctions {
private final BranchProfile errorProfile = BranchProfile.create();
+ static {
+ Casts.noCasts(DotExternalGraphics.class);
+ }
+
@Override
@TruffleBoundary
protected RExternalBuiltinNode lookupBuiltin(RList f) {
@@ -970,6 +974,10 @@ public class CallAndExternalFunctions {
private final BranchProfile errorProfile = BranchProfile.create();
+ static {
+ Casts.noCasts(DotCallGraphics.class);
+ }
+
@Override
public Object[] getDefaultParameterValues() {
return new Object[]{RMissing.instance, RArgsValuesAndNames.EMPTY, RMissing.instance};
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
index b9140ddfa37645ceea1f58eb135f6b32508dd29f..6a8a449ed938b77889963326a092a789242a536f 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/ExpectedTestOutput.test
@@ -132606,6 +132606,20 @@ list(cyl, hp, mpg, disp, drat, wt, qsec, vs, am, gear, carb)
9 8 9
10 9 10
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelFrame#
+#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;; model.frame(terms.formula(~k+y+z)) }
+ k y z
+1 2 0 1
+2 3 1 2
+3 4 2 3
+4 5 3 4
+5 6 4 5
+6 7 5 6
+7 8 6 7
+8 9 7 8
+9 10 8 9
+10 11 9 10
+
##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelFrame#
#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;k <- factor(rep(c('m', 'f'), 5));z <- factor(c(rep(c('a', 'b', 'c'), 3), 'c')); ; model.frame(terms.formula(u~z*k+w*m)) }
u z k w m
@@ -132816,6 +132830,20 @@ list(cyl, hp, mpg, disp, drat, wt, qsec, vs, am, gear, carb)
9 8 c
10 9 c
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelFrame#
+#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;k <- factor(rep(c('m', 'f'), 5));z <- factor(c(rep(c('a', 'b', 'c'), 3), 'c')); ; model.frame(terms.formula(~k+y+z)) }
+ k y z
+1 m 0 a
+2 f 1 b
+3 m 2 c
+4 f 3 a
+5 m 4 b
+6 f 5 c
+7 m 6 a
+8 f 7 b
+9 m 8 c
+10 f 9 c
+
##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelMatrix#
#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;; model.matrix(model.frame(terms.formula(u~z*k+w*m))) }
(Intercept) z k w m z:k w:m
@@ -133056,6 +133084,22 @@ attr(,"assign")
attr(,"assign")
[1] 0 1
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelMatrix#
+#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;; model.matrix(model.frame(terms.formula(~k+y+z))) }
+ (Intercept) k y z
+1 1 2 0 1
+2 1 3 1 2
+3 1 4 2 3
+4 1 5 3 4
+5 1 6 4 5
+6 1 7 5 6
+7 1 8 6 7
+8 1 9 7 8
+9 1 10 8 9
+10 1 11 9 10
+attr(,"assign")
+[1] 0 1 2 3
+
##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelMatrix#
#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;k <- factor(rep(c('m', 'f'), 5));z <- factor(c(rep(c('a', 'b', 'c'), 3), 'c')); ; model.matrix(model.frame(terms.formula(u~z*k+w*m))) }
(Intercept) zb zc km w m zb:km zc:km w:m
@@ -133370,6 +133414,29 @@ attr(,"contrasts")$z
[1] "contr.treatment"
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testModelMatrix#
+#{y<-0:9;z<-1:10;k<-2:11;w<-3:12;m<-4:13;u<-5:14;v<-6:15;k <- factor(rep(c('m', 'f'), 5));z <- factor(c(rep(c('a', 'b', 'c'), 3), 'c')); ; model.matrix(model.frame(terms.formula(~k+y+z))) }
+ (Intercept) km y zb zc
+1 1 1 0 0 0
+2 1 0 1 1 0
+3 1 1 2 0 1
+4 1 0 3 0 0
+5 1 1 4 1 0
+6 1 0 5 0 1
+7 1 1 6 0 0
+8 1 0 7 1 0
+9 1 1 8 0 1
+10 1 0 9 0 1
+attr(,"assign")
+[1] 0 1 2 3 3
+attr(,"contrasts")
+attr(,"contrasts")$k
+[1] "contr.treatment"
+
+attr(,"contrasts")$z
+[1] "contr.treatment"
+
+
##com.oracle.truffle.r.test.library.stats.TestFormulae.testSpecialsTermsform#
#f <- terms.formula(y~myfun(z)+x, c('myfun')); attrs <- attributes(f); envIdx <- which(names(attrs)=='.Environment'); print(attrs[envIdx]); attrs[sort(names(attrs[-envIdx]))]
$.Environment
@@ -133866,6 +133933,36 @@ $variables
list(y, z)
+##com.oracle.truffle.r.test.library.stats.TestFormulae.testTermsform#
+#f <- terms.formula(~k+y+z); attrs <- attributes(f); envIdx <- which(names(attrs)=='.Environment'); print(attrs[envIdx]); attrs[sort(names(attrs[-envIdx]))]
+$.Environment
+<environment: R_GlobalEnv>
+
+$class
+[1] "terms" "formula"
+
+$factors
+ k y z
+k 1 0 0
+y 0 1 0
+z 0 0 1
+
+$intercept
+[1] 1
+
+$order
+[1] 1 1 1
+
+$response
+[1] 0
+
+$term.labels
+[1] "k" "y" "z"
+
+$variables
+list(k, y, z)
+
+
##com.oracle.truffle.r.test.library.stats.TestRandGenerationFunctions.testFunctions1#Output.IgnoreWhitespace#
#set.seed(10); rsignrank(12, c(NA, NaN, 1/0, -1/0, -1, 1, 0.3, -0.6, 0.0653, 0.000123, 32e-80, 10))
[1] NA NA 0 NA NA 1 0 NA 0 0 0 21
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java
index deb60b64d75a815886b0db2f360e6c4c3489d4c1..c2d7be4e0b73e889737f4a424536c3a14a7ba03e 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/TestFormulae.java
@@ -1,5 +1,5 @@
/*
- * Copyright (c) 2014, 2016, Oracle and/or its affiliates. All rights reserved.
+ * Copyright (c) 2014, 2017, Oracle and/or its affiliates. All rights reserved.
* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
*
* This code is free software; you can redistribute it and/or modify it
@@ -59,7 +59,8 @@ public class TestFormulae extends TestBase {
private static final String[] FORMULAE = new String[]{
"y~z", "y~1+z", "y~0+z", "y~-1+z", "y~z*k", "y~z*k+w*m", "u~z*k+w*m",
"y~z:k", "y~z^2", "y~(z+k)^2", "y~z*((m+w)^3)",
- "y~(z+k)*(w+u)", "y~w%in%v", "y~w/k", "y~(1 + w/k)"
+ "y~(z+k)*(w+u)", "y~w%in%v", "y~w/k", "y~(1 + w/k)",
+ "~k+y+z"
};
/**
diff --git a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R
index d4458943fbd3bca915de0cec2cdb928819cd8a22..583810e2628389de07f020badfa4dd4ad6d7366c 100644
--- a/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R
+++ b/com.oracle.truffle.r.test/src/com/oracle/truffle/r/test/library/stats/modelTests.R
@@ -1,4 +1,4 @@
-# Copyright (c) 2016, Oracle and/or its affiliates. All rights reserved.
+# Copyright (c) 2016, 2017 Oracle and/or its affiliates. All rights reserved.
# DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
#
# This code is free software; you can redistribute it and/or modify it
@@ -79,7 +79,7 @@ check <- function(expected, actual, name) {
# tests data: formulae
tests <- c(y~z, y~1+z, y~0+z, y~-1+z, y~z*k, y~z*k+w*m, u~z*k+w*m, y~z:k)
tests <- c(tests, y~z^2, y~(z+k)^2, y~z*((m+w)^3), y~(z+k)*(w+u))
-tests <- c(tests, y~w%in%v, y~w/k, y~(1 + w/k))
+tests <- c(tests, y~w%in%v, y~w/k, y~(1 + w/k), ~k+y+z)
ignoremm <- c(y~log(z), y~z+I(k+4), y~z+I(k^2), y~z+offset(log(z)))
ignoremf <- NULL
tests <- c(tests, ignoremm)