[rkward-cvs] SF.net SVN: rkward:[3527] trunk/rkward

tfry at users.sourceforge.net tfry at users.sourceforge.net
Mon Apr 25 11:40:08 UTC 2011


Revision: 3527
          http://rkward.svn.sourceforge.net/rkward/?rev=3527&view=rev
Author:   tfry
Date:     2011-04-25 11:40:08 +0000 (Mon, 25 Apr 2011)

Log Message:
-----------
Add convenience function rk.list() to allow simplification of plugin generated code.
Esp. this should allow to do away with most substitute()ing. Crosstabs N to 1 is the first plugin to make use of this.

Modified Paths:
--------------
    trunk/rkward/ChangeLog
    trunk/rkward/rkward/plugins/analysis/crosstab.js
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R
    trunk/rkward/rkward/rbackend/rpackages/rkward/man/rk.get.label.Rd

Modified: trunk/rkward/ChangeLog
===================================================================
--- trunk/rkward/ChangeLog	2011-04-25 09:28:51 UTC (rev 3526)
+++ trunk/rkward/ChangeLog	2011-04-25 11:40:08 UTC (rev 3527)
@@ -1,3 +1,4 @@
+- Added convenience R function rk.list() to allow simplification of plugin code		# TODO: ideally, this should be used in all applicable plugins
 - Added stack-based window switching using Ctrl+(Shift)+Tab; this replaces the old "Next Window" and "Previous Window" actions
 - Fixed: Graphics device windows would disappear when trying to attach them to the main window with some versions of Qt
 - Fixed: tcl/tk widgets would locki up after running commands in the R Console

Modified: trunk/rkward/rkward/plugins/analysis/crosstab.js
===================================================================
--- trunk/rkward/rkward/plugins/analysis/crosstab.js	2011-04-25 09:28:51 UTC (rev 3526)
+++ trunk/rkward/rkward/plugins/analysis/crosstab.js	2011-04-25 11:40:08 UTC (rev 3527)
@@ -1,18 +1,14 @@
 function calculate () {
 	var x = getValue ("x") ;
-	var y = "substitute (" + trim (getValue ("y")).replace (/\n/g, "), substitute (") + ")";
+	var y = trim (getValue ("y")).split (/\n/).join (', ');
 
-	echo ('x <- ' + x + "\n");
-	echo ('yvars <- list (' + y + ')\n');
+	echo ('x <- rk.list (' + x + ')\n');
+	echo ('yvars <- rk.list (' + y + ')\n');
 	echo ('results <- list()\n');
-	echo ('descriptions <- list ()\n');
 	echo ('\n');
 	echo ('# calculate crosstabs\n');
 	echo ('for (i in 1:length (yvars)) {\n');
-	echo ('	yvar <- eval (yvars[[i]], envir=globalenv ())\n');
-	echo ('	results[[i]] <- table(x, yvar)\n');
-	echo ('\n');
-	echo ('	descriptions[[i]] <- list (\'Dependent\'=rk.get.description (' + x + '), \'Independent\'=rk.get.description (yvars[[i]], is.substitute=TRUE))\n');
+	echo ('	results[[i]] <- table(x[[1]], yvars[[i]])\n');
 	echo ('}\n');
 	if (getValue ("chisq") == "TRUE") {
 		echo ('\n');
@@ -44,17 +40,17 @@
 	if (full) {
 		echo ('rk.header ("Crosstabs (n to 1)", level=1)\n');
 		echo ('for (i in 1:length (results)) {\n');
-		echo ('	rk.header ("Crosstabs (n to 1)", parameters=list ("Dependent", descriptions[[i]][[\'Dependent\']], "Independent", descriptions[[i]][[\'Independent\']]), level=2)\n');
-		echo ('	rk.results (results[[i]], titles=c(descriptions[[i]][[\'Dependent\']], descriptions[[i]][[\'Independent\']]))\n');
+		echo ('	rk.header ("Crosstabs (n to 1)", parameters=list ("Dependent", names (x)[1], "Independent", names (yvars)[i]), level=2)\n');
+		echo ('	rk.results (results[[i]], titles=c(names (x)[1], names (yvars)[i]))\n');
 		if (getValue ("chisq") == "TRUE") {
 			echo ('\n');
-			echo ('	rk.header ("Pearson\'s Chi Square Test for Crosstabs", list ("Dependent", descriptions[[i]][[\'Dependent\']], "Independent", descriptions[[i]][[\'Independent\']], "Method", chisquares[[i]][["method"]]), level=2)\n');
+			echo ('	rk.header ("Pearson\'s Chi Square Test for Crosstabs", list ("Dependent", names (x)[1], "Independent", names (yvars)[i], "Method", chisquares[[i]][["method"]]), level=2)\n');
 			echo ('	rk.results (list (\'Statistic\'=chisquares[[i]][[\'statistic\']], \'df\'=chisquares[[i]][[\'parameter\']], \'p\'=chisquares[[i]][[\'p.value\']]))\n');
 		}
 
 		if (getValue ("barplot") == "TRUE") {
 			echo ('\n');
-			echo ('	rk.header ("Barplot for Crosstabs", list ("Dependent", descriptions[[i]][[\'Dependent\']], "Independent", descriptions[[i]][[\'Independent\']]' + getValue ('barplot_embed.code.preprocess') + '), level=2)\n');
+			echo ('	rk.header ("Barplot for Crosstabs", list ("Dependent", names (x)[1], "Independent", names (yvars)[i]' + getValue ('barplot_embed.code.preprocess') + '), level=2)\n');
 			echo ('	rk.graph.on ()\n');
 			echo ('	try ({\n');
 			printIndented ("\t\t", getValue ('barplot_embed.code.printout'));
@@ -67,6 +63,5 @@
 		echo ("i <- 1\n");
 		echo (getValue ('barplot_embed.code.printout'));
 	}
-
 }
 

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R	2011-04-25 09:28:51 UTC (rev 3526)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R	2011-04-25 11:40:08 UTC (rev 3527)
@@ -74,6 +74,13 @@
 	}
 }
 
+# Drop-in replacement for list(). Returns a list of the given arguments, but with names set according to rk.get.description
+"rk.list" <- function (...) {
+	ret <- list (...)
+	names (ret) <- rk.get.description (...)
+	ret
+}
+
 # this is basically copied from R-base table (). Returns the arguments passed to ... as a character vector
 "rk.list.names" <- function(..., deparse.level=2) {
 	l <- as.list(substitute(list(...)))[-1]

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/man/rk.get.label.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/man/rk.get.label.Rd	2011-04-25 09:28:51 UTC (rev 3526)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/man/rk.get.label.Rd	2011-04-25 11:40:08 UTC (rev 3527)
@@ -5,6 +5,7 @@
 \alias{rk.get.short.name}
 \alias{rk.get.description}
 \alias{rk.list.names}
+\alias{rk.list}
 
 \title{Various label related utility functions}
 
@@ -14,6 +15,7 @@
 rk.get.short.name(x)
 rk.get.description(..., paste.sep = NULL, is.substitute = FALSE)
 rk.list.names(..., deparse.level = 2)
+rk.list(...)
 }
 
 \arguments{
@@ -34,6 +36,8 @@
  \code{rk.get.description} creates descriptive string(s) for each of the arguments in "\code{\dots}"; collapsing into a single string using \code{paste.sep} (if not NULL). If \code{is.substitute=TRUE}, the arguments will be deparsed, first, which can be useful when using \code{rk.get.description} inside a function.
 
  \code{rk.list.names} returns the names of the arguments passed as \code{...}; when using \code{rk.list.names} inside a function, it may be necessary to increase the \code{deparse.level} level.
+
+ \code{rk.list} returns a list of its arguments, with \code{names} set as returned by \code{rk.get.description()}. This can be used as a drop-in replacement for \code{\link{list}}.
 }
 
 \value{
@@ -49,6 +53,7 @@
 rk.get.label (x$a)                        # "First column"
 rk.get.description (x$a)                  # "x$a (First column)"
 rk.list.names (x, x$a, x$b)               # "x" "x$a" "x$b"
+names (rk.list (x$a, x$b))                # "x$a (First column)" "x$b"
 }
 
 \keyword{utilities}


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




More information about the rkward-tracker mailing list