From jonathan.zhou at utoronto.ca  Wed Jul 25 20:26:42 2007
From: jonathan.zhou at utoronto.ca (Jonathan Zhou)
Date: Wed, 25 Jul 2007 11:26:42 -0700 (PDT)
Subject: [Rd] Using R_MakeExternalPtr
In-Reply-To: <46A77D03.5090607@cimr.cam.ac.uk>
References: <11785023.post@talk.nabble.com> <46A77D03.5090607@cimr.cam.ac.uk>
Message-ID: <11790985.post@talk.nabble.com>


Hi Hin-Tak,

Here is the R code function in where I called the two C++ and further below
are the 2 C++ functions I used to create the externalptr and use it :

soam.Rapply <- function (x, func, ...,
                          join.method=cbind,
                          njobs,
                          batch.size=100,
                          packages=NULL,
                          savelist=NULL)
{
   if(missing(njobs))
       njobs <- max(1,ceiling(nrow(x)/batch.size))

   if(!is.matrix(x) && !is.data.frame(x))
       stop("x must be a matrix or data frame")

   if(njobs>1)
       {rowSet <- lapply(splitIndices(nrow(x), njobs), function(i) x[i, ,
drop = FALSE])} else {rowSet <- list(x)}

   sesCon <- .Call("soamInit")

   script <- " "

   fname <- tempfile(pattern = "Rsoam_data", tmpdir = getwd())
   file(fname, open="w+")
   if(!is.null(savelist)) {
       dump(savelist, fname)
       script<-readLines(fname)
   }

   if(!is.null(packages))
   for(counter in 1:length(packages))
   {
       temp<-call("library", packages[counter], character.only=TRUE)
       dput(temp, fname)
       pack.call<-readLines(fname)
       script<-append(script, pack.call)
   }

   for(counter in 1:njobs)
   {
       caller <- paste("caller", counter, sep = "")
       soam.call<-call("dput", call("apply", X=rowSet[[counter]], MARGIN=1,
FUN=func), caller)
       dput(soam.call, fname)
       soam.call<-readLines(fname)

       temp<-append(script, soam.call)
       final.script = temp[1]
       for(count in 2:length(temp)){
           final.script<-paste(final.script, temp[count], "\n")}

       .Call("soamSubmit", counter, sesCon, final.script, packages)
   }

   .Call("soamGetResults", sesCon, njobs, join.method, parent.frame())

   for(job in 1:njobs)
   {
       caller <- paste("result", job, sep = "")
       temp = dget(caller)
       if(job==1) {retval=temp} else {retval=join.method(retval,temp)}
   }

   .Call("soamUninit")

   retval
}

*** Here are the 2 C++ functions:

extern "C"
{
SEXP soamInit ()
{
   // Initialize the API
   SoamFactory::initialize();

   // Set up application specific information to be supplied to Symphony
   char appName[] = "SampleAppCPP";

   // Set up application authentication information using the default
security provider
   DefaultSecurityCallback securityCB("Guest", "Guest");

   // Connect to the specified application
   ConnectionPtr conPtr = SoamFactory::connect(appName, &securityCB);

   // Set up session creation attributes
   SessionCreationAttributes attributes;
   attributes.setSessionName("mySession");
   attributes.setSessionType("ShortRunningTasks");
   attributes.setSessionFlags(SF_RECEIVE_SYNC);

   // Create a synchronous session
   Session* sesPtr = conPtr->createSession(attributes);

   SEXP out = R_MakeExternalPtr((void*)temp, R_NilValue, R_NilValue);

   return out;
}
}

extern "C"
{
 void soamSubmit       (SEXP jobID,            //job ID
                        SEXP sesCon,           //session pointer
                        SEXP caller,                   //objects
                        SEXP pack)                     //packages
{
       char* savelist = CHAR(STRING_ELT(caller, 0));
       string strTemp = "";
       int job = INTEGER(jobID)[0];

       void* temp = R_ExternalPtrAddr(sesCon);
       Session* sesPtr = reinterpret_cast<Session*>(temp);

   // Create a message
       MyMessage inMsg(job, /*pack,*/ savelist);

   // Send it
   TaskInputHandlePtr input = sesPtr->sendTaskInput(&inMsg);
}
}
-- 
View this message in context: http://www.nabble.com/Using-R_MakeExternalPtr-tf4142904.html#a11790985
Sent from the R devel mailing list archive at Nabble.com.



[Rd] Using R_MakeExternalPtr
Jonathan Zhou