alexgutteridge-rsruby 0.5

data/ext/rsruby.c

@@ -0,0 +1,182 @@
+/*
+* == Author
+* Alex Gutteridge
+*
+* == Copyright
+*Copyright (C) 2006 Alex Gutteridge
+*
+* The Original Code is the RPy python module.
+*
+* The Initial Developer of the Original Code is Walter Moreira.
+* Portions created by the Initial Developer are Copyright (C) 2002
+* the Initial Developer. All Rights Reserved.
+*
+* Contributor(s):
+*    Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
+*
+*This library is free software; you can redistribute it and/or
+*modify it under the terms of the GNU Lesser General Public
+*License as published by the Free Software Foundation; either
+*version 2.1 of the License, or (at your option) any later version.
+*
+*This library is distributed in the hope that it will be useful,
+*but WITHOUT ANY WARRANTY; without even the implied warranty of
+*MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+*Lesser General Public License for more details.
+*
+*You should have received a copy of the GNU Lesser General Public
+*License along with this library; if not, write to the Free Software
+*Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+*/
+
+#include "rsruby.h"
+
+/* Global list to protect R objects from garbage collection */
+/* This is inspired in $R_SRC/src/main/memory.c */
+//static SEXP R_References;
+
+SEXP
+RecursiveRelease(SEXP obj, SEXP list)
+{
+  if (!isNull(list)) {
+    if (obj == CAR(list))
+      return CDR(list);
+    else
+      SETCDR(list, RecursiveRelease(obj, CDR(list)));
+  }
+  return list;
+}
+
+/* TODO: This needs implementing as a Ruby destructor for each RObj */
+/*static void
+  Robj_dealloc(VALUE self)
+  {
+  SEXP robj;
+  
+  Data_Get_Struct(self, struct SEXPREC, robj);
+  
+  R_References = RecursiveRelease(robj, R_References);
+  SET_SYMVALUE(install("R.References"), R_References);
+  
+  return;
+  }*/
+
+
+/* Obtain an R object via its name.
+ * This is only used to get the 'get' function.
+ * All subsequent calls go via the 'get' function itself
+ */
+VALUE get_fun(VALUE self, VALUE name){
+
+  VALUE str;
+  int conversion=TOP_MODE;
+  SEXP robj;
+  VALUE  rubyobj;
+  char* cstr_name;
+
+  str = StringValue(name);
+
+  cstr_name = RSTRING(str)->ptr;
+
+  robj = (SEXP)get_fun_from_name(cstr_name);
+  if (!robj)
+    return Qnil;
+
+  /* Wrap the returned R object as a ruby Object */
+  rubyobj = Data_Wrap_Struct(rb_const_get(rb_cObject, 
+					  rb_intern("RObj")), 0, 0, robj);
+  rb_iv_set(rubyobj,"@conversion",INT2FIX(conversion));
+  rb_iv_set(rubyobj,"@wrap",Qfalse);
+
+  return rubyobj;
+
+}
+
+//TODO - This function does not appear to be working correctly
+void r_finalize(void)
+{
+  unsigned char buf[1024];
+  char * tmpdir;
+  
+  R_dot_Last();           
+  R_RunExitFinalizers();  
+  CleanEd();              
+  KillAllDevices();       
+
+  if((tmpdir = getenv("R_SESSION_TMPDIR"))) {          
+    snprintf((char *)buf, 1024, "rm -rf %s", tmpdir); 
+    R_system((char *)buf);                            
+  }
+  
+  PrintWarnings();	/* from device close and .Last */
+  R_gc();  /* Remove any remaining R objects from memory */
+}
+
+/*
+ * Shutdown the R interpreter
+ */
+VALUE rs_shutdown(VALUE self){
+
+  r_finalize();
+  Rf_endEmbeddedR(0);
+  return Qtrue;
+
+}
+
+/*
+ * Starts the R interpreter.
+ */
+VALUE rr_init(VALUE self){
+
+  SEXP R_References;
+
+  init_R(0,NULL);
+  // Initialize the list of protected objects
+  R_References = R_NilValue;
+  SET_SYMVALUE(install("R.References"), R_References);
+
+  return self;
+
+}
+
+/*
+ * Initialises the R interpreter.
+ */
+void init_R(int argc, char **argv){
+
+  char *defaultArgv[] = {"rsruby","-q","--vanilla"};
+
+  Rf_initEmbeddedR(sizeof(defaultArgv) / sizeof(defaultArgv[0]), defaultArgv);
+  R_Interactive = FALSE; //Remove crash menu (and other interactive R features)
+}
+             
+/* This method is for testing catching of segfaults */
+VALUE crash(){
+  int* ptr = (int*)0;
+  *ptr = 1;
+  return Qtrue; 
+}
+
+
+/* Ruby code */
+
+VALUE cRRuby;
+VALUE cRObj;
+
+void Init_rsruby_c(){
+
+  cRRuby = rb_define_class("RSRuby",rb_cObject);
+
+  rb_define_method(cRRuby, "r_init", rr_init, 0);
+  rb_define_method(cRRuby, "get_fun", get_fun, 1);
+  rb_define_method(cRRuby, "shutdown", rs_shutdown, 0);
+
+  rb_define_method(cRRuby, "crash", crash, 0);
+
+  //Add the lcall method to RObj
+  cRObj  = rb_const_get(rb_cObject,rb_intern("RObj"));
+  rb_define_method(cRObj, "lcall", RObj_lcall, 1);
+  rb_define_method(cRObj, "__init_lcall__", RObj_init_lcall, 1);  
+  rb_define_method(cRObj, "to_ruby", RObj_to_ruby, -2);
+
+}

data/ext/rsruby.h

@@ -0,0 +1,87 @@
+/*
+* == Author
+* Alex Gutteridge
+*
+* == Copyright
+*Copyright (C) 2006 Alex Gutteridge
+*
+* The Original Code is the RPy python module.
+*
+* The Initial Developer of the Original Code is Walter Moreira.
+* Portions created by the Initial Developer are Copyright (C) 2002
+* the Initial Developer. All Rights Reserved.
+*
+* Contributor(s):
+*    Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
+*
+*This library is free software; you can redistribute it and/or
+*modify it under the terms of the GNU Lesser General Public
+*License as published by the Free Software Foundation; either
+*version 2.1 of the License, or (at your option) any later version.
+*
+*This library is distributed in the hope that it will be useful,
+*but WITHOUT ANY WARRANTY; without even the implied warranty of
+*MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+*Lesser General Public License for more details.
+*
+*You should have received a copy of the GNU Lesser General Public
+*License along with this library; if not, write to the Free Software
+*Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+*/
+
+#ifndef R_RUBY_MAIN
+#define R_RUBY_MAIN
+
+#include "ruby.h"
+
+#include "R.h"
+#include "Rdefines.h"
+#include "Rinternals.h"
+#include "Rdefines.h"
+#include "Rdevices.h"
+
+#include "signal.h"
+
+#include "R_eval.h"
+#include "Converters.h"
+
+#define MAXIDSIZE 256
+
+#define NO_CONVERSION 0
+#define VECTOR_CONVERSION 1
+#define BASIC_CONVERSION 2
+#define CLASS_CONVERSION 3
+#define PROC_CONVERSION 4
+
+#define TOP_MODE 4
+
+#define RSRUBY rb_funcall(rb_const_get(rb_cObject,rb_intern("RSRuby")),rb_intern("instance"),0)
+
+/* Missing definitions from Rinterface.h or RStartup.h */
+# define CleanEd Rf_CleanEd
+extern int Rf_initEmbeddedR(int argc, char **argv);   
+extern int R_Interactive;
+extern void CleanEd(void);
+extern int R_CollectWarnings; 
+# define PrintWarnings Rf_PrintWarnings
+extern void PrintWarnings(void);
+
+void Init_rsruby();
+
+void init_R(int argc, char *argv[0]);
+void r_finalize(void);
+
+SEXP RecursiveRelease(SEXP obj, SEXP list);
+//static void Robj_dealloc(VALUE self);
+
+VALUE rs_shutdown(VALUE self);
+VALUE get_fun(VALUE self, VALUE name);
+VALUE rr_init(VALUE self);   
+
+VALUE crash(void);
+
+VALUE RObj_lcall(VALUE self, VALUE args);
+VALUE RObj_init_lcall(VALUE self, VALUE args);
+VALUE RObj_to_ruby(VALUE self, VALUE args);
+int make_argl(VALUE args, SEXP *e);
+#endif

data/lib/rsruby.rb

@@ -0,0 +1,302 @@
+require 'rsruby/robj'
+require 'rsruby_c'
+require 'singleton'
+
+require 'complex'
+
+#== Synopsis
+#
+#This class represents the embedded R interpreter. The Singleton module is 
+#mixed in to ensure that only one R interpreter is running in a script at 
+#any one time and that the interpreter can always be easily accessed without
+#using a global variable. 
+#
+#The R interpreter is started by calling RSRuby.instance. The returned 
+#object represents the R interpreter and R functions are called by 
+#calling methods on this object:
+#
+#  r = RSRuby.instance
+#  r.sum(1,2,3)
+#  puts r.t_test(1,2,3)['p-value']
+#
+#See the manual[http://web.kuicr.kyoto-u.ac.jp/~alexg/rsruby/manual.pdf] for 
+#more details on calling functions and the conversion system for passing data
+#between Ruby and R. If no suitable conversion from R to Ruby is found, an RObj
+#is returned (all R functions are returned as instances of RObj).
+#--
+#== Copyright
+#Copyright (C) 2006 Alex Gutteridge
+#
+#The Original Code is the RPy python module.
+#
+#The Initial Developer of the Original Code is Walter Moreira.
+#Portions created by the Initial Developer are Copyright (C) 2002
+#the Initial Developer. All Rights Reserved.
+#
+#Contributor(s):
+#Gregory R. Warnes <greg@warnes.net> (RPy Maintainer)
+#
+#This library is free software; you can redistribute it and/or
+#modify it under the terms of the GNU Lesser General Public
+#License as published by the Free Software Foundation; either
+#version 2.1 of the License, or (at your option) any later version.
+#
+#This library is distributed in the hope that it will be useful,
+#but WITHOUT ANY WARRANTY; without even the implied warranty of
+#MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+#Lesser General Public License for more details.
+#
+#You should have received a copy of the GNU Lesser General Public
+#License along with this library; if not, write to the Free Software
+#Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
+#++
+
+class RSRuby
+
+  VERSION = '0.5'
+
+  include Singleton
+
+  #Constants for conversion modes
+  TOP_CONVERSION = 4
+  PROC_CONVERSION = 4
+  CLASS_CONVERSION = 3
+  BASIC_CONVERSION = 2
+  VECTOR_CONVERSION = 1
+  NO_CONVERSION = 0
+  NO_DEFAULT = -1
+
+  attr_accessor :proc_table, :class_table, :default_mode, :caching
+
+  #Create a new RSRuby interpreter instance. The Singleton design pattern
+  #ensures that only one instance can be running in a script. Further
+  #calls to RSRuby.instance will return the original instance.
+  def initialize()
+
+    #Initialize R
+    r_init
+
+    @default_mode = NO_DEFAULT
+
+    @class_table = {}
+    @proc_table  = {}
+    
+    @caching = true
+    reset_cache
+    
+    #Catch errors
+    self.__init_eval_R__("options(error=expression(NULL))")
+    #disable errors
+    self.__init_eval_R__("options(show.error.messages=F)")
+
+  end
+  
+  def reset_cache
+    #Setup R object cache
+    @cache = {}
+    @cache['get'] = self.get_fun('get')
+
+    #Get constants
+    @cache['TRUE']  = self.__getitem__('T',true)
+    @cache['FALSE'] = self.__getitem__('F',true)
+
+    @cache['parse'] = self.__getitem__('parse',true)
+    @cache['eval']  = self.__getitem__('eval',true)
+
+    @cache['NA']    = self.__init_eval_R__('NA')
+    @cache['NaN']   = self.__init_eval_R__('NaN')
+    # @cache['NAN']   = self.eval_R('as.double(NA)')
+    
+    #help!
+    @cache['helpfun'] = self.with_mode(NO_CONVERSION, self.__getitem__('help',true))
+  end
+  
+  #Delete an R object from the cache. Use R-style function naming, not ruby style.
+  def delete_from_cache(x)
+    @cache.delete(x)
+  end
+
+  def self.img(filename,args={})
+    format = File.extname(filename).gsub(".","").to_sym
+    r = RSRuby.instance
+    raise ArgumentError, "Format #{format.to_s} is not supported" unless [:pdf].include? format
+    r.pdf(filename,args)
+    yield(r)
+    r.dev_off.call
+  end
+
+  #Handles method name conversion and calling of R functions
+  #If called without args the R function/varialbe is returned rather
+  #than called.
+  def method_missing(r_id,*args)
+
+    #Translate Ruby method call to R
+    robj_name = RSRuby.convert_method_name(r_id.to_s)
+
+    #Retrieve it
+    robj = self.__getitem__(robj_name)
+
+    #TODO perhaps this is not neccessary - always call these methods
+    #use the [] syntax for variables etc...
+    if args.length > 0
+
+      #convert arguments to lcall format
+      lcall_args = RSRuby.convert_args_to_lcall(args)
+      
+      #Return result of calling object with lcall 
+      #formatted args
+      return robj.lcall(lcall_args)
+
+    end
+
+    return robj
+
+  end  
+
+  #The same as  method_missing, but only returns the R function/object,
+  #does not call it.
+  def [](r_id)
+
+    #Translate Ruby method call to R
+    robj_name = RSRuby.convert_method_name(r_id.to_s)
+    
+    #Retrieve it
+    robj = self.__getitem__(robj_name)
+    
+    #And return it
+    return robj
+
+  end
+
+  #Takes an #RObj representing an R function and sets the 'wrapping'
+  #mode for that function. Implemented for compatibility with RPy.
+  def with_mode(mode,func)
+    func.wrap = mode
+    return func
+  end
+
+  #Converts a String representing a 'Ruby-style' R function name into a 
+  #String with the real R name according to the rules given in the manual.
+  def RSRuby.convert_method_name(name)
+    if name.length > 1 and name[-1].chr == '_' and name[-2].chr != '_'
+      name = name[0..-2]
+    end
+    name.gsub!(/__/,'<-')
+    name.gsub!(/_/, '.')
+    return name
+  end
+
+  #Converts an Array of function arguments into lcall format. If the last 
+  #element of the array is a Hash then the contents of the Hash are 
+  #interpreted as named arguments.
+  #
+  #The returned value is an Array of tuples (Arrays of length two). Each 
+  #tupple corresponds to a name/argument pair.
+  #
+  #For example:
+  #  convert_args_to_lcall([1,2,3,{:a=>4,:b=>5}) 
+  #  => [['',1],['',2],['',3],['a',4],['b',5]]
+  def RSRuby.convert_args_to_lcall(args)
+
+    lcall_args = []
+    
+    args.each_with_index do |arg,i|
+      unless arg.kind_of?(Hash) and i == args.length-1
+        lcall_args.push(['',arg])
+      else
+        arg.each do |k,v|
+          lcall_args.push([k.to_s,v])
+        end
+      end
+    end
+
+    return lcall_args
+
+  end
+
+  #Sets the default conversion mode for RSRuby. The constants defined
+  #in #RSRuby should be used
+  #DEPRECATED: Use the accessor instead
+  def RSRuby.set_default_mode(m)
+    if m < -1 or m > TOP_CONVERSION
+      raise ArgumentError, "Invalid mode requested"
+    end
+    RSRuby.instance.default_mode = m
+  end
+  #Returns the current default conversion mode as an Integer.
+  #DEPRECATED: Use the accessor on the RSRuby instance isntead
+  def RSRuby.get_default_mode
+    RSRuby.instance.default_mode
+  end
+
+  #TODO - not implemented
+  def RSRuby.set_rsruby_input(m)
+    @@rsruby_input = m
+  end
+
+  #TODO - not implemented
+  def RSRuby.get_rsruby_input
+    @@rsruby_input
+  end
+
+  #TODO - not implemented
+  def RSRuby.set_rsruby_output(m)
+    @@rsruby_output = m
+  end
+
+  #TODO - not implemented
+  def RSRuby.get_rsruby_output
+    @@rsruby_output
+  end
+
+  #TODO - not implemented
+  def RSRuby.set_rsruby_showfiles(m)
+    @@rsruby_showfiles = m
+  end
+
+  #TODO - not implemented
+  def RSRuby.get_rsruby_showfiles
+    @@rsruby_showfiles
+  end
+
+  #Evaluates the given string in R. Returns the result of the evaluation.
+  def eval_R(s)
+    self.eval(self.parse(:text => s))
+  end
+
+
+  #Wraps the R help function.
+  def help(*args)
+    helpobj = @cache['helpfun'].call(args)
+    self.print(helpobj)
+  end
+
+
+  def __init_eval_R__(s)
+    parsed = self.parse.__init_lcall__([['text',s]])
+    self.eval.__init_lcall__([['',parsed]])
+  end
+
+  def __getitem__(name,init=false)
+
+    #Find the identifier and cache (unless already cached)
+    unless @cache.has_key?(name) && @caching
+      if init
+        robj = @cache['get'].__init_lcall__([['',name]])
+      else
+        robj = @cache['get'].lcall([['',name]])
+      end
+      @cache[name] = robj if @caching
+    end
+
+    #Retrieve object from cache
+    robj ||= @cache[name]
+
+    return robj
+
+  end
+
+end
+
+class RException < RuntimeError
+end