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

tfry at users.sourceforge.net tfry at users.sourceforge.net
Mon Dec 4 13:27:19 UTC 2006


Revision: 978
          http://svn.sourceforge.net/rkward/?rev=978&view=rev
Author:   tfry
Date:     2006-12-04 05:27:19 -0800 (Mon, 04 Dec 2006)

Log Message:
-----------
Simplify scatterplot plugin code

Modified Paths:
--------------
    trunk/rkward/ChangeLog
    trunk/rkward/rkward/plugins/02plots/scatterplot/code.php
    trunk/rkward/rkward/plugins/02plots/scatterplot/description.xml

Modified: trunk/rkward/ChangeLog
===================================================================
--- trunk/rkward/ChangeLog	2006-12-04 12:26:10 UTC (rev 977)
+++ trunk/rkward/ChangeLog	2006-12-04 13:27:19 UTC (rev 978)
@@ -1,4 +1,4 @@
-- add (comment) captions to the sections of commands produced by plugins
+- add comment headers to the sections of commands produced by plugins
 - if a user command results in the output html file to be modified, auto-refresh output
 - add RMB menu to script editor windows
 - add options "clear" and "configure" in the console RMB menu, and the command log RMB menu

Modified: trunk/rkward/rkward/plugins/02plots/scatterplot/code.php
===================================================================
--- trunk/rkward/rkward/plugins/02plots/scatterplot/code.php	2006-12-04 12:26:10 UTC (rev 977)
+++ trunk/rkward/rkward/plugins/02plots/scatterplot/code.php	2006-12-04 13:27:19 UTC (rev 978)
@@ -1,148 +1,85 @@
 <?
-	function preprocess () {
-	}
+function preprocess () {
+?>
+	rk.temp <- list ()
+<?
+}
 
-	function calculate () {
-$x = str_replace ("\n", ",", trim (getRK_val ("x"))) ;
-$y = str_replace ("\n", ",", trim (getRK_val ("y"))) ;
-
-/** fetch some values which are needed in more than one place, to avoid mulitple transfer */
-$type = getRK_val ("type");
-$typeCusto = getRK_val ("typeCusto");
-$col = getRK_val ("col");
-$pch = getRK_val ("pch");
-$cex = getRK_val ("cex");
-if (getRK_val("isXaxis") == "1") $Xname = getRK_val ("Xname"); else $Xname = "";
-if (getRK_val("isYaxis") == "1") $Yname = getRK_val ("Yname"); else $Yname = "";
-if (getRK_val("isTitle") == "1") $main = getRK_val ("main"); else $main = "";
-if (getRK_val("isSub") == "1") $sub = getRK_val ("sub"); else $sub = "";
+function calculate () {
+	$x = str_replace ("\n", ",", trim (getRK_val ("x"))) ;
+	$y = str_replace ("\n", ",", trim (getRK_val ("y"))) ;
+	
+	/** fetch some values which are needed in more than one place, to avoid mulitple transfer */
+	$type = getRK_val ("type");
+	$typeCusto = getRK_val ("typeCusto");
+	if ($type == "custoType") $type_string = $typeCusto;
+	else $type_string = $type;
+	$col = getRK_val ("col");
+	$pch = getRK_val ("pch");
+	$cex = getRK_val ("cex");
+	if (getRK_val("isXaxis") == "1") $Xname = getRK_val ("Xname"); else $Xname = "";
+	if (getRK_val("isYaxis") == "1") $Yname = getRK_val ("Yname"); else $Yname = "";
+	if (getRK_val("isTitle") == "1") $main = getRK_val ("main"); else $main = "";
+	if (getRK_val("isSub") == "1") $sub = getRK_val ("sub"); else $sub = "";
 ?>
 
 <? #input ?>
-rk.plugin.Xvar <- list(<? echo ($x) ;?>)
-rk.plugin.Yvar <- list(<? echo ($y) ;?>)
-rk.plugin.Xval <- <? if (getRK_val("columns") == "custoCol" ) echo (getRK_val("Xscale") . "\n"); else echo ("c(" . $x . ")\n"); ?>
-rk.plugin.Yval <- <? if (getRK_val("rows") == "custoRow" ) echo (getRK_val("Yscale") . "\n"); else echo ("c(" . $y . ")\n"); ?>
+rk.temp$Xvar <- list(<? echo ($x) ;?>)
+rk.temp$Yvar <- list(<? echo ($y) ;?>)
+rk.temp$Xval <- <? if (getRK_val("columns") == "custoCol" ) echo (getRK_val("Xscale") . "\n"); else echo ("c(" . $x . ")\n"); ?>
+rk.temp$Yval <- <? if (getRK_val("rows") == "custoRow" ) echo (getRK_val("Yscale") . "\n"); else echo ("c(" . $y . ")\n"); ?>
 
 <? # verification (chiant mais doit \xEAtre fait)?>
-rk.plugin.ok <- TRUE
-if (length(rk.plugin.Xvar) != length(rk.plugin.Yvar) ) { 
-	rk.plugin.ok <- FALSE ;
-	stop("'X' is of length ",length(rk.plugin.Xvar)," and 'Y' of length ",length(rk.plugin.Yvar) )
+rk.temp$ok <- TRUE
+if (length(rk.temp$Xvar) != length(rk.temp$Yvar)) {
+	rk.temp$ok <- FALSE ;
+	stop("Unequal number of X and Y variables given")
 }
-<?
-if (getRK_val ("color") == "each") { ?>
-if (length( <? echo ($col); ?>) != length(rk.plugin.Xvar)) {
-	rk.plugin.ok <- FALSE
-	stop('only ', length( <? echo ($col); ?>) ,' color(s) is(are) displayed') ;
-}
-<? }
-if (getRK_val ("isPch") == "each") { ?>
-if (length( <? echo ($pch); ?>) != length(rk.plugin.Xvar)) {
-	rk.plugin.ok <- FALSE
-	stop('only ', length( <? echo ($pch); ?>) ,' symbol(s) is(are) displayed') ;
-}
-<? }
-if (getRK_val ("isCe") == "each") { ?>
-if (length( <? echo ($cex); ?>) != length(rk.plugin.Xvar)) {
-	rk.plugin.ok <- FALSE
-	stop('only ', length( <? echo ($cex); ?>) ,' size(s) is(are) displayed') ;
-}
-<? }
-if ($type == "custoType") { ?>
-if (length( <? echo ($typeCusto); ?>) != length(rk.plugin.Xvar)) {
-	rk.plugin.ok <- FALSE
-	stop('only ', length( <? echo ($typeCusto); ?>) ,' type(s) is(are) displayed') ;
-}
-<? } ?>
 
-if (rk.plugin.ok) {
+# find range of X/Y values needed
+rk.temp$Xdef <- c(min(rk.temp$Xval,na.rm=TRUE), max(rk.temp$Xval,na.rm=TRUE))
+rk.temp$Ydef <- c(min(rk.temp$Yval,na.rm=TRUE), max(rk.temp$Yval,na.rm=TRUE))
 
-<? #finding min and max for default plotin  ; ?>
-rk.plugin.Xdef <- c(min(rk.plugin.Xval,na.rm=TRUE) , max(rk.plugin.Xval,na.rm=TRUE))
-rk.plugin.Ydef <- c(min(rk.plugin.Yval,na.rm=TRUE) , max(rk.plugin.Yval,na.rm=TRUE))
-
-<? # names ?>
-rk.plugin.Xname <- '<? echo ($Xname); ?>'
-rk.plugin.Yname <- '<? echo ($Yname); ?>'
-rk.plugin.title <- '<? echo ($main); ?>'
-rk.plugin.sub <- '<? echo ($sub); ?>'
-
-<? # type ?>
-rk.plugin.tc <- data.frame(
-type = rep(NA,length(rk.plugin.Xvar)),
-col = rep(NA,length(rk.plugin.Xvar)),
-pch = rep(NA,length(rk.plugin.Xvar)),
-cex = rep(NA,length(rk.plugin.Xvar)))
-
-<? if  ($type != "custoType" ) echo ( $type . " ->  rk.plugin.tc[[1]]\n" ) ;
-else echo( $typeCusto . " ->  rk.plugin.tc[[1]]\n"  ) ?>
-rk.plugin.tc[[2]] <- <? echo ($col . "\n"); ?>
-rk.plugin.tc[[3]] <- <? echo ($cex . "\n"); ?>
-rk.plugin.tc[[4]] <- <? echo ($pch . "\n"); ?>
-
-<? # avant apr\xE8s ?>
-<? /* TODO 
-rk.plugin.on = expression( <? getRK("rkgraphson") ; ?>) ;
-rk.plugin.off = expression( <? getRK("rkgraphsoff") ; ?>) ;
-*/ ?>
-
-<? # axes ?>
-rk.plugin.axes = <? getRK("axes") ;?> 
-rk.plugin.log = '<? getRK("logX") ; getRK("logY") ; ?>'
-
-
-}
+rk.temp$type <- rep (<? echo ($type_string); ?>, length.out=length (rk.temp$Xvar));
+rk.temp$col <- rep (<? echo ($col); ?>, length.out=length (rk.temp$Xvar));
+rk.temp$cex <- rep (<? echo ($cex); ?>, length.out=length (rk.temp$Xvar));
+rk.temp$pch <- rep (<? echo ($pch); ?>, length.out=length (rk.temp$Xvar));
 <?
+}
 
-	}
-
-	function printout () {
+function printout () {
 	
 ?>
-if (rk.plugin.ok) {
+if (rk.temp$ok) stop ()
 
 rk.graph.on()
-<? 
-$before = getRK_val ("before");
-if (!empty ($before)) echo ($before);
-?>
 
-# making frame 
-plot(rk.plugin.Xdef,rk.plugin.Ydef,type="n" , xlab = rk.plugin.Xname , ylab = rk.plugin.Yname , main = rk.plugin.title , sub = rk.plugin.sub , axes = rk.plugin.axes , log = rk.plugin.log)
-
-# ploting 
-for (rk.plugin.iterator in 1:length(rk.plugin.Xvar)) {
-	points  (
-		rk.plugin.Xvar[[rk.plugin.iterator]] ,
-		rk.plugin.Yvar[[rk.plugin.iterator]] , 
-		type = rk.plugin.tc[[1]][[rk.plugin.iterator]] , 
-		col = rk.plugin.tc [[2]] [[rk.plugin.iterator]] ,
-		cex = rk.plugin.tc [[3]] [[rk.plugin.iterator]] ,
-		pch = rk.plugin.tc [[4]] [[rk.plugin.iterator]] 
+try ({
+	# make frame and axes
+	plot(rk.temp$Xdef, rk.temp$Ydef, type="n", xlab = "<? echo ($Xname); ?>", ylab = "<? echo ($Yname); ?>", main = "<? echo ($main); ?>", sub = "<? echo ($sub); ?>", axes = <? getRK("axes") ;?>, log = "<? getRK("logX") ; getRK("logY") ; ?>")
+	
+	# plot variables one X/Y pair at a time
+	for (rk.temp.iterator in 1:length(rk.temp$Xvar)) {
+		points (
+			rk.temp$Xvar[[rk.temp.iterator]],
+			rk.temp$Yvar[[rk.temp.iterator]],
+			type = rk.temp$type[[rk.temp.iterator]],
+			col = rk.temp$col[[rk.temp.iterator]],
+			cex = rk.temp$cex[[rk.temp.iterator]],
+			pch = rk.temp$pch[[rk.temp.iterator]]
 		)
-}
+	}
+})
 
-<?
-$after = getRK_val ("after");
-if (!empty ($after)) echo ($after);
-?>
-
-<? /*#doesn't work very well
-#if (!is.null(eval(rk.plugin.off))) eval(rk.plugin.off) */ ?>
 rk.graph.off()
-}
 
 <?
-	}
-	
-	function cleanup () {
-?>
+}
 
-rk.plugin.remove = ls() [grep('rk.plugin',ls())]
-rm(list=rk.plugin.remove)
-rm(rk.plugin.remove)
- 
+function cleanup () {
+?>
+rm(rk.temp)
+rm(rk.temp.iterator)
 <?
-	}
+}
 ?>

Modified: trunk/rkward/rkward/plugins/02plots/scatterplot/description.xml
===================================================================
--- trunk/rkward/rkward/plugins/02plots/scatterplot/description.xml	2006-12-04 12:26:10 UTC (rev 977)
+++ trunk/rkward/rkward/plugins/02plots/scatterplot/description.xml	2006-12-04 13:27:19 UTC (rev 978)
@@ -128,21 +128,6 @@
 					</row>
 				</frame>
 			</tab>
-			<tab label="More options" >
-				<text>
-				Everything cannot be here handled : R is too flexibel as concerns plots. Nonetheless, you can add extra code before and after the code of the plugin if you want to add whatever. This will allow you to modify if you want before par() and after to add low-level graphs. Please refer to 'R : an introduction' 
-				</text>
-				<frame label="Advanced options" >
-			<!-- doesn't work very well TODO
-				<checkbox value_unchecked=" " checked="true" value="rk.graph.on()" id="rkgraphson" label="Enter 'rk.graph.on()'" />
-			-->
-				<input size="big" id="before" label="Before plot" />
-				<!-- doesn't work very well TODO
-				<checkbox value_unchecked=" " checked="true" value="rk.graph.off()" id="rkgraphsoff" label="Enter 'rk.graph.off()'" />
-				-->
-				<input size="big" id="after" label="After plot" />
-				</frame>
-			</tab>
 		</tabbook>
 	</dialog>
 	<wizard label="Scatterplot">


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