R/PyObject.R

In PythonInR: Use Python from Within R

## ----------------------------------------------------------------------------- 
##
##   PythonObjects
##
##  
## -----------------------------------------------------------------------------

pyObjectFinalize <- function(self){
    pyExec(pyTry(sprintf("del(%s)", self$.name)))
}

pyTry <- function(x) {
    sprintf('try: %s \nexcept: pass', x)
}

callFun <- '
function(..., autoTypecast=pyOptions("autoTypecast"), simplify=pyOptions("simplify")) {
  x <- list(...)
  i <- if ( !is.null(names(x)) ) (nchar(names(x)) > 0) else rep(FALSE, length(x))
  xargs <- if ( sum(!i) > 0 ) x[!i] else NULL
  xkwargs <- if ( sum(i) > 0 ) x[i] else NULL
  return( pyCall("%s", args=xargs, kwargs=xkwargs, 
          autoTypecast=autoTypecast, simplify=simplify) )
}
'

activeFun <- '
function(value){
    if (missing(value)){
        return(pyGet0("%s.%s"))
    }else{
        pySet("%s", value, "%s")
    } 
}
'

activeFun0 <- '
function(value){
    if (missing(value)){
        return(pyGet0("%s"))
    }else{
        pySet("%s", value)
    } 
}
'

## In Python try except is faster than if.
pyGetName <- function(x){
    pyExecg(sprintf('
try:
    x = %s.__name__
except:
    x = None
', x))[['x']]
}

getTypeInfo <- function(key) {
    x <- pyGet(sprintf("str(type(%s))", key))
    if ( (!is.character(x) | isTRUE(nchar(x) == 0)) ) return(NULL)
    x <- sub("'.*", "", sub(".+?'", "", x))
    return( rev(unlist(strsplit(x, ".", fixed=TRUE))) )
}

##  ---------------------------------------------------------
##  pyObject
##  ========
##' @title Creates a virtual Python object
##'
##' @description The function pyObject creates a virtual Python object 
##'              of type PythonInR_Object.
##' @param key a character string giving the name of the Python object.
##' @param regFinalizer a logical indicating if a finalizer should be
##'                     be registered, the default value is TRUE.
##' @details Every PythonInR_Object has the following members:
##' \itemize{
##'   \item \strong{.name} the variable name used in Python.
##'   \item \strong{.objname} the name of the Python object 
##'         (obtained by \code{x.__name__}) or NULL.
##'   \item \strong{.type} the type of the Python object 
##'         (obtained by \code{type(x).__name__)}.
##'   \item \strong{.del} a function to delete the Python object.
##'   \item \strong{print} for more information see R6 classes.
##'   \item \strong{initialize} for more information see R6 classes.
##' }
##'
##' The other members of PythonInR_Object's are generated dynamically
##' based on the provided Python object. The R function \strong{ls} can be used
##' to view the members of a PythonInR_Object object.
##'
##' @examples
##' \dontshow{PythonInR:::pyCranConnect()}
##' if ( pyIsConnected() ){
##' pyExec("import os")
##' os <- pyObject("os", regFinalizer = FALSE)
##' ls(os)
##' ## To show again the difference between pyGet and pyGet0.
##' os1 <- pyGet0("os") ## has no finalizer
##' os2 <- pyGet("os")  ## has a finalizer
##' os$.name
##' os1$.name
##' os2$.name
##' }
##  ---------------------------------------------------------
pyObject <- function(key, regFinalizer = TRUE) {
    if ( pyConnectionCheck() ) return(invisible(NULL))
    check_string(key)

    objectName <- pyGetName(key)
    type <- pyType(key)

    pyMethods <- list()
    pyActive <- list()
    
    pydir <- pyDir(key)
    for (o in pydir){
        po <- paste(c(key, o), collapse=".")
        if (pyIsCallableFt(po)){
            cfun <- sprintf(callFun, po)
            pyMethods[[o]] <- eval(parse(text=cfun))
        }else{
            afun <- sprintf(activeFun, key, o, o, key)
            pyActive[[o]] <- eval(parse(text=afun))
        }
    }

    ## Choose names with a '.' since a point would violate the python
    ## name convention! This leaves me to take care of initialize and
    ## print where I can't chane the name. Therefore if a object 
    ## has a member with the name print it is renamed to .print
    ## and initialize to .initialize
    for (n in c("print", "initialize")){
        names(pyMethods)[names(pyMethods) == n] <- sprintf(".%s", n)
        names(pyActive)[names(pyActive) == n] <- sprintf(".%s", n)
    }

    pyTypeInfo <- getTypeInfo(key)
    if ( !is.null(pyTypeInfo) ) {
        className <- pyTypeInfo
    } else if ( (!is.null(objectName)) & (!is.null(type)) ){
        className <- sprintf("%s.%s", type, objectName)
    }else if (is.null(objectName)){
        className <- type
    }else if (is.null(type)){ # should never happen since everything should have a type
        className <- objectName
    }else{
        className <- "?"
    }

    if (regFinalizer){
        pyobject <- R6Class(className,
                    portable = TRUE,
                    inherit = PythonInR_Object,
                    public = pyMethods,
                    active = pyActive)
    }else{
        pyobject <- R6Class(className,
                    portable = TRUE,
                    inherit = PythonInR_ObjectNoFinalizer,
                    public = pyMethods,
                    active = pyActive)
    }
    obj <- pyobject$new(key, objectName, type)
    class(obj) <- class(obj)[!duplicated(class(obj))]
    return(obj)
}

## TODO: check the types else try to type cast
pyObjectToR <- function(name) {
    pyGet(name)
}

PythonInR_Object <- R6Class(
    "PythonInR_Object",
    public=list(
        portable=TRUE,
        .name=NA, ## variable name
        .objname="", ## object name
        .type="",
        .del = function() pyObjectFinalize(self),
        toR = function() pyObjectToR(self$.name),
        initialize = function(variableName, objectName, type) {
            if (!missing(variableName)) self$.name <- variableName
            if (!missing(objectName)) self$.objname <- objectName
            if (!missing(type)) self$.type <- type
            reg.finalizer(self, pyObjectFinalize, onexit = TRUE)
        },
        # #print = function(){pyExecp(self$.name)}
        ## This should better handle unicode.
        print = function() pyPrint(self$.name)
        ))

PythonInR_ObjectNoFinalizer <-
    R6Class("PythonInR_Object",
            portable = TRUE,
            inherit = PythonInR_Object,
            public = list(
                initialize = function(variableName, objectName, type) {
                    if (!missing(variableName)) self$.name <- variableName
                    if (!missing(objectName)) self$.objname <- objectName
                    if (!missing(type)) self$.type <- type
                }
            ))

##  ---------------------------------------------------------
##  pyFunction
##  ==========
##' @title creates a virtual Python function
##'
##' @description The function pyFunction creates a new object of type 
##'              pyFunction based on a given key.
##' @param key a string specifying the name of a Python method/function.
##' @param regFinalizer a logical indicating if a finalizer should be
##'                     be registered, the default value is FALSE.    
##' @details The function pyFunction makes it easy to create interfaces 
##'          to Python functions.
##' @examples
##' \dontshow{PythonInR:::pyCranConnect()}
##' if ( pyIsConnected() ){
##' pySum <- pyFunction("sum")
##' pySum(1:3)
##' }
##  ---------------------------------------------------------
pyFunction <- function(key, regFinalizer = FALSE){
    if ( pyConnectionCheck() ) return(invisible(NULL))
    cfun <- sprintf(callFun, key)
    fun <- eval(parse(text=cfun))
    class(fun) <- c("pyFunction", "PythonInR_Object")
    attr(fun, "name") <- key
    if ( regFinalizer ) {
        funenv <- new.env(parent = emptyenv())
        reg.finalizer(funenv, function(x) pyExec(pyTry(sprintf("del(%s)", key))))
    }
    fun
}

is.pyFunction <- function(x) inherits(x, "pyFunction")

print.pyFunction <- function(x, ...) pyExecp(attr(x, "name"))

length.PythonInR_Object <- function(x) {
    pyGet(sprintf("len(%s)", x$.name))
    invisible(NULL)
}

print.PythonInR_Object <- function(x) {
    pyExec(sprintf("print(%s)", x$.name))
    invisible(NULL)
}

as.list.PythonInR_Object <- function(x) {
    pyGet(sprintf("list(%s)", x$.name))
}

##  ---------------------------------------------------------
##  is.PythonInR_Object
##  ===================
##' @rdname pyObject
##' @param x an R object.
##  ---------------------------------------------------------
is.PythonInR_Object <- function(x) inherits(x, "PythonInR_Object")