R-project integration (provides client to connect to remote Rserve server)

lib/WeBWorK/PG/Translator.pm

@@ -11,6 +11,7 @@ use Opcode;
 use WWSafe;
 use Net::SMTP;
 use WeBWorK::PG::IO;
+use WeBWorK::Debug;
 
 #use PadWalker;     # used for processing error messages
 #use Data::Dumper;
@@ -100,7 +101,7 @@ sub evaluate_modules {
 	my @modules = @_;
 	local $SIG{__DIE__} = "DEFAULT"; # we're going to be eval()ing code
 	foreach (@modules) {
-		#warn "attempting to load $_\n";
+		# debug "attempting to load $_\n";
 		# ensure that the name is in fact a base name
 		s/\.pm$// and warn "fixing your broken package name: $_.pm => $_";
 		# call runtime_use on the package name
@@ -127,7 +128,7 @@ sub evaluate_modules {
 
 Loads extra packages for modules that contain more than one package.  Works in conjunction with
 evaluate_modules.  It is assumed that the file containing the extra packages (along with the base
-pachage name which is the same as the name of the file minus the .pm extension) has already been
+package name which is the same as the name of the file minus the .pm extension) has already been
 loaded using evaluate_modules
 =cut
 
@@ -155,7 +156,14 @@ sub load_extra_packages{
 
 sub new {
 	my $class = shift;
+
+        debug("Creating new translator.");
+
 	my $safe_cmpt = new WWSafe; #('PG_priv');
+
+        debug("Created new safe compartment.");
+        debug("Safe: " . $safe_cmpt->{Root});
+
 	my $self = {
 	    preprocess_code           =>  \&default_preprocess_code,
 	    postprocess_code           => \&default_postprocess_code,
@@ -396,7 +404,9 @@ sub pre_load_macro_files {
 #    all other files are loaded with restriction
 #     
 			# construct a regex that matches only these three files safely
-			my @unrestricted_files = (); #  no longer needed? FIXME w/PG.pl IO.pl/;
+
+                        #  no longer needed? FIXME w/PG.pl IO.pl/;
+			my @unrestricted_files = qw(); 
 			my $unrestricted_files = join("|", map { quotemeta } @unrestricted_files);
 
 			my $store_mask; 
@@ -531,7 +541,6 @@ sub source_file {
 }
 
 
-
 sub unrestricted_load {
 	my $self = shift;
 	my $filePath = shift;
@@ -551,7 +560,7 @@ sub unrestricted_load {
 	my $init_subroutine  = eval { \&{$init_subroutine_name} };
 	warn "No init routine for $init_subroutine_name: $@" if  $debugON and $@;
 	use strict;
-    my $macro_file_loaded = ref($init_subroutine) =~ /CODE/;
+        my $macro_file_loaded = ref($init_subroutine) =~ /CODE/;
 
 	#print STDERR "$macro_file_name   has not yet been loaded\n" unless $macro_file_loaded;	
 	unless ($macro_file_loaded) {

macros/RserveClient.pl

@@ -0,0 +1,123 @@
+=head1 NAME
+
+RserveClient.pl - Macros for querying an Rserve server (see R-project.org)
+
+=head1 SYNPOSIS
+
+Example: generate a normally distributed vector of 15 elements,
+with mean 1, standard deviation 2, rounded to 4 decimal places.
+
+ $m = 1;
+ $sd = 2;
+ @rnorm = rserve_query(EV2(<<END_RCODE));
+   data1=rnorm(15,mean=$m,sd=$sd)
+   round(data1,4)
+ END_RCODE
+
+=head1 DESCRIPTION
+
+This file depends on the CPAN module Statistics::RserveClient.
+
+The macros in this file set up a connection to the R server and
+pass a string parameter to R for evaluation.  The resulting
+vector is returned as a perl array object.
+
+=cut
+
+# This uses Statistics::RserveClient::Connection, but to play nicely
+# with the Safe compartment, we load the module and all of its
+# dependencies by specifying them in the modules configuration of
+# defaults.config.  Hence the following line is commented out.
+
+# Statistics::RserveClient::Connection;
+
+#use strict;
+#use warnings;
+
+# RserveClient connection
+my $cnx;
+
+sub _rserve_init {
+};
+
+sub rserve_start {
+    if (!defined $cnx or ref($cnx) ne "Statistics::RserveClient::Connection") {
+	$cnx = Statistics::RserveClient::Connection->new('localhost');
+    }
+
+    # Ensure R's random number generation is given a well-defined seed.
+    # $problemSeed is the environmental variable defined by WeBWorK which
+    # gives the random seed associated to a given problem/user assignment.
+    $cnx->evalString("set.seed($problemSeed)");
+}
+
+sub rserve_finish {
+    if (ref($cnx) eq "Statistics::RserveClient::Connection") {
+	$cnx->close_connection();
+    }
+}
+
+sub rserve_eval { 
+  my $query = shift; 
+
+  if (ref($cnx) ne "Statistics::RserveClient::Connection") {
+      $cnx = Statistics::RserveClient::Connection->new('localhost');
+  }
+  my @res = $cnx->evalString($query);
+  return @res;
+}
+
+
+sub rserve_query {
+  my $query = shift; 
+  $query = "set.seed($problemSeed)\n" . $query;
+  my $rserve_client = Statistics::RserveClient::Connection->new('localhost');
+  my @res = $rserve_client->evalString($query);
+  #print ("result = $res");
+  return @res;
+}
+
+sub rserve_start_plot ($) {
+    my $imgtype = shift;
+
+    my $filename = "";
+
+    if ($imgtype eq 'png') {
+	@filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".png" )');
+	$filename = $filename_ref[0];
+	rserve_eval("png(filename='$filename')");
+    }
+    elsif ($imgtype eq 'jpg') {
+	@filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".jpg" )');
+	$filename = $filename_ref[0];
+	rserve_eval("jpeg(filename='$filename')");
+    }
+    elsif ($imgtype eq 'pdf') {
+	@filename_ref = rserve_eval('tempfile("tmpfile", tempdir(), ".pdf" )');
+	$filename = $filename_ref[0];
+	rserve_eval("pdf(filename='$filename')");
+    }
+    else {
+	warn "unknown/unsupported image type '$imgtype'\n";
+    }
+    return $filename;
+}
+
+sub rserve_finish_plot ($) {
+    my $filepath = shift;
+
+    @pathcomponents = split "/", $filepath;
+    $file = $pathcomponents[@pathcomponents-1];
+
+    my $imgfile = $tempDirectory . $file;
+
+    rserve_eval("dev.off()");
+
+    # $tempDirectory is a WeBWorK "environmental variable";
+    $cnx-> evalStringToFile("readBin('$filepath', what='raw', n=1e6)", $imgfile);
+
+
+    return $imgfile;
+}
+
+1;