[rkward-cvs] SF.net SVN: rkward:[2982] trunk/rkward/rkward/rbackend/rpackages/rkward/R/ public_graphics.R

[kapatp at users.sourceforge.net]

Revision: 2982
          http://rkward.svn.sourceforge.net/rkward/?rev=2982&view=rev
Author:   kapatp
Date:     2010-09-01 06:41:03 +0000 (Wed, 01 Sep 2010)

Log Message:
-----------
Add meta data for standard graphics plots to show info box.

Modified Paths:
--------------
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R	2010-08-31 11:28:27 UTC (rev 2981)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/public_graphics.R	2010-09-01 06:41:03 UTC (rev 2982)
@@ -461,15 +461,50 @@
 		}
 		invisible (NULL)
 	}
+	.get.oldplot.call.std <- function (deviceId)
+	{
+		# rp <- recordPlot () is a nested pairlist object (of class "recordedplot"):
+		# rp[[1]] is the "meta data", rp[[2]] is always raw,
+		# We then figure out the relevant stuff from rp[[1]]. Use "str (rp)" for details.
+		# Currently, only main, xlab, and ylab meta data can be extracted, unambiguously.
+		# The high level calls are not part of the meta data, only the low level .Internal
+		#   calls are stored: Eg: .Primitive (plot.xy), .Primitive (rect), .Primitive (persp), etc...
+		
+		# .f. identifies which element in rp[[1]] contains title (=main,sub,xlab,ylab) information:
+		# differs from call to call. Eg: for plot () calls this is 7, for hist () this is 3, ...
+		.f. <- function ()
+			which (lapply (recorded [[histPositions [[deviceId]]]][[1]], FUN = function (x) x[[1]]) == ".Primitive(\"title\")")
+		# Sometimes there is no title information at all - happens when the high level calling function
+		#   does not specifically provide any of main/sub/xlab/ylab arguemnts: Eg: persp (...)
+		
+		.x. <- list (main = "", xlab = "", ylab = "")
+		
+		# when present, rp [[1]] [[.n.]] [[2]] contains main, sub, xlab, ylab, etc.
+		.n. <- .f. ()
+		if (length (.n.) > 0)
+			.x. [c ("main", "xlab", "ylab")] <- recorded [[histPositions [[deviceId]]]] [[1]] [[.n.]] [[2]] [c(1,3,4)]
+		
+		# single quotes are used becuase kdialog in showPlotInfo needs double quotes
+		paste ("Main: '", .x.$main, "'; X label: '", .x.$xlab, "'; Y label: '", .x.$ylab, "'", sep = "")
+	}
+	.get.oldplot.call.lattice <- function (deviceId)
+	{
+		# trellis objects contain a call object which is the best meta data possible!
+		# If needed, main/xlab/ylab can be extracted as well.
+		paste ("Call: ", deparse (recorded [[histPositions [[deviceId]]]]$call), sep = "")
+	}
 	.get.oldplot.call <- function (deviceId)
 	{
+		# this can be easily extended to more types
 		switch (gType [[histPositions [[deviceId]]]],
-			standard = "\"standard graphics\"",
-			lattice = deparse (recorded [[histPositions [[deviceId]]]]$call),
+			standard = .get.oldplot.call.std (deviceId),
+			lattice = .get.oldplot.call.lattice (deviceId),
 			"Unknown")
 	}
 	.get.plot.info.str <- function (deviceId = dev.cur ())
 	{
+		# if needed a 'timestamp' field can be stored while recording, which can then be used here
+		
 		deviceId <- as.character (deviceId)
 		if (!deviceId %in% names (histPositions)) return ("Preview devices is not managed.")
 		
@@ -480,7 +515,7 @@
 			info.str <- paste ("Device: ", deviceId, 
 				", Position: ", histPositions [[deviceId]], 
 				", Size (KB): ", round (object.size (recorded [[histPositions [[deviceId]]]])/1024, 2),
-				"\nCall: ", .get.oldplot.call (deviceId), sep = "")
+				"\n", .get.oldplot.call (deviceId), sep = "")
 		} # else info.str <- NULL
 		info.str
 	}


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