R-alpha: (minor?) S-R inconsistency: NULL =~= list() -- useful is.ALL function

Martin Maechler Martin Maechler <maechler@stat.math.ethz.ch>
Fri, 15 Aug 1997 17:06:35 +0200


In S, 
	NULL
and
	list()
are not the same.

In R they are (I think).

---------------------------------------------------

At least,

	is.list(NULL) #-> 'F' in S;   'TRUE' in R


Yes: I had an instance where this broke correct S code:

	match(c("xlab","ylab"), names(list(...)))

when '...' is empty, 
gives an error in R,
but gives
	c(NA,NA)
in S.

------------
You may like my function 'is.ALL(.)' for detecting things like these :
(actually some more functions;
 a relatively nice example of using NextMethod(..) for a new "print" method
)

is.ALL <- function(obj, func.names = ls("library:base"),
                   not.using = c("is.single", "is.na.data.frame", "is.loaded"),
                   true.only = FALSE)
{
  ## Purpose: show many 'attributes' of  R object __obj__
  ## -------------------------------------------------------------------------
  ## Arguments: obj: any R object
  ## -------------------------------------------------------------------------
  ## Author: Martin Maechler, Date:  6 Dec 96, 15:23

  is.fn <- func.names[substring(func.names,1,3) == "is."]
  use.fn <- is.fn[ is.na(match(is.fn, not.using))]

  r <- if(true.only) character(0)
  else structure(vector("list", length= length(use.fn)), names= use.fn)
  for(f in use.fn) {
    if(any(f == c("is.na", "is.finite"))) {
      if(!is.list(obj) && !is.vector(obj) && !is.array(obj)) {
        if(!true.only) r[[f]] <- NA
        next
      }
    }
    ##prt.DEBUG("f =",f,"; last rr:", if(f!=use.fn[1]) rr else ".. not yet..")
    rr <-  (get(f))(obj)
    if(!is.logical(rr)) cat("f=",f," --- rr  is NOT logical  = ",rr,"\n")
    ##if(1!=length(rr))   cat("f=",f," --- rr NOT of length 1; = ",rr,"\n")
    if(true.only && length(rr)==1 && rr) r <- c(r, f)
    else if(!true.only) r[[f]] <- rr
  }
  if(is.list(r)) structure(r, class = "isList") else r
}

print.isList <- function(r, ...)
{
  ## Purpose:  print METHOD  for  'isList' objects
  ## -------------------------------------------------------------------------
  ## Arguments:
  ## -------------------------------------------------------------------------
  ## Author: Martin Maechler, Date: 12 Mar 97, 15:07
  ## >>>>> needs  cmp.logical  --> /u/maechler/R/Util.R
  if(is.list(r)) {
    nm <- format(names(r))
    rr <- lapply(r,cmp.logical)
    for(i in seq(along=r)) cat(nm[i],":",rr[[i]],"\n", ...)
  } else NextMethod("print", ...)
}

cmp.logical <- function(log.v)
{
  ## Purpose: compact printing of logicals
  ## -------------------------------------------------------------------------
  ## Arguments: log.v : logical vector
  ## -------------------------------------------------------------------------
  ## Author: Martin Maechler, Date: 13 Dec 96, 16:28
  if(!is.logical(log.v)) {
    warning("coercing argument 'log.v' to logical")
    log.v <- as.logical(log.v)
  }
  structure(if(length(log.v) == 0) "()" else c(".","|")[ 1+ log.v],
	    class = "noquote")
}


## The constructor function
noquote <- function(obj) {
  if(!inherits(obj,"noquote"))
    class(obj) <- c(class(obj),"noquote")
  obj
}
##-- this is just like 'expression'
"[.noquote" <- function (x, subs) structure(unclass(x)[subs], class = "noquote")
## A method for (character) objects of class  'noquote' :
print.noquote <- function(obj,...) {
  cl <- class(obj)
  class(obj) <- cl[cl != "noquote"]
  NextMethod('print', obj, quote = F, ...)
}


### ------------------------------------------------------------------
### Here are some examples on its (is.ALL)  usage :


is.ALL(NULL)

###------- more compactly : ------------ here, we see that   NULL "==" list()

is.ALL(NULL,   true.only = TRUE)
## [1] "is.atomic" "is.list"   "is.null"  
is.ALL(list(), true.only = TRUE)
## [1] "is.atomic" "is.list"   "is.null"  



is.ALL(1:5)
is.ALL(array(1:24, 2:4))
is.ALL(1 + 3)
e13 <- expression(1 + 3)
is.ALL(e13)
## fails (0.50-a) [is.loaded]
##   is.ALL(e13, not.using=c("is.single", "is.finite", "is.na"))
is.ALL(y ~ x) #--> (0.49):  NA  for 'is.na' (& is.finite)



is.ALL(numeric(0), true=T)
is.ALL(array(1,1:3), true=T)
is.ALL(cbind(1:3), true=T)
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-