[Rd] Using R_MakeExternalPtr

Jonathan Zhou jonathan.zhou at utoronto.ca
Wed Jul 25 18:53:36 CEST 2007


Hi all, 

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#a11786494
Sent from the R devel mailing list archive at Nabble.com.



More information about the R-devel mailing list