PUB-575: ifelse with assign in a non-test slot

nkhuyu · Jul 25, 2014 · 4b3ef78 · 4b3ef78
1 parent 3b8b0c6
commit 4b3ef78
Show file tree

Hide file tree

Showing 2 changed files with 87 additions and 24 deletions.
diff --git a/R/h2o-package/R/Classes.R b/R/h2o-package/R/Classes.R
@@ -1243,34 +1243,77 @@ screeplot.H2OPCAModel <- function(x, npcs = min(10, length(x@model$sdev)), type
   as.logical(.h2o.__unop2("canBeCoercedToLogical", vec))
 }
 
-setMethod("ifelse", signature(test="H2OParsedData", yes="ANY", no="ANY"), function(test, yes, no) {
-  if(!(is.numeric(yes) || class(yes) == "H2OParsedData") || !(is.numeric(no) || class(no) == "H2OParsedData"))
-    stop("Unimplemented")
-  if(!test@logic && !.canBeCoercedToLogical(test)) stop(test@key, " is not a H2O logical data type")
-  .h2o.__multop2("ifelse", test, yes, no)
-})
+.check.ifelse.conditions <-
+function(test, yes, no, type) {
+ if (type == "test") {
+   return(class(test) == "H2OParsedData"
+            && (is.numeric(yes) || class(yes) == "H2OParsedData")
+            && (is.numeric(no) || class(no) == "H2OParsedData")
+            && (test@logic || .canBeCoercedToLogical(test)))
+ }
+}
 
-setMethod("ifelse", signature(test="logical", yes="H2OParsedData", no="numeric"), function(test, yes, no) {
-  if(length(test) > 1) stop("test must be a single logical value")
-  .h2o.__multop2("ifelse", as.numeric(test), yes, no)
-})
+ifelse<-
+function (test, yes, no)
+{
+    if (.check.ifelse.conditions(test, yes, no, "test")) {
+      return(.h2o.__multop2("ifelse", test, yes, no))
 
-setMethod("ifelse", signature(test="logical", yes="numeric", no="H2OParsedData"), function(test, yes, no) {
-  if(length(test) > 1) stop("test must be a single logical value")
-  .h2o.__multop2("ifelse", as.numeric(test), yes, no)
-})
+    } else if ( class(yes) == "H2OParsedData" && class(test) == "logical") {
+      return(.h2o.__multop2("ifelse", as.numeric(test), yes, no))
 
-setMethod("ifelse", signature(test="logical", yes="H2OParsedData", no="H2OParsedData"), function(test, yes, no) {
-  if(length(test) > 1) stop("test must be a single logical value")
-  .h2o.__multop2("ifelse", as.numeric(test), yes, no)
-})
+    } else if (class(no) == "H2OParsedData" && class(test) == "logical") {
+      return(.h2o.__multop2("ifelse", as.numeric(test), yes, no))
+    }
+    if (is.atomic(test))
+        storage.mode(test) <- "logical"
+    else test <- if (isS4(test))
+        as(test, "logical")
+    else as.logical(test)
+    ans <- test
+    ok <- !(nas <- is.na(test))
+    if (any(test[ok]))
+        ans[test & ok] <- rep(yes, length.out = length(ans))[test &
+            ok]
+    if (any(!test[ok]))
+        ans[!test & ok] <- rep(no, length.out = length(ans))[!test &
+            ok]
+    ans[nas] <- NA
+    ans
+}
 
-setMethod("levels", "H2OParsedData", function(x) {
-  # if(ncol(x) != 1) return(NULL)
-  if(ncol(x) != 1) stop("Can only retrieve levels of one column.")
-  res = .h2o.__remoteSend(x@h2o, .h2o.__HACK_LEVELS2, source = x@key, max_ncols = .Machine$integer.max)
-  res$levels[[1]]
-})
+#setMethod("ifelse", signature(test="H2OParsedData", yes="ANY", no="ANY"), function(test, yes, no) {
+#  if(!(is.numeric(yes) || class(yes) == "H2OParsedData") || !(is.numeric(no) || class(no) == "H2OParsedData"))
+#    stop("Unimplemented")
+#  if(!test@logic && !.canBeCoercedToLogical(test)) stop(test@key, " is not a H2O logical data type")
+#  h2o.exec(ifelse(test, yes, no))
+##  .h2o.__multop2("ifelse", eval(test), yes, no)
+#})
+##
+#setMethod("ifelse", signature(test="logical", yes="H2OParsedData", no="ANY"), function(test, yes, no) {
+#  if(length(test) > 1) stop("test must be a single logical value")
+#  h2o.exec(ifelse(test, yes, no))
+##  .h2o.__multop2("ifelse", as.numeric(test), eval(yes), no)
+#})
+#
+#setMethod("ifelse", signature(test="logical", yes="ANY", no="H2OParsedData"), function(test, yes, no) {
+#  if(length(test) > 1) stop("test must be a single logical value")
+#  h2o.exec(ifelse(test, yes, no))
+##  .h2o.__multop2("ifelse", as.numeric(test), yes, eval(no))
+#})
+#
+#setMethod("ifelse", signature(test="logical", yes="H2OParsedData", no="H2OParsedData"), function(test, yes, no) {
+#  if(length(test) > 1) stop("test must be a single logical value")
+#  h2o.exec(ifelse(test, yes, no))
+##  .h2o.__multop2("ifelse", as.numeric(test), eval(yes), eval(no))
+#})
+#
+#setMethod("levels", "H2OParsedData", function(x) {
+#  # if(ncol(x) != 1) return(NULL)
+#  if(ncol(x) != 1) stop("Can only retrieve levels of one column.")
+#  res = .h2o.__remoteSend(x@h2o, .h2o.__HACK_LEVELS2, source = x@key, max_ncols = .Machine$integer.max)
+#  res$levels[[1]]
+#})
 
 #----------------------------- Work in Progress -------------------------------#
 # TODO: Need to change ... to environment variables and pass to substitute method,

diff --git a/R/tests/testdir_jira/runit_pub_575_ifelse_with_assign.R b/R/tests/testdir_jira/runit_pub_575_ifelse_with_assign.R
@@ -0,0 +1,20 @@
+setwd(normalizePath(dirname(R.utils::commandArgs(asValues=TRUE)$"f")))
+source('../findNSourceUtils.R')
+
+test.pub_575 <- function(localH2O) {
+
+covtype.hex <- h2o.importFile(localH2O, normalizePath(locate("smalldata/covtype/covtype.20k.data")), "cov")
+
+hex <- covtype.hex
+
+print(ifelse(TRUE, hex, hex[,1] <- hex[,1] + 1))
+
+#ensure that base ifelse is not broken
+print(ifelse(TRUE, iris, iris[,1] <- iris[,1] + 1))
+
+testEnd()
+
+}
+
+doTest("PUB-575 ifelse with embedded assignment", test.pub_575)
+