From e8257ab931e4c981e33d11180060c0e46561f60a Mon Sep 17 00:00:00 2001
From: Tomas Stupka <tomas.stupka@oracle.com>
Date: Thu, 15 Feb 2018 18:03:29 +0100
Subject: [PATCH] use an equivalent of the Rf_isVector C function instead of
is.vector which works differently
---
.../com/oracle/truffle/r/library/stats/model.R | 18 ++++++++++++------
1 file changed, 12 insertions(+), 6 deletions(-)
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 5827c72a33..861b588603 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
@@ -20,7 +20,7 @@
# The structure of the implementation somewhat reflects GnuR so that
# it is easier to update this code, should the code in GnuR be changed.
#
-# Please run tests in modelTests.R when updating this file!
+# Please run in GnuR the tests in modelTests.R when updating this file!
#
# ================================================================
@@ -35,9 +35,15 @@ isLanguage <- function(x) {
is.null(x) || typeof(x) == "language"
}
+# as in Rf_isVector which works differently to is.vector
+isVector <- function(x) {
+ typeof(x) %in% c("logical", "integer", "numeric",
+ "double", "complex", "character", "raw", "expression")
+}
+
nrows <- function(x) {
- plain <- unclass(x) # this is necessary because of 'AsIs' class: e.g. I(var+4)
- if (is.factor(x) || is.vector(plain) || is.list(plain) || is.matrix(plain)) {
+ plain <- unclass(x) # this is necessary because of 'AsIs' class: e.g. I(var+4)
+ if (is.factor(x) || isVector(plain) || is.list(plain)) {
dims <- dim(plain);
if (is.null(dims)) {
return(length(plain))
@@ -51,7 +57,7 @@ nrows <- function(x) {
ncols <- function(x) {
plain <- unclass(x)
- if (is.factor(x) || is.vector(plain) || is.list(plain) || is.matrix(plain)) {
+ if (is.factor(x) || isVector(plain) || is.list(plain)) {
dims <- dim(plain);
if (is.null(dims)) {
return(1L);
@@ -88,7 +94,7 @@ isZeroOne <- function(x) {
}
MatchVar <- function(var1, var2) {
- if (is.vector(var1) && is.vector(var2) && var1 == var2) {
+ if (isVector(var1) && isVector(var2) && var1 == var2) {
return(TRUE)
} else if (is.null(var1) && is.null(var2)) {
return(TRUE)
@@ -783,7 +789,7 @@ modelframe <- function(formula, rownames, variables, varnames, dots, dotnames, s
data <- variables
dataNames <- varnames
}
-
+
names(data) <- dataNames
# Note, the following steps up to running na.action could be simplified to:
--
GitLab