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

[tfry at users.sourceforge.net]

Revision: 1262
          http://svn.sourceforge.net/rkward/?rev=1262&view=rev
Author:   tfry
Date:     2007-01-31 12:49:22 -0800 (Wed, 31 Jan 2007)

Log Message:
-----------
implement SPSS import plugin

Modified Paths:
--------------
    trunk/rkward/ChangeLog
    trunk/rkward/rkward/plugins/00saveload/import/import_spss.php
    trunk/rkward/rkward/plugins/00saveload/import/import_spss.xml
    trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R

Modified: trunk/rkward/ChangeLog
===================================================================
--- trunk/rkward/ChangeLog	2007-01-31 19:26:34 UTC (rev 1261)
+++ trunk/rkward/ChangeLog	2007-01-31 20:49:22 UTC (rev 1262)
@@ -1,3 +1,5 @@
+- new plugin: import SPSS files								TODO: document
+- new documentation pages: console
 - improvements to distribution plot plugins
 - new plugins: distribution plots 							TODO: list them
 - fixed: installing packages as root would not work, when $R_HOME is not defined

Modified: trunk/rkward/rkward/plugins/00saveload/import/import_spss.php
===================================================================
--- trunk/rkward/rkward/plugins/00saveload/import/import_spss.php	2007-01-31 19:26:34 UTC (rev 1261)
+++ trunk/rkward/rkward/plugins/00saveload/import/import_spss.php	2007-01-31 20:49:22 UTC (rev 1262)
@@ -5,15 +5,41 @@
 }
 
 function calculate () {
+	if (getRK_val ("data_frame")) {
+		$data_frame = true;
+		$data_frame_opt = ", to.data.frame=TRUE";
+	}
+
+	if (getRK_val ("use_labels")) {
+		$labels_opt = ", use.value.labels=TRUE";
+		$labels_opt .= ", max.value.labels=" . getRK_val ("labels_limit");
+		if (getRK_val ("trim_labels")) $labels_opt .= ", trim.factor.names=TRUE";
+	}
+
+	$object = getRK_val ("saveto");
 ?>
-print ("<? getRK ("file"); ?>")
+<? echo ($object); ?> <- read.spss ("<? getRK ("file"); ?>"<? echo ($data_frame_opt); echo ($labels_opt); ?>)
+
+<?	if ($data_frame) { ?>
+# set variable labels for use in RKWard
+rk.temp.labels <- attr (<? echo ($object); ?>, "variable.labels");
+if (!is.null (rk.temp.labels)) {
+	for (rk.temp.i in 1:length (rk.temp.labels)) {
+		rk.temp.col <- make.names (names (rk.temp.labels[rk.temp.i]))
+		if (!is.null (rk.temp.col)) {
+			rk.set.label (<? echo ($object); ?>[[rk.temp.col]], rk.temp.labels[rk.temp.i])
+		}
+	}
+}
+<?	} ?>
 <?
 }
 	
 function printout () {
 }
 	
-function cleanup () {
-?><?
+function cleanup () { ?>
+rm (list=grep ("^rk.temp", ls (), value=TRUE))
+<?
 }
 ?>

Modified: trunk/rkward/rkward/plugins/00saveload/import/import_spss.xml
===================================================================
--- trunk/rkward/rkward/plugins/00saveload/import/import_spss.xml	2007-01-31 19:26:34 UTC (rev 1261)
+++ trunk/rkward/rkward/plugins/00saveload/import/import_spss.xml	2007-01-31 20:49:22 UTC (rev 1262)
@@ -13,11 +13,11 @@
 		<stretch/>
 		<saveobject id="saveto" initial="my.spss.data" label="Object to save to"/>
 		<stretch/>
-		<checkbox id="data_frame" checked="true" label="Import as a data.frame"/>
+		<checkbox id="data_frame" checked="true" label="Import as a data.frame" value="1" value_unchecked="0"/>
 		<frame label="Labels">
-			<checkbox id="use_labels" checked="true" label="Use value labels"/>
+			<checkbox id="use_labels" checked="true" label="Use value labels" value="1" value_unchecked="0"/>
 			<spinbox id="labels_limit" type="integer" initial="1000000" min="1" label="Maximum number of labels per object" />
-			<checkbox id="trim_labels" checked="false" label="Trim white space"/>
+			<checkbox id="trim_labels" checked="false" label="Trim white space" value="1" value_unchecked="0"/>
 		</frame>
 	</dialog>
 </document>

Modified: trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R	2007-01-31 19:26:34 UTC (rev 1261)
+++ trunk/rkward/rkward/rbackend/rpackages/rkward/R/public.R	2007-01-31 20:49:22 UTC (rev 1262)
@@ -8,6 +8,17 @@
 	as.character (as.vector (ret))
 }
 
+# set rkward label
+"rk.set.label" <- function (x, label) {
+	if (is.call (x) || is.name (x)) {
+		meta <- attr (eval (x), ".rk.meta")
+	} else {
+		meta <- attr (x, ".rk.meta")
+	}
+	meta[["label"]] <- as.character (label)
+	eval (substitute (attr (x, ".rk.meta") <<- meta))
+}
+
 # get a short name for the given object
 "rk.get.short.name" <- function (x) {
 	if (is.call (x) || is.name (x)) {


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