[Sciviews-commits] r325 - pkg/svMisc/R

[noreply at r-forge.r-project.org]

Author: prezez
Date: 2010-10-04 11:46:50 +0200 (Mon, 04 Oct 2010)
New Revision: 325

Modified:
   pkg/svMisc/R/objList.R
Log:
svMisc::objList - fixed: recursive listing for S4 objects' components, added: backtick quoting for non-syntactic names

Modified: pkg/svMisc/R/objList.R
===================================================================
--- pkg/svMisc/R/objList.R	2010-09-30 12:57:40 UTC (rev 324)
+++ pkg/svMisc/R/objList.R	2010-10-04 09:46:50 UTC (rev 325)
@@ -56,6 +56,13 @@
 		}
 		res <- data.frame(t(sapply(Items, describe, all.info = all.info)),
 			stringsAsFactors = FALSE)
+
+
+		# Quote non-syntactic names
+		nsx <- res$Name != make.names(res$Name)
+		res$Full.name[!nsx] <- res$Name[!nsx]
+		res$Full.name[nsx] <- paste("`", res$Name[nsx], "`", sep = "")
+		res <- res[, c(1, 6, 2:5)]
 	}
 
 	if (NROW(res) == 0) return(Nothing)
@@ -202,19 +209,8 @@
 				seq_along(itemnames)[!w.names], "]]", sep = "")
 		}
 
-		ret <- t(sapply(seq_along(obj), function (i) {
-			x <- obj[[i]]
+		ret <- t(sapply(seq_along(obj), function (i) .objDescr(obj[[i]])))
 
-			d <- dim(x)
-			if (is.null(d)) d <- length(x)
-
-			ret <- c(paste(d, collapse = "x"), mode(x), class(x)[1],
-				is.function(x) || (is.recursive(x) && !is.language(x) &&
-				sum(d) != 0)
-			)
-			return(ret)
-		}))
-
 		ret <- data.frame(itemnames, fullnames, ret, stringsAsFactors = FALSE)
 	}
 	if (!is.null(ret))
@@ -265,17 +261,23 @@
 	itemnames[nsx] <- paste("`", itemnames[nsx], "`", sep = "")
 	fullnames <- paste(objname, "@", itemnames, sep = "")
 
-	ret <- t(sapply(itemnames, function (i) {
-		x <- slot(obj, i)
+	ret <- t(sapply(itemnames, function (i) .objDescr(slot(obj, i))))
 
-		d <- dim(x)
-		if (is.null(d)) d <- length(x)
-
-		ret <- c(paste(d, collapse = "x"), mode(x), class(x)[1],
-			is.function(x) || (is.recursive(x) && !is.language(x) &&
-			sum(d) != 0))
-	}))
-
 	ret <- data.frame(itemnames, fullnames, ret, stringsAsFactors = FALSE)
 	return(ret)
 }
+
+## Returns a *character* vector with elements: dims, mode, class, rec(ursive)
+.objDescr <- function (x) {
+	d <- dim(x)
+	if (is.null(d)) d <- length(x)
+
+	return(c(
+	  dims=paste(d, collapse = "x"),
+	  mode=mode(x),
+	  class=class(x)[1],
+	  rec=mode(x) == "S4" ||
+		is.function(x) ||
+		(is.recursive(x) && !is.language(x) && sum(d) != 0)
+	  ))
+}