Martin Maechler
1997-Aug-15 15:06 UTC
R-alpha: (minor?) S-R inconsistency: NULL =~= list() -- useful is.ALL function
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 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
Thomas Lumley
1997-Aug-15 15:53 UTC
R-alpha: (minor?) S-R inconsistency: NULL =~= list() -- useful is.ALL function
On Fri, 15 Aug 1997, Martin Maechler wrote:> In S, > NULL > and > list() > are not the same. > > In R they are (I think). >The thing that really broke your code is an incompatibility I reported a while back that people didn't seem to think was serious. Comparisons involving NULL give an error in R, but give NA in S. I didn't have an example at the time except to point out that returning NA would at least allow correct short-circuiting of & and | conditions. I think in match() there is a much stronger argument for returning NA (or the nomatch value). After all, the description of match says If x[i] is found to equal table[j] then the value returned in the i-th position of the return value is j. If no match is found, the value is nomatch. Surely if table==NULL then the correct return value is nomatch. Thomas Lumley ------------------------------------------------------+------ Biostatistics : "Never attribute to malice what : Uni of Washington : can be adequately explained by : Box 357232 : incompetence" - Hanlon's Razor : Seattle WA 98195-7232 : : ------------------------------------------------------------ =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- 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 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-