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

tfry at users.sourceforge.net tfry at users.sourceforge.net
Sun Oct 1 21:44:22 UTC 2006


Revision: 786
          http://svn.sourceforge.net/rkward/?rev=786&view=rev
Author:   tfry
Date:     2006-10-01 14:44:11 -0700 (Sun, 01 Oct 2006)

Log Message:
-----------
First raw implementation of RData fetching

Modified Paths:
--------------
    trunk/rkward/rkward/rbackend/Makefile.am
    trunk/rkward/rkward/rbackend/rcommand.cpp
    trunk/rkward/rkward/rbackend/rcommand.h
    trunk/rkward/rkward/rbackend/rembedinternal.cpp
    trunk/rkward/rkward/rbackend/rembedinternal.h
    trunk/rkward/rkward/rbackend/rthread.cpp

Added Paths:
-----------
    trunk/rkward/rkward/rbackend/rdata.cpp
    trunk/rkward/rkward/rbackend/rdata.h

Modified: trunk/rkward/rkward/rbackend/Makefile.am
===================================================================
--- trunk/rkward/rkward/rbackend/Makefile.am	2006-10-01 20:37:10 UTC (rev 785)
+++ trunk/rkward/rkward/rbackend/Makefile.am	2006-10-01 21:44:11 UTC (rev 786)
@@ -5,7 +5,7 @@
 
 noinst_LIBRARIES =  librbackend.a
 librbackend_a_SOURCES = rembedinternal.cpp rinterface.cpp rthread.cpp rcommand.cpp rcommandreceiver.cpp rcommandstack.cpp \
-rkwindowcatcher.cpp
+rkwindowcatcher.cpp rdata.cpp
 noinst_HEADERS = rembedinternal.h rinterface.h rthread.h rcommand.h rcommandreceiver.h rcommandstack.h \
-rkwindowcatcher.h
+rkwindowcatcher.h rdata.h
 SUBDIRS =  rpackages

Modified: trunk/rkward/rkward/rbackend/rcommand.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rcommand.cpp	2006-10-01 20:37:10 UTC (rev 785)
+++ trunk/rkward/rkward/rbackend/rcommand.cpp	2006-10-01 21:44:11 UTC (rev 786)
@@ -2,7 +2,7 @@
                           rcommand.cpp  -  description
                              -------------------
     begin                : Mon Nov 11 2002
-    copyright            : (C) 2002 by Thomas Friedrichsmeier
+    copyright            : (C) 2002, 2006 by Thomas Friedrichsmeier
     email                : tfry at users.sourceforge.net
  ***************************************************************************/
 
@@ -154,68 +154,3 @@
 	}
 	return ret;
 }
-
-//////////////////////// RData ////////////////////////////77
-
-RData::RData () {
-	RK_TRACE (RBACKEND);
-	datatype = NoData;
-	data = 0;
-	length = 0; 
-}
-
-RData::~RData () {
-	RK_TRACE (RBACKEND);
-
-	if (datatype == StructureVector) {
-		RData **sdata = getStructureVector ();
-		for (int i=length-1; i >= 0; --i) {
-			delete (sdata[i]);
-		}
-		delete [] sdata;
-	} else if (datatype == IntVector) {
-		int *idata = getIntVector ();
-		delete [] idata;
-	} else if (datatype == RealVector) {
-		double *rdata = getRealVector ();
-		delete [] rdata;
-	} else if (datatype == StringVector) {
-		QString *stdata = getStringVector ();
-		delete [] stdata;
-	} else {
-		RK_ASSERT (datatype == NoData);
-	}
-}
-
-double *RData::getRealVector () {
-	if (datatype == RealVector) return (static_cast<double *> (data));
-
-	RK_ASSERT (false);
-	return 0;
-}
-
-int *RData::getIntVector () {
-	if (datatype == IntVector) return (static_cast<int *> (data));
-
-	RK_ASSERT (false);
-	return 0;
-}
-
-QString *RData::getStringVector () {
-	if (datatype == StringVector) return (static_cast<QString *> (data));
-
-	RK_ASSERT (false);
-	return 0;
-}
-
-RData **RData::getStructureVector () {
-	if (datatype == StructureVector) return (static_cast<RData **> (data));
-
-	RK_ASSERT (false);
-	return 0;
-}
-
-void RData::detachData () {
-	data = 0;
-	length = 0;
-}

Modified: trunk/rkward/rkward/rbackend/rcommand.h
===================================================================
--- trunk/rkward/rkward/rbackend/rcommand.h	2006-10-01 20:37:10 UTC (rev 785)
+++ trunk/rkward/rkward/rbackend/rcommand.h	2006-10-01 21:44:11 UTC (rev 786)
@@ -2,7 +2,7 @@
                           rcommand.h  -  description
                              -------------------
     begin                : Mon Nov 11 2002
-    copyright            : (C) 2002 by Thomas Friedrichsmeier
+    copyright            : (C) 2002, 2006 by Thomas Friedrichsmeier
     email                : tfry at users.sourceforge.net
  ***************************************************************************/
 
@@ -24,8 +24,9 @@
 #include <qptrlist.h>
 #include <qvaluelist.h>
 
-class RCommandReceiver;
+#include "rdata.h"
 
+class RCommandReceiver;
 class RCommand;
 class RChainOrCommand;
 
@@ -76,39 +77,6 @@
 	QString output;
 };
 
-/** Class to represent data (other than output/erros) passed from the R backend to the main thread. Data is usually a vector of type int, double or QString, but can also contain a hierarchy of RData*s. RCommand is a subclass of this */ 
-class RData {
-public:
-	RData ();
-	~RData ();
-	enum RDataType {
-		StructureVector,
-		IntVector,
-		RealVector,
-		StringVector,
-		NoData
-	};
-
-/** returns the type of data contained */
-	RDataType getDataType () { return datatype; };
-/** returns the length (size) of the data array. @see RCommand::GetStringVector @see RCommand::GetRealVector @see RCommand::GetIntVector @see RCommand:GetStructure */
-	unsigned int getDataLength () { return length; };
-/** returns an array of double, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetRealVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
-	double *getRealVector ();
-/** returns an array of int, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetIntVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
-	int *getIntVector ();
-/** returns an array of QString, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetStringVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
-	QString *getStringVector ();
-/** returns an array of RData*, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetStructureVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
-	RData **getStructureVector ();
-/** The data contained in the RData structure is owned by RData, and will usually be deleted at the end of the lifetime of the RData object. If you want to keep the data, call detachData () to prevent this deletion. You will be responsible for deletion of the data yourself. */
-	void detachData ();
-protected:
-	RDataType datatype;
-	void *data;
-	unsigned int length;
-};
-
 /*
 struct RGetValueRequest {
 private:
@@ -192,7 +160,8 @@
 		GetIntVector=512,			/**< Try to fetch result as an array of integers */
 		GetStringVector=1024,	/**< Try to fetch result as an array of chars */
 		GetRealVector=2048,		/**< Try to fetch result as an array of doubles */
-		DirectToOutput=4096		/**< Append command output to the HTML-output file */
+		GetStructuredData=4096,		/**< Try to fetch result as an RData structure */
+		DirectToOutput=8192		/**< Append command output to the HTML-output file */
 	};
 	enum CommandStatus {
 		WasTried=1,						/**< the command has been passed to the backend. */

Added: trunk/rkward/rkward/rbackend/rdata.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rdata.cpp	                        (rev 0)
+++ trunk/rkward/rkward/rbackend/rdata.cpp	2006-10-01 21:44:11 UTC (rev 786)
@@ -0,0 +1,94 @@
+/***************************************************************************
+                          rdata  -  description
+                             -------------------
+    begin                : Sun Oct 01 2006
+    copyright            : (C) 2006 by Thomas Friedrichsmeier
+    email                : tfry at users.sourceforge.net
+ ***************************************************************************/
+
+/***************************************************************************
+ *                                                                         *
+ *   This program is free software; you can redistribute it and/or modify  *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ ***************************************************************************/
+
+#include "rdata.h"
+
+#include <qstring.h>
+
+#include "../debug.h"
+
+RData::RData () {
+	RK_TRACE (RBACKEND);
+	datatype = NoData;
+	data = 0;
+	length = 0; 
+}
+
+RData::~RData () {
+	RK_TRACE (RBACKEND);
+
+	if (datatype == StructureVector) {
+		RData **sdata = getStructureVector ();
+		for (int i=length-1; i >= 0; --i) {
+			delete (sdata[i]);
+		}
+		delete [] sdata;
+	} else if (datatype == IntVector) {
+		int *idata = getIntVector ();
+		delete [] idata;
+	} else if (datatype == RealVector) {
+		double *rdata = getRealVector ();
+		delete [] rdata;
+	} else if (datatype == StringVector) {
+		QString *stdata = getStringVector ();
+		delete [] stdata;
+	} else {
+		RK_ASSERT (datatype == NoData);
+	}
+}
+
+double *RData::getRealVector () {
+	if (datatype == RealVector) return (static_cast<double *> (data));
+
+	RK_ASSERT (false);
+	return 0;
+}
+
+int *RData::getIntVector () {
+	if (datatype == IntVector) return (static_cast<int *> (data));
+
+	RK_ASSERT (false);
+	return 0;
+}
+
+QString *RData::getStringVector () {
+	if (datatype == StringVector) return (static_cast<QString *> (data));
+
+	RK_ASSERT (false);
+	return 0;
+}
+
+RData **RData::getStructureVector () {
+	if (datatype == StructureVector) return (static_cast<RData **> (data));
+
+	RK_ASSERT (false);
+	return 0;
+}
+
+void RData::detachData () {
+	data = 0;
+	length = 0;
+}
+
+void RData::setData (RData *from) {
+	data = from->data;
+	length = from->length;
+	datatype = from->datatype;
+
+	from->detachData ();
+	delete from;
+}

Added: trunk/rkward/rkward/rbackend/rdata.h
===================================================================
--- trunk/rkward/rkward/rbackend/rdata.h	                        (rev 0)
+++ trunk/rkward/rkward/rbackend/rdata.h	2006-10-01 21:44:11 UTC (rev 786)
@@ -0,0 +1,60 @@
+/***************************************************************************
+                          rdata  -  description
+                             -------------------
+    begin                : Sun Oct 01 2006
+    copyright            : (C) 2006 by Thomas Friedrichsmeier
+    email                : tfry at users.sourceforge.net
+ ***************************************************************************/
+
+/***************************************************************************
+ *                                                                         *
+ *   This program is free software; you can redistribute it and/or modify  *
+ *   it under the terms of the GNU General Public License as published by  *
+ *   the Free Software Foundation; either version 2 of the License, or     *
+ *   (at your option) any later version.                                   *
+ *                                                                         *
+ ***************************************************************************/
+
+#ifndef RDATA_H
+#define RDATA_H
+
+class QString;
+/** Class to represent data (other than output/erros) passed from the R backend to the main thread. Data is usually a vector of type int, double or QString, but can also contain a hierarchy of RData*s. RCommand is a subclass of this */
+class RData {
+public:
+	RData ();
+	~RData ();
+	enum RDataType {
+		StructureVector,
+		IntVector,
+		RealVector,
+		StringVector,
+		NoData
+	};
+
+/** returns the type of data contained */
+	RDataType getDataType () { return datatype; };
+/** returns the length (size) of the data array. @see RCommand::GetStringVector @see RCommand::GetRealVector @see RCommand::GetIntVector @see RCommand:GetStructure */
+	unsigned int getDataLength () { return length; };
+/** returns an array of double, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetRealVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
+	double *getRealVector ();
+/** returns an array of int, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetIntVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
+	int *getIntVector ();
+/** returns an array of QString, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetStringVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
+	QString *getStringVector ();
+/** returns an array of RData*, if that is the type of data contained (else 0). The array is owned by the RCommand! @see RCommand::GetStructureVector @see RData::detachData () @see RData::getDataLength () @see RData::getDataType () */
+	RData **getStructureVector ();
+/** The data contained in the RData structure is owned by RData, and will usually be deleted at the end of the lifetime of the RData object. If you want to keep the data, call detachData () to prevent this deletion. You will be responsible for deletion of the data yourself. */
+	void detachData ();
+
+/** public for technical reasons only. Do not use! Copy data from the given RData, and discard it */
+	void setData (RData *from);
+/** public for technical reasons only. Do not use! */
+	RDataType datatype;
+/** public for technical reasons only. Do not use! */
+	void *data;
+/** public for technical reasons only. Do not use! */
+	unsigned int length;
+};
+
+#endif

Modified: trunk/rkward/rkward/rbackend/rembedinternal.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rembedinternal.cpp	2006-10-01 20:37:10 UTC (rev 785)
+++ trunk/rkward/rkward/rbackend/rembedinternal.cpp	2006-10-01 21:44:11 UTC (rev 786)
@@ -62,6 +62,7 @@
 }
 
 #include "../rkglobals.h"
+#include "rdata.h"
 
 #ifdef REMBEDINTERNALEXPERIMENTAL
 // code mostly copied from RObjectTables
@@ -404,6 +405,73 @@
 	return list;
 }
 
+int *SEXPToIntArray (SEXP from_exp, unsigned int *count) {
+	int *integers;
+
+	SEXP intexp;
+	PROTECT (intexp = coerceVector (from_exp, INTSXP));
+	*count = length (intexp);
+	integers = new int[*count];
+	for (unsigned int i = 0; i < *count; ++i) {
+		integers[i] = INTEGER (intexp)[i];
+	}
+	UNPROTECT (1);
+
+	return integers;
+}
+
+double *SEXPToRealArray (SEXP from_exp, unsigned int *count) {
+	double *reals;
+
+	SEXP realexp;
+	PROTECT (realexp = coerceVector (from_exp, REALSXP));
+	*count = length (realexp);
+	reals = new double[*count];
+	for (unsigned int i = 0; i < *count; ++i) {
+		reals[i] = REAL (realexp)[i];
+		if (R_IsNaN (reals[i]) || R_IsNA (reals[i]) ) reals[i] = RKGlobals::na_double;
+	}
+	UNPROTECT (1);	// realexp
+
+	return reals;
+}
+
+RData *SEXPToRData (SEXP from_exp) {
+	RData *data = new RData;
+
+	unsigned int count;
+	int type = TYPEOF (from_exp);
+	switch (type) {
+		case INTSXP:
+			data->data = SEXPToIntArray (from_exp, &count);
+			data->datatype = RData::IntVector;
+			break;
+		case REALSXP:
+			data->data = SEXPToRealArray (from_exp, &count);
+			data->datatype = RData::RealVector;
+			break;
+		case VECSXP:
+			count = length (from_exp);
+			{
+				RData **structure_array = new RData*[count];
+				for (unsigned int i=0; i < count; ++i) {
+					structure_array[i] = SEXPToRData (VECTOR_ELT (from_exp, i));
+				}
+				data->data = structure_array;
+			}
+			data->datatype = RData::StructureVector;
+			break;
+		case STRSXP:
+		default:
+			data->data = SEXPToStringList (from_exp, &count);
+			data->datatype = RData::StringVector;
+	}
+
+	data->length = count;
+
+	return data;
+}
+
 SEXP doError (SEXP call) {
 	unsigned int count;
 	QString *strings = SEXPToStringList (call, &count);
@@ -605,15 +673,7 @@
 	PROTECT (exp = runCommandInternalBase (command, error));
 	
 	if (*error == NoError) {
-		SEXP realexp;
-		PROTECT (realexp = coerceVector (exp, REALSXP));
-		*count = length (realexp);
-		reals = new double[*count];
-		for (unsigned int i = 0; i < *count; ++i) {
-			reals[i] = REAL (realexp)[i];
-			if (R_IsNaN (reals[i]) || R_IsNA (reals[i]) ) reals[i] = RKGlobals::na_double;
-		}
-		UNPROTECT (1);	// realexp
+		reals = SEXPToRealArray (exp, count);
 	}
 	
 	UNPROTECT (1); // exp
@@ -632,14 +692,7 @@
 	PROTECT (exp = runCommandInternalBase (command, error));
 	
 	if (*error == NoError) {
-		SEXP intexp;
-		PROTECT (intexp = coerceVector (exp, INTSXP));
-		*count = length (intexp);
-		integers = new int[*count];
-		for (unsigned int i = 0; i < *count; ++i) {
-				integers[i] = INTEGER (intexp)[i];
-		}
-		UNPROTECT (1);	// intexp
+		integers = SEXPToIntArray (exp, count);
 	}
 	
 	UNPROTECT (1); // exp
@@ -651,4 +704,21 @@
 	return integers;
 }
 
+RData *REmbedInternal::getCommandAsRData (const char *command, RKWardRError *error) {
+	SEXP exp;
+	RData *data = 0;
+	
+	PROTECT (exp = runCommandInternalBase (command, error));
+	
+	if (*error == NoError) {
+		data = SEXPToRData (exp);
+	}
+	
+	UNPROTECT (1); // exp
+	
+	if (*error != NoError) {
+		return 0;
+	}
+	return data;
+}
 

Modified: trunk/rkward/rkward/rbackend/rembedinternal.h
===================================================================
--- trunk/rkward/rkward/rbackend/rembedinternal.h	2006-10-01 20:37:10 UTC (rev 785)
+++ trunk/rkward/rkward/rbackend/rembedinternal.h	2006-10-01 21:44:11 UTC (rev 786)
@@ -46,6 +46,7 @@
 };
 
 class QString;
+class RData;
 /** This function converts a list of strings to a QStringList (locale aware), and returns the pointer. Needed to keep R and Qt includes separate. The strings can be deleted afterwards. Implementation is in rthread.cpp */
 QString *stringsToStringList (char **strings, int count);
 /** Function to delete an array of Qstring. Does delete [] strings, nothing more. But can not inline this in this class due to conflicting R and Qt includes. Implementation is in rthread.cpp */
@@ -91,7 +92,7 @@
 will only be printed if called for expressedly with print ("...") or similar. */
 	void runCommandInternal (const char *command, RKWardRError *error, bool print_result=false);
 /** basically a wrapper to runCommandInternal (). Tries to convert the result of the command to an array of char* after running the command. Since
-this will not ever be done for user commands, the R_Visible flag will never be set. @see RCommand::GetStringVector
+this will not ever be done for user commands, the R_Visible flag will never be set.
 @param command char* of the command to be run 
 @param count length of list returned
 @param error this will be set to a value in RKWardError depending on success/failure of the command
@@ -99,7 +100,7 @@
 @see RCommand::GetStringVector */
 	QString *getCommandAsStringVector (const char *command, unsigned int *count, RKWardRError *error);
 /** basically a wrapper to runCommandInternal (). Tries to convert the result of the command to an array of double after running the command. Since
-this will not ever be done for user commands, the R_Visible flag will never be set. @see RCommand::GetRealVector
+this will not ever be done for user commands, the R_Visible flag will never be set.
 @param command char* of the command to be run 
 @param count length of array returned
 @param error this will be set to a value in RKWardError depending on success/failure of the command
@@ -107,13 +108,19 @@
 @see RCommand::GetRealVector */
 	double *getCommandAsRealVector (const char *command, unsigned int *count, RKWardRError *error);
 /** basically a wrapper to runCommandInternal (). Tries to convert the result of the command to an array of int after running the command. Since
-this will not ever be done for user commands, the R_Visible flag will never be set.  @see RCommand::GetIntVector
+this will not ever be done for user commands, the R_Visible flag will never be set.
 @param command char* of the command to be run 
 @param count length of array returned
 @param error this will be set to a value in RKWardError depending on success/failure of the command
 @returns an array of int or 0 on failure
 @see RCommand::GetIntVector */
 	int *getCommandAsIntVector (const char *command, unsigned int *count, RKWardRError *error);
+/** basically a wrapper to runCommandInternal (). Tries to convert the result of the command to an RData structure after running the command. Since this will not ever be done for user commands, the R_Visible flag will never be set.
+ at param command char* of the command to be run 
+ at param error this will be set to a value in RKWardError depending on success/failure of the command
+ at returns an array of int or 0 on failure
+ at see RCommand::GetStructuredData */
+	RData *getCommandAsRData (const char *command, RKWardRError *error);
 public:
 /** call this periodically to make R's x11 windows process their events */
 	static void processX11Events ();

Modified: trunk/rkward/rkward/rbackend/rthread.cpp
===================================================================
--- trunk/rkward/rkward/rbackend/rthread.cpp	2006-10-01 20:37:10 UTC (rev 785)
+++ trunk/rkward/rkward/rbackend/rthread.cpp	2006-10-01 21:44:11 UTC (rev 786)
@@ -159,6 +159,8 @@
 		} else if (ctype & RCommand::GetIntVector) {
 			command->datatype = RData::IntVector;
 			command->data = getCommandAsIntVector (ccommand, &(command->length), &error);
+		} else if (ctype & RCommand::GetStructuredData) {
+			command->setData (getCommandAsRData (ccommand, &error));
 		} else {
 			runCommandInternal (ccommand, &error, ctype & RCommand::User);
 		}


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