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 = "[EMAIL PROTECTED]";
>>
>>        /// <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 = "[EMAIL PROTECTED]")]
>>        static extern int Variant2BDX([MarshalAs(UnmanagedType.Struct)]object 
>> var, out IntPtr bdx);
>>        [DllImport("Rproxy.dll", EntryPoint = "[EMAIL PROTECTED]")]
>>        static extern int BDX2Variant(IntPtr 
>> bdx,[MarshalAs(UnmanagedType.Struct)]out object var);
>>        [DllImport("Rproxy.dll", EntryPoint = "[EMAIL PROTECTED]")]
>>        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                    [EMAIL PROTECTED]
>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]]

______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel

Reply via email to