[rkward-cvs] SF.net SVN: rkward: [1330] trunk/rkward/rkward/plugins/analysis

[tfry at users.sourceforge.net]

Revision: 1330
          http://svn.sourceforge.net/rkward/?rev=1330&view=rev
Author:   tfry
Date:     2007-02-05 11:08:50 -0800 (Mon, 05 Feb 2007)

Log Message:
-----------
Proper handling of complete case exclusion
(why, oh why can't cor() have an option to calculate the probabilities, directly?)

Modified Paths:
--------------
    trunk/rkward/rkward/plugins/analysis/corr_matrix.php
    trunk/rkward/rkward/plugins/analysis/corr_matrix.xml

Modified: trunk/rkward/rkward/plugins/analysis/corr_matrix.php
===================================================================
--- trunk/rkward/rkward/plugins/analysis/corr_matrix.php	2007-02-05 18:30:52 UTC (rev 1329)
+++ trunk/rkward/rkward/plugins/analysis/corr_matrix.php	2007-02-05 19:08:50 UTC (rev 1330)
@@ -3,36 +3,52 @@
 }
 	
 function calculate () {
+	global $use;
+	global $exclude_whole;
+
 	$vars = "substitute (" . str_replace ("\n", "), substitute (", trim (getRK_val ("x"))) . ")";
+	$use = getRK_val ("use");
+	if ($use == "pairwise") {
+		$exclude_whole = false;
+		$use = "\"pairwise.complete.obs\"";
+	} else {
+		$exclude_whole = true;
+		$use = "\"complete.obs\"";
+	}
 
 ?>rk.temp.objects <- list (<? echo ($vars); ?>)
 
 # cor requires all object to be inside the same data.frame.
 # Here we construct such a temporary frame from the input variables
-rk.temp.frame <- data.frame (lapply (rk.temp.objects, eval))
+rk.temp.frame <- data.frame (lapply (rk.temp.objects, function (x) eval (x, envir=globalenv ())))
 
 # calculate correlation matrix
-rk.temp <- cor (rk.temp.frame, use="<? getRK ("use"); ?>", method="<? getRK ("method"); ?>")
+rk.temp <- cor (rk.temp.frame, use=<? echo ($use); ?>, method="<? getRK ("method"); ?>")
 <?	if (getRK_val ("do_p")) { ?>
 # calculate matrix of probabilities
-rk.temp.p <- matrix (nrow = length (rk.temp.objects), ncol = length (rk.temp.objects))
-local (
-	for (i in 1:length (rk.temp.objects)) {
-		for (j in i:length (rk.temp.objects)) {
+rk.temp.p <- matrix (nrow = length (rk.temp.frame), ncol = length (rk.temp.frame))
+local ({
+<?	if ($exclude_whole) { ?>
+	# as we need to do pairwise comparisons for technical reasons,
+	# we need to exclude incomplete cases first to match the use="complete.obs" parameter to cor()
+	rk.temp.frame <- rk.temp.frame[complete.cases (rk.temp.frame),]
+<?	} ?>
+	for (i in 1:length (rk.temp.frame)) {
+		for (j in i:length (rk.temp.frame)) {
 			if (i != j) {
-				t <- cor.test (eval (rk.temp.objects[[i]]), eval (rk.temp.objects[[j]]), use="<? getRK ("use"); ?>", method="<? getRK ("method"); ?>")
+				t <- cor.test (rk.temp.frame[[i]], rk.temp.frame[[j]], method="<? getRK ("method"); ?>")
 				rk.temp.p[i, j] <<- t$p.value
 				rk.temp.p[j, i] <<- t$parameter["df"]
 			}
 		}
 	}
-)
+})
 <?	}
 }
 
 function printout () {
 ?>
-rk.header ("Correlation Matrix", parameters=list ("Method", "<? getRK ("method"); ?>", "Exclusion", "<? getRK ("use"); ?>"))
+rk.header ("Correlation Matrix", parameters=list ("Method", "<? getRK ("method"); ?>", "Exclusion", <? echo ($use); ?>))
 
 rk.temp <- data.frame (I (sapply (rk.temp.objects, FUN=function (x) rk.get.description (x, is.substitute=TRUE))), as.data.frame (rk.temp))
 rk.results (rk.temp, titles=c ('Coefficient', sapply (rk.temp.objects, rk.get.short.name)))

Modified: trunk/rkward/rkward/plugins/analysis/corr_matrix.xml
===================================================================
--- trunk/rkward/rkward/plugins/analysis/corr_matrix.xml	2007-02-05 18:30:52 UTC (rev 1329)
+++ trunk/rkward/rkward/plugins/analysis/corr_matrix.xml	2007-02-05 19:08:50 UTC (rev 1330)
@@ -2,7 +2,7 @@
 
 <document>
 	<code file="corr_matrix.php"/>
-	
+
 	<dialog label="Correlation matrix">
 		<tabbook>
 			<tab label="variables">
@@ -19,8 +19,8 @@
 					<option value="spearman" label="Spearman"/>
 				</radio>
 				<radio id="use" label="Exclude missing values">
-					<option value="complete.obs" label="whole cases"/>
-					<option value="pairwise.complete.obs" label="pairwise" checked="true"/>
+					<option value="complete" label="whole cases"/>
+					<option value="pairwise" label="pairwise" checked="true"/>
 				</radio>
 			</tab>
 		</tabbook>


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