[R] Why does debugging print() change output of function?

David Winsemius
Sat, 06 Sep 2014 22:31:49 -0000

The goal:
   to create a function modeled after `subset` (notorious for its non-standard
evaluation) that will take a series of logical tests as unqiuoted expressions to
be evaluated in the framework of a dataframe environment and return a dataframe
of logicals:


 mtest.data.frame <-
 function (x, ..., drop=FALSE)
 { tests <- list(...); print(tests)
     r <- if (length(tests)==0)
         stop("no 'tests'")
     else { cbind.data.frame(
             lapply( tests, function(t){
                          e <- substitute(t)
                          r <- eval(e, x, parent.frame() )
                  if ( !is.logical(r) ) {
                      stop("'tests' must be logical") }
                     r & !is.na(r) } ) )
     }
 }
#--------------

testdata <- structure(list(group1 = structure(1:7, .Label = c("Group
A",
"Group B", "Group C", "Group D", "Group
E", "Group F", "Group G"
), class = "factor"), group2 = structure(c(3L, 3L, 2L, 1L, 1L,
2L, 3L), .Label = c("LS", "SS", "UNC"), class =
"factor"), valid1 = structure(c(2L,
1L, NA, 1L, 2L, 2L, 1L), .Label = c("N", "Y"), class =
"factor"),
    valid2 = structure(c(1L, 1L, 2L, 1L, 1L, 2L, 1L), .Label = c("N",
    "Y"), class = "factor"), valid3 = structure(c(4L, 3L,
NA,
    2L, 1L, NA, 5L), .Label = c("0.3", "0.7",
"1.2", "1.4", "1.7"
    ), class = "factor"), valid4 = structure(c(2L, 1L, 3L, 4L,
    1L, 1L, 5L), .Label = c("0.3", "0.4", "0.53",
"0.66", "0.71"
    ), class = "factor"), valid5 = structure(c(4L, 1L, NA, NA,
    3L, NA, 2L), .Label = c("11.2", "11.7", "8.3",
"8.5"), class = "factor")), .Names = c("group1",
"group2", "valid1", "valid2", "valid3",
"valid4", "valid5"), row.names = c(NA,
-7L), class = "data.frame")

#######


> mtest.data.frame(testdata, valid2=="N", valid3 > 1)
[[1]]
[1] "tests are"

[[2]]
[1]  TRUE  TRUE FALSE  TRUE  TRUE FALSE  TRUE

[[3]]
[1]  TRUE  TRUE    NA FALSE FALSE    NA  TRUE

This actually seemed to be somewhat successful, but when ...

Now if I take out the `print()` call for 'tests', I get an different
answer:

> mtest.data.frame <-
+  function (x, ..., drop=FALSE)
+  { tests <- list(...)
+      r <- if (length(tests)==0)
+          stop("no 'tests'")
+      else { cbind.data.frame(
+              lapply( tests, function(t){
+                           e <- substitute(t)
+                           r <- eval(e, x, parent.frame() )
+                   if ( !is.logical(r) ) {
+                       stop("'tests' must be logical") }
+                      r & !is.na(r) } ) )
+      }
+  }
> mtest.data.frame(testdata, valid2=="N", valid3 > 1)
>   # i.e. no answer

--

David Winsemius
Alameda, CA, USA