After a long processing, I was able to create a version of a small C# class
that was able to emulate the rproxy by P/Invoke. This is mostly to find a
workaround a performance problem of the StatConnector.
It's almost work but ... I have strange memory exception when I call the
print function. The variable seems to not survive from one call to the
other.
As there is no debug symbol for the R.DLL (and I don't want to spend my
youth on the disassembly window of VS), I put there the result of my search.
If some of you can find the reason of the crash, I will be extremely happy!
Here is a sample program.cs to invoke the DLL (and crash) :
using System;
using System.Collections;
using System.Text;
namespace SharpR
{
class Program
{
static void Main(string[] args)
{
RWrapper.EvaluateNoReturn("print(\"Boom!\")");
}
}
}
-------------- next part --------------
#define SUPERCONSOLE
using System;
using System.Collections;
using System.Runtime.InteropServices;
using System.Text;
using Microsoft.Win32;
namespace SharpR
{
/// <summary>
/// Class for interp with the R.DLL. All is static as R is mono-threaded.
/// </summary>
class RWrapper
{
#region <R.DLL interop signatures>
//- DLL Management/Information
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
[return: MarshalAs(UnmanagedType.LPStr)]
static extern string getDLLVersion();
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
[return: MarshalAs(UnmanagedType.LPStr)]
static extern string get_R_HOME();
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
[return: MarshalAs(UnmanagedType.LPStr)]
static extern string getRUser();
//- R Start Up
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_setStartTime();
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_DefParams(ref RStartStruct @params);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_SetParams(ref RStartStruct @params);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_set_command_line_arguments(int argc, string[]
args);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern int GA_initapp(int argc, string[] args);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void readconsolecfg();
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void setup_Rmainloop();
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void R_ReplDLLinit();
//- R SEXP management
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_mkString(string toConvert);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_protect(IntPtr ptr);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void Rf_unprotect(int l);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void Rf_unprotect_ptr(IntPtr ptr);
//- R Parser/Eval
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr R_ParseVector(IntPtr str, int x, out RParseStatus
result);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr R_tryEval(IntPtr exp, IntPtr env, out int
evalError);
//- R Symbols
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_install(string name);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern IntPtr Rf_findVar(IntPtr symbol, IntPtr env);
[DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
static extern void Rf_setVar(IntPtr symbol, IntPtr value, IntPtr env);
#endregion
#region <R.DLL interop types>
enum RParseStatus
{
PARSE_NULL,
PARSE_OK,
PARSE_INCOMPLETE,
PARSE_ERROR,
PARSE_EOF
};
enum SaType
{
SA_NORESTORE = 0,/* = 0 */
SA_RESTORE,
SA_DEFAULT,/* was === SA_RESTORE */
SA_NOSAVE,
SA_SAVE,
SA_SAVEASK,
SA_SUICIDE
};
enum RBool
{
RFalse = 0,
RTrue
};
enum RYesNoCancel
{
Yes = 1,
No = -1,
Cancel = 0
};
enum RUIMode
{
RGui = 0, RTerm, LinkDLL
};
[StructLayout(LayoutKind.Sequential)]
struct RStartStruct
{
public RBool R_Quiet;
public RBool R_Slave;
public RBool R_Interactive;
public RBool R_Verbose;
public RBool LoadSiteFile;
public RBool LoadInitFile;
public RBool DebugInitFile;
public SaType RestoreAction;
public SaType SaveAction;
public uint vsize;
public uint nsize;
public uint max_vsize;
public uint max_nsize;
public uint ppsize;
public int NoRenviron;
//!! Warning - R will keep theses pointers. See gnuwin32\system.c
(line 638)
public IntPtr home;
public IntPtr rhome;
//!!
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgReadConsole readConsole;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgWriteConsole writeConsole;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgCallback callback;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgShowMessage showMessage;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgYesNoCancel yesNoCancel;
[MarshalAs(UnmanagedType.FunctionPtr)]
public dgBusy busy;
public RUIMode characterMode;
};
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate int dgReadConsole(
[MarshalAs(UnmanagedType.LPStr)]string prompt,
IntPtr buf, int len,
int addtohistory
);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgWriteConsole(
[MarshalAs(UnmanagedType.LPStr,SizeParamIndex = 1)]
string buf, int len);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgCallback();
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgShowMessage(string msg);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
[return: MarshalAs(UnmanagedType.I4)]
delegate RYesNoCancel dgYesNoCancel(string msg);
//[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net 2.0
delegate void dgBusy(int which);
#endregion
#region <BDX Interops frm RPROXY.DLL>
/* const string strBdxGetObject = "BDX_get_vtbl at 8";
/// <summary>
/// PInvoke with automatic marshal on GetProcAddress to return
dgScProxyGetObject function
/// </summary>
/// <param name="hModule">HMODULE of the
RPROXY.DLL</param>
/// <param name="procName">*MUST* be
strScProxyGetObject</param>
/// <returns></returns>
[DllImport("kernel32.dll", CharSet = CharSet.Ansi, EntryPoint
= "GetProcAddress")]
[return: MarshalAs(UnmanagedType.FunctionPtr)]
static extern dgBdxGetObject GetPABdxGetObject(IntPtr hModule, string
procName);
delegate int dgBdxGetObject(out IntPtr vtable, uint value);
delegate void BdxFree(IntPtr bdx);
delegate void BdxTrace(IntPtr bdx);
delegate int BdxVariant2BDX([MarshalAs(UnmanagedType.Struct)]object var,
out IntPtr bdx);
delegate int BdxBDX2Variant(IntPtr bdx,
[MarshalAs(UnmanagedType.Struct)]out object var);
[StructLayout(LayoutKind.Sequential)]
struct RBdxVtable
{
public BdxFree free;
public BdxTrace trace;
public BdxVariant2BDX v2bdx;
public BdxBDX2Variant bdx2v;
} */
[DllImport("Rproxy.DLL", CallingConvention =
CallingConvention.Cdecl)]
static extern int BDX2SEXP(IntPtr pBDXData, out IntPtr pSEXPData);
[DllImport("Rproxy.dll", CallingConvention =
CallingConvention.Cdecl)]
static extern int SEXP2BDX(IntPtr pSexp, out IntPtr ppBDXData);
[DllImport("Rproxy.dll", EntryPoint = "Variant2BDX at
20")]
static extern int Variant2BDX([MarshalAs(UnmanagedType.Struct)]object
var, out IntPtr bdx);
[DllImport("Rproxy.dll", EntryPoint = "BDX2Variant at
8")]
static extern int BDX2Variant(IntPtr
bdx,[MarshalAs(UnmanagedType.Struct)]out object var);
[DllImport("Rproxy.dll", EntryPoint = "bdx_free at
4")]
static extern void bdx_free(IntPtr bdx);
#endregion
#region <Win32 interop signatures>
[DllImport("kernel32.dll")]
static extern IntPtr LoadLibrary(string lpFileName);
[DllImport("kernel32.dll", CharSet = CharSet.Ansi,
ExactSpelling = true)]
public static extern IntPtr GetProcAddress(IntPtr hModule, string
procName);
#endregion
static string sg_dllVersion,sg_RHome,sg_RUsersHome;
static IntPtr sg_hModR;
static IntPtr sg_hModRProxy;
static StringBuilder sg_ConsoleOutput;
static IntPtr sg_rDll_R_GlobalEnvPtr, sg_rDll_R_UserBreakPtr;
static IntPtr sg_rDll_R_UnboundValue;
static GCHandle[] sg_lockDelegates;
static RWrapper()
{
try {
//- Get the active DLL path from the registry
string dllPath = Convert.ToString(
Registry.LocalMachine.OpenSubKey("Software\\R-core\\R",
false).GetValue("InstallPath")
);
//- Fix the process PATH
Environment.SetEnvironmentVariable("PATH",
dllPath + "\\bin;" +
Environment.GetEnvironmentVariable("PATH"),
EnvironmentVariableTarget.Process
);
//- Load the R.DLL module into the process
sg_hModR = LoadLibrary(dllPath + "\\bin\\R.dll");
if (sg_hModR == IntPtr.Zero) throw new Exception("Unable to
load R.DLL");
//- Load the Rproxy.DLL module into the process
sg_hModRProxy = LoadLibrary(dllPath +
"\\bin\\Rproxy.dll");
if (sg_hModRProxy == IntPtr.Zero) throw new Exception("Unable
to load R.DLL");
//- Read the DLL version by Interop
sg_dllVersion = getDLLVersion();
//- Get important R global variable pointers from GetProcAddress
sg_rDll_R_GlobalEnvPtr = GetProcAddress(sg_hModR,
"R_GlobalEnv");
sg_rDll_R_UserBreakPtr = GetProcAddress(sg_hModR,
"UserBreak");
sg_rDll_R_UnboundValue = GetProcAddress(sg_hModR,
"R_UnboundValue");
//- Output DLL
sg_ConsoleOutput = new StringBuilder();
//- Let's start R
RStartStruct start = new RStartStruct();
//- Get Defaults
R_setStartTime();
R_DefParams(ref start);
sg_RHome = get_R_HOME();
sg_RUsersHome = getRUser();
//- Inject R Home
start.home = Marshal.StringToHGlobalAnsi(sg_RHome);
start.rhome = Marshal.StringToHGlobalAnsi(sg_RUsersHome);
//- Setup R in embedded/batch mode
start.characterMode = RUIMode.LinkDLL;
start.R_Quiet = RBool.RTrue;
start.R_Interactive = RBool.RTrue;
start.RestoreAction = SaType.SA_RESTORE;
start.SaveAction = SaType.SA_NOSAVE;
//- Setup the callbacks
start.readConsole = new dgReadConsole(cbReadConsole);
start.writeConsole = new dgWriteConsole(cbWriteConsole);
start.busy = new dgBusy(cbBusy);
start.callback = new dgCallback(cbCallback);
start.showMessage = new dgShowMessage(cbShowMessage);
start.yesNoCancel = new dgYesNoCancel(cbYesNoCancel);
sg_lockDelegates = new GCHandle[7];
sg_lockDelegates[0] = GCHandle.Alloc(start.readConsole);
sg_lockDelegates[1] = GCHandle.Alloc(start.writeConsole);
sg_lockDelegates[2] = GCHandle.Alloc(start.busy);
sg_lockDelegates[3] = GCHandle.Alloc(start.callback);
sg_lockDelegates[4] = GCHandle.Alloc(start.showMessage);
sg_lockDelegates[5] = GCHandle.Alloc(start.yesNoCancel);
sg_lockDelegates[6] = GCHandle.Alloc(start);
//- Gentleman start your engines !
R_SetParams(ref start);
R_set_command_line_arguments(0, new string[] { });
GA_initapp(0, new string[] { });
readconsolecfg();
setup_Rmainloop();
R_ReplDLLinit();
} catch(Exception e)
{
throw;
}
}
private RWrapper() {}
static int UserBreak
{
get
{
return Marshal.ReadInt32(sg_rDll_R_UserBreakPtr);
}
set
{
Marshal.WriteInt32(sg_rDll_R_UserBreakPtr,value);
}
}
static public string RDllVersion { get { return sg_dllVersion; } }
static public string RHome { get { return sg_RHome; } }
static public string RUsersHome { get { return sg_RUsersHome; } }
#region <R Callbacks>
static int cbReadConsole(string prompt, IntPtr buf, int len, int
addtohistory)
{
//- We don't use the console to interact with R. The function
returns 0
// to force R exiting any event loop.
return 0;
}
static void cbWriteConsole(string buf, int len)
{
sg_ConsoleOutput.Append(buf);
#if SUPERCONSOLE
ConsoleColor c = Console.ForegroundColor;
Console.ForegroundColor = ConsoleColor.Green;
Console.Write(buf);
Console.ForegroundColor = c;
#endif
}
static void cbCallback() { /*NoOp*/ }
static void cbBusy(int which)
{
#if SUPERCONSOLE
int top = Console.CursorTop, left = Console.CursorLeft;
Console.CursorTop = Console.CursorLeft = 0;
Console.Write("Busy : {0}", which);
Console.CursorTop = top; Console.CursorLeft = left;
#endif
}
static void cbShowMessage(string msg)
{
Console.WriteLine("Message : " + msg);
}
static RYesNoCancel cbYesNoCancel(string msg)
{
Console.WriteLine("YesNoCancel : " + msg);
return RYesNoCancel.Cancel;
}
#endregion
static IntPtr GetCurrentEnv()
{
IntPtr ret = Marshal.ReadIntPtr(sg_rDll_R_GlobalEnvPtr);
return ret;
}
static bool IsUnbound(IntPtr Sexp)
{
IntPtr unbound = Marshal.ReadIntPtr(sg_rDll_R_UnboundValue);
return Sexp == unbound;
}
static public void EvaluateNoReturn(string statement)
{
//- Parse the expresion
RParseStatus status;
IntPtr lSexpVect = R_ParseVector(Rf_mkString(statement), 1, out
status);
if(status!=RParseStatus.PARSE_OK)
{
throw new Exception("R Parse Error : " +
status.ToString());
}
Rf_protect(lSexpVect);
// lSexpVect is a vector of lSexp. We need to read the memory
directly to get
// the lSexp
int evalError;
IntPtr lSexp = Marshal.ReadIntPtr(lSexpVect, 24);
R_tryEval(lSexp, IntPtr.Zero, out evalError);
Rf_unprotect(1);
if (evalError != 0) throw new Exception("R Eval Error : "
+ evalError.ToString());
}
static public object Evaluate(string statement)
{
//- Parse the expresion
RParseStatus status;
IntPtr lSexpVect = R_ParseVector(Rf_mkString(statement), 1, out
status);
if (status != RParseStatus.PARSE_OK)
{
throw new Exception("R Parse Error : " +
status.ToString());
}
Rf_protect(lSexpVect);
// lSexpVect is a vector of lSexp. We need to read the memory
directly to get
// the lSexp
int evalError;
IntPtr lSexp = Marshal.ReadIntPtr(lSexpVect, 24);
Rf_protect(lSexp);
IntPtr lresult = R_tryEval(lSexp, GetCurrentEnv(), out evalError);
Rf_unprotect(1);
if (evalError != 0) throw new Exception("R Eval Error : "
+ evalError.ToString());
IntPtr bdxResult;
object result;
evalError = SEXP2BDX(lresult, out bdxResult);
evalError = BDX2Variant(bdxResult, out result);
bdx_free(bdxResult);
return result;
}
static public object GetSymbol(string name)
{
IntPtr lsValue = Rf_findVar(Rf_install(name), GetCurrentEnv());
if (IsUnbound(lsValue))
{
throw new Exception(name + " is an unbound value");
}
IntPtr bdxResult;
object result;
int evalError = SEXP2BDX(lsValue, out bdxResult);
evalError = BDX2Variant(bdxResult, out result);
bdx_free(bdxResult);
return result;
}
static public void SetSymbol(string name,object value)
{
IntPtr bdxData, sexpData;
int evalError = Variant2BDX(value, out bdxData);
evalError = BDX2SEXP(bdxData, out sexpData);
bdx_free(bdxData);
IntPtr lsSymbol = Rf_install(name);
Rf_setVar(lsSymbol, sexpData, GetCurrentEnv());
}
static public string CollectConsole()
{
string ret = sg_ConsoleOutput.ToString();
sg_ConsoleOutput = new StringBuilder();
return ret;
}
}
}
Beileive me, this option was tested extensively. There is a lot of
problem there :
* There is no simple way to extract data frames as they are returned
as vectors (there is no place for the attributes in a COM Variant)
* The console is returned by using DCOM Event. This doesn't work
very well on large text as the OS waste a lot of time inside the
marshaller.
Laurent
Duncan Temple Lang wrote:
>-----BEGIN PGP SIGNED MESSAGE-----
>Hash: SHA1
>
>
>I am not certain precisely what the performance problem
>of StatConnector you are referring to is, but did you
>look at RDCOMServer to see if that avoids the problem.
>
>It is at http://www.omegahat.org/RDCOMServer/
>
>I don't know whether it will solve your problem,
>but it seems reasonable to try it before developing
>a lot of code.
>
> D.
>
>
>I wrote:
>
>
>>After a long processing, I was able to create a version of a small C#
>>class that was able to emulate the rproxy by P/Invoke. This is mostly to
>>find a workaround a performance problem of the StatConnector.
>>It's almost work but ... I have strange memory exception when I call
the
>>print function. The variable seems to not survive from one call to the
>>other.
>>As there is no debug symbol for the R.DLL (and I don't want to spend
my
>>youth on the disassembly window of VS), I put there the result of my
>>search. If some of you can find the reason of the crash, I will be
>>extremely happy!
>>Here is a sample program.cs to invoke the DLL (and crash) :
>>using System;
>>using System.Collections;
>>using System.Text;
>>namespace SharpR
>>{
>> class Program
>> {
>> static void Main(string[] args)
>> {
>>
RWrapper.EvaluateNoReturn("print(\"Boom!\")");
>> }
>> }
>>}
>>
>>
>>------------------------------------------------------------------------
>>
>>#define SUPERCONSOLE
>>
>>using System;
>>using System.Collections;
>>using System.Runtime.InteropServices;
>>using System.Text;
>>using Microsoft.Win32;
>>
>>namespace SharpR
>>{
>> /// <summary>
>> /// Class for interp with the R.DLL. All is static as R is
mono-threaded.
>> /// </summary>
>> class RWrapper
>> {
>> #region <R.DLL interop signatures>
>> //- DLL Management/Information
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> [return: MarshalAs(UnmanagedType.LPStr)]
>> static extern string getDLLVersion();
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> [return: MarshalAs(UnmanagedType.LPStr)]
>> static extern string get_R_HOME();
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> [return: MarshalAs(UnmanagedType.LPStr)]
>> static extern string getRUser();
>>
>> //- R Start Up
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void R_setStartTime();
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void R_DefParams(ref RStartStruct @params);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void R_SetParams(ref RStartStruct @params);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void R_set_command_line_arguments(int argc,
string[] args);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern int GA_initapp(int argc, string[] args);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void readconsolecfg();
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void setup_Rmainloop();
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void R_ReplDLLinit();
>>
>> //- R SEXP management
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern IntPtr Rf_mkString(string toConvert);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern IntPtr Rf_protect(IntPtr ptr);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void Rf_unprotect(int l);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void Rf_unprotect_ptr(IntPtr ptr);
>>
>> //- R Parser/Eval
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern IntPtr R_ParseVector(IntPtr str, int x, out
RParseStatus result);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern IntPtr R_tryEval(IntPtr exp, IntPtr env, out int
evalError);
>>
>> //- R Symbols
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern IntPtr Rf_install(string name);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern IntPtr Rf_findVar(IntPtr symbol, IntPtr env);
>> [DllImport("R.DLL", /*CallingConvention =
CallingConvention.Cdecl,*/ CharSet = CharSet.Ansi)]
>> static extern void Rf_setVar(IntPtr symbol, IntPtr value, IntPtr
env);
>>
>> #endregion
>>
>> #region <R.DLL interop types>
>> enum RParseStatus
>> {
>> PARSE_NULL,
>> PARSE_OK,
>> PARSE_INCOMPLETE,
>> PARSE_ERROR,
>> PARSE_EOF
>> };
>>
>> enum SaType
>> {
>> SA_NORESTORE = 0,/* = 0 */
>> SA_RESTORE,
>> SA_DEFAULT,/* was === SA_RESTORE */
>> SA_NOSAVE,
>> SA_SAVE,
>> SA_SAVEASK,
>> SA_SUICIDE
>> };
>> enum RBool
>> {
>> RFalse = 0,
>> RTrue
>> };
>> enum RYesNoCancel
>> {
>> Yes = 1,
>> No = -1,
>> Cancel = 0
>> };
>> enum RUIMode
>> {
>> RGui = 0, RTerm, LinkDLL
>> };
>> [StructLayout(LayoutKind.Sequential)]
>> struct RStartStruct
>> {
>> public RBool R_Quiet;
>> public RBool R_Slave;
>> public RBool R_Interactive;
>> public RBool R_Verbose;
>> public RBool LoadSiteFile;
>> public RBool LoadInitFile;
>> public RBool DebugInitFile;
>> public SaType RestoreAction;
>> public SaType SaveAction;
>> public uint vsize;
>> public uint nsize;
>> public uint max_vsize;
>> public uint max_nsize;
>> public uint ppsize;
>> public int NoRenviron;
>> //!! Warning - R will keep theses pointers. See
gnuwin32\system.c (line 638)
>> public IntPtr home;
>> public IntPtr rhome;
>> //!!
>> [MarshalAs(UnmanagedType.FunctionPtr)]
>> public dgReadConsole readConsole;
>> [MarshalAs(UnmanagedType.FunctionPtr)]
>> public dgWriteConsole writeConsole;
>> [MarshalAs(UnmanagedType.FunctionPtr)]
>> public dgCallback callback;
>> [MarshalAs(UnmanagedType.FunctionPtr)]
>> public dgShowMessage showMessage;
>> [MarshalAs(UnmanagedType.FunctionPtr)]
>> public dgYesNoCancel yesNoCancel;
>> [MarshalAs(UnmanagedType.FunctionPtr)]
>> public dgBusy busy;
>> public RUIMode characterMode;
>> };
>>
>> //[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net
2.0
>> delegate int dgReadConsole(
>> [MarshalAs(UnmanagedType.LPStr)]string prompt,
>> IntPtr buf, int len,
>> int addtohistory
>> );
>> //[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net
2.0
>> delegate void dgWriteConsole(
>> [MarshalAs(UnmanagedType.LPStr,SizeParamIndex = 1)]
>> string buf, int len);
>> //[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net
2.0
>> delegate void dgCallback();
>> //[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net
2.0
>> delegate void dgShowMessage(string msg);
>> //[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net
2.0
>> [return: MarshalAs(UnmanagedType.I4)]
>> delegate RYesNoCancel dgYesNoCancel(string msg);
>> //[UnmanagedFunctionPointer(CallingConvention.Cdecl)] < .Net
2.0
>> delegate void dgBusy(int which);
>>
>> #endregion
>>
>> #region <BDX Interops frm RPROXY.DLL>
>> /* const string strBdxGetObject = "BDX_get_vtbl@8";
>>
>> /// <summary>
>> /// PInvoke with automatic marshal on GetProcAddress to return
dgScProxyGetObject function
>> /// </summary>
>> /// <param name="hModule">HMODULE of the
RPROXY.DLL</param>
>> /// <param name="procName">*MUST* be
strScProxyGetObject</param>
>> /// <returns></returns>
>> [DllImport("kernel32.dll", CharSet = CharSet.Ansi,
EntryPoint = "GetProcAddress")]
>> [return: MarshalAs(UnmanagedType.FunctionPtr)]
>> static extern dgBdxGetObject GetPABdxGetObject(IntPtr hModule,
string procName);
>>
>> delegate int dgBdxGetObject(out IntPtr vtable, uint value);
>>
>> delegate void BdxFree(IntPtr bdx);
>> delegate void BdxTrace(IntPtr bdx);
>> delegate int
BdxVariant2BDX([MarshalAs(UnmanagedType.Struct)]object var, out IntPtr bdx);
>> delegate int BdxBDX2Variant(IntPtr bdx,
[MarshalAs(UnmanagedType.Struct)]out object var);
>>
>> [StructLayout(LayoutKind.Sequential)]
>> struct RBdxVtable
>> {
>> public BdxFree free;
>> public BdxTrace trace;
>> public BdxVariant2BDX v2bdx;
>> public BdxBDX2Variant bdx2v;
>> } */
>>
>> [DllImport("Rproxy.DLL", CallingConvention =
CallingConvention.Cdecl)]
>> static extern int BDX2SEXP(IntPtr pBDXData, out IntPtr
pSEXPData);
>> [DllImport("Rproxy.dll", CallingConvention =
CallingConvention.Cdecl)]
>> static extern int SEXP2BDX(IntPtr pSexp, out IntPtr ppBDXData);
>> [DllImport("Rproxy.dll", EntryPoint =
"Variant2BDX@20")]
>> static extern int
Variant2BDX([MarshalAs(UnmanagedType.Struct)]object var, out IntPtr bdx);
>> [DllImport("Rproxy.dll", EntryPoint =
"BDX2Variant@8")]
>> static extern int BDX2Variant(IntPtr
bdx,[MarshalAs(UnmanagedType.Struct)]out object var);
>> [DllImport("Rproxy.dll", EntryPoint =
"bdx_free@4")]
>> static extern void bdx_free(IntPtr bdx);
>> #endregion
>>
>>
>> #region <Win32 interop signatures>
>> [DllImport("kernel32.dll")]
>> static extern IntPtr LoadLibrary(string lpFileName);
>> [DllImport("kernel32.dll", CharSet = CharSet.Ansi,
ExactSpelling = true)]
>> public static extern IntPtr GetProcAddress(IntPtr hModule,
string procName);
>> #endregion
>>
>> static string sg_dllVersion,sg_RHome,sg_RUsersHome;
>> static IntPtr sg_hModR;
>> static IntPtr sg_hModRProxy;
>> static StringBuilder sg_ConsoleOutput;
>>
>> static IntPtr sg_rDll_R_GlobalEnvPtr, sg_rDll_R_UserBreakPtr;
>> static IntPtr sg_rDll_R_UnboundValue;
>>
>> static GCHandle[] sg_lockDelegates;
>>
>> static RWrapper()
>> {
>> try {
>> //- Get the active DLL path from the registry
>> string dllPath = Convert.ToString(
>>
Registry.LocalMachine.OpenSubKey("Software\\R-core\\R",
false).GetValue("InstallPath")
>> );
>> //- Fix the process PATH
>> Environment.SetEnvironmentVariable("PATH",
>> dllPath + "\\bin;" +
Environment.GetEnvironmentVariable("PATH"),
>> EnvironmentVariableTarget.Process
>> );
>>
>> //- Load the R.DLL module into the process
>> sg_hModR = LoadLibrary(dllPath + "\\bin\\R.dll");
>> if (sg_hModR == IntPtr.Zero) throw new
Exception("Unable to load R.DLL");
>> //- Load the Rproxy.DLL module into the process
>> sg_hModRProxy = LoadLibrary(dllPath +
"\\bin\\Rproxy.dll");
>> if (sg_hModRProxy == IntPtr.Zero) throw new
Exception("Unable to load R.DLL");
>>
>> //- Read the DLL version by Interop
>> sg_dllVersion = getDLLVersion();
>>
>> //- Get important R global variable pointers from
GetProcAddress
>> sg_rDll_R_GlobalEnvPtr = GetProcAddress(sg_hModR,
"R_GlobalEnv");
>> sg_rDll_R_UserBreakPtr = GetProcAddress(sg_hModR,
"UserBreak");
>> sg_rDll_R_UnboundValue = GetProcAddress(sg_hModR,
"R_UnboundValue");
>>
>> //- Output DLL
>> sg_ConsoleOutput = new StringBuilder();
>>
>> //- Let's start R
>> RStartStruct start = new RStartStruct();
>>
>> //- Get Defaults
>> R_setStartTime();
>> R_DefParams(ref start);
>>
>> sg_RHome = get_R_HOME();
>> sg_RUsersHome = getRUser();
>>
>> //- Inject R Home
>> start.home = Marshal.StringToHGlobalAnsi(sg_RHome);
>> start.rhome = Marshal.StringToHGlobalAnsi(sg_RUsersHome);
>>
>> //- Setup R in embedded/batch mode
>> start.characterMode = RUIMode.LinkDLL;
>> start.R_Quiet = RBool.RTrue;
>> start.R_Interactive = RBool.RTrue;
>> start.RestoreAction = SaType.SA_RESTORE;
>> start.SaveAction = SaType.SA_NOSAVE;
>>
>> //- Setup the callbacks
>> start.readConsole = new dgReadConsole(cbReadConsole);
>> start.writeConsole = new dgWriteConsole(cbWriteConsole);
>> start.busy = new dgBusy(cbBusy);
>> start.callback = new dgCallback(cbCallback);
>> start.showMessage = new dgShowMessage(cbShowMessage);
>> start.yesNoCancel = new dgYesNoCancel(cbYesNoCancel);
>>
>> sg_lockDelegates = new GCHandle[7];
>> sg_lockDelegates[0] = GCHandle.Alloc(start.readConsole);
>> sg_lockDelegates[1] = GCHandle.Alloc(start.writeConsole);
>> sg_lockDelegates[2] = GCHandle.Alloc(start.busy);
>> sg_lockDelegates[3] = GCHandle.Alloc(start.callback);
>> sg_lockDelegates[4] = GCHandle.Alloc(start.showMessage);
>> sg_lockDelegates[5] = GCHandle.Alloc(start.yesNoCancel);
>> sg_lockDelegates[6] = GCHandle.Alloc(start);
>>
>> //- Gentleman start your engines !
>> R_SetParams(ref start);
>> R_set_command_line_arguments(0, new string[] { });
>> GA_initapp(0, new string[] { });
>> readconsolecfg();
>> setup_Rmainloop();
>> R_ReplDLLinit();
>> } catch(Exception e)
>> {
>> throw;
>> }
>> }
>> private RWrapper() {}
>>
>> static int UserBreak
>> {
>> get
>> {
>> return Marshal.ReadInt32(sg_rDll_R_UserBreakPtr);
>> }
>> set
>> {
>> Marshal.WriteInt32(sg_rDll_R_UserBreakPtr,value);
>> }
>> }
>>
>> static public string RDllVersion { get { return sg_dllVersion; }
}
>> static public string RHome { get { return sg_RHome; } }
>> static public string RUsersHome { get { return sg_RUsersHome; }
}
>>
>> #region <R Callbacks>
>> static int cbReadConsole(string prompt, IntPtr buf, int len, int
addtohistory)
>> {
>> //- We don't use the console to interact with R. The
function returns 0
>> // to force R exiting any event loop.
>> return 0;
>> }
>>
>> static void cbWriteConsole(string buf, int len)
>> {
>> sg_ConsoleOutput.Append(buf);
>>#if SUPERCONSOLE
>> ConsoleColor c = Console.ForegroundColor;
>> Console.ForegroundColor = ConsoleColor.Green;
>> Console.Write(buf);
>> Console.ForegroundColor = c;
>>#endif
>> }
>>
>> static void cbCallback() { /*NoOp*/ }
>>
>> static void cbBusy(int which)
>> {
>>#if SUPERCONSOLE
>> int top = Console.CursorTop, left = Console.CursorLeft;
>> Console.CursorTop = Console.CursorLeft = 0;
>> Console.Write("Busy : {0}", which);
>> Console.CursorTop = top; Console.CursorLeft = left;
>>#endif
>> }
>>
>> static void cbShowMessage(string msg)
>> {
>> Console.WriteLine("Message : " + msg);
>> }
>>
>> static RYesNoCancel cbYesNoCancel(string msg)
>> {
>> Console.WriteLine("YesNoCancel : " + msg);
>> return RYesNoCancel.Cancel;
>> }
>> #endregion
>>
>> static IntPtr GetCurrentEnv()
>> {
>> IntPtr ret = Marshal.ReadIntPtr(sg_rDll_R_GlobalEnvPtr);
>> return ret;
>> }
>>
>> static bool IsUnbound(IntPtr Sexp)
>> {
>> IntPtr unbound = Marshal.ReadIntPtr(sg_rDll_R_UnboundValue);
>> return Sexp == unbound;
>> }
>>
>> static public void EvaluateNoReturn(string statement)
>> {
>> //- Parse the expresion
>> RParseStatus status;
>> IntPtr lSexpVect = R_ParseVector(Rf_mkString(statement), 1,
out status);
>> if(status!=RParseStatus.PARSE_OK)
>> {
>> throw new Exception("R Parse Error : " +
status.ToString());
>> }
>>
>> Rf_protect(lSexpVect);
>> // lSexpVect is a vector of lSexp. We need to read the
memory directly to get
>> // the lSexp
>> int evalError;
>> IntPtr lSexp = Marshal.ReadIntPtr(lSexpVect, 24);
>> R_tryEval(lSexp, IntPtr.Zero, out evalError);
>> Rf_unprotect(1);
>>
>> if (evalError != 0) throw new Exception("R Eval Error :
" + evalError.ToString());
>> }
>>
>> static public object Evaluate(string statement)
>> {
>> //- Parse the expresion
>> RParseStatus status;
>> IntPtr lSexpVect = R_ParseVector(Rf_mkString(statement), 1,
out status);
>> if (status != RParseStatus.PARSE_OK)
>> {
>> throw new Exception("R Parse Error : " +
status.ToString());
>> }
>>
>> Rf_protect(lSexpVect);
>> // lSexpVect is a vector of lSexp. We need to read the
memory directly to get
>> // the lSexp
>> int evalError;
>> IntPtr lSexp = Marshal.ReadIntPtr(lSexpVect, 24);
>> Rf_protect(lSexp);
>> IntPtr lresult = R_tryEval(lSexp, GetCurrentEnv(), out
evalError);
>> Rf_unprotect(1);
>>
>> if (evalError != 0) throw new Exception("R Eval Error :
" + evalError.ToString());
>>
>> IntPtr bdxResult;
>> object result;
>> evalError = SEXP2BDX(lresult, out bdxResult);
>> evalError = BDX2Variant(bdxResult, out result);
>> bdx_free(bdxResult);
>>
>> return result;
>> }
>>
>> static public object GetSymbol(string name)
>> {
>> IntPtr lsValue = Rf_findVar(Rf_install(name),
GetCurrentEnv());
>> if (IsUnbound(lsValue))
>> {
>> throw new Exception(name + " is an unbound
value");
>> }
>>
>> IntPtr bdxResult;
>> object result;
>> int evalError = SEXP2BDX(lsValue, out bdxResult);
>> evalError = BDX2Variant(bdxResult, out result);
>> bdx_free(bdxResult);
>>
>> return result;
>> }
>>
>> static public void SetSymbol(string name,object value)
>> {
>> IntPtr bdxData, sexpData;
>> int evalError = Variant2BDX(value, out bdxData);
>> evalError = BDX2SEXP(bdxData, out sexpData);
>> bdx_free(bdxData);
>>
>> IntPtr lsSymbol = Rf_install(name);
>> Rf_setVar(lsSymbol, sexpData, GetCurrentEnv());
>> }
>>
>> static public string CollectConsole()
>> {
>> string ret = sg_ConsoleOutput.ToString();
>> sg_ConsoleOutput = new StringBuilder();
>> return ret;
>> }
>>
>> }
>>}
>>
>>
>>------------------------------------------------------------------------
>>
>>______________________________________________
>>R-devel@r-project.org mailing list
>>https://stat.ethz.ch/mailman/listinfo/r-devel
>>
>>
>
>- --
>Duncan Temple Lang duncan@wald.ucdavis.edu
>Department of Statistics work: (530) 752-4782
>4210 Mathematical Sciences Building fax: (530) 752-7099
>One Shields Ave.
>University of California at Davis
>Davis,
>CA 95616,
>USA
>-----BEGIN PGP SIGNATURE-----
>Version: GnuPG v1.4.3 (Darwin)
>
>iD8DBQFFayrE9p/Jzwa2QP4RApdiAJ48r2dkA2p5I6V9Y3vZeh/mQhI+egCdGgZL
>98WT+K9jtfFEL/44P60Y7ro>=4qlw
>-----END PGP SIGNATURE-----
>
>
[[alternative HTML version deleted]]